diff options
Diffstat (limited to 'lisp/emacs-lisp/shortdoc.el')
| -rw-r--r-- | lisp/emacs-lisp/shortdoc.el | 470 |
1 files changed, 365 insertions, 105 deletions
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 99035c9e892..ed4e205d204 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1,6 +1,6 @@ ;;; shortdoc.el --- Short function summaries -*- lexical-binding: t -*- -;; Copyright (C) 2020-2022 Free Software Foundation, Inc. +;; Copyright (C) 2020-2023 Free Software Foundation, Inc. ;; Keywords: lisp, help ;; Package: emacs @@ -22,6 +22,15 @@ ;;; Commentary: +;; This package lists functions based on various groupings. +;; +;; For instance, `string-trim' and `mapconcat' are `string' functions, +;; so `M-x shortdoc RET string RET' will give an overview of functions +;; that operate on strings. +;; +;; The documentation groups are created with the +;; `define-short-documentation-group' macro. + ;;; Code: (require 'seq) @@ -41,40 +50,78 @@ '((t :inherit variable-pitch)) "Face used for a section.") -(defvar shortdoc--groups nil) +;;;###autoload +(progn + (defvar shortdoc--groups nil) -(defmacro define-short-documentation-group (group &rest functions) - "Add GROUP to the list of defined documentation groups. + (defmacro define-short-documentation-group (group &rest functions) + "Add GROUP to the list of defined documentation groups. FUNCTIONS is a list of elements on the form: - (fun + (FUNC :no-manual BOOL :args ARGS - :eval EXAMPLE-FORM + :eval EVAL :no-eval EXAMPLE-FORM - :no-eval* EXAMPLE-FORM :no-value EXAMPLE-FORM + :no-eval* EXAMPLE-FORM :result RESULT-FORM - :result-string RESULT-FORM + :result-string RESULT-STRING :eg-result RESULT-FORM - :eg-result-string RESULT-FORM) + :eg-result-string RESULT-STRING) + +FUNC is the function being documented. -BOOL should be non-nil if the function isn't documented in the +NO-MANUAL should be non-nil if FUNC isn't documented in the manual. -ARGS is optional; the function's signature is displayed if ARGS -is not present. +ARGS is optional list of function FUNC's arguments. FUNC's +signature is displayed automatically if ARGS is not present. +Specifying ARGS might be useful where you don't want to document +some of the uncommon arguments a function might have. -If EVAL isn't a string, it will be printed with `prin1', and then -evaluated to give a result, which is also printed. If it's a -string, it'll be inserted as is, then the string will be `read', -and then evaluated. +While the `:no-manual' and `:args' property can be used for +any (FUNC ..) form, all of the other properties shown above +cannot be used simultaneously in such a form. -There can be any number of :example/:result elements." - `(progn - (setq shortdoc--groups (delq (assq ',group shortdoc--groups) - shortdoc--groups)) - (push (cons ',group ',functions) shortdoc--groups))) +Here are some common forms with examples of properties that go +together: + +1. Document a form or string, and its evaluated return value. + (FUNC + :eval EVAL) + +If EVAL is a string, it will be inserted as is, and then that +string will be `read' and evaluated. + +2. Document a form or string, but manually document its evaluation + result. The provided form will not be evaluated. + + (FUNC + :no-eval EXAMPLE-FORM + :result RESULT-FORM) ;Use `:result-string' if value is in string form + +Using `:no-value' is the same as using `:no-eval'. + +Use `:no-eval*' instead of `:no-eval' where the successful +execution of the documented form depends on some conditions. + +3. Document a form or string EXAMPLE-FORM. Also manually + document an example result. This result could be unrelated to + the documented form. + + (FUNC + :no-eval EXAMPLE-FORM + :eg-result RESULT-FORM) ;Use `:eg-result-string' if value is in string form + +A FUNC form can have any number of `:no-eval' (or `:no-value'), +`:no-eval*', `:result', `:result-string', `:eg-result' and +`:eg-result-string' properties." + (declare (indent defun)) + `(progn + (setq shortdoc--groups (delq (assq ',group shortdoc--groups) + shortdoc--groups)) + (push (cons ',group ',functions) shortdoc--groups)))) (define-short-documentation-group alist "Alist Basics" @@ -195,19 +242,33 @@ There can be any number of :example/:result elements." :eval (substring-no-properties (propertize "foobar" 'face 'bold) 0 3)) (try-completion :eval (try-completion "foo" '("foobar" "foozot" "gazonk"))) + "Unicode Strings" + (string-glyph-split + :eval (string-glyph-split "Hello, πΌπ»π§πΌβπ€βπ§π»")) + (string-glyph-compose + :eval (string-glyph-compose "AΜ")) + (string-glyph-decompose + :eval (string-glyph-decompose "β«")) "Predicates for Strings" (string-equal - :eval (string-equal "foo" "foo")) - (eq - :eval (eq "foo" "foo")) - (eql - :eval (eql "foo" "foo")) + :eval (string-equal "abc" "abc") + :eval (string-equal "abc" "ABC")) + (string-equal-ignore-case + :eval (string-equal-ignore-case "foo" "FOO")) (equal :eval (equal "foo" "foo")) (cl-equalp :eval (cl-equalp "Foo" "foo")) (stringp + :eval (stringp "a") + :eval (stringp 'a) :eval "(stringp ?a)") + (string-or-null-p + :eval (string-or-null-p "a") + :eval (string-or-null-p nil)) + (char-or-string-p + :eval "(char-or-string-p ?a)" + :eval (char-or-string-p "a")) (string-empty-p :no-manual t :eval (string-empty-p "")) @@ -215,11 +276,16 @@ There can be any number of :example/:result elements." :no-manual t :eval (string-blank-p " \n")) (string-lessp - :eval (string-lessp "foo" "bar")) + :eval (string-lessp "abc" "def") + :eval (string-lessp "pic4.png" "pic32.png") + :eval (string-lessp "1.1" "1.2")) (string-greaterp :eval (string-greaterp "foo" "bar")) (string-version-lessp - :eval (string-version-lessp "pic4.png" "pic32.png")) + :eval (string-version-lessp "pic4.png" "pic32.png") + :eval (string-version-lessp "1.9.3" "1.10.2")) + (string-collate-lessp + :eval (string-collate-lessp "abc" "abd")) (string-prefix-p :eval (string-prefix-p "foo" "foobar")) (string-suffix-p @@ -236,12 +302,23 @@ There can be any number of :example/:result elements." "Converting Strings" (string-to-number :eval (string-to-number "42") - :eval (string-to-number "deadbeef" 16)) + :eval (string-to-number "deadbeef" 16) + :eval (string-to-number "2.5e+03")) (number-to-string :eval (number-to-string 42)) + (char-uppercase-p + :eval "(char-uppercase-p ?A)" + :eval "(char-uppercase-p ?a)") "Data About Strings" (length - :eval (length "foo")) + :eval (length "foo") + :eval (length "avocado: π₯")) + (string-width + :eval (string-width "foo") + :eval (string-width "avocado: π₯")) + (string-pixel-width + :eval (string-pixel-width "foo") + :eval (string-pixel-width "avocado: π₯")) (string-search :eval (string-search "bar" "foobarzot")) (assoc-string @@ -271,6 +348,9 @@ There can be any number of :example/:result elements." :eval (file-name-base "/tmp/foo.txt")) (file-relative-name :eval (file-relative-name "/tmp/foo" "/tmp")) + (file-name-split + :eval (file-name-split "/tmp/foo") + :eval (file-name-split "foo/bar")) (make-temp-name :eval (make-temp-name "/tmp/foo-")) (file-name-concat @@ -293,6 +373,11 @@ There can be any number of :example/:result elements." (abbreviate-file-name :no-eval (abbreviate-file-name "/home/some-user") :eg-result "~some-user") + (file-name-parent-directory + :eval (file-name-parent-directory "/foo/bar") + :eval (file-name-parent-directory "/foo/") + :eval (file-name-parent-directory "foo/bar") + :eval (file-name-parent-directory "foo")) "Quoted File Names" (file-name-quote :args (name) @@ -336,8 +421,8 @@ There can be any number of :example/:result elements." (file-readable-p :no-eval (file-readable-p "/tmp/foo") :eg-result t) - (file-writeable-p - :no-eval (file-writeable-p "/tmp/foo") + (file-writable-p + :no-eval (file-writable-p "/tmp/foo") :eg-result t) (file-accessible-directory-p :no-eval (file-accessible-directory-p "/tmp") @@ -348,6 +433,9 @@ There can be any number of :example/:result elements." (file-newer-than-file-p :no-eval (file-newer-than-file-p "/tmp/foo" "/tmp/bar") :eg-result nil) + (file-has-changed-p + :no-eval (file-has-changed-p "/tmp/foo") + :eg-result t) (file-equal-p :no-eval (file-equal-p "/tmp/foo" "/tmp/bar") :eg-result nil) @@ -405,7 +493,9 @@ There can be any number of :example/:result elements." :no-eval* (directory-files-and-attributes "/tmp/foo")) (file-expand-wildcards :no-eval (file-expand-wildcards "/tmp/*.png") - :eg-result ("/tmp/foo.png" "/tmp/zot.png")) + :eg-result ("/tmp/foo.png" "/tmp/zot.png") + :no-eval (file-expand-wildcards "/*/foo.png") + :eg-result ("/tmp/foo.png" "/var/foo.png")) (locate-dominating-file :no-eval (locate-dominating-file "foo.png" "/tmp/foo/bar/zot") :eg-result "/tmp/foo.png") @@ -429,7 +519,7 @@ There can be any number of :example/:result elements." (set-file-modes :no-value "(set-file-modes \"/tmp/foo\" #o644)") (set-file-times - :no-value (set-file-times "/tmp/foo" (current-time))) + :no-value (set-file-times "/tmp/foo")) "File Modes" (set-default-file-modes :no-value "(set-default-file-modes #o755)") @@ -523,6 +613,10 @@ There can be any number of :example/:result elements." :eval (nth 1 '(one two three))) (nthcdr :eval (nthcdr 1 '(one two three))) + (take + :eval (take 3 '(one two three four))) + (ntake + :eval (ntake 3 (list 'one 'two 'three 'four))) (elt :eval (elt '(one two three) 1)) (car-safe @@ -542,8 +636,7 @@ There can be any number of :example/:result elements." (nconc :eval (nconc (list 1) (list 2 3 4))) (delq - :eval (delq 2 (list 1 2 3 4)) - :eval (delq "a" (list "a" "b" "c" "d"))) + :eval (delq 'a (list 'a 'b 'c 'd))) (delete :eval (delete 2 (list 1 2 3 4)) :eval (delete "a" (list "a" "b" "c" "d"))) @@ -559,8 +652,8 @@ There can be any number of :example/:result elements." :eval (mapcan #'list '(1 2 3))) (mapc :eval (mapc #'insert '("1" "2" "3"))) - (reduce - :eval (reduce #'+ '(1 2 3))) + (seq-reduce + :eval (seq-reduce #'+ '(1 2 3) 0)) (mapconcat :eval (mapconcat #'identity '("foo" "bar") "|")) "Predicates" @@ -585,29 +678,25 @@ There can be any number of :example/:result elements." :eval (nlistp '(1 . 2))) "Finding Elements" (memq - :eval (memq 2 '(1 2 3)) - :eval (memq 2.0 '(1.0 2.0 3.0)) - :eval (memq "b" '("a" "b" "c"))) + :eval (memq 'b '(a b c))) + (memql + :eval (memql 2.0 '(1.0 2.0 3.0))) (member :eval (member 2 '(1 2 3)) :eval (member "b" '("a" "b" "c"))) (remq - :eval (remq 2 '(1 2 3 2 4 2)) - :eval (remq "b" '("a" "b" "c"))) - (memql - :eval (memql 2.0 '(1.0 2.0 3.0))) + :eval (remq 'b '(a b c))) (member-ignore-case :eval (member-ignore-case "foo" '("bar" "Foo" "zot"))) "Association Lists" (assoc - :eval (assoc 'b '((a 1) (b 2)))) + :eval (assoc "b" '(("a" . 1) ("b" . 2)))) (rassoc - :eval (rassoc '2 '((a . 1) (b . 2)))) + :eval (rassoc "b" '((1 . "a") (2 . "b")))) (assq - :eval (assq 'b '((a 1) (b 2))) - :eval (assq "a" '(("a" 1) ("b" 2)))) + :eval (assq 'b '((a . 1) (b . 2)))) (rassq - :eval (rassq '2 '((a . 1) (b . 2)))) + :eval (rassq 'b '((1 . a) (2 . b)))) (assoc-string :eval (assoc-string "foo" '(("a" 1) (foo 2)))) (alist-get @@ -626,11 +715,6 @@ There can be any number of :example/:result elements." (plist-put :no-eval (setq plist (plist-put plist 'd 4)) :eq-result (a 1 b 2 c 3 d 4)) - (lax-plist-get - :eval (lax-plist-get '("a" 1 "b" 2 "c" 3) "b")) - (lax-plist-put - :no-eval (setq plist (lax-plist-put plist "d" 4)) - :eq-result '("a" 1 "b" 2 "c" 3 "d" 4)) (plist-member :eval (plist-member '(a 1 b 2 c 3) 'b)) "Data About Lists" @@ -645,6 +729,88 @@ There can be any number of :example/:result elements." (safe-length :eval (safe-length '(a b c)))) +(define-short-documentation-group symbol + "Making symbols" + (intern + :eval (intern "abc")) + (intern-soft + :eval (intern-soft "Phooey!")) + (make-symbol + :eval (make-symbol "abc")) + "Comparing symbols" + (eq + :eval (eq 'abc 'abc) + :eval (eq 'abc 'abd)) + (eql + :eval (eql 'abc 'abc)) + (equal + :eval (equal 'abc 'abc)) + "Name" + (symbol-name + :eval (symbol-name 'abc))) + +(define-short-documentation-group comparison + "General-purpose" + (eq + :eval (eq 'a 'a) + :eval "(eq ?A ?A)" + :eval (let ((x (list 'a "b" '(c) 4 5.0))) + (eq x x))) + (eql + :eval (eql 2 2) + :eval (eql 2.0 2.0) + :eval (eql 2.0 2)) + (equal + :eval (equal "abc" "abc") + :eval (equal 2.0 2.0) + :eval (equal 2.0 2) + :eval (equal '(a "b" (c) 4.0) '(a "b" (c) 4.0))) + (cl-equalp + :eval (cl-equalp 2 2.0) + :eval (cl-equalp "ABC" "abc")) + "Numeric" + (= + :args (number &rest numbers) + :eval (= 2 2) + :eval (= 2.0 2.0) + :eval (= 2.0 2) + :eval (= 4 4 4 4)) + (/= + :eval (/= 4 4)) + (< + :args (number &rest numbers) + :eval (< 4 4) + :eval (< 1 2 3)) + (<= + :args (number &rest numbers) + :eval (<= 4 4) + :eval (<= 1 2 2 3)) + (> + :args (number &rest numbers) + :eval (> 4 4) + :eval (> 3 2 1)) + (>= + :args (number &rest numbers) + :eval (>= 4 4) + :eval (>= 3 2 2 1)) + "String" + (string-equal + :eval (string-equal "abc" "abc") + :eval (string-equal "abc" "ABC")) + (string-equal-ignore-case + :eval (string-equal-ignore-case "abc" "ABC")) + (string-lessp + :eval (string-lessp "abc" "abd") + :eval (string-lessp "abc" "abc") + :eval (string-lessp "pic4.png" "pic32.png")) + (string-greaterp + :eval (string-greaterp "abd" "abc") + :eval (string-greaterp "abc" "abc")) + (string-version-lessp + :eval (string-version-lessp "pic4.png" "pic32.png") + :eval (string-version-lessp "1.9.3" "1.10.2")) + (string-collate-lessp + :eval (string-collate-lessp "abc" "abd"))) (define-short-documentation-group vector "Making Vectors" @@ -753,7 +919,7 @@ There can be any number of :example/:result elements." (seq-set-equal-p :eval (seq-set-equal-p '(1 2 3) '(3 1 2))) (seq-some - :eval (seq-some #'cl-evenp '(1 2 3))) + :eval (seq-some #'floatp '(1 2.0 3))) "Building Sequences" (seq-concatenate :eval (seq-concatenate 'vector '(1 2) '(c d))) @@ -773,6 +939,10 @@ There can be any number of :example/:result elements." :eval (seq-find #'numberp '(a b 3 4 f 6))) (seq-position :eval (seq-position '(a b c) 'c)) + (seq-positions + :eval (seq-positions '(a b c a d) 'a) + :eval (seq-positions '(a b c a d) 'z) + :eval (seq-positions '(11 5 7 12 9 15) 10 #'>=)) (seq-length :eval (seq-length "abcde")) (seq-max @@ -813,10 +983,15 @@ There can be any number of :example/:result elements." :eval (seq-drop-while #'numberp '(1 2 c d 5))) (seq-filter :eval (seq-filter #'numberp '(a b 3 4 f 6))) + (seq-keep + :eval (seq-keep #'car-safe '((1 2) 3 t (a . b)))) (seq-remove :eval (seq-remove #'numberp '(1 2 c d 5))) + (seq-remove-at-position + :eval (seq-remove-at-position '(a b c d e) 3) + :eval (seq-remove-at-position [a b c d e] 0)) (seq-group-by - :eval (seq-group-by #'cl-plusp '(-1 2 3 -4 -5 6))) + :eval (seq-group-by #'natnump '(-1 2 3 -4 -5 6))) (seq-union :eval (seq-union '(1 2 3) '(3 5))) (seq-difference @@ -829,8 +1004,10 @@ There can be any number of :example/:result elements." :eval (seq-subseq '(a b c d e) 2 4)) (seq-take :eval (seq-take '(a b c d e) 3)) + (seq-split + :eval (seq-split [0 1 2 3 5] 2)) (seq-take-while - :eval (seq-take-while #'cl-evenp [2 4 9 6 5])) + :eval (seq-take-while #'integerp [1 2 3.0 4])) (seq-uniq :eval (seq-uniq '(a b d b a c)))) @@ -866,12 +1043,24 @@ There can be any number of :example/:result elements." :eval (point-min)) (point-max :eval (point-max)) + (pos-bol + :eval (pos-bol)) + (pos-eol + :eval (pos-eol)) + (bolp + :eval (bolp)) + (eolp + :eval (eolp)) (line-beginning-position :eval (line-beginning-position)) (line-end-position :eval (line-end-position)) (buffer-size :eval (buffer-size)) + (bobp + :eval (bobp)) + (eobp + :eval (eobp)) "Moving Around" (goto-char :no-eval (goto-char (point-max)) @@ -897,8 +1086,13 @@ There can be any number of :example/:result elements." (following-char :no-eval (following-char) :eg-result 67) + (preceding-char + :no-eval (preceding-char) + :eg-result 38) (char-after :eval (char-after 45)) + (char-before + :eval (char-before 13)) (get-byte :no-eval (get-byte 45) :eg-result-string "#xff") @@ -907,6 +1101,8 @@ There can be any number of :example/:result elements." :no-value (delete-region (point-min) (point-max))) (erase-buffer :no-value (erase-buffer)) + (delete-line + :no-value (delete-line)) (insert :no-value (insert "This string will be inserted in the buffer\n")) (subst-char-in-region @@ -1021,13 +1217,10 @@ There can be any number of :example/:result elements." :args (number &rest numbers) :eval (= 4 4) :eval (= 4.0 4.0) - :eval (= 4 5 6 7)) - (eq - :eval (eq 4 4) - :eval (eq 4.0 4.0)) + :eval (= 4 4.0) + :eval (= 4 4 4 4)) (eql :eval (eql 4 4) - :eval (eql 4 "4") :eval (eql 4.0 4.0)) (/= :eval (/= 4 4)) @@ -1038,15 +1231,15 @@ There can be any number of :example/:result elements." (<= :args (number &rest numbers) :eval (<= 4 4) - :eval (<= 1 2 3)) + :eval (<= 1 2 2 3)) (> :args (number &rest numbers) :eval (> 4 4) - :eval (> 1 2 3)) + :eval (> 3 2 1)) (>= :args (number &rest numbers) :eval (>= 4 4) - :eval (>= 1 2 3)) + :eval (>= 3 2 2 1)) (zerop :eval (zerop 0)) (cl-plusp @@ -1110,9 +1303,6 @@ There can be any number of :example/:result elements." (ash :eval (ash 1 4) :eval (ash 16 -1)) - (lsh - :eval (lsh 1 4) - :eval (lsh 16 -1)) (logand :no-eval "(logand #b10 #b111)" :result-string "#b10") @@ -1206,17 +1396,54 @@ There can be any number of :example/:result elements." (text-property-search-backward :no-eval (text-property-search-backward 'face nil t))) +(define-short-documentation-group keymaps + "Defining keymaps" + (define-keymap + :no-eval (define-keymap "C-c C-c" #'quit-buffer)) + (defvar-keymap + :no-eval (defvar-keymap my-keymap "C-c C-c" #'quit-buffer)) + "Setting keys" + (keymap-set + :no-eval (keymap-set map "C-c C-c" #'quit-buffer)) + (keymap-local-set + :no-eval (keymap-local-set "C-c C-c" #'quit-buffer)) + (keymap-global-set + :no-eval (keymap-global-set "C-c C-c" #'quit-buffer)) + (keymap-unset + :no-eval (keymap-unset map "C-c C-c")) + (keymap-local-unset + :no-eval (keymap-local-unset "C-c C-c")) + (keymap-global-unset + :no-eval (keymap-global-unset "C-c C-c")) + (keymap-substitute + :no-eval (keymap-substitute map "C-c C-c" "M-a")) + (keymap-set-after + :no-eval (keymap-set-after map "<separator-2>" menu-bar-separator)) + "Predicates" + (keymapp + :eval (keymapp (define-keymap))) + (key-valid-p + :eval (key-valid-p "C-c C-c") + :eval (key-valid-p "C-cC-c")) + "Lookup" + (keymap-lookup + :eval (keymap-lookup (current-global-map) "C-x x g"))) + ;;;###autoload -(defun shortdoc-display-group (group &optional function) +(defun shortdoc-display-group (group &optional function same-window) "Pop to a buffer with short documentation summary for functions in GROUP. -If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)." +If FUNCTION is non-nil, place point on the entry for FUNCTION (if any). +If SAME-WINDOW, don't pop to a new window." (interactive (list (completing-read "Show summary for functions in: " (mapcar #'car shortdoc--groups)))) (when (stringp group) (setq group (intern group))) (unless (assq group shortdoc--groups) (error "No such documentation group %s" group)) - (pop-to-buffer (format "*Shortdoc %s*" group)) + (funcall (if same-window + #'pop-to-buffer-same-window + #'pop-to-buffer) + (format "*Shortdoc %s*" group)) (let ((inhibit-read-only t) (prev nil)) (erase-buffer) @@ -1230,13 +1457,20 @@ If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)." (unless (bobp) (insert "\n")) (insert (propertize - (concat (substitute-command-keys data) "\n\n") + (substitute-command-keys data) + 'face 'shortdoc-heading + 'shortdoc-section t + 'outline-level 1)) + (insert (propertize + "\n\n" 'face 'shortdoc-heading 'shortdoc-section t))) ;; There may be functions not yet defined in the data. ((fboundp (car data)) (when prev - (insert (make-separator-line))) + (insert (make-separator-line) + ;; This helps with hidden outlines (bug#53981) + (propertize "\n" 'face '(:height 0)))) (setq prev t) (shortdoc--display-function data)))) (cdr (assq group shortdoc--groups)))) @@ -1245,12 +1479,15 @@ If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)." (text-property-search-forward 'shortdoc-function function t) (beginning-of-line))) +;;;###autoload +(defalias 'shortdoc #'shortdoc-display-group) + (defun shortdoc--display-function (data) (let ((function (pop data)) (start-section (point)) arglist-start) ;; Function calling convention. - (insert (propertize "(" 'shortdoc-function function)) + (insert (propertize "(" 'shortdoc-function function 'outline-level 2)) (if (plist-get data :no-manual) (insert-text-button (symbol-name function) @@ -1258,15 +1495,15 @@ If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)." 'action (lambda (_) (describe-function function)) 'follow-link t - 'help-echo (purecopy "mouse-1, RET: describe function")) + 'help-echo "mouse-1, RET: describe function") (insert-text-button (symbol-name function) 'face 'button 'action (lambda (_) (info-lookup-symbol function 'emacs-lisp-mode)) 'follow-link t - 'help-echo (purecopy "mouse-1, RET: show \ -function's documentation in the Info manual"))) + 'help-echo "mouse-1, RET: show \ +function's documentation in the Info manual")) (setq arglist-start (point)) (insert ")\n") ;; Doc string. @@ -1286,14 +1523,16 @@ function's documentation in the Info manual"))) do (cl-case type (:eval + (insert " ") (if (stringp value) - (insert " " value "\n") - (insert " ") - (prin1 value (current-buffer)) - (insert "\n") - (insert " " double-arrow " ") - (prin1 (eval value) (current-buffer)) - (insert "\n"))) + (insert value) + (prin1 value (current-buffer))) + (insert "\n " double-arrow " ") + (let ((expr (if (stringp value) + (car (read-from-string value)) + value))) + (prin1 (eval expr) (current-buffer))) + (insert "\n")) (:no-eval* (if (stringp value) (insert " " value "\n") @@ -1351,11 +1590,14 @@ function's documentation in the Info manual"))) If GROUP doesn't exist, it will be created. If SECTION doesn't exist, it will be added. +ELEM is a Lisp form. See `define-short-documentation-group' for +details. + Example: (shortdoc-add-function - 'file \"Predicates\" - '(file-locked-p :no-eval (file-locked-p \"/tmp\")))" + \\='file \"Predicates\" + \\='(file-locked-p :no-eval (file-locked-p \"/tmp\")))" (let ((glist (assq group shortdoc--groups))) (unless glist (setq glist (list group)) @@ -1369,18 +1611,22 @@ Example: (setq slist (cdr slist))) (setcdr slist (cons elem (cdr slist)))))) -(defvar shortdoc-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "n") 'shortdoc-next) - (define-key map (kbd "p") 'shortdoc-previous) - (define-key map (kbd "C-c C-n") 'shortdoc-next-section) - (define-key map (kbd "C-c C-p") 'shortdoc-previous-section) - map) - "Keymap for `shortdoc-mode'.") +(defvar-keymap shortdoc-mode-map + :doc "Keymap for `shortdoc-mode'." + "n" #'shortdoc-next + "p" #'shortdoc-previous + "N" #'shortdoc-next-section + "P" #'shortdoc-previous-section + "C-c C-n" #'shortdoc-next-section + "C-c C-p" #'shortdoc-previous-section + "w" #'shortdoc-copy-function-as-kill) (define-derived-mode shortdoc-mode special-mode "shortdoc" "Mode for shortdoc." - :interactive nil) + :interactive nil + (setq-local outline-search-function #'outline-search-level + outline-level (lambda () + (get-text-property (point) 'outline-level)))) (defun shortdoc--goto-section (arg sym &optional reverse) (unless (natnump arg) @@ -1389,35 +1635,49 @@ Example: (funcall (if reverse 'text-property-search-backward 'text-property-search-forward) - sym nil t t) + sym nil t) (setq arg (1- arg)))) (defun shortdoc-next (&optional arg) - "Move cursor to the next function. -With ARG, do it that many times." + "Move point to the next function. +With prefix numeric argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-function)) (defun shortdoc-previous (&optional arg) - "Move cursor to the previous function. -With ARG, do it that many times." + "Move point to the previous function. +With prefix numeric argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-function t) (backward-char 1)) (defun shortdoc-next-section (&optional arg) - "Move cursor to the next section. -With ARG, do it that many times." + "Move point to the next section. +With prefix numeric argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-section)) (defun shortdoc-previous-section (&optional arg) - "Move cursor to the previous section. -With ARG, do it that many times." + "Move point to the previous section. +With prefix numeric argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-section t) (forward-line -2)) +(defun shortdoc-copy-function-as-kill () + "Copy name of the function near point into the kill ring." + (interactive) + (save-excursion + (goto-char (pos-bol)) + (when-let* ((re (rx bol "(" (group (+ (not (in " ")))))) + (string + (and (or (looking-at re) + (re-search-backward re nil t)) + (match-string 1)))) + (set-text-properties 0 (length string) nil string) + (kill-new string) + (message string)))) + (provide 'shortdoc) ;;; shortdoc.el ends here |