emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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


From: MON KEY
Subject: Re: locate-library, the NOSUFFIX arg and a [PATCH]
Date: Thu, 28 Jan 2010 21:55:28 -0500

On Wed, Jan 27, 2010 at 9:46 PM, Stefan Monnier
<address@hidden> wrote:
>
>>> Depending on this question, we may be able to determine things like
>>> whether you'd like (your-locate-library "foo.el" t) to return "/bar/foo"
>>> or "/bar/foo.el".
>> Exactly.
>
> Now that was helpful.  I'm just wasting my time here.
>

Indeed, it appears you are wasting time.

Your question contained the answer(s) I have already given.
These are the determinations sought. What else would you have me reply???

I've gone out of my way to identify the perceived problem, along with my
expectations, as I understand them.

I've included two patches (now three) to transparently identify with unambiguous
Elisp both the perceived problem and a perceived solution. I've indicated
multiple times that the proposed solution needn't be breaking.

I'm including some elisp source which:

a) A function which does to not alter the semantics of NOSUFFIX and uses an
   external functional call to tdo the work.

b) A revised version of the previously proposed patch that does alter the
   semantics of NOSUFFIX. This newest revision fixes a bug where the return
   value of the altered NOSUFFIX semantic was orthogonal to the existing
   unmodified locate-library. With this bug fixed the revised version should be
   transparent to the user.

I've written adequate documentation for b) which clarifies the existing
behavior of locate-library and illustrates the proposed semantics of the
proposed patch.

I won't bother wasting your time your with those details unless you should find
them useful. Let me know and I'll forward them along.

Following is the elisp. Knock yourself out...

;;; ==============================
;;; :UNMODIFIED `locate-library'. Evaluate me later to get back to Kansas.
(defun locate-library (library &optional nosuffix path interactive-call)
  (interactive (list (completing-read "Locate library: "
                                      (apply-partially
                                       'locate-file-completion-table
                                       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))))
    (if interactive-call
        (if file
            (message "Library is file %s" (abbreviate-file-name file))
          (message "No library %s in search path" library)))
    file))

;;; ==============================
;;; :MODIFIED `locate-library'.
;;; NOSUFFIX with alternative semantics and new arg SHOW-COMPRESSED.
;;; Revised version of previous patch(s).
;;; <Timestamp: #{2010-01-28T21:45:20-05:00Z}#{10044} - by MON>
(defun locate-library (library &optional nosuffix path
interactive-call show-compressed)
  (interactive (list (completing-read "Locate library: "
                                      (apply-partially
                                       'locate-file-completion-table
                                       load-path (get-load-suffixes)))
                     nil nil
                     t (if current-prefix-arg t)))
  (let* ((lfrs (remove "" load-file-rep-suffixes))
         (gls (sort (get-load-suffixes) #'(lambda (l1 l2) (< (length
l1) (length l2)))))
         (sfx  (cond ((booleanp nosuffix)
                      (delete-dups (append gls lfrs)))
                     ((and nosuffix (stringp nosuffix))
                      `(,nosuffix
                        ,@(mapcar #'(lambda (z)
                                      (concat nosuffix z))
                                  lfrs)))
                     ((consp nosuffix) (delete-dups (append nosuffix lfrs)))
                     (t (append gls lfrs))))
         (cln-lib (if (string= (file-name-sans-extension library) library)
                      library
                      (let ((lib-cln library))
                        (mapc #'(lambda (rgx)
                                  (let ((ms (string-match-p rgx lib-cln)))
                                    (when ms (setq lib-cln (substring
lib-cln 0 ms)))))
                              '("\\(\\(\\.elc\\|\\.el\\)\\.gz\\)" ; ->
1 .el[c].gz
                                "\\(\\.elc\\|\\.el\\)"            ; ->
1 .elc | .el
                                "\\(\\.gz\\)"))                   ; -> 1 .gz
                        lib-cln)))
         (file (locate-file cln-lib (or path load-path) sfx)))
    (when (and file (or nosuffix (and show-compressed (not nosuffix))))
      (setq file (file-truename file))
      (let ((smp-gz ;;(string-match-p ".*.gz" file)))
             (string-match-p ".*\\.gz" file)))
        (setq file (concat (file-name-directory file)
                           (cond ((or (not show-compressed)
                                      (and show-compressed (not smp-gz)))
                                  (file-name-sans-extension
                                   (file-name-nondirectory
                                    (file-name-sans-extension file))))
                                 ((or (and show-compressed smp-gz) t)
                                  (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)))
    file))

;;; ==============================
;;; :MODIFIED `locate-library'. Semantics of NOSUFFIX untouched.
;;; Additional arg STRIPSUFFIX when non-nil evaluates `locate-library-rmv-sfx'
;;; <Timestamp: #{2010-01-28T21:45:33-05:00Z}#{10044} - by MON>
(defun locate-library (library &optional nosuffix path
interactive-call stripsuffix)
  (interactive (list (completing-read "Locate library: "
                                      (apply-partially
                                       'locate-file-completion-table
                                       load-path (get-load-suffixes)))
                     nil nil
                     t))
  (let ((file
         (if (and (not nosuffix) stripsuffix)
             (locate-library-rmv-sfx library path stripsuffix)
             (locate-file library
                          (or path load-path)
                          (append (unless nosuffix (get-load-suffixes))
                                  load-file-rep-suffixes)))))
    (if interactive-call
        (if file
            (message "Library is file %s" (abbreviate-file-name file))
            (message "No library %s in search path" library)))
    file))
;;;
;;; Assume the following files are present in "/home/MON/loc-libr":
;;; "subr" "subr.bubba" "subr.bubba.gz" "subr.el" "subr.el.gz"
"subr.elc.gz" "subr.el~"
;;;
;;; :TEST-ME (locate-library "subr.el" nil '("/home/MON/loc-libr") nil
 '((".bubba" ".el" ".el.gz") . t))
;;;          => "/home/MON/loc-libr/subr.el.gz"
;;;
;;; :TEST-ME (locate-library "subr.el" nil '("/home/MON/loc-libr") nil
 '((".bubba" ".el" ".el.gz") . nil))
;;;           => "/home/MON/loc-libr/subr"
;;;
;;; :TEST-ME (locate-library "subr.el" t)
;;;          => "/home/MON/loc-libr/subr"
;;;

;;; ==============================
;;; :NOTE For backwards compat we strip the extension in the `cln-lib' var.
;;;       Not using `file-name-extension'/`file-name-extension' b/c:
;;;       (file-name-extension "subr.elc.gz") => "gz"
;;;       (file-name-sans-extension "subr.elc.gz") => "subr.elc"
;;;
;;; <Timestamp: #{2010-01-28T19:31:03-05:00Z}#{10044} - by MON>
(defun locate-library-rmv-sfx (library locpath rmvsfx-shw-gz)
  "LIBRARY is a string naming the library to locate.
LOCPATH is a list of paths in which to locate LIBRARY
RMVSFX-SHW-GZ is a dotted list with the form:\n
 '\(\(\".el\" \".el.gz\" \".bubba\"\) . t\)\"
The first element is a list of suffix names which LIBRARY might have.
When present the second element is a boolean, t or nil. If t when LIBRARY is
found in PATH with a suffix matching the first element of RMVSFX-SHW-GZ and that
element represents a compressed file extension show the file name with the
extension."
  (let* ((gls (sort (get-load-suffixes) #'(lambda (l1 l2) (< (length
l1) (length l2)))))
         (lfrs   (remove "" load-file-rep-suffixes))
         (cln-lib (if (string= (file-name-sans-extension library) library)
                      library
                      (let ((lib-cln library))
                        (mapc #'(lambda (rgx)
                                  (let ((ms (string-match-p rgx lib-cln)))
                                    (when ms (setq lib-cln (substring
lib-cln 0 ms)))))
                              '("\\(\\(\\.elc\\|\\.el\\)\\.gz\\)" ; ->
1 .el[c].gz
                                "\\(\\.elc\\|\\.el\\)" ; -> 1 .elc | .el
                                "\\(\\.gz\\)"))        ; -> 1 .gz
                        lib-cln)))
         ;; :NOTE arg
         (shw-gz  (cdr rmvsfx-shw-gz))  ; => t
         (rmvsfx (car rmvsfx-shw-gz))   ; => (".el" ".el.gz" ".bubba")
         (sfx  (cond ((booleanp rmvsfx) (delete-dups (append gls lfrs)))
                     ((and rmvsfx (stringp rmvsfx))
                      `(,rmvsfx ,@(mapcar #'(lambda (z) (concat rmvsfx
z)) lfrs)))
                     ((consp rmvsfx) (delete-dups (append rmvsfx lfrs)))
                     ;; (t (append  gls lfrs)))) ;; <-should not happen.
                     ))
         (file (locate-file cln-lib locpath sfx 'exists)))
    (when file
      (setq file (file-truename file))
      (let ((smp-gz (string-match-p ".*\\.gz" file)))
        (setq file (concat (file-name-directory file)
                           (cond ((or (not shw-gz) (and shw-gz (not smp-gz)))
                                  ;; Call it twice to knock the .gz
off the .el.gz
                                  (file-name-sans-extension
                                   (file-name-nondirectory
                                    (file-name-sans-extension file))))
                                 ((or (and shw-gz smp-gz) t)
                                  (file-name-nondirectory file)))))))
    file))
;;
;;;
;;; :TEST-ME (locate-library-rmv-sfx "subr.el" '("/home/MON/loc-libr")
'((".bubba" ".el" ".el.gz") . t))
;;;          => "/home/MON/loc-libr/subr"
;;; :TEST-ME (locate-library-rmv-sfx "subr.el" '("/home/MON/loc-libr")
'((".bubba" ".el" ".el.gz")))
;;;          => "/home/MON/loc-libr/subr"
;;; :TEST-ME (locate-library-rmv-sfx "subr" '("/home/MON/loc-libr")
'((".el.gz" ".bubba"  ".el") . t))
;;;          =>"/home/MON/loc-libr/subr.el.gz"
;;; :TEST-ME (locate-library-rmv-sfx "subr.el" '("/home/MON/loc-libr")
'((".el.gz" ".bubba"  ".el") . nil))
;;;          => "/home/MON/loc-libr/subr"
;;; :TEST-ME (locate-library-rmv-sfx "subr.el.gz"
'("/home/MON/loc-libr") '((".el.gz" ".bubba"  ".el") . nil))
;;;          => "/home/MON/loc-libr/subr"
;;; :TEST-ME (locate-library-rmv-sfx "subr.el.gz"
'("/home/MON/loc-libr") '((".el.gz" ".bubba"  ".el") . t))
;;;           => "/home/MON/loc-libr/subr.el.gz"
;;; :TEST-ME (locate-library-rmv-sfx "subr.el.gz"
'("/home/MON/loc-libr") '((".el.gz" ".bubba"  ".el") . t))
;;;
;;; :TEST-ME (locate-library-rmv-sfx "subr.el.gz"
'("/home/MON/loc-libr" "/usr/share/emacs/23.1.90/lisp")
;;;                        '((".el.gz" ".bubba"  ".el") . t))
;;;            => "/home/MON/loc-libr/subr.el.gz"
;;;
;;; :TEST-ME (locate-library-rmv-sfx "subr.el.gz"
'("/usr/share/emacs/23.1.90/lisp" "/home/MON/loc-libr" )
;;;                    '((".el.gz" ".bubba"  ".el") . t))
;;;           => "/usr/share/emacs/23.1.90/lisp/subr.el.gz"
;;;
;;; :TEST-ME (locate-library-rmv-sfx "subr"
'("/usr/share/emacs/23.1.90/lisp""/home/MON/loc-libr")
;;;                    '((".el.gz" ".bubba"  ".el") . t))
;;;          => "/usr/share/emacs/23.1.90/lisp/subr.el.gz"
;;;
;;; :TEST-ME (locate-library-rmv-sfx "subr"
'("/usr/share/emacs/23.1.90/lisp" "/home/MON/loc-libr")
;;;                    '((".el.gz" ".bubba"  ".el")))
;;;          => "/usr/share/emacs/23.1.90/lisp/subr"
;;;
;;; :TEST-ME
;;; :NOTE :SEE `ffap-locate-file' for more on  why this is a relevant use-case.
;;; (let ((find-vaguely
;;;        (locate-library-rmv-sfx
;;;         "subr"
;;;         '( "/home/MON/loc-libr" "/usr/share/emacs/23.1.90/lisp")
;;;         '(( ".bubba" ".el.gz" ".el") .t))))
;;;   (if (file-exists-p find-vaguely)
;;;       (find-file find-vaguely)
;;;       (completing-read "Which file :"
;;;                        (file-expand-wildcards (concat find-vaguely "*")))))
;;;
;;; ==============================

Attachment: locate-library-redux
Description: Binary data


reply via email to

[Prev in Thread] Current Thread [Next in Thread]