New command 'describe-library'

* lisp/emacs-lisp/find-func.el
(find-library-include-other-files): Deprecate.
* lisp/emacs-lisp/find-func.el
(read-library-name-narrow-completions-by-keyword)
(find-func--finder-keyword-affixation)
(read-library-name-affixation): New functions.
(read-library-name): Add completions narrowing, annotations, and
a new argument PROMPT.
(display-library, find-library, find-library-other-window)
(find-library-other-frame)
* lisp/files.el (load-library)
* lisp/subr.el (locate-library): Use new PROMPT argument.
* lisp/help-mode.el (help-library-def): New button type.
* lisp/help-fns.el (describe-library): New command.
* lisp/help.el (help-map): Bind it to 'C-h C-l'.

diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index ffcd3196259c7df08c472e722933758078389aa0..c3a468950699110fa3859d312b8a6802695e0c55 100644 (file)
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -183,16 +183,14 @@ See the functions `find-function' and `find-variable'."
   :group 'find-function
   :version "20.3")
 
-(defcustom find-library-include-other-files t
-  "If non-nil, `read-library-name' will also include non-library files.
-This affects commands like `read-library'.
-
-If nil, only library files (i.e., \".el\" files) will be offered
-for completion."
+(defcustom find-library-include-other-files nil
+  "This variable is obsolete and has no effect."
   :type 'boolean
-  :version "29.1"
+  :version "30.1"
   :group 'find-function)
 
+(make-obsolete-variable 'find-library-include-other-files nil "30.1")
+
 ;;; Functions:
 
 (defun find-library-suffixes ()
@@ -317,7 +315,7 @@ This function searches `find-library-source-path' if non-nil, and
 
 See the `find-library-include-other-files' user option for
 customizing the candidate completions."
-  (interactive (list (read-library-name)))
+  (interactive (list (read-library-name "Display library")))
   (display-buffer (find-file-noselect (find-library-name library))))
 
 ;;;###autoload
@@ -331,47 +329,105 @@ This function searches `find-library-source-path' if non-nil, and
 
 See the `find-library-include-other-files' user option for
 customizing the candidate completions."
-  (interactive (list (read-library-name)))
+  (interactive (list (read-library-name "Find library")))
   (prog1
       (switch-to-buffer (find-file-noselect (find-library-name library)))
     (run-hooks 'find-function-after-hook)))
 
 (put 'find-library 'minibuffer-action '(display-library . "find"))
 
+(defvar finder-known-keywords)
+(declare-function finder-unknown-keywords "finder" ())
+(declare-function lm-keywords "lisp-mnt" (&optional library))
+(declare-function lm-summary "lisp-mnt" (&optional library))
+
+(defun find-func--finder-keyword-affixation (keywords)
+  "Add annotations to list of keyword completion candidates KEYWORDS."
+  (require 'finder)                     ; `finder-known-keywords'
+  (let ((max (seq-max (cons 0 (mapcar #'string-width keywords)))))
+    (mapcar (lambda (keyword)
+              (list keyword
+                    ""
+                    (concat
+                     (make-string (1+ (- max (string-width keyword))) ?\s)
+                     (propertize
+                      (alist-get (intern keyword) finder-known-keywords "")
+                      'face 'completions-annotations))))
+            keywords)))
+
+(defun read-library-name-narrow-completions-by-keyword ()
+  "Restrict library completions list to libraries with a given keyword."
+  (require 'finder)                     ; `finder-(un)known-keywords'
+  (require 'lisp-mnt)                   ; `lm-keywords'
+  (let* ((keyword (completing-read
+                   "Keep libraries with keyword: "
+                   (completion-table-with-metadata
+                    (mapcar (compose #'symbol-name #'car)
+                            (append finder-known-keywords
+                                    (finder-unknown-keywords)))
+                    `((category . finder-keyword)
+                      ,@(when completions-detailed
+                          `((affixation-function
+                             . find-func--finder-keyword-affixation))))))))
+    (cons (lambda (cand &rest _)
+            (let* ((string (cond
+                            ((stringp cand)              cand)
+                            ((symbolp cand) (symbol-name cand))
+                            (t              (car         cand))))
+                   (sym (intern string)))
+              (string-match (concat "\\<" keyword "\\>")
+                            (or (get sym 'library-keywords)
+                                (let ((kws (or (lm-keywords (find-library-name string)) "")))
+                                  (put sym 'library-keywords kws)
+                                  kws)))))
+          (concat "keyword=" keyword))))
+
+(defun read-library-name-affixation (libraries)
+  "Add annotations to list of library completion candidates LIBRARIES."
+  (require 'lisp-mnt)                   ; `lm-summary'
+  (let ((max (seq-max (cons 0 (mapcar #'string-width libraries)))))
+    (mapcar (lambda (library)
+              (list library
+                    ""
+                    (concat
+                     (make-string (1+ (- max (string-width library))) ?\s)
+                     (let ((sym (intern library)))
+                       (propertize
+                        (or (get sym 'library-summary)
+                            (let ((sum (or
+                                        (lm-summary (find-library-name library))
+                                        "[No summary available]")))
+                              (put sym 'library-summary sum)
+                              sum))
+                        'face 'completions-annotations)))))
+            libraries)))
+
 ;;;###autoload
-(defun read-library-name ()
+(defun read-library-name (&optional prompt)
   "Read and return a library name, defaulting to the one near point.
 
 A library name is the filename of an Emacs Lisp library located
 in a directory under `load-path' (or `find-library-source-path',
-if non-nil)."
-  (let* ((dirs (or find-library-source-path load-path))
-         (suffixes (find-library-suffixes))
-         (def (if (eq (function-called-at-point) 'require)
-                  ;; `function-called-at-point' may return 'require
-                  ;; with `point' anywhere on this line.  So wrap the
-                  ;; `save-excursion' below in a `condition-case' to
-                  ;; avoid reporting a scan-error here.
-                  (condition-case nil
-                      (save-excursion
-                        (backward-up-list)
-                        (forward-char)
-                        (forward-sexp 2)
-                        (thing-at-point 'symbol))
-                    (error nil))
-                (thing-at-point 'symbol))))
-    (if find-library-include-other-files
-        (let ((table (apply-partially #'locate-file-completion-table
-                                      dirs suffixes)))
-          (when (and def (not (test-completion def table)))
-            (setq def nil))
-          (completing-read (format-prompt "Library name" def)
-                           table nil nil nil nil def))
-      (let ((files (read-library-name--find-files dirs suffixes)))
-        (when (and def (not (member def files)))
-          (setq def nil))
-        (completing-read (format-prompt "Library name" def)
-                         files nil t nil nil def)))))
+if non-nil).
+
+Optional argument PROMPT is the minibuffer prompt to use, when nil or
+omitted it defaults to \"Library name\"."
+  (let* ((prompt (or prompt "Library name"))
+         (files (read-library-name--find-files
+                 (or find-library-source-path load-path)
+                 (find-library-suffixes)))
+         (def (thing-at-point 'symbol))
+         (def (and (member def files) def)))
+    (completing-read (format-prompt prompt def)
+                     (completion-table-with-metadata
+                      files
+                      `((category . library)
+                        (narrow-completions-function
+                         . read-library-name-narrow-completions-by-keyword)
+                        ,@(when completions-detailed
+                            '((affixation-function
+                               . read-library-name-affixation)))))
+                     nil t nil nil def)))
 
 (defun read-library-name--find-files (dirs suffixes)
   "Return a list of all files in DIRS that match SUFFIXES."
@@ -388,7 +444,7 @@ if non-nil)."
   "Find the Emacs Lisp source of LIBRARY in another window.
 
 See `find-library' for more details."
-  (interactive (list (read-library-name)))
+  (interactive (list (read-library-name "Find library")))
   (prog1
       (switch-to-buffer-other-window (find-file-noselect
                                       (find-library-name library)))
@@ -401,7 +457,7 @@ See `find-library' for more details."
   "Find the Emacs Lisp source of LIBRARY in another frame.
 
 See `find-library' for more details."
-  (interactive (list (read-library-name)))
+  (interactive (list (read-library-name "Find library")))
   (prog1
       (switch-to-buffer-other-frame (find-file-noselect
                                      (find-library-name library)))

diff --git a/lisp/files.el b/lisp/files.el
index fc26655701bb9a69880cd08f308639c4ada3b1a5..54b1f04ce6a1aeb8e9b2f4f636956e8c58ce5234 100644 (file)
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1262,7 +1262,7 @@ well as `load-file-rep-suffixes').
 
 See Info node `(emacs)Lisp Libraries' for more details.
 See `load-file' for a different interface to `load'."
-  (interactive (list (read-library-name)))
+  (interactive (list (read-library-name "Load library")))
   (load library))
 
 (put 'load-library 'minibuffer-action "load")

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 18cc2fccbad07fbf311959ddd97ed531a9b2456f..bd27e7b3623e0adc997dcba16e661a2356aa7d7f 100644 (file)
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -2559,6 +2559,41 @@ to find out more details about the symbols."
       (puthash function name help-fns--function-names)
       name))))
 
+(declare-function find-library-name "find-func" (library))
+(declare-function lm-summary "lisp-mnt" (&optional file))
+(declare-function lm-keywords "lisp-mnt" (&optional file))
+(declare-function lm-commentary "lisp-mnt" (&optional file))
+
+;;;###autoload
+(defun describe-library (library)
+  "Display information about LIBRARY in a help buffer."
+  (interactive (list (read-library-name "Describe library")))
+  (require 'find-func)
+  (require 'lisp-mnt)
+  (let* ((file (find-library-name library))
+         (name (file-name-nondirectory file))
+         (help-buffer-under-preparation t))
+    (help-setup-xref (list #'describe-library library)
+                     (called-interactively-p 'interactive))
+    (with-help-window (help-buffer)
+      (with-current-buffer standard-output
+        (insert name
+                " --- " (substitute-quotes (or (lm-summary file)
+                                               "[No summary available]"))
+                (if-let (keywords (lm-keywords file))
+                    (concat "\n\nKeywords: ["
+                            (replace-regexp-in-string ",? " "] [" keywords)
+                            "]")
+                  "")
+                "\n\n"
+                (substitute-quotes (or (lm-commentary file)
+                                       "[No description available]")))
+        (make-text-button (point-min) (+ (length name) (point-min))
+                          'type 'help-library-def 'help-args (list file))
+        (setq help-mode--current-data (list :file file))))))
+
+(put 'describe-library 'minibuffer-action "describe")
+
 (provide 'help-fns)
 
 ;;; help-fns.el ends here

diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index e16408be7b0eb3e0625988221316e6ce21cec8dc..46004b41c2aa47db791cdd82c59ea69d1fb6b67b 100644 (file)
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -396,6 +396,11 @@ The format is (FUNCTION ARGS...).")
     (goto-char pos))
   'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement"))
 
+(define-button-type 'help-library-def
+  :supertype 'help-xref
+  'help-function #'find-file
+  'help-echo (purecopy "mouse-2, RET: visit library file"))
+
 ;;;###autoload
 (defun help-mode--add-function-link (str fun)
   (make-text-button (copy-sequence str) nil

diff --git a/lisp/help.el b/lisp/help.el
index f5213bdfa9acf77f5b5b706d5a2b8efb3c661ae0..5bed130477b525bfa91a0e28678b552208eb7dc5 100644 (file)
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -80,6 +80,7 @@ buffer.")
   "C-s"  #'search-forward-help-for-help
   "C-t"  #'view-emacs-todo
   "C-w"  #'describe-no-warranty
+  "C-l"  #'describe-library
 
   ;; This does not fit the pattern, but it is natural given the C-\ command.
   "C-\\" #'describe-input-method

diff --git a/lisp/subr.el b/lisp/subr.el
index 12e3f605afb0ddcd080a7c2304e460dab44c57d4..8dfcacb61454503fc34f0f66c533c6e20df10db1 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3140,7 +3140,7 @@ is used instead of `load-path'.
 When called from a program, the file name is normally returned as a
 string.  When run interactively, the argument INTERACTIVE-CALL is t,
 and the file name is displayed in the echo area."
-  (interactive (list (read-library-name) nil nil t))
+  (interactive (list (read-library-name "Locate library") nil nil t))
   (let ((file (locate-file library
                           (or path load-path)
                           (append (unless nosuffix (get-load-suffixes))