locate-library, the NOSUFFIX arg and a [PATCH]

[MON KEY]

`locate-libary' is either broken, doesn't work as documented, or both.

(documentation 'locate-library)

,----
| It can omit the suffix (a.k.a. file-name extension) if NOSUFFIX is
| nil (which is the default, see below).
`----

,----
| Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes'
| to the specified name LIBRARY.
`----

Aren't these two statements mutually exclusive?

I don't think the docstring even reflects the intent of locate-library's
NOSUFFIX arg esp. as it doesn't appear to be _able_ to return a library name
sans extension when not called-interactively.

FWICG there is a problem occuring with the return value of
`load-file-rep-suffixes', which returns an empty string "" as the first elt of
its return value (unless bound otherwise).

This appears to be happening at the variables primitive definition per lread.c's
`Fcons'ing of `empty_unibyte_string'. Which among other things may be causing
problems like this:

(locate-file-completion-table load-path '("") "subr" #'(lambda (y)
(string-match-p ".*z" y)) 'nil)
=> "subr.el.gz"

Which, as it relates to locate-library, causes wonkiness with the local variable
`file'.  Following shows this with NOSUFFIX both t and nil:

(let (nosuffix)
  (append (unless nosuffix (get-load-suffixes))
          load-file-rep-suffixes))
=> (".elc" ".elc.gz" ".el" ".el.gz" "" ".gz")

(let ((nosuffix t))
  (append (unless nosuffix (get-load-suffixes))
          load-file-rep-suffixes))
=> ("" ".gz")

IOW, even if where the empty string problem is corrected, if my reading is
correct `locate-library' still won't perform according to the docstring as
written.

The attached patch corrects the problem without mucking with
`load-file-rep-suffixes' and changes the semanics of nosuffix to mean:

"When called from a program and NOSUFFIX is a boolean, string, or list of
strings, return LIBRARY's file-truename as if by `file-name-sans-extension'."

Following are examples of the behavior provided by the patch:

(locate-library "subr")
=> "/usr/share/emacs/23.1.90/lisp/subr.elc"

(locate-library "subr" ".elc")
=> "/usr/share/emacs/23.1.90/lisp/subr"

(locate-library "subr" ".el")
=> "/usr/share/emacs/23.1.90/lisp/subr"

(locate-library "subr.el" ".gz")
=> "/usr/share/emacs/23.1.90/lisp/subr"

(locate-library "subr" ".el.gz")
=> "/usr/share/emacs/23.1.90/lisp/subr"

(locate-library "subr" ".gz")
=> nil

(locate-library "subr" t)
=> "/usr/share/emacs/23.1.90/lisp/subr"

(apply 'locate-library "subr" '(nil nil t))
=> "/usr/share/emacs/23.1.90/lisp/subr.elc"

(apply 'locate-library "subr" '(".el.gz" nil t))
=> "/usr/share/emacs/23.1.90/lisp/subr"

(apply 'locate-library "subr" '(".elc" nil t))
=> "/usr/share/emacs/23.1.90/lisp/subr"

(let (with-symbolic)
  (shell-command (concat "ln -s "
                         (locate-file "subr.el.gz" load-path)
                         " ~/subr.el.gz"))
  (prog1
      (setq with-symbolic
            (list (locate-library "subr" t '("~/"))
                  (locate-library "subr" ".el" '("~/"))
                  (locate-library "subr" '(".el" ".el.gz" ".elc"
".bubba") '("~/"))
                  (locate-library "subr" nil '("~/"))
                  (locate-library "subr" ".elc" '("~/")) ;<- return nil
                  (apply 'locate-library "subr" '(".el" nil t))
                  (apply 'locate-library "subr" '(".el" nil t))
                  ;; follwing returns nil a PATH can't override intractive's
                  ;; load-path arg to `locate-file-completion-table'
                  (apply 'locate-library "subr" '(t '("~/") t))))
    (shell-command "rm -f ~/subr.el.gz")))

=> ("/usr/share/emacs/23.1.90/lisp/subr"
    "/usr/share/emacs/23.1.90/lisp/subr"
    "/usr/share/emacs/23.1.90/lisp/subr"
    "/home/MON/subr.el.gz"
    nil
    "/usr/share/emacs/23.1.90/lisp/subr"
    "/usr/share/emacs/23.1.90/lisp/subr"
    nil)

;;; ==============================
--- subr.el~99304~      2010-01-19 15:34:00.000000000 -0500
+++ subr.el     2010-01-19 17:05:24.000000000 -0500
@@ -1586,16 +1586,34 @@
                                        load-path (get-load-suffixes)))
                     nil nil
                     t))
-  (let ((file (locate-file library
-                          (or path load-path)
-                          (append (unless nosuffix (get-load-suffixes))
-                                  load-file-rep-suffixes))))
+  (let* ((lfrs (remove "" load-file-rep-suffixes))
+         (sfx  (cond ((booleanp nosuffix)
+                      (delete-dups (append lfrs (get-load-suffixes))))
+                     ((and nosuffix (stringp nosuffix))
+                      `(,nosuffix
+                        ,@(mapcar #'(lambda (z)
+                                      (concat nosuffix z))
+                                  lfrs)))
+                     ((consp nosuffix)
+                      (delete-dups (append nosuffix lfrs)))
+                     (t (append lfrs(get-load-suffixes)))))
+         (file (locate-file library
+                            (or path load-path)
+                            sfx)))
+    (when (and file nosuffix)
+      (setq file (file-truename file))
+      (setq file (concat (file-name-directory file)
+                         (if (string-match-p ".*.gz" file)
+                             (file-name-sans-extension
+                              (file-name-nondirectory
+                               (file-name-sans-extension file)))
+                             (file-name-sans-extension
+                              (file-name-nondirectory file))))))
     (if interactive-call
-       (if file
-           (message "Library is file %s" (abbreviate-file-name file))
-         (message "No library %s in search path" library)))
+        (if file
+            (message "Library is file %s" (abbreviate-file-name file))
+            (message "No library %s in search path" library)))
     file))
-
 
 ;;;; Specifying things to do later.

;;; ==============================

subr.el.diff
Description: Binary data