From 8e96f8cff4d779f74f42e89eecc5330fb77c030e Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 7 Jun 2024 11:45:19 +0200 Subject: [PATCH] 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'. --- lisp/emacs-lisp/find-func.el | 136 ++++++++++++++++++++++++----------- lisp/files.el | 2 +- lisp/help-fns.el | 35 +++++++++ lisp/help-mode.el | 5 ++ lisp/help.el | 1 + lisp/subr.el | 2 +- 6 files changed, 139 insertions(+), 42 deletions(-) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index ffcd3196259..c3a46895069 100644 --- 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 fc26655701b..54b1f04ce6a 100644 --- 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 18cc2fccbad..bd27e7b3623 100644 --- 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 e16408be7b0..46004b41c2a 100644 --- 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 f5213bdfa9a..5bed130477b 100644 --- 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 12e3f605afb..8dfcacb6145 100644 --- 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)) -- 2.39.5