From c96c89faaa02a2ff76ec30146ba466aece622603 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sun, 22 Mar 2026 10:58:40 -0400 Subject: (dabbrev-completion): Improve last fix for bug#80645 * lisp/dabbrev.el (dabbrev-completion): Signal the error that `dabbrev-capf` doesn't signal any more. --- lisp/dabbrev.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 0e3c8bf6a5f..9fe2904c415 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -398,7 +398,11 @@ then it searches *all* buffers." ;; Set it so `dabbrev-capf' won't reset the vars. (setq dabbrev--last-abbrev-location (point-marker)) (let ((completion-at-point-functions '(dabbrev-capf))) - (completion-at-point))) + (unless (completion-at-point) + (user-error "No dynamic expansion for \"%s\" found%s" + (dabbrev--abbrev-at-point) + (if dabbrev--check-other-buffers + "" " in this-buffer"))))) (defun dabbrev-capf () "Dabbrev completion function for `completion-at-point-functions'." -- cgit v1.2.1 From 17a3f6bf99382cdf5f982dade86d902ec6427db7 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 22 Mar 2026 16:03:16 +0000 Subject: * lisp/subr.el (member-if): Fix compiler macro multiple evaluation. Problem reported by Pip Cet . --- lisp/subr.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/subr.el b/lisp/subr.el index a1d718ca5b7..7a5412d3fb7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1226,8 +1226,13 @@ with (member-if (lambda (x) (foo (bar x))) items)" (declare (compiler-macro (lambda (_) - (let ((x (make-symbol "x"))) - `(drop-while (lambda (,x) (not (funcall ,pred ,x))) ,list))))) + (let* ((x (make-symbol "x")) + (f (and (not (internal--effect-free-fun-arg-p pred)) + (make-symbol "f"))) + (form `(drop-while (lambda (,x) + (not (funcall ,(or f pred) ,x))) + ,list))) + (if f `(let ((,f ,pred)) ,form) form))))) (drop-while (lambda (x) (not (funcall pred x))) list)) ;; This is good to have for improved readability in certain uses, but -- cgit v1.2.1 From 1932bb434ab87e870faf89eb351ce55e36f41926 Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Sun, 22 Mar 2026 10:08:13 +0000 Subject: Delay initializing 'compile-command' to runtime (bug#80648) * lisp/progmodes/compile.el (compile-command): Use 'custom-initialize-delay'. --- lisp/progmodes/compile.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 27b2e59409d..c0a734ae818 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -991,6 +991,7 @@ You might also use mode hooks to specify it in certain modes, like this: (file-name-sans-extension buffer-file-name)))))))) It's often useful to leave a space at the end of the value." + :initialize #'custom-initialize-delay :type 'string) ;;;###autoload(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (if (boundp 'compilation-read-command) compilation-read-command t)))) -- cgit v1.2.1 From 6c79b6bede776d987a228f34a1a33f4fecd03845 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 22 Mar 2026 20:54:58 -0700 Subject: ; * lisp/treesit.el (treesit-range-rules): Fix range-fn handler. --- lisp/treesit.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 7d6113e3249..d7cfe0a9f3f 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -753,10 +753,10 @@ that encompasses the region between START and END." (numberp (cdr range-offset))) (signal 'treesit-error (list "Value of :offset option should be a pair of numbers" range-offset))) (setq offset range-offset))) - (:range-fn (let ((range-fn (pop query-specs))) - (unless (functionp range-fn) - (signal 'treesit-error (list "Value of :range-fn option should be a function" range-fn))) - (setq range-fn range-fn))) + (:range-fn (let ((fn (pop query-specs))) + (unless (functionp fn) + (signal 'treesit-error (list "Value of :range-fn option should be a function" fn))) + (setq range-fn fn))) (query (if (functionp query) (push (list query nil nil) result) (when (null embed) -- cgit v1.2.1 From a4d99971d8e835fddf5a604d8da1d74c5eb3c858 Mon Sep 17 00:00:00 2001 From: Basil L. Contovounesios Date: Sun, 22 Mar 2026 11:40:28 +0100 Subject: Fix recent whitespace.el changes * etc/NEWS (Changes in Specialized Modes and Packages in Emacs 31.1): Announce new user option whitespace-global-mode-buffers (bug#79230). * lisp/whitespace.el (whitespace-global-modes): Improve docstring grammar. (whitespace-global-mode-buffers): Make default value match *scratch* exactly for backward compatibility. Fix custom :type. (whitespace-enable-predicate): Prefer any over seq-find. --- lisp/whitespace.el | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 9eb88eb35d0..d6ff4c9bed9 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -907,8 +907,8 @@ means that `whitespace-mode' is turned on for buffers in C and C++ modes only. Global `whitespace-mode' will not automatically turn on in internal -buffers (with name starting from space) and special buffers (with name -starting from \"*\"), except \"*scratch*\" buffer. Use +buffers (whose name starts with a space) and special buffers (whose name +starts with \"*\"), with the exception of the \"*scratch*\" buffer. Use `whitespace-global-mode-buffers' to customize this behavior." :type '(choice :tag "Global Modes" (const :tag "None" nil) @@ -919,11 +919,11 @@ starting from \"*\"), except \"*scratch*\" buffer. Use (repeat :inline t (symbol :tag "Mode"))))) -(defcustom whitespace-global-mode-buffers (list (regexp-quote "*scratch*")) +(defcustom whitespace-global-mode-buffers (list (rx bos "*scratch*" eos)) "Buffer name regexps where global `whitespace-mode' can be auto-enabled. The value is a list of regexps. Set this custom option when you need -`whitespace-mode' in special buffers like *Org Src*." - :type '(list (regexp :tag "Regexp matching buffer name")) +`whitespace-mode' in special buffers like \"*Org Src*\"." + :type '(repeat (regexp :tag "Regexp matching buffer name")) :version "31.1") (defcustom whitespace-action nil @@ -1049,14 +1049,13 @@ See also `whitespace-newline' and `whitespace-display-mappings'." ;; ...we have a display (not running a batch job) (not noninteractive) ;; ...the buffer is not internal (name starts with a space) - (not (eq (aref (buffer-name) 0) ?\ )) + (not (eq (aref (buffer-name) 0) ?\s)) ;; ...the buffer is not special (name starts with *) (or (not (eq (aref (buffer-name) 0) ?*)) - ;; except the scratch buffer. - (seq-find - (lambda (re) - (string-match-p re (buffer-name))) - whitespace-global-mode-buffers)))) + ;; except, e.g., the scratch buffer. + (any (lambda (re) + (string-match-p re (buffer-name))) + whitespace-global-mode-buffers)))) "Predicate to decide which buffers obey `global-whitespace-mode'. This function is called with no argument and should return non-nil if the current buffer should obey `global-whitespace-mode'. -- cgit v1.2.1 From f08dcace703e1e90fb0197bf33d14a24839570e5 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 23 Mar 2026 21:11:38 +0000 Subject: ; * lisp/whitespace.el (whitespace-global-modes): Grammar fix. --- lisp/whitespace.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/whitespace.el b/lisp/whitespace.el index d6ff4c9bed9..50a687fe16b 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -907,9 +907,9 @@ means that `whitespace-mode' is turned on for buffers in C and C++ modes only. Global `whitespace-mode' will not automatically turn on in internal -buffers (whose name starts with a space) and special buffers (whose name -starts with \"*\"), with the exception of the \"*scratch*\" buffer. Use -`whitespace-global-mode-buffers' to customize this behavior." +buffers (whose names start with a space) and special buffers (whose +names start with \"*\"), with the exception of the \"*scratch*\" buffer. +Use `whitespace-global-mode-buffers' to customize this behavior." :type '(choice :tag "Global Modes" (const :tag "None" nil) (const :tag "All" t) -- cgit v1.2.1 From bb3c10396885cb1334fb56eaf4c7a0fdada65e73 Mon Sep 17 00:00:00 2001 From: F. Jason Park Date: Fri, 16 Jan 2026 16:43:15 -0800 Subject: Avoid nested erc-display-message in alert utility * lisp/erc/erc.el (erc--warn-once-before-connect): Don't call `erc-display-message' from insertion hooks because doing so places an unnecessary burden on the caller to preserve the insertion marker and "msg prop" environment. --- lisp/erc/erc.el | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 572b73188e3..6facb7966b0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1693,11 +1693,18 @@ time `erc-mode-hook' runs for any connection." (declare (indent 1)) (cl-assert (stringp (car args))) (if (derived-mode-p 'erc-mode) - (unless (or (erc-with-server-buffer ; needs `erc-server-process' - (apply #'erc-button--display-error-notice-with-keys - (current-buffer) args) - t) - erc--target) ; unlikely + (unless + (or (erc-with-server-buffer ; needs `erc-server-process' + (let ((fn + (lambda (buffer) + (erc-with-buffer (buffer) + (apply #'erc-button--display-error-notice-with-keys + buffer args))))) + (if erc--msg-props + (run-at-time nil nil fn (current-buffer)) + (funcall fn (current-buffer)))) + t) + erc--target) ; unlikely (let (hook) (setq hook (lambda (_) -- cgit v1.2.1 From 52e5dbd2da295e7a67e66920a67423a6ca355e7c Mon Sep 17 00:00:00 2001 From: Ivan Date: Sat, 21 Mar 2026 20:01:15 +0100 Subject: Fix erc-track-faces-normal-list regression * lisp/erc/erc-track.el (erc-track--select-mode-line-face): Check whether ranked faces in the message appear in the value of the option `erc-track-faces-normal-list' rather than repeatedly checking if the current nominee does, usually the highest ranked face in the message. Failure to do so caused ERC to treat faces absent from the option's value as being present and thus eligible to replace ranked faces in the mode line segment. This bug was introduced in ERC 5.6 and is also part of 5.6.1. (Bug#80659) Copyright-paperwork-exempt: yes --- lisp/erc/erc-track.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index f5ea63ae764..6306df3fa2a 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -1006,7 +1006,7 @@ Failing that, choose the first face in both NEW-FACES and NORMALS." (dolist (candidate (cdr ranks)) (when (and (not (equal candidate choice)) (gethash candidate (car new-faces)) - (gethash choice normals)) + (gethash candidate normals)) (throw 'face candidate))) ;; Otherwise, go with any "normal" face other than ;; `choice' in the region. -- cgit v1.2.1 From 617b254fe330855610a517ece668b5e2359ff5ff Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 24 Mar 2026 15:54:49 -0400 Subject: minibuffer.el: De-iconify a `*Completions*` frame only for eager display * lisp/minibuffer.el (completions--after-change) (minibuffer--completions-visible): Don't consider an iconified frame as visible. --- lisp/minibuffer.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 13d0e712821..94fc63440b4 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2807,7 +2807,7 @@ has been requested by the completion table." "Update displayed *Completions* buffer after change in buffer contents." (if (not (or (minibufferp nil t) completion-in-region-mode)) (remove-hook 'after-change-functions #'completions--after-change t) - (when-let* ((window (get-buffer-window "*Completions*" 0))) + (when-let* ((window (get-buffer-window "*Completions*" 'visible))) (when completion-auto-deselect (with-selected-window window (completions--deselect)))) @@ -3480,7 +3480,7 @@ in the minibuffer window." (defun minibuffer--completions-visible () "Return the window where the current *Completions* buffer is visible, if any." - (when-let* ((window (get-buffer-window "*Completions*" 0))) + (when-let* ((window (get-buffer-window "*Completions*" 'visible))) (let ((reference-buffer (buffer-local-value 'completion-reference-buffer (window-buffer window)))) -- cgit v1.2.1 From 23b16cd6968ad4ec9b8fd4e1258bc4001880b956 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 25 Mar 2026 14:59:56 +0200 Subject: ; Make 'default-korean-keyboard' a defcustom * lisp/language/korea-util.el (default-korean-keyboard): Now a defcustom. (Bug#80648) --- lisp/language/korea-util.el | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el index da91e692719..cca702f71b0 100644 --- a/lisp/language/korea-util.el +++ b/lisp/language/korea-util.el @@ -27,13 +27,22 @@ ;;; Code: +(defgroup korean nil + "Options for writing Korean." + :version "31.1" + :group 'languages) + ;;;###autoload -(defvar default-korean-keyboard +(defcustom default-korean-keyboard (if (string-search "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "") "The kind of Korean keyboard for Korean (Hangul) input method. -\"\" for 2, \"3\" for 3, and \"3f\" for 3f.") +\"\" for 2, \"3\" for 3, and \"3f\" for 3f." + :initialize #'custom-initialize-delay + :group 'korean + :version "31.1" + :type 'string) ;; functions useful for Korean text input -- cgit v1.2.1 From 99384b18696e2c2305aba64c32953c4b5f03835c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 25 Mar 2026 15:23:46 +0200 Subject: ; * lisp/info.el (Info-goto-node-web, Info-url-for-node): Doc fix (bug#80670). --- lisp/info.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/info.el b/lisp/info.el index 368255092a1..320ac7de65c 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1897,8 +1897,10 @@ of NODENAME; if none is found it then tries a case-insensitive match (if (equal nodename "") "Top" nodename) nil strict-case))) (defun Info-goto-node-web (node) - "Use `browse-url' to go to the gnu.org web server's version of NODE. -By default, go to the current Info node." + "Use `browse-url' to go to the gnu.org Web server's version of NODE. +By default, go to the URL corresponding to the current Info node. + +This uses `Info-url-for-node' to determine the URL that corresponds to NODE." (interactive (list (Info-read-node-name "Go to node (default current page): " Info-current-node)) Info-mode) @@ -1924,7 +1926,10 @@ By default, go to the current Info node." (defun Info-url-for-node (node) "Return the URL corresponding to NODE. -NODE should be a string of the form \"(manual)Node\"." +NODE should be a string of the form \"(manual)Node\". + +The correspondence between Info manuals and their Web URLs is +established by `Info-url-alist', which see." ;; GNU Texinfo skips whitespaces and newlines between the closing ;; parenthesis and the node-name, i.e. space, tab, line feed and ;; carriage return. -- cgit v1.2.1 From 9b0c23a890a482b1d1c0a323f9866bc67d997850 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 25 Mar 2026 15:43:12 +0200 Subject: Fix "File->Open Directory" menu item after 'ffap-bindings' * lisp/dired.el (dired-from-menubar): New function. * lisp/menu-bar.el (menu-bar-file-menu): Use it in the "Open Directory" menu item, instead of calling Dired directly. This ensures we show the correct GUI dialog even if some package remaps 'dired' to something else (like 'ffap-bindings' does). (Bug#80545) --- lisp/dired.el | 8 ++++++++ lisp/menu-bar.el | 6 +++--- 2 files changed, 11 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/dired.el b/lisp/dired.el index 7f598433a9d..4c0d34344c3 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1232,6 +1232,14 @@ If DIRNAME is already in a Dired buffer, that buffer is used without refresh." (interactive (dired-read-dir-and-switches "")) (pop-to-buffer-same-window (dired-noselect dirname switches))) +;; This is needed to let clicks on the menu bar invoke Dired even if +;; some feature remaps the Dired command to another command. +;;;###autoload +(defun dired-from-menubar (dirname &optional switches) + "Edit an existing directory." + (interactive (dired-read-dir-and-switches "")) + (dired dirname switches)) + ;;;###autoload (keymap-set ctl-x-4-map "d" #'dired-other-window) ;;;###autoload (defun dired-other-window (dirname &optional switches) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 44e8665eebd..b1d7bd83983 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -231,8 +231,8 @@ in the tool bar will close the current window where possible." '(menu-item "Open Project Directory" project-dired :enable (menu-bar-non-minibuffer-window-p) :help "Read the root directory of the current project, to operate on its files")) - (define-key menu [dired] - '(menu-item "Open Directory..." dired + (define-key menu [open-directory] + '(menu-item "Open Directory..." dired-from-menubar :enable (menu-bar-non-minibuffer-window-p) :help "Read a directory, to operate on its files")) (define-key menu [project-open-file] @@ -2287,7 +2287,7 @@ this frame." (and menu-bar-close-window (window-parent (selected-window))))) -(put 'dired 'menu-enable '(menu-bar-non-minibuffer-window-p)) +(put 'dired-from-menubar 'menu-enable '(menu-bar-non-minibuffer-window-p)) ;; Permit deleting frame if it would leave a visible or iconified frame. (defun delete-frame-enabled-p () -- cgit v1.2.1 From 0048dd0da0fdce9a2687e19bfef0c0299051a067 Mon Sep 17 00:00:00 2001 From: Basil L. Contovounesios Date: Wed, 25 Mar 2026 16:06:16 +0100 Subject: Give compile-command a :group again Like the commit of 2022-07-31 "Fix further package.el loaddefs byte-compile warnings" this pacifies the warning that compile-command fails to specify a containing group when byte-compiling loaddefs.el (bug#80648). * lisp/progmodes/compile.el (compile-command): Restore explicit custom :group on autoloaded user option. --- lisp/progmodes/compile.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index c0a734ae818..07974906a90 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -991,6 +991,7 @@ You might also use mode hooks to specify it in certain modes, like this: (file-name-sans-extension buffer-file-name)))))))) It's often useful to leave a space at the end of the value." + :group 'compilation :initialize #'custom-initialize-delay :type 'string) ;;;###autoload(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (if (boundp 'compilation-read-command) compilation-read-command t)))) -- cgit v1.2.1 From bb67a210f1c12ddf159f54c5b33ba98ca8aa3ddf Mon Sep 17 00:00:00 2001 From: Jens Schmidt Date: Wed, 25 Mar 2026 16:32:32 +0100 Subject: ; Rename shortdoc.el to shortdoc-doc.el --- lisp/emacs-lisp/shortdoc-doc.el | 1960 +++++++++++++++++++++++++++++++++++++++ lisp/emacs-lisp/shortdoc.el | 1960 --------------------------------------- 2 files changed, 1960 insertions(+), 1960 deletions(-) create mode 100644 lisp/emacs-lisp/shortdoc-doc.el delete mode 100644 lisp/emacs-lisp/shortdoc.el (limited to 'lisp') diff --git a/lisp/emacs-lisp/shortdoc-doc.el b/lisp/emacs-lisp/shortdoc-doc.el new file mode 100644 index 00000000000..ea6910c60fc --- /dev/null +++ b/lisp/emacs-lisp/shortdoc-doc.el @@ -0,0 +1,1960 @@ +;;; shortdoc.el --- Short function summaries -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2026 Free Software Foundation, Inc. + +;; Keywords: lisp, help +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; 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) +(require 'text-property-search) +(eval-when-compile (require 'cl-lib)) + +(defgroup shortdoc nil + "Short documentation." + :group 'lisp) + +(defface shortdoc-heading + '((t :inherit variable-pitch :height 1.3 :weight bold)) + "Face used for a heading." + :version "28.1") + +(defface shortdoc-section + '((t :inherit variable-pitch)) + "Face used for a section.") + +;;;###autoload +(defun shortdoc--check (group functions) + (let ((keywords '( :no-manual :args :eval :no-eval :no-value :no-eval* + :result :result-string :eg-result :eg-result-string :doc))) + (dolist (f functions) + (when (consp f) + (dolist (x f) + (when (and (keywordp x) (not (memq x keywords))) + (error "Shortdoc %s function `%s': bad keyword `%s'" + group (car f) x))))))) + +;;;###autoload +(progn + (defvar shortdoc--groups nil) + + (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: + + (FUNC + :no-manual BOOL + :args ARGS + :eval EVAL + :no-eval EXAMPLE-FORM + :no-value EXAMPLE-FORM + :no-eval* EXAMPLE-FORM + :result RESULT-FORM + :result-string RESULT-STRING + :eg-result RESULT-FORM + :eg-result-string RESULT-STRING) + +FUNC is the function being documented. + +NO-MANUAL should be non-nil if FUNC isn't documented in the +manual. + +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. + +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. + +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)) + (shortdoc--check group functions) + `(progn + (setq shortdoc--groups (delq (assq ',group shortdoc--groups) + shortdoc--groups)) + (push (cons ',group ',functions) shortdoc--groups)))) + +(define-short-documentation-group alist + "Alist Basics" + (assoc + :eval (assoc 'foo '((foo . bar) (zot . baz)))) + (rassoc + :eval (rassoc 'bar '((foo . bar) (zot . baz)))) + (assq + :eval (assq 'foo '((foo . bar) (zot . baz)))) + (rassq + :eval (rassq 'bar '((foo . bar) (zot . baz)))) + (assoc-string + :eval (assoc-string "foo" '(("foo" . "bar") ("zot" "baz")))) + "Manipulating Alists" + (assoc-delete-all + :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) + (assq-delete-all + :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) + (rassq-delete-all + :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) + (alist-get + :eval (let ((foo '((bar . baz)))) + (setf (alist-get 'bar foo) 'zot) + foo)) + "Misc" + (assoc-default + :eval (assoc-default "foobar" '(("foo" . baz)) #'string-match)) + (copy-alist + :eval (let* ((old '((foo . bar))) + (new (copy-alist old))) + (eq old new))) + ;; FIXME: Outputs "\.rose" for the symbol `.rose'. It would be + ;; better if that could be cleaned up. + (let-alist + :eval (let ((colors '((rose . red) + (lily . white)))) + (let-alist colors + (if (eq .rose 'red) + .lily))))) + +(define-short-documentation-group map + "Map Basics" + (mapp + :eval (mapp (list 'bar 1 'foo 2 'baz 3)) + :eval (mapp (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (mapp [bar foo baz]) + :eval (mapp "this is a string") + :eval (mapp #s(hash-table data (bar 1 foo 2 baz 3))) + :eval (mapp '()) + :eval (mapp nil) + :eval (mapp (make-char-table 'shortdoc-test))) + (map-empty-p + :args (map) + :eval (map-empty-p nil) + :eval (map-empty-p []) + :eval (map-empty-p '())) + (map-elt + :args (map key) + :eval (map-elt (list 'bar 1 'foo 2 'baz 3) 'foo) + :eval (map-elt (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) + :eval (map-elt [bar foo baz] 1) + :eval (map-elt #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) + (map-contains-key + :args (map key) + :eval (map-contains-key (list 'bar 1 'foo 2 'baz 3) 'foo) + :eval (map-contains-key (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) + :eval (map-contains-key [bar foo baz] 1) + :eval (map-contains-key #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) + (map-put! + (map key value) + :eval +"(let ((map (list 'bar 1 'baz 3))) + (map-put! map 'foo 2) + map)" +;; This signals map-not-inplace when used in shortdoc.el :-( +;; :eval +;; "(let ((map (list '(bar . 1) '(baz . 3)))) +;; (map-put! map 'foo 2) +;; map)" + :eval +"(let ((map [bar bot baz])) + (map-put! map 1 'foo) + map)" + :eval +"(let ((map #s(hash-table data (bar 1 baz 3)))) + (map-put! map 'foo 2) + map)") + (map-insert + :args (map key value) + :eval (map-insert (list 'bar 1 'baz 3 'foo 7) 'foo 2) + :eval (map-insert (list '(bar . 1) '(baz . 3) '(foo . 7)) 'foo 2) + :eval (map-insert [bar bot baz] 1 'foo) + :eval (map-insert #s(hash-table data (bar 1 baz 3 foo 7)) 'foo 2)) + (map-delete + :args (map key) + :eval (map-delete (list 'bar 1 'foo 2 'baz 3) 'foo) + :eval (map-delete (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) + :eval (map-delete [bar foo baz] 1) + :eval (map-delete #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) + (map-keys + :eval (map-keys (list 'bar 1 'foo 2 'baz 3)) + :eval (map-keys (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-keys [bar foo baz]) + :eval (map-keys #s(hash-table data (bar 1 foo 2 baz 3)))) + (map-values + :args (map) + :eval (map-values (list 'bar 1 'foo 2 'baz 3)) + :eval (map-values (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-values [bar foo baz]) + :eval (map-values #s(hash-table data (bar 1 foo 2 baz 3)))) + (map-pairs + :eval (map-pairs (list 'bar 1 'foo 2 'baz 3)) + :eval (map-pairs (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-pairs [bar foo baz]) + :eval (map-pairs #s(hash-table data (bar 1 foo 2 baz 3)))) + (map-length + :args (map) + :eval (map-length (list 'bar 1 'foo 2 'baz 3)) + :eval (map-length (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-length [bar foo baz]) + :eval (map-length #s(hash-table data (bar 1 foo 2 baz 3)))) + (map-copy + :args (map) + :eval (map-copy (list 'bar 1 'foo 2 'baz 3)) + :eval (map-copy (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-copy [bar foo baz]) + :eval (map-copy #s(hash-table data (bar 1 foo 2 baz 3)))) + "Doing things to maps and their contents" + (map-apply + :args (function map) + :eval (map-apply #'+ (list '(1 . 2) '(3 . 4)))) + (map-do + :args (function map) + :eval +"(let ((map (list '(1 . 1) '(2 . 3))) + acc) + (map-do (lambda (k v) (push (+ k v) acc)) map) + (nreverse acc))") + (map-keys-apply + :eval (map-keys-apply #'1+ (list '(1 . 2) '(3 . 4)))) + (map-values-apply + :args (function map) + :eval (map-values-apply #'1+ (list '(1 . 2) '(3 . 4)))) + (map-filter + :eval (map-filter (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) + :eval (map-filter (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) + (map-remove + :eval (map-remove (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) + :eval (map-remove (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) + (map-some + :eval (map-some (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) + :eval (map-some (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) + (map-every-p + :eval (map-every-p (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) + :eval (map-every-p (lambda (k v) (evenp (+ k v))) (list '(1 . 3) '(4 . 6)))) + "Combining and changing maps" + (map-merge + :eval (map-merge 'alist '(1 2 3 4) #s(hash-table data (5 6 7 8))) + :eval (map-merge 'list '(1 2 3 4) #s(hash-table data (5 6 7 8))) + :eval (map-merge 'plist '(1 2 3 4) #s(hash-table data (5 6 7 8))) + :eval (map-merge 'hash-table '(1 2 3 4) #s(hash-table data (5 6 7 8)))) + (map-merge-with + :eval (map-merge-with 'alist #'max '(1 2 3 4) #s(hash-table data (1 1 3 5))) + :eval (map-merge-with 'alist #'min '(1 2 3 4) #s(hash-table data (1 1 3 5))) + :eval (map-merge-with 'hash-table #'min '(1 2 3 4) #s(hash-table data (1 1 3 5)))) + (map-into + :args (map type) + :eval (map-into #s(hash-table data '(5 6 7 8)) 'list) + :eval (map-into '((5 . 6) (7 . 8)) 'plist) + :eval (map-into '((5 . 6) (7 . 8)) 'hash-table))) + +(define-short-documentation-group string + "Making Strings" + (make-string + :args (length init) + :eval "(make-string 5 ?x)") + (string + :eval "(string ?a ?b ?c)") + (concat + :eval (concat "foo" "bar" "zot")) + (string-join + :no-manual t + :eval (string-join '("foo" "bar" "zot") " ")) + (mapconcat + :eval (mapconcat (lambda (a) (concat "[" a "]")) + '("foo" "bar" "zot") " ")) + (string-pad + :eval (string-pad "foo" 5) + :eval (string-pad "foobar" 5) + :eval (string-pad "foo" 5 ?- t)) + (mapcar + :eval (mapcar #'identity "123")) + (format + :eval (format "This number is %d" 4)) + "Manipulating Strings" + (substring + :eval (substring "abcde" 1 3) + :eval (substring "abcde" 2) + :eval (substring "abcde" 1 -1) + :eval (substring "abcde" -4 4)) + (string-limit + :eval (string-limit "foobar" 3) + :eval (string-limit "foobar" 3 t) + :eval (string-limit "foobar" 10) + :eval (string-limit "fo好" 3 nil 'utf-8)) + (truncate-string-to-width + :eval (truncate-string-to-width "foobar" 3) + :eval (truncate-string-to-width "你好bar" 5)) + (split-string + :eval (split-string "foo bar") + :eval (split-string "|foo|bar|" "|") + :eval (split-string "|foo|bar|" "|" t)) + (split-string-and-unquote + :eval (split-string-and-unquote "foo \"bar zot\"")) + (split-string-shell-command + :eval (split-string-shell-command "ls /tmp/'foo bar'")) + (string-lines + :eval (string-lines "foo\n\nbar") + :eval (string-lines "foo\n\nbar" t)) + (string-replace + :eval (string-replace "foo" "bar" "foozot")) + (replace-regexp-in-string + :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) + (string-trim + :args (string) + :doc "Trim STRING of leading and trailing white space." + :eval (string-trim " foo ")) + (string-trim-left + :eval (string-trim-left "oofoo" "o+")) + (string-trim-right + :eval (string-trim-right "barkss" "s+")) + (string-truncate-left + :no-manual t + :eval (string-truncate-left "longstring" 8)) + (string-remove-suffix + :no-manual t + :eval (string-remove-suffix "bar" "foobar")) + (string-remove-prefix + :no-manual t + :eval (string-remove-prefix "foo" "foobar")) + (string-chop-newline + :eval (string-chop-newline "foo\n")) + (string-clean-whitespace + :eval (string-clean-whitespace " foo bar ")) + (string-fill + :eval (string-fill "Three short words" 12) + :eval (string-fill "Long-word" 3)) + (reverse + :eval (reverse "foo")) + (substring-no-properties + :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 "Å")) + (string-glyph-decompose + :eval (string-glyph-decompose "Å")) + "Predicates for Strings" + (string-equal + :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 "")) + (string-blank-p + :no-manual t + :eval (string-blank-p " \n")) + (string-lessp + :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 "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 + :eval (string-suffix-p "bar" "foobar")) + "Case Manipulation" + (upcase + :eval (upcase "foo")) + (downcase + :eval (downcase "FOObar")) + (capitalize + :eval (capitalize "foo bar zot")) + (upcase-initials + :eval (upcase-initials "The CAT in the hAt")) + "Converting Strings" + (string-to-number + :eval (string-to-number "42") + :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 "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 + :eval (assoc-string "foo" '(("a" 1) (foo 2)))) + (seq-position + :eval "(seq-position \"foobarzot\" ?z)")) + +(define-short-documentation-group file-name + "File Name Manipulation" + (file-name-directory + :eval (file-name-directory "/tmp/foo") + :eval (file-name-directory "/tmp/foo/")) + (file-name-nondirectory + :eval (file-name-nondirectory "/tmp/foo") + :eval (file-name-nondirectory "/tmp/foo/")) + (file-name-sans-versions + :args (filename) + :eval (file-name-sans-versions "/tmp/foo~")) + (file-name-extension + :eval (file-name-extension "/tmp/foo.txt")) + (file-name-sans-extension + :eval (file-name-sans-extension "/tmp/foo.txt")) + (file-name-with-extension + :eval (file-name-with-extension "foo.txt" "bin") + :eval (file-name-with-extension "foo" "bin")) + (file-name-base + :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 + :eval (file-name-concat "/tmp/" "foo") + :eval (file-name-concat "/tmp" "foo") + :eval (file-name-concat "/tmp" "foo" "bar/" "zot") + :eval (file-name-concat "/tmp" "~")) + (expand-file-name + :eval (expand-file-name "foo" "/tmp/") + :eval (expand-file-name "foo" "/tmp///") + :eval (expand-file-name "foo" "/tmp/foo/.././") + :eval (expand-file-name "~" "/tmp/")) + (substitute-in-file-name + :eval (substitute-in-file-name "$HOME/foo")) + "Directory Functions" + (file-name-as-directory + :eval (file-name-as-directory "/tmp/foo")) + (directory-file-name + :eval (directory-file-name "/tmp/foo/")) + (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) + :eval (file-name-quote "/tmp/foo")) + (file-name-unquote + :args (name) + :eval (file-name-unquote "/:/tmp/foo")) + "Predicates" + (file-name-absolute-p + :eval (file-name-absolute-p "/tmp/foo") + :eval (file-name-absolute-p "foo")) + (directory-name-p + :eval (directory-name-p "/tmp/foo/")) + (file-name-quoted-p + :eval (file-name-quoted-p "/:/tmp/foo"))) + +(define-short-documentation-group file + "Inserting Contents" + (insert-file-contents + :no-eval (insert-file-contents "/tmp/foo") + :eg-result ("/tmp/foo" 6)) + (insert-file-contents-literally + :no-eval (insert-file-contents-literally "/tmp/foo") + :eg-result ("/tmp/foo" 6)) + (find-file + :no-eval (find-file "/tmp/foo") + :eg-result-string "#") + "Predicates" + (file-symlink-p + :no-eval (file-symlink-p "/tmp/foo") + :eg-result t) + (file-directory-p + :no-eval (file-directory-p "/tmp") + :eg-result t) + (file-regular-p + :no-eval (file-regular-p "/tmp/foo") + :eg-result t) + (file-exists-p + :no-eval (file-exists-p "/tmp/foo") + :eg-result t) + (file-readable-p + :no-eval (file-readable-p "/tmp/foo") + :eg-result t) + (file-writable-p + :no-eval (file-writable-p "/tmp/foo") + :eg-result t) + (file-accessible-directory-p + :no-eval (file-accessible-directory-p "/tmp") + :eg-result t) + (file-executable-p + :no-eval (file-executable-p "/bin/cat") + :eg-result t) + (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) + (file-in-directory-p + :no-eval (file-in-directory-p "/tmp/foo" "/tmp/") + :eg-result t) + (file-locked-p + :no-eval (file-locked-p "/tmp/foo") + :eg-result nil) + "Information" + (file-attributes + :no-eval* (file-attributes "/tmp")) + (file-truename + :no-eval (file-truename "/tmp/foo/bar") + :eg-result "/tmp/foo/zot") + (file-chase-links + :no-eval (file-chase-links "/tmp/foo/bar") + :eg-result "/tmp/foo/zot") + (vc-responsible-backend + :args (file &optional no-error) + :no-eval (vc-responsible-backend "/src/foo/bar.c") + :eg-result Git) + (file-acl + :no-eval (file-acl "/tmp/foo") + :eg-result "user::rw-\ngroup::r--\nother::r--\n") + (file-extended-attributes + :no-eval* (file-extended-attributes "/tmp/foo")) + (file-selinux-context + :no-eval* (file-selinux-context "/tmp/foo")) + (locate-file + :no-eval (locate-file "syslog" '("/var/log" "/usr/bin")) + :eg-result "/var/log/syslog") + (executable-find + :no-eval (executable-find "ls") + :eg-result "/usr/bin/ls") + "Creating" + (make-temp-file + :no-eval (make-temp-file "/tmp/foo-") + :eg-result "/tmp/foo-ZcXFMj") + (make-nearby-temp-file + :no-eval (make-nearby-temp-file "/tmp/foo-") + :eg-result "/tmp/foo-xe8iON") + (write-region + :no-value (write-region (point-min) (point-max) "/tmp/foo")) + "Directories" + (make-directory + :no-value (make-directory "/tmp/bar/zot/" t)) + (directory-files + :no-eval (directory-files "/tmp/") + :eg-result ("." ".." ".ICE-unix" ".Test-unix")) + (directory-files-recursively + :no-eval (directory-files-recursively "/tmp/" "\\.png\\'") + :eg-result ("/tmp/foo.png" "/tmp/zot.png" "/tmp/bar/foobar.png")) + (directory-files-and-attributes + :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") + :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") + (copy-directory + :no-value (copy-directory "/tmp/bar/" "/tmp/barcopy")) + (delete-directory + :no-value (delete-directory "/tmp/bar/")) + "File Operations" + (rename-file + :no-value (rename-file "/tmp/foo" "/tmp/newname")) + (copy-file + :no-value (copy-file "/tmp/foo" "/tmp/foocopy")) + (delete-file + :no-value (delete-file "/tmp/foo")) + (make-empty-file + :no-value (make-empty-file "/tmp/foo")) + (make-symbolic-link + :no-value (make-symbolic-link "/tmp/foo" "/tmp/foosymlink")) + (add-name-to-file + :no-value (add-name-to-file "/tmp/foo" "/tmp/bar")) + (set-file-modes + :no-value "(set-file-modes \"/tmp/foo\" #o644)") + (set-file-times + :no-value (set-file-times "/tmp/foo")) + "File Modes" + (set-default-file-modes + :no-value "(set-default-file-modes #o755)") + (default-file-modes + :no-eval (default-file-modes) + :eg-result-string "#o755") + (file-modes-symbolic-to-number + :no-eval (file-modes-symbolic-to-number "a+r") + :eg-result-string "#o444") + (file-modes-number-to-symbolic + :eval "(file-modes-number-to-symbolic #o444)") + (set-file-extended-attributes + :no-eval (set-file-extended-attributes + "/tmp/foo" '((acl . "group::rxx"))) + :eg-result t) + (set-file-selinux-context + :no-eval (set-file-selinux-context + "/tmp/foo" '(unconfined_u object_r user_home_t s0)) + :eg-result t) + (set-file-acl + :no-eval (set-file-acl "/tmp/foo" "group::rxx") + :eg-result t)) + +(define-short-documentation-group hash-table + "Hash Table Basics" + (make-hash-table + :no-eval (make-hash-table) + :result-string "#s(hash-table ...)") + (puthash + :no-eval (puthash 'key "value" table)) + (gethash + :no-eval (gethash 'key table) + :eg-result "value") + (remhash + :no-eval (remhash 'key table) + :result nil) + (clrhash + :no-eval (clrhash table) + :result-string "#s(hash-table ...)") + (maphash + :no-eval (maphash (lambda (key value) (message value)) table) + :result nil) + "Other Hash Table Functions" + (hash-table-p + :eval (hash-table-p 123)) + (hash-table-contains-p + :no-eval (hash-table-contains-p 'key table)) + (copy-hash-table + :no-eval (copy-hash-table table) + :result-string "#s(hash-table ...)") + (hash-table-count + :no-eval (hash-table-count table) + :eg-result 15)) + +(define-short-documentation-group list + "Making Lists" + (make-list + :eval (make-list 5 'a)) + (cons + :eval (cons 1 '(2 3 4))) + (list + :eval (list 1 2 3)) + (number-sequence + :eval (number-sequence 5 8)) + (ensure-list + :eval (ensure-list "foo") + :eval (ensure-list '(1 2 3)) + :eval (ensure-list '(1 . 2))) + (ensure-proper-list + :eval (ensure-proper-list "foo") + :eval (ensure-proper-list '(1 2 3)) + :eval (ensure-proper-list '(1 . 2))) + "Operations on Lists" + (append + :eval (append '("foo" "bar") '("zot"))) + (copy-tree + :eval (copy-tree '(1 (2 3) 4))) + (flatten-tree + :eval (flatten-tree '(1 (2 3) 4))) + (car + :eval (car '(one two three)) + :eval (car '(one . two)) + :eval (car nil)) + (cdr + :eval (cdr '(one two three)) + :eval (cdr '(one . two)) + :eval (cdr nil)) + (last + :eval (last '(one two three))) + (butlast + :eval (butlast '(one two three))) + (nbutlast + :eval (nbutlast (list 'one 'two 'three))) + (nth + :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))) + (take-while + :eval (take-while #'numberp '(1 2 three 4 five))) + (drop-while + :eval (drop-while #'numberp '(1 2 three 4 five))) + (any + :eval (any #'symbolp '(1 2 three 4 five))) + (all + :eval (all #'symbolp '(one 2 three)) + :eval (all #'symbolp '(one two three))) + (elt + :eval (elt '(one two three) 1)) + (car-safe + :eval (car-safe '(one two three))) + (cdr-safe + :eval (cdr-safe '(one two three))) + (push + :no-eval* (push 'a list)) + (pop + :no-eval* (pop list)) + (setcar + :no-eval (setcar list 'c) + :result c) + (setcdr + :no-eval (setcdr list (list c)) + :result '(c)) + (nconc + :eval (nconc (list 1) (list 2 3 4))) + (delq + :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"))) + (remq + :eval (remq 'b '(a b c))) + (remove + :eval (remove 2 '(1 2 3 4)) + :eval (remove "a" '("a" "b" "c" "d"))) + (delete-dups + :eval (delete-dups (list 1 2 4 3 2 4))) + "Mapping Over Lists" + (mapcar + :eval (mapcar #'list '(1 2 3))) + (mapcan + :eval (mapcan #'list '(1 2 3))) + (mapc + :eval (mapc #'insert '("1" "2" "3"))) + (seq-reduce + :eval (seq-reduce #'+ '(1 2 3) 0)) + (mapconcat + :eval (mapconcat #'identity '("foo" "bar") "|")) + "Predicates" + (listp + :eval (listp '(1 2 3)) + :eval (listp nil) + :eval (listp '(1 . 2))) + (consp + :eval (consp '(1 2 3)) + :eval (consp nil)) + (proper-list-p + :eval (proper-list-p '(1 2 3)) + :eval (proper-list-p nil) + :eval (proper-list-p '(1 . 2))) + (null + :eval (null nil)) + (atom + :eval (atom 'a)) + (nlistp + :eval (nlistp '(1 2 3)) + :eval (nlistp t) + :eval (nlistp '(1 . 2))) + "Finding Elements" + (memq + :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"))) + (member-ignore-case + :eval (member-ignore-case "foo" '("bar" "Foo" "zot"))) + "Association Lists" + (assoc + :eval (assoc "b" '(("a" . 1) ("b" . 2)))) + (rassoc + :eval (rassoc "b" '((1 . "a") (2 . "b")))) + (assq + :eval (assq 'b '((a . 1) (b . 2)))) + (rassq + :eval (rassq 'b '((1 . a) (2 . b)))) + (assoc-string + :eval (assoc-string "foo" '(("a" 1) (foo 2)))) + (alist-get + :eval (alist-get 2 '((1 . a) (2 . b)))) + (assoc-default + :eval (assoc-default 2 '((1 . a) (2 . b) #'=))) + (copy-alist + :eval (copy-alist '((1 . a) (2 . b)))) + (assoc-delete-all + :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) + (assq-delete-all + :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) + (rassq-delete-all + :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) + "Property Lists" + (plist-get + :eval (plist-get '(a 1 b 2 c 3) 'b)) + (plist-put + :no-eval (setq plist (plist-put plist 'd 4)) + :eg-result (a 1 b 2 c 3 d 4)) + (plist-member + :eval (plist-member '(a 1 b 2 c 3) 'b)) + "Data About Lists" + (length + :eval (length '(a b c))) + (length< + :eval (length< '(a b c) 1)) + (length> + :eval (length> '(a b c) 1)) + (length= + :eval (length= '(a b c) 3)) + (safe-length + :eval (safe-length '(a b c)))) + +(define-short-documentation-group symbol + "Making symbols" + (intern + :eval (intern "abc")) + (intern-soft + :eval (intern-soft "list") + :eval (intern-soft "Phooey!")) + (make-symbol + :eval (make-symbol "abc")) + (gensym + :no-eval (gensym) + :eg-result g37) + "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)) + "Obarrays" + (obarray-make + :eval (obarray-make)) + (obarrayp + :eval (obarrayp (obarray-make)) + :eval (obarrayp nil)) + (unintern + :no-eval (unintern "abc" my-obarray) + :eg-result t) + (mapatoms + :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray)) + (obarray-clear + :no-eval (obarray-clear my-obarray))) + +(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" + (make-vector + :eval (make-vector 5 "foo")) + (vector + :eval (vector 1 "b" 3)) + "Operations on Vectors" + (vectorp + :eval (vectorp [1]) + :eval (vectorp "1")) + (vconcat + :eval (vconcat '(1 2) [3 4])) + (append + :eval (append [1 2] nil)) + (length + :eval (length [1 2 3])) + (seq-reduce + :eval (seq-reduce #'+ [1 2 3] 0)) + (seq-subseq + :eval (seq-subseq [1 2 3 4 5] 1 3) + :eval (seq-subseq [1 2 3 4 5] 1)) + (copy-tree + :eval (copy-tree [1 (2 3) [4 5]] t)) + "Mapping Over Vectors" + (mapcar + :eval (mapcar #'identity [1 2 3])) + (mapc + :eval (mapc #'insert ["1" "2" "3"]))) + +(define-short-documentation-group regexp + "Matching Strings" + (replace-regexp-in-string + :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) + (string-match-p + :eval (string-match-p "^[fo]+" "foobar")) + "Looking in Buffers" + (re-search-forward + :no-eval (re-search-forward "^foo$" nil t) + :eg-result 43) + (re-search-backward + :no-eval (re-search-backward "^foo$" nil t) + :eg-result 43) + (looking-at-p + :no-eval (looking-at-p "f[0-9]") + :eg-result t) + "Match Data" + (match-string + :eval (and (string-match "^\\([fo]+\\)b" "foobar") + (match-string 0 "foobar"))) + (match-beginning + :no-eval (match-beginning 1) + :eg-result 0) + (match-end + :no-eval (match-end 1) + :eg-result 3) + (save-match-data + :no-eval (save-match-data ...)) + "Replacing Match" + (replace-match + :no-eval (replace-match "new") + :eg-result nil) + (match-substitute-replacement + :no-eval (match-substitute-replacement "new") + :eg-result "new") + (replace-regexp-in-region + :no-value (replace-regexp-in-region "[0-9]+" "Num \\&")) + "Utilities" + (regexp-quote + :eval (regexp-quote "foo.*bar")) + (regexp-opt + :eval (regexp-opt '("foo" "bar"))) + (regexp-opt-depth + :eval (regexp-opt-depth "\\(a\\(b\\)\\)")) + (regexp-opt-charset + :eval (regexp-opt-charset '(?a ?b ?c ?d ?e))) + "The `rx' Structured Regexp Notation" + (rx + :eval (rx "IP=" (+ digit) (= 3 "." (+ digit)))) + (rx-to-string + :eval (rx-to-string '(| "foo" "bar"))) + (rx-define + :no-eval "(and (rx-define haskell-comment (seq \"--\" (zero-or-more nonl))) + (rx haskell-comment))" + :result "--.*") + (rx-let + :eval "(rx-let ((comma-separated (item) (seq item (0+ \",\" item))) + (number (1+ digit)) + (numbers (comma-separated number))) + (rx \"(\" numbers \")\"))" + :result "([[:digit:]]+\\(?:,[[:digit:]]+\\)*)") + (rx-let-eval + :eval "(rx-let-eval + '((ponder (x) (seq \"Where have all the \" x \" gone?\"))) + (rx-to-string + '(ponder (or \"flowers\" \"cars\" \"socks\"))))" + :result "\\(?:Where have all the \\(?:\\(?:car\\|flower\\|sock\\)s\\) gone\\?\\)")) + +(define-short-documentation-group sequence + "Sequence Predicates" + (seq-contains-p + :eval (seq-contains-p '(a b c) 'b) + :eval (seq-contains-p '(a b c) 'd)) + (seq-every-p + :eval (seq-every-p #'numberp '(1 2 3))) + (seq-empty-p + :eval (seq-empty-p [])) + (seq-set-equal-p + :eval (seq-set-equal-p '(1 2 3) '(3 1 2))) + (seq-some + :eval (seq-some #'floatp '(1 2.0 3))) + "Building Sequences" + (seq-concatenate + :eval (seq-concatenate 'vector '(1 2) '(c d))) + (seq-copy + :eval (seq-copy '(a 2))) + (seq-into + :eval (seq-into '(1 2 3) 'vector)) + "Utility Functions" + (seq-count + :eval (seq-count #'numberp '(1 b c 4))) + (seq-elt + :eval (seq-elt '(a b c) 1)) + (seq-random-elt + :no-eval (seq-random-elt '(a b c)) + :eg-result c) + (seq-find + :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 + :eval (seq-max [1 2 3])) + (seq-min + :eval (seq-min [1 2 3])) + (seq-first + :eval (seq-first [a b c])) + (seq-rest + :eval (seq-rest '[1 2 3])) + (seq-reverse + :eval (seq-reverse '(1 2 3))) + (seq-sort + :eval (seq-sort #'> '(1 2 3))) + (seq-sort-by + :eval (seq-sort-by (lambda (a) (/ 1.0 a)) #'< '(1 2 3))) + "Mapping Over Sequences" + (seq-map + :eval (seq-map #'1+ '(1 2 3))) + (seq-map-indexed + :eval (seq-map-indexed (lambda (a i) (cons i a)) '(a b c))) + (seq-mapcat + :eval (seq-mapcat #'upcase '("a" "b" "c") 'string)) + (seq-doseq + :no-eval (seq-doseq (a '("foo" "bar")) (insert a)) + :eg-result ("foo" "bar")) + (seq-do + :no-eval (seq-do (lambda (a) (insert a)) '("foo" "bar")) + :eg-result ("foo" "bar")) + (seq-do-indexed + :no-eval (seq-do-indexed + (lambda (a index) (message "%s:%s" index a)) + '("foo" "bar")) + :eg-result nil) + (seq-reduce + :eval (seq-reduce #'* [1 2 3] 2)) + "Excerpting Sequences" + (seq-drop + :eval (seq-drop '(a b c) 2)) + (seq-drop-while + :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 #'natnump '(-1 2 3 -4 -5 6))) + (seq-union + :eval (seq-union '(1 2 3) '(3 5))) + (seq-difference + :eval (seq-difference '(1 2 3) '(2 3 4))) + (seq-intersection + :eval (seq-intersection '(1 2 3) '(2 3 4))) + (seq-partition + :eval (seq-partition '(a b c d e f g h) 3)) + (seq-subseq + :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 #'integerp [1 2 3.0 4])) + (seq-uniq + :eval (seq-uniq '(a b d b a c)))) + +(define-short-documentation-group buffer + "Buffer Basics" + (current-buffer + :no-eval (current-buffer) + :eg-result-string "#") + (bufferp + :eval (bufferp 23)) + (buffer-live-p + :no-eval (buffer-live-p some-buffer) + :eg-result t) + (buffer-modified-p + :eval (buffer-modified-p (current-buffer))) + (buffer-name + :eval (buffer-name)) + (window-buffer + :eval (window-buffer)) + "Selecting Buffers" + (get-buffer-create + :no-eval (get-buffer-create "*foo*") + :eg-result-string "#") + (pop-to-buffer + :no-eval (pop-to-buffer "*foo*") + :eg-result-string "#") + (with-current-buffer + :no-eval* (with-current-buffer buffer (buffer-size))) + "Points and Positions" + (point + :eval (point)) + (point-min + :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)) + :eg-result 342) + (search-forward + :no-eval (search-forward "some-string" nil t) + :eg-result 245) + (re-search-forward + :no-eval (re-search-forward "some-s.*g" nil t) + :eg-result 245) + (forward-line + :no-eval (forward-line 1) + :eg-result 0 + :no-eval (forward-line -2) + :eg-result 0) + "Strings from Buffers" + (buffer-string + :no-eval* (buffer-string)) + (buffer-substring + :eval (buffer-substring (point-min) (+ (point-min) 10))) + (buffer-substring-no-properties + :eval (buffer-substring-no-properties (point-min) (+ (point-min) 10))) + (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") + "Altering Buffers" + (delete-region + :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 + :no-eval "(subst-char-in-region (point-min) (point-max) ?+ ?-)") + (replace-string-in-region + :no-value (replace-string-in-region "foo" "bar")) + "Locking" + (lock-buffer + :no-value (lock-buffer "/tmp/foo")) + (unlock-buffer + :no-value (unlock-buffer))) + +(define-short-documentation-group overlay + "Predicates" + (overlayp + :no-eval (overlayp some-overlay) + :eg-result t) + "Creation and Deletion" + (make-overlay + :args (beg end &optional buffer) + :no-eval (make-overlay 1 10) + :eg-result-string "#") + (delete-overlay + :no-eval (delete-overlay foo) + :eg-result t) + "Searching Overlays" + (overlays-at + :no-eval (overlays-at 15) + :eg-result-string "(#)") + (overlays-in + :no-eval (overlays-in 1 30) + :eg-result-string "(#)") + (next-overlay-change + :no-eval (next-overlay-change 1) + :eg-result 20) + (previous-overlay-change + :no-eval (previous-overlay-change 30) + :eg-result 20) + "Overlay Properties" + (overlay-start + :no-eval (overlay-start foo) + :eg-result 1) + (overlay-end + :no-eval (overlay-end foo) + :eg-result 10) + (overlay-put + :no-eval (overlay-put foo 'happy t) + :eg-result t) + (overlay-get + :no-eval (overlay-get foo 'happy) + :eg-result t) + (overlay-buffer + :no-eval (overlay-buffer foo)) + "Moving Overlays" + (move-overlay + :no-eval (move-overlay foo 5 20) + :eg-result-string "#")) + +(define-short-documentation-group process + (make-process + :no-eval (make-process :name "foo" :command '("cat" "/tmp/foo")) + :eg-result-string "#") + (processp + :eval (processp t)) + (process-status + :no-eval (process-status process) + :eg-result exit) + (delete-process + :no-value (delete-process process)) + (kill-process + :no-value (kill-process process)) + (set-process-sentinel + :no-value (set-process-sentinel process (lambda (proc string)))) + (process-buffer + :no-eval (process-buffer process) + :eg-result-string "#") + (get-buffer-process + :no-eval (get-buffer-process buffer) + :eg-result-string "#") + (process-live-p + :no-eval (process-live-p process) + :eg-result t)) + +(define-short-documentation-group number + "Arithmetic" + (+ + :args (&rest numbers) + :eval (+ 1 2) + :eval (+ 1 2 3 4)) + (- + :args (&rest numbers) + :eval (- 3 2) + :eval (- 6 3 2)) + (* + :args (&rest numbers) + :eval (* 3 4 5)) + (/ + :eval (/ 10 5) + :eval (/ 10 6) + :eval (/ 10.0 6) + :eval (/ 10.0 3 3)) + (% + :eval (% 10 5) + :eval (% 10 6)) + (mod + :eval (mod 10 5) + :eval (mod 10 6) + :eval (mod 10.5 6)) + (1+ + :eval (1+ 2) + :eval (let ((x 2)) (1+ x) x)) + (1- + :eval (1- 4) + :eval (let ((x 4)) (1- x) x)) + (incf + :eval (let ((x 2)) (incf x) x) + :eval (let ((x 2)) (incf x 2) x)) + (decf + :eval (let ((x 4)) (decf x) x) + :eval (let ((x 4)) (decf x 2)) x) + "Predicates" + (= + :args (number &rest numbers) + :eval (= 4 4) + :eval (= 4.0 4.0) + :eval (= 4 4.0) + :eval (= 4 4 4 4)) + (eql + :eval (eql 4 4) + :eval (eql 4.0 4.0)) + (/= + :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)) + (zerop + :eval (zerop 0)) + (natnump + :eval (natnump -1) + :eval (natnump 0) + :eval (natnump 23)) + (plusp + :eval (plusp 0) + :eval (plusp 1)) + (minusp + :eval (minusp 0) + :eval (minusp -1)) + (oddp + :eval (oddp 3)) + (evenp + :eval (evenp 6)) + (bignump + :eval (bignump 4) + :eval (bignump (expt 2 90))) + (fixnump + :eval (fixnump 4) + :eval (fixnump (expt 2 90))) + (floatp + :eval (floatp 5.4)) + (integerp + :eval (integerp 5.4)) + (numberp + :eval (numberp "5.4")) + (cl-digit-char-p + :eval (cl-digit-char-p ?5 10) + :eval (cl-digit-char-p ?f 16)) + "Operations" + (max + :args (number &rest numbers) + :eval (max 7 9 3)) + (min + :args (number &rest numbers) + :eval (min 7 9 3)) + (abs + :eval (abs -4)) + (float + :eval (float 2)) + (truncate + :eval (truncate 1.2) + :eval (truncate -1.2) + :eval (truncate 5.4 2)) + (floor + :eval (floor 1.2) + :eval (floor -1.2) + :eval (floor 5.4 2)) + (ceiling + :eval (ceiling 1.2) + :eval (ceiling -1.2) + :eval (ceiling 5.4 2)) + (round + :eval (round 1.2) + :eval (round -1.2) + :eval (round 5.4 2)) + (random + :eval (random 6)) + "Bit Operations" + (ash + :eval (ash 1 4) + :eval (ash 16 -1)) + (logand + :no-eval "(logand #b10 #b111)" + :result-string "#b10") + (logior + :eval (logior 4 16)) + (logxor + :eval (logxor 4 16)) + (lognot + :eval (lognot 5)) + (logcount + :eval (logcount 5)) + "Floating Point" + (isnan + :eval (isnan 5.0)) + (frexp + :eval (frexp 5.7)) + (ldexp + :eval (ldexp 0.7125 3)) + (logb + :eval (logb 10.5)) + (ffloor + :eval (ffloor 1.2)) + (fceiling + :eval (fceiling 1.2)) + (ftruncate + :eval (ftruncate 1.2)) + (fround + :eval (fround 1.2)) + "Standard Math Functions" + (sin + :eval (sin float-pi)) + (cos + :eval (cos float-pi)) + (tan + :eval (tan float-pi)) + (asin + :eval (asin float-pi)) + (acos + :eval (acos float-pi)) + (atan + :eval (atan float-pi)) + (exp + :eval (exp 4)) + (log + :eval (log 54.59)) + (expt + :eval (expt 2 16)) + (sqrt + :eval (sqrt -1))) + +(define-short-documentation-group text-properties + "Examining Text Properties" + (get-text-property + :eval (get-text-property 0 'foo (propertize "x" 'foo t))) + (get-char-property + :eval (get-char-property 0 'foo (propertize "x" 'foo t))) + (get-pos-property + :eval (get-pos-property 0 'foo (propertize "x" 'foo t))) + (get-char-property-and-overlay + :eval (get-char-property-and-overlay 0 'foo (propertize "x" 'foo t))) + (text-properties-at + :eval (text-properties-at (point))) + "Changing Text Properties" + (put-text-property + :eval (let ((s (copy-sequence "abc"))) (put-text-property 0 1 'foo t s) s) + :no-eval (put-text-property (point) (1+ (point)) 'face 'error)) + (add-text-properties + :no-eval (add-text-properties (point) (1+ (point)) '(face error))) + (remove-text-properties + :no-eval (remove-text-properties (point) (1+ (point)) '(face nil))) + (remove-list-of-text-properties + :no-eval (remove-list-of-text-properties (point) (1+ (point)) '(face font-lock-face))) + (set-text-properties + :no-eval (set-text-properties (point) (1+ (point)) '(face error))) + (add-face-text-property + :no-eval (add-face-text-property START END '(:foreground "green"))) + (propertize + :eval (propertize "foo" 'face 'italic 'mouse-face 'bold-italic)) + "Searching for Text Properties" + (next-property-change + :no-eval (next-property-change (point) (current-buffer))) + (previous-property-change + :no-eval (previous-property-change (point) (current-buffer))) + (next-single-property-change + :no-eval (next-single-property-change (point) 'face (current-buffer))) + (previous-single-property-change + :no-eval (previous-single-property-change (point) 'face (current-buffer))) + ;; TODO: There are some more that could be added here. + (text-property-search-forward + :no-eval (text-property-search-forward 'face nil t)) + (text-property-search-backward + :no-eval (text-property-search-backward 'face nil t))) + +(define-short-documentation-group keymaps + "Defining keymaps or adding bindings to existing keymaps" + (define-keymap + :no-eval (define-keymap "C-c C-c" #'quit-buffer) + :no-eval (define-keymap :keymap ctl-x-map + "C-r" #'recentf-open + "k" #'kill-current-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 "" 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 same-window) + "Pop to a buffer with short documentation summary for functions in GROUP. +Interactively, prompt for GROUP. +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 + "Group of functions for which to show summary: " + (mapcar #'car shortdoc--groups)))) + (when (stringp group) + (setq group (intern group))) + (unless (assq group shortdoc--groups) + (error "No such documentation group %s" group)) + (let ((buf (get-buffer-create (format "*Shortdoc %s*" group)))) + (shortdoc--insert-group-in-buffer group buf) + (funcall (if same-window + #'pop-to-buffer-same-window + #'pop-to-buffer) + buf)) + (goto-char (point-min)) + (when function + (text-property-search-forward 'shortdoc-function function t) + (beginning-of-line))) + +(defun shortdoc--insert-group-in-buffer (group &optional buf) + "Insert a short documentation summary for functions in GROUP in buffer BUF. +BUF defaults to the current buffer if nil or omitted." + (with-current-buffer (or buf (current-buffer)) + (let ((inhibit-read-only t) + (prev nil)) + (erase-buffer) + (shortdoc-mode) + (button-mode) + (mapc + (lambda (data) + (cond + ((stringp data) + (setq prev nil) + (unless (bobp) + (insert "\n")) + (insert (propertize + (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) + ;; This helps with hidden outlines (bug#53981) + (propertize "\n" 'face '(:height 0)))) + (setq prev t) + (shortdoc--display-function data)))) + (cdr (assq group shortdoc--groups)))))) + +;;;###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 'outline-level 2)) + (if (plist-get data :no-manual) + (insert-text-button + (symbol-name function) + 'face 'button + 'action (lambda (_) + (describe-function function)) + 'follow-link t + '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 "mouse-1, RET: show \ +function's documentation in the Info manual")) + (setq arglist-start (point)) + (insert ")\n") + ;; Doc string. + (insert " " + (or (plist-get data :doc) + (car (split-string (or (documentation function) + "Error: missing docstring.") + "\n")))) + (insert "\n") + (add-face-text-property start-section (point) 'shortdoc-section t) + (let ((print-escape-newlines t) + (double-arrow (if (char-displayable-p ?⇒) + "⇒" + "=>")) + (single-arrow (if (char-displayable-p ?→) + "→" + "->")) + (start-example (point))) + (cl-loop for (type value) on data by #'cddr + do + (cl-case type + (:eval + (insert " ") + (if (stringp value) + (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") + (insert " ") + (prin1 value (current-buffer))) + (insert "\n " single-arrow " " + (propertize "[it depends]" + 'face 'shortdoc-section) + "\n")) + (:no-value + (if (stringp value) + (insert " " value) + (insert " ") + (prin1 value (current-buffer))) + (insert "\n")) + (:no-eval + (if (stringp value) + (insert " " value) + (insert " ") + (prin1 value (current-buffer))) + (insert "\n")) + (:result + (insert " " double-arrow " ") + (prin1 value (current-buffer)) + (insert "\n")) + (:result-string + (insert " " double-arrow " ") + (princ value (current-buffer)) + (insert "\n")) + (:eg-result + (insert " e.g. " double-arrow " ") + (prin1 value (current-buffer)) + (insert "\n")) + (:eg-result-string + (insert " e.g. " double-arrow " ") + (princ value (current-buffer)) + (insert "\n")))) + (add-text-properties start-example (point) `(shortdoc-example ,function))) + ;; Insert the arglist after doing the evals, in case that's pulled + ;; in the function definition. + (save-excursion + (goto-char arglist-start) + (dolist (param (or (plist-get data :args) + (help-function-arglist function t))) + (insert " " (symbol-name param))) + (add-face-text-property arglist-start (point) 'shortdoc-section t)))) + +(defun shortdoc-function-examples (function) + "Return all shortdoc examples for FUNCTION. +The result is an alist with items of the form (GROUP . EXAMPLES), +where GROUP is a shortdoc group where FUNCTION appears, and +EXAMPLES is a string with the usage examples of FUNCTION defined +in GROUP. Return nil if FUNCTION is not a function or if it +doesn't has any shortdoc information." + (let ((groups (and (symbolp function) + (shortdoc-function-groups function))) + (examples nil)) + (mapc + (lambda (group) + (with-temp-buffer + (shortdoc--insert-group-in-buffer group) + (goto-char (point-min)) + (let ((match (text-property-search-forward + 'shortdoc-example function t))) + (push `(,group . ,(string-trim + (buffer-substring-no-properties + (prop-match-beginning match) + (prop-match-end match)))) + examples)))) + groups) + examples)) + +(defun shortdoc-help-fns-examples-function (function) + "Insert Emacs Lisp examples for FUNCTION into the current buffer. +You can add this function to the `help-fns-describe-function-functions' +hook to show examples of using FUNCTION in *Help* buffers produced +by \\[describe-function]." + (let* ((examples (shortdoc-function-examples function)) + (num-examples (length examples)) + (times 0)) + (dolist (example examples) + (when (zerop times) + (if (> num-examples 1) + (insert "\n Examples:\n\n") + ;; Some functions have more than one example per group. + ;; Count the number of arrows to know if we need to + ;; pluralize "Example". + (let* ((text (cdr example)) + (count 0) + (pos 0) + (end (length text)) + (double-arrow (if (char-displayable-p ?⇒) + " ⇒" + " =>")) + (double-arrow-example (if (char-displayable-p ?⇒) + " e.g. ⇒" + " e.g. =>")) + (single-arrow (if (char-displayable-p ?→) + " →" + " ->"))) + (while (and (< pos end) + (or (string-match double-arrow text pos) + (string-match double-arrow-example text pos) + (string-match single-arrow text pos))) + (setq count (1+ count) + pos (match-end 0))) + (if (> count 1) + (insert "\n Examples:\n\n") + (insert "\n Example:\n\n"))))) + (setq times (1+ times)) + (insert " ") + (insert (cdr example)) + (insert "\n\n")))) + +(defun shortdoc-function-groups (function) + "Return all shortdoc groups FUNCTION appears in." + (cl-loop for group in shortdoc--groups + when (assq function (cdr group)) + collect (car group))) + +(defun shortdoc-add-function (group section elem) + "Add ELEM to shortdoc GROUP in SECTION. +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\")))" + (let ((glist (assq group shortdoc--groups))) + (unless glist + (setq glist (list group)) + (push glist shortdoc--groups)) + (let ((slist (member section glist))) + (unless slist + (setq slist (list section)) + (nconc glist slist)) + (while (and (cdr slist) + (not (stringp (cadr slist)))) + (setq slist (cdr slist))) + (setcdr slist (cons elem (cdr slist)))))) + +(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 + (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) + (setq arg 1)) + (while (> arg 0) + (funcall + (if reverse 'text-property-search-backward + 'text-property-search-forward) + sym nil t) + (setq arg (1- arg)))) + +(defun shortdoc-next (&optional arg) + "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 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 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 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 diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el deleted file mode 100644 index ea6910c60fc..00000000000 --- a/lisp/emacs-lisp/shortdoc.el +++ /dev/null @@ -1,1960 +0,0 @@ -;;; shortdoc.el --- Short function summaries -*- lexical-binding: t -*- - -;; Copyright (C) 2020-2026 Free Software Foundation, Inc. - -;; Keywords: lisp, help -;; Package: emacs - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; 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) -(require 'text-property-search) -(eval-when-compile (require 'cl-lib)) - -(defgroup shortdoc nil - "Short documentation." - :group 'lisp) - -(defface shortdoc-heading - '((t :inherit variable-pitch :height 1.3 :weight bold)) - "Face used for a heading." - :version "28.1") - -(defface shortdoc-section - '((t :inherit variable-pitch)) - "Face used for a section.") - -;;;###autoload -(defun shortdoc--check (group functions) - (let ((keywords '( :no-manual :args :eval :no-eval :no-value :no-eval* - :result :result-string :eg-result :eg-result-string :doc))) - (dolist (f functions) - (when (consp f) - (dolist (x f) - (when (and (keywordp x) (not (memq x keywords))) - (error "Shortdoc %s function `%s': bad keyword `%s'" - group (car f) x))))))) - -;;;###autoload -(progn - (defvar shortdoc--groups nil) - - (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: - - (FUNC - :no-manual BOOL - :args ARGS - :eval EVAL - :no-eval EXAMPLE-FORM - :no-value EXAMPLE-FORM - :no-eval* EXAMPLE-FORM - :result RESULT-FORM - :result-string RESULT-STRING - :eg-result RESULT-FORM - :eg-result-string RESULT-STRING) - -FUNC is the function being documented. - -NO-MANUAL should be non-nil if FUNC isn't documented in the -manual. - -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. - -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. - -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)) - (shortdoc--check group functions) - `(progn - (setq shortdoc--groups (delq (assq ',group shortdoc--groups) - shortdoc--groups)) - (push (cons ',group ',functions) shortdoc--groups)))) - -(define-short-documentation-group alist - "Alist Basics" - (assoc - :eval (assoc 'foo '((foo . bar) (zot . baz)))) - (rassoc - :eval (rassoc 'bar '((foo . bar) (zot . baz)))) - (assq - :eval (assq 'foo '((foo . bar) (zot . baz)))) - (rassq - :eval (rassq 'bar '((foo . bar) (zot . baz)))) - (assoc-string - :eval (assoc-string "foo" '(("foo" . "bar") ("zot" "baz")))) - "Manipulating Alists" - (assoc-delete-all - :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) - (assq-delete-all - :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) - (rassq-delete-all - :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) - (alist-get - :eval (let ((foo '((bar . baz)))) - (setf (alist-get 'bar foo) 'zot) - foo)) - "Misc" - (assoc-default - :eval (assoc-default "foobar" '(("foo" . baz)) #'string-match)) - (copy-alist - :eval (let* ((old '((foo . bar))) - (new (copy-alist old))) - (eq old new))) - ;; FIXME: Outputs "\.rose" for the symbol `.rose'. It would be - ;; better if that could be cleaned up. - (let-alist - :eval (let ((colors '((rose . red) - (lily . white)))) - (let-alist colors - (if (eq .rose 'red) - .lily))))) - -(define-short-documentation-group map - "Map Basics" - (mapp - :eval (mapp (list 'bar 1 'foo 2 'baz 3)) - :eval (mapp (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (mapp [bar foo baz]) - :eval (mapp "this is a string") - :eval (mapp #s(hash-table data (bar 1 foo 2 baz 3))) - :eval (mapp '()) - :eval (mapp nil) - :eval (mapp (make-char-table 'shortdoc-test))) - (map-empty-p - :args (map) - :eval (map-empty-p nil) - :eval (map-empty-p []) - :eval (map-empty-p '())) - (map-elt - :args (map key) - :eval (map-elt (list 'bar 1 'foo 2 'baz 3) 'foo) - :eval (map-elt (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) - :eval (map-elt [bar foo baz] 1) - :eval (map-elt #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) - (map-contains-key - :args (map key) - :eval (map-contains-key (list 'bar 1 'foo 2 'baz 3) 'foo) - :eval (map-contains-key (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) - :eval (map-contains-key [bar foo baz] 1) - :eval (map-contains-key #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) - (map-put! - (map key value) - :eval -"(let ((map (list 'bar 1 'baz 3))) - (map-put! map 'foo 2) - map)" -;; This signals map-not-inplace when used in shortdoc.el :-( -;; :eval -;; "(let ((map (list '(bar . 1) '(baz . 3)))) -;; (map-put! map 'foo 2) -;; map)" - :eval -"(let ((map [bar bot baz])) - (map-put! map 1 'foo) - map)" - :eval -"(let ((map #s(hash-table data (bar 1 baz 3)))) - (map-put! map 'foo 2) - map)") - (map-insert - :args (map key value) - :eval (map-insert (list 'bar 1 'baz 3 'foo 7) 'foo 2) - :eval (map-insert (list '(bar . 1) '(baz . 3) '(foo . 7)) 'foo 2) - :eval (map-insert [bar bot baz] 1 'foo) - :eval (map-insert #s(hash-table data (bar 1 baz 3 foo 7)) 'foo 2)) - (map-delete - :args (map key) - :eval (map-delete (list 'bar 1 'foo 2 'baz 3) 'foo) - :eval (map-delete (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) - :eval (map-delete [bar foo baz] 1) - :eval (map-delete #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) - (map-keys - :eval (map-keys (list 'bar 1 'foo 2 'baz 3)) - :eval (map-keys (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-keys [bar foo baz]) - :eval (map-keys #s(hash-table data (bar 1 foo 2 baz 3)))) - (map-values - :args (map) - :eval (map-values (list 'bar 1 'foo 2 'baz 3)) - :eval (map-values (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-values [bar foo baz]) - :eval (map-values #s(hash-table data (bar 1 foo 2 baz 3)))) - (map-pairs - :eval (map-pairs (list 'bar 1 'foo 2 'baz 3)) - :eval (map-pairs (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-pairs [bar foo baz]) - :eval (map-pairs #s(hash-table data (bar 1 foo 2 baz 3)))) - (map-length - :args (map) - :eval (map-length (list 'bar 1 'foo 2 'baz 3)) - :eval (map-length (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-length [bar foo baz]) - :eval (map-length #s(hash-table data (bar 1 foo 2 baz 3)))) - (map-copy - :args (map) - :eval (map-copy (list 'bar 1 'foo 2 'baz 3)) - :eval (map-copy (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-copy [bar foo baz]) - :eval (map-copy #s(hash-table data (bar 1 foo 2 baz 3)))) - "Doing things to maps and their contents" - (map-apply - :args (function map) - :eval (map-apply #'+ (list '(1 . 2) '(3 . 4)))) - (map-do - :args (function map) - :eval -"(let ((map (list '(1 . 1) '(2 . 3))) - acc) - (map-do (lambda (k v) (push (+ k v) acc)) map) - (nreverse acc))") - (map-keys-apply - :eval (map-keys-apply #'1+ (list '(1 . 2) '(3 . 4)))) - (map-values-apply - :args (function map) - :eval (map-values-apply #'1+ (list '(1 . 2) '(3 . 4)))) - (map-filter - :eval (map-filter (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) - :eval (map-filter (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) - (map-remove - :eval (map-remove (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) - :eval (map-remove (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) - (map-some - :eval (map-some (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) - :eval (map-some (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) - (map-every-p - :eval (map-every-p (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) - :eval (map-every-p (lambda (k v) (evenp (+ k v))) (list '(1 . 3) '(4 . 6)))) - "Combining and changing maps" - (map-merge - :eval (map-merge 'alist '(1 2 3 4) #s(hash-table data (5 6 7 8))) - :eval (map-merge 'list '(1 2 3 4) #s(hash-table data (5 6 7 8))) - :eval (map-merge 'plist '(1 2 3 4) #s(hash-table data (5 6 7 8))) - :eval (map-merge 'hash-table '(1 2 3 4) #s(hash-table data (5 6 7 8)))) - (map-merge-with - :eval (map-merge-with 'alist #'max '(1 2 3 4) #s(hash-table data (1 1 3 5))) - :eval (map-merge-with 'alist #'min '(1 2 3 4) #s(hash-table data (1 1 3 5))) - :eval (map-merge-with 'hash-table #'min '(1 2 3 4) #s(hash-table data (1 1 3 5)))) - (map-into - :args (map type) - :eval (map-into #s(hash-table data '(5 6 7 8)) 'list) - :eval (map-into '((5 . 6) (7 . 8)) 'plist) - :eval (map-into '((5 . 6) (7 . 8)) 'hash-table))) - -(define-short-documentation-group string - "Making Strings" - (make-string - :args (length init) - :eval "(make-string 5 ?x)") - (string - :eval "(string ?a ?b ?c)") - (concat - :eval (concat "foo" "bar" "zot")) - (string-join - :no-manual t - :eval (string-join '("foo" "bar" "zot") " ")) - (mapconcat - :eval (mapconcat (lambda (a) (concat "[" a "]")) - '("foo" "bar" "zot") " ")) - (string-pad - :eval (string-pad "foo" 5) - :eval (string-pad "foobar" 5) - :eval (string-pad "foo" 5 ?- t)) - (mapcar - :eval (mapcar #'identity "123")) - (format - :eval (format "This number is %d" 4)) - "Manipulating Strings" - (substring - :eval (substring "abcde" 1 3) - :eval (substring "abcde" 2) - :eval (substring "abcde" 1 -1) - :eval (substring "abcde" -4 4)) - (string-limit - :eval (string-limit "foobar" 3) - :eval (string-limit "foobar" 3 t) - :eval (string-limit "foobar" 10) - :eval (string-limit "fo好" 3 nil 'utf-8)) - (truncate-string-to-width - :eval (truncate-string-to-width "foobar" 3) - :eval (truncate-string-to-width "你好bar" 5)) - (split-string - :eval (split-string "foo bar") - :eval (split-string "|foo|bar|" "|") - :eval (split-string "|foo|bar|" "|" t)) - (split-string-and-unquote - :eval (split-string-and-unquote "foo \"bar zot\"")) - (split-string-shell-command - :eval (split-string-shell-command "ls /tmp/'foo bar'")) - (string-lines - :eval (string-lines "foo\n\nbar") - :eval (string-lines "foo\n\nbar" t)) - (string-replace - :eval (string-replace "foo" "bar" "foozot")) - (replace-regexp-in-string - :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) - (string-trim - :args (string) - :doc "Trim STRING of leading and trailing white space." - :eval (string-trim " foo ")) - (string-trim-left - :eval (string-trim-left "oofoo" "o+")) - (string-trim-right - :eval (string-trim-right "barkss" "s+")) - (string-truncate-left - :no-manual t - :eval (string-truncate-left "longstring" 8)) - (string-remove-suffix - :no-manual t - :eval (string-remove-suffix "bar" "foobar")) - (string-remove-prefix - :no-manual t - :eval (string-remove-prefix "foo" "foobar")) - (string-chop-newline - :eval (string-chop-newline "foo\n")) - (string-clean-whitespace - :eval (string-clean-whitespace " foo bar ")) - (string-fill - :eval (string-fill "Three short words" 12) - :eval (string-fill "Long-word" 3)) - (reverse - :eval (reverse "foo")) - (substring-no-properties - :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 "Å")) - (string-glyph-decompose - :eval (string-glyph-decompose "Å")) - "Predicates for Strings" - (string-equal - :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 "")) - (string-blank-p - :no-manual t - :eval (string-blank-p " \n")) - (string-lessp - :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 "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 - :eval (string-suffix-p "bar" "foobar")) - "Case Manipulation" - (upcase - :eval (upcase "foo")) - (downcase - :eval (downcase "FOObar")) - (capitalize - :eval (capitalize "foo bar zot")) - (upcase-initials - :eval (upcase-initials "The CAT in the hAt")) - "Converting Strings" - (string-to-number - :eval (string-to-number "42") - :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 "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 - :eval (assoc-string "foo" '(("a" 1) (foo 2)))) - (seq-position - :eval "(seq-position \"foobarzot\" ?z)")) - -(define-short-documentation-group file-name - "File Name Manipulation" - (file-name-directory - :eval (file-name-directory "/tmp/foo") - :eval (file-name-directory "/tmp/foo/")) - (file-name-nondirectory - :eval (file-name-nondirectory "/tmp/foo") - :eval (file-name-nondirectory "/tmp/foo/")) - (file-name-sans-versions - :args (filename) - :eval (file-name-sans-versions "/tmp/foo~")) - (file-name-extension - :eval (file-name-extension "/tmp/foo.txt")) - (file-name-sans-extension - :eval (file-name-sans-extension "/tmp/foo.txt")) - (file-name-with-extension - :eval (file-name-with-extension "foo.txt" "bin") - :eval (file-name-with-extension "foo" "bin")) - (file-name-base - :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 - :eval (file-name-concat "/tmp/" "foo") - :eval (file-name-concat "/tmp" "foo") - :eval (file-name-concat "/tmp" "foo" "bar/" "zot") - :eval (file-name-concat "/tmp" "~")) - (expand-file-name - :eval (expand-file-name "foo" "/tmp/") - :eval (expand-file-name "foo" "/tmp///") - :eval (expand-file-name "foo" "/tmp/foo/.././") - :eval (expand-file-name "~" "/tmp/")) - (substitute-in-file-name - :eval (substitute-in-file-name "$HOME/foo")) - "Directory Functions" - (file-name-as-directory - :eval (file-name-as-directory "/tmp/foo")) - (directory-file-name - :eval (directory-file-name "/tmp/foo/")) - (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) - :eval (file-name-quote "/tmp/foo")) - (file-name-unquote - :args (name) - :eval (file-name-unquote "/:/tmp/foo")) - "Predicates" - (file-name-absolute-p - :eval (file-name-absolute-p "/tmp/foo") - :eval (file-name-absolute-p "foo")) - (directory-name-p - :eval (directory-name-p "/tmp/foo/")) - (file-name-quoted-p - :eval (file-name-quoted-p "/:/tmp/foo"))) - -(define-short-documentation-group file - "Inserting Contents" - (insert-file-contents - :no-eval (insert-file-contents "/tmp/foo") - :eg-result ("/tmp/foo" 6)) - (insert-file-contents-literally - :no-eval (insert-file-contents-literally "/tmp/foo") - :eg-result ("/tmp/foo" 6)) - (find-file - :no-eval (find-file "/tmp/foo") - :eg-result-string "#") - "Predicates" - (file-symlink-p - :no-eval (file-symlink-p "/tmp/foo") - :eg-result t) - (file-directory-p - :no-eval (file-directory-p "/tmp") - :eg-result t) - (file-regular-p - :no-eval (file-regular-p "/tmp/foo") - :eg-result t) - (file-exists-p - :no-eval (file-exists-p "/tmp/foo") - :eg-result t) - (file-readable-p - :no-eval (file-readable-p "/tmp/foo") - :eg-result t) - (file-writable-p - :no-eval (file-writable-p "/tmp/foo") - :eg-result t) - (file-accessible-directory-p - :no-eval (file-accessible-directory-p "/tmp") - :eg-result t) - (file-executable-p - :no-eval (file-executable-p "/bin/cat") - :eg-result t) - (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) - (file-in-directory-p - :no-eval (file-in-directory-p "/tmp/foo" "/tmp/") - :eg-result t) - (file-locked-p - :no-eval (file-locked-p "/tmp/foo") - :eg-result nil) - "Information" - (file-attributes - :no-eval* (file-attributes "/tmp")) - (file-truename - :no-eval (file-truename "/tmp/foo/bar") - :eg-result "/tmp/foo/zot") - (file-chase-links - :no-eval (file-chase-links "/tmp/foo/bar") - :eg-result "/tmp/foo/zot") - (vc-responsible-backend - :args (file &optional no-error) - :no-eval (vc-responsible-backend "/src/foo/bar.c") - :eg-result Git) - (file-acl - :no-eval (file-acl "/tmp/foo") - :eg-result "user::rw-\ngroup::r--\nother::r--\n") - (file-extended-attributes - :no-eval* (file-extended-attributes "/tmp/foo")) - (file-selinux-context - :no-eval* (file-selinux-context "/tmp/foo")) - (locate-file - :no-eval (locate-file "syslog" '("/var/log" "/usr/bin")) - :eg-result "/var/log/syslog") - (executable-find - :no-eval (executable-find "ls") - :eg-result "/usr/bin/ls") - "Creating" - (make-temp-file - :no-eval (make-temp-file "/tmp/foo-") - :eg-result "/tmp/foo-ZcXFMj") - (make-nearby-temp-file - :no-eval (make-nearby-temp-file "/tmp/foo-") - :eg-result "/tmp/foo-xe8iON") - (write-region - :no-value (write-region (point-min) (point-max) "/tmp/foo")) - "Directories" - (make-directory - :no-value (make-directory "/tmp/bar/zot/" t)) - (directory-files - :no-eval (directory-files "/tmp/") - :eg-result ("." ".." ".ICE-unix" ".Test-unix")) - (directory-files-recursively - :no-eval (directory-files-recursively "/tmp/" "\\.png\\'") - :eg-result ("/tmp/foo.png" "/tmp/zot.png" "/tmp/bar/foobar.png")) - (directory-files-and-attributes - :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") - :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") - (copy-directory - :no-value (copy-directory "/tmp/bar/" "/tmp/barcopy")) - (delete-directory - :no-value (delete-directory "/tmp/bar/")) - "File Operations" - (rename-file - :no-value (rename-file "/tmp/foo" "/tmp/newname")) - (copy-file - :no-value (copy-file "/tmp/foo" "/tmp/foocopy")) - (delete-file - :no-value (delete-file "/tmp/foo")) - (make-empty-file - :no-value (make-empty-file "/tmp/foo")) - (make-symbolic-link - :no-value (make-symbolic-link "/tmp/foo" "/tmp/foosymlink")) - (add-name-to-file - :no-value (add-name-to-file "/tmp/foo" "/tmp/bar")) - (set-file-modes - :no-value "(set-file-modes \"/tmp/foo\" #o644)") - (set-file-times - :no-value (set-file-times "/tmp/foo")) - "File Modes" - (set-default-file-modes - :no-value "(set-default-file-modes #o755)") - (default-file-modes - :no-eval (default-file-modes) - :eg-result-string "#o755") - (file-modes-symbolic-to-number - :no-eval (file-modes-symbolic-to-number "a+r") - :eg-result-string "#o444") - (file-modes-number-to-symbolic - :eval "(file-modes-number-to-symbolic #o444)") - (set-file-extended-attributes - :no-eval (set-file-extended-attributes - "/tmp/foo" '((acl . "group::rxx"))) - :eg-result t) - (set-file-selinux-context - :no-eval (set-file-selinux-context - "/tmp/foo" '(unconfined_u object_r user_home_t s0)) - :eg-result t) - (set-file-acl - :no-eval (set-file-acl "/tmp/foo" "group::rxx") - :eg-result t)) - -(define-short-documentation-group hash-table - "Hash Table Basics" - (make-hash-table - :no-eval (make-hash-table) - :result-string "#s(hash-table ...)") - (puthash - :no-eval (puthash 'key "value" table)) - (gethash - :no-eval (gethash 'key table) - :eg-result "value") - (remhash - :no-eval (remhash 'key table) - :result nil) - (clrhash - :no-eval (clrhash table) - :result-string "#s(hash-table ...)") - (maphash - :no-eval (maphash (lambda (key value) (message value)) table) - :result nil) - "Other Hash Table Functions" - (hash-table-p - :eval (hash-table-p 123)) - (hash-table-contains-p - :no-eval (hash-table-contains-p 'key table)) - (copy-hash-table - :no-eval (copy-hash-table table) - :result-string "#s(hash-table ...)") - (hash-table-count - :no-eval (hash-table-count table) - :eg-result 15)) - -(define-short-documentation-group list - "Making Lists" - (make-list - :eval (make-list 5 'a)) - (cons - :eval (cons 1 '(2 3 4))) - (list - :eval (list 1 2 3)) - (number-sequence - :eval (number-sequence 5 8)) - (ensure-list - :eval (ensure-list "foo") - :eval (ensure-list '(1 2 3)) - :eval (ensure-list '(1 . 2))) - (ensure-proper-list - :eval (ensure-proper-list "foo") - :eval (ensure-proper-list '(1 2 3)) - :eval (ensure-proper-list '(1 . 2))) - "Operations on Lists" - (append - :eval (append '("foo" "bar") '("zot"))) - (copy-tree - :eval (copy-tree '(1 (2 3) 4))) - (flatten-tree - :eval (flatten-tree '(1 (2 3) 4))) - (car - :eval (car '(one two three)) - :eval (car '(one . two)) - :eval (car nil)) - (cdr - :eval (cdr '(one two three)) - :eval (cdr '(one . two)) - :eval (cdr nil)) - (last - :eval (last '(one two three))) - (butlast - :eval (butlast '(one two three))) - (nbutlast - :eval (nbutlast (list 'one 'two 'three))) - (nth - :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))) - (take-while - :eval (take-while #'numberp '(1 2 three 4 five))) - (drop-while - :eval (drop-while #'numberp '(1 2 three 4 five))) - (any - :eval (any #'symbolp '(1 2 three 4 five))) - (all - :eval (all #'symbolp '(one 2 three)) - :eval (all #'symbolp '(one two three))) - (elt - :eval (elt '(one two three) 1)) - (car-safe - :eval (car-safe '(one two three))) - (cdr-safe - :eval (cdr-safe '(one two three))) - (push - :no-eval* (push 'a list)) - (pop - :no-eval* (pop list)) - (setcar - :no-eval (setcar list 'c) - :result c) - (setcdr - :no-eval (setcdr list (list c)) - :result '(c)) - (nconc - :eval (nconc (list 1) (list 2 3 4))) - (delq - :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"))) - (remq - :eval (remq 'b '(a b c))) - (remove - :eval (remove 2 '(1 2 3 4)) - :eval (remove "a" '("a" "b" "c" "d"))) - (delete-dups - :eval (delete-dups (list 1 2 4 3 2 4))) - "Mapping Over Lists" - (mapcar - :eval (mapcar #'list '(1 2 3))) - (mapcan - :eval (mapcan #'list '(1 2 3))) - (mapc - :eval (mapc #'insert '("1" "2" "3"))) - (seq-reduce - :eval (seq-reduce #'+ '(1 2 3) 0)) - (mapconcat - :eval (mapconcat #'identity '("foo" "bar") "|")) - "Predicates" - (listp - :eval (listp '(1 2 3)) - :eval (listp nil) - :eval (listp '(1 . 2))) - (consp - :eval (consp '(1 2 3)) - :eval (consp nil)) - (proper-list-p - :eval (proper-list-p '(1 2 3)) - :eval (proper-list-p nil) - :eval (proper-list-p '(1 . 2))) - (null - :eval (null nil)) - (atom - :eval (atom 'a)) - (nlistp - :eval (nlistp '(1 2 3)) - :eval (nlistp t) - :eval (nlistp '(1 . 2))) - "Finding Elements" - (memq - :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"))) - (member-ignore-case - :eval (member-ignore-case "foo" '("bar" "Foo" "zot"))) - "Association Lists" - (assoc - :eval (assoc "b" '(("a" . 1) ("b" . 2)))) - (rassoc - :eval (rassoc "b" '((1 . "a") (2 . "b")))) - (assq - :eval (assq 'b '((a . 1) (b . 2)))) - (rassq - :eval (rassq 'b '((1 . a) (2 . b)))) - (assoc-string - :eval (assoc-string "foo" '(("a" 1) (foo 2)))) - (alist-get - :eval (alist-get 2 '((1 . a) (2 . b)))) - (assoc-default - :eval (assoc-default 2 '((1 . a) (2 . b) #'=))) - (copy-alist - :eval (copy-alist '((1 . a) (2 . b)))) - (assoc-delete-all - :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) - (assq-delete-all - :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) - (rassq-delete-all - :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) - "Property Lists" - (plist-get - :eval (plist-get '(a 1 b 2 c 3) 'b)) - (plist-put - :no-eval (setq plist (plist-put plist 'd 4)) - :eg-result (a 1 b 2 c 3 d 4)) - (plist-member - :eval (plist-member '(a 1 b 2 c 3) 'b)) - "Data About Lists" - (length - :eval (length '(a b c))) - (length< - :eval (length< '(a b c) 1)) - (length> - :eval (length> '(a b c) 1)) - (length= - :eval (length= '(a b c) 3)) - (safe-length - :eval (safe-length '(a b c)))) - -(define-short-documentation-group symbol - "Making symbols" - (intern - :eval (intern "abc")) - (intern-soft - :eval (intern-soft "list") - :eval (intern-soft "Phooey!")) - (make-symbol - :eval (make-symbol "abc")) - (gensym - :no-eval (gensym) - :eg-result g37) - "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)) - "Obarrays" - (obarray-make - :eval (obarray-make)) - (obarrayp - :eval (obarrayp (obarray-make)) - :eval (obarrayp nil)) - (unintern - :no-eval (unintern "abc" my-obarray) - :eg-result t) - (mapatoms - :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray)) - (obarray-clear - :no-eval (obarray-clear my-obarray))) - -(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" - (make-vector - :eval (make-vector 5 "foo")) - (vector - :eval (vector 1 "b" 3)) - "Operations on Vectors" - (vectorp - :eval (vectorp [1]) - :eval (vectorp "1")) - (vconcat - :eval (vconcat '(1 2) [3 4])) - (append - :eval (append [1 2] nil)) - (length - :eval (length [1 2 3])) - (seq-reduce - :eval (seq-reduce #'+ [1 2 3] 0)) - (seq-subseq - :eval (seq-subseq [1 2 3 4 5] 1 3) - :eval (seq-subseq [1 2 3 4 5] 1)) - (copy-tree - :eval (copy-tree [1 (2 3) [4 5]] t)) - "Mapping Over Vectors" - (mapcar - :eval (mapcar #'identity [1 2 3])) - (mapc - :eval (mapc #'insert ["1" "2" "3"]))) - -(define-short-documentation-group regexp - "Matching Strings" - (replace-regexp-in-string - :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) - (string-match-p - :eval (string-match-p "^[fo]+" "foobar")) - "Looking in Buffers" - (re-search-forward - :no-eval (re-search-forward "^foo$" nil t) - :eg-result 43) - (re-search-backward - :no-eval (re-search-backward "^foo$" nil t) - :eg-result 43) - (looking-at-p - :no-eval (looking-at-p "f[0-9]") - :eg-result t) - "Match Data" - (match-string - :eval (and (string-match "^\\([fo]+\\)b" "foobar") - (match-string 0 "foobar"))) - (match-beginning - :no-eval (match-beginning 1) - :eg-result 0) - (match-end - :no-eval (match-end 1) - :eg-result 3) - (save-match-data - :no-eval (save-match-data ...)) - "Replacing Match" - (replace-match - :no-eval (replace-match "new") - :eg-result nil) - (match-substitute-replacement - :no-eval (match-substitute-replacement "new") - :eg-result "new") - (replace-regexp-in-region - :no-value (replace-regexp-in-region "[0-9]+" "Num \\&")) - "Utilities" - (regexp-quote - :eval (regexp-quote "foo.*bar")) - (regexp-opt - :eval (regexp-opt '("foo" "bar"))) - (regexp-opt-depth - :eval (regexp-opt-depth "\\(a\\(b\\)\\)")) - (regexp-opt-charset - :eval (regexp-opt-charset '(?a ?b ?c ?d ?e))) - "The `rx' Structured Regexp Notation" - (rx - :eval (rx "IP=" (+ digit) (= 3 "." (+ digit)))) - (rx-to-string - :eval (rx-to-string '(| "foo" "bar"))) - (rx-define - :no-eval "(and (rx-define haskell-comment (seq \"--\" (zero-or-more nonl))) - (rx haskell-comment))" - :result "--.*") - (rx-let - :eval "(rx-let ((comma-separated (item) (seq item (0+ \",\" item))) - (number (1+ digit)) - (numbers (comma-separated number))) - (rx \"(\" numbers \")\"))" - :result "([[:digit:]]+\\(?:,[[:digit:]]+\\)*)") - (rx-let-eval - :eval "(rx-let-eval - '((ponder (x) (seq \"Where have all the \" x \" gone?\"))) - (rx-to-string - '(ponder (or \"flowers\" \"cars\" \"socks\"))))" - :result "\\(?:Where have all the \\(?:\\(?:car\\|flower\\|sock\\)s\\) gone\\?\\)")) - -(define-short-documentation-group sequence - "Sequence Predicates" - (seq-contains-p - :eval (seq-contains-p '(a b c) 'b) - :eval (seq-contains-p '(a b c) 'd)) - (seq-every-p - :eval (seq-every-p #'numberp '(1 2 3))) - (seq-empty-p - :eval (seq-empty-p [])) - (seq-set-equal-p - :eval (seq-set-equal-p '(1 2 3) '(3 1 2))) - (seq-some - :eval (seq-some #'floatp '(1 2.0 3))) - "Building Sequences" - (seq-concatenate - :eval (seq-concatenate 'vector '(1 2) '(c d))) - (seq-copy - :eval (seq-copy '(a 2))) - (seq-into - :eval (seq-into '(1 2 3) 'vector)) - "Utility Functions" - (seq-count - :eval (seq-count #'numberp '(1 b c 4))) - (seq-elt - :eval (seq-elt '(a b c) 1)) - (seq-random-elt - :no-eval (seq-random-elt '(a b c)) - :eg-result c) - (seq-find - :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 - :eval (seq-max [1 2 3])) - (seq-min - :eval (seq-min [1 2 3])) - (seq-first - :eval (seq-first [a b c])) - (seq-rest - :eval (seq-rest '[1 2 3])) - (seq-reverse - :eval (seq-reverse '(1 2 3))) - (seq-sort - :eval (seq-sort #'> '(1 2 3))) - (seq-sort-by - :eval (seq-sort-by (lambda (a) (/ 1.0 a)) #'< '(1 2 3))) - "Mapping Over Sequences" - (seq-map - :eval (seq-map #'1+ '(1 2 3))) - (seq-map-indexed - :eval (seq-map-indexed (lambda (a i) (cons i a)) '(a b c))) - (seq-mapcat - :eval (seq-mapcat #'upcase '("a" "b" "c") 'string)) - (seq-doseq - :no-eval (seq-doseq (a '("foo" "bar")) (insert a)) - :eg-result ("foo" "bar")) - (seq-do - :no-eval (seq-do (lambda (a) (insert a)) '("foo" "bar")) - :eg-result ("foo" "bar")) - (seq-do-indexed - :no-eval (seq-do-indexed - (lambda (a index) (message "%s:%s" index a)) - '("foo" "bar")) - :eg-result nil) - (seq-reduce - :eval (seq-reduce #'* [1 2 3] 2)) - "Excerpting Sequences" - (seq-drop - :eval (seq-drop '(a b c) 2)) - (seq-drop-while - :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 #'natnump '(-1 2 3 -4 -5 6))) - (seq-union - :eval (seq-union '(1 2 3) '(3 5))) - (seq-difference - :eval (seq-difference '(1 2 3) '(2 3 4))) - (seq-intersection - :eval (seq-intersection '(1 2 3) '(2 3 4))) - (seq-partition - :eval (seq-partition '(a b c d e f g h) 3)) - (seq-subseq - :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 #'integerp [1 2 3.0 4])) - (seq-uniq - :eval (seq-uniq '(a b d b a c)))) - -(define-short-documentation-group buffer - "Buffer Basics" - (current-buffer - :no-eval (current-buffer) - :eg-result-string "#") - (bufferp - :eval (bufferp 23)) - (buffer-live-p - :no-eval (buffer-live-p some-buffer) - :eg-result t) - (buffer-modified-p - :eval (buffer-modified-p (current-buffer))) - (buffer-name - :eval (buffer-name)) - (window-buffer - :eval (window-buffer)) - "Selecting Buffers" - (get-buffer-create - :no-eval (get-buffer-create "*foo*") - :eg-result-string "#") - (pop-to-buffer - :no-eval (pop-to-buffer "*foo*") - :eg-result-string "#") - (with-current-buffer - :no-eval* (with-current-buffer buffer (buffer-size))) - "Points and Positions" - (point - :eval (point)) - (point-min - :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)) - :eg-result 342) - (search-forward - :no-eval (search-forward "some-string" nil t) - :eg-result 245) - (re-search-forward - :no-eval (re-search-forward "some-s.*g" nil t) - :eg-result 245) - (forward-line - :no-eval (forward-line 1) - :eg-result 0 - :no-eval (forward-line -2) - :eg-result 0) - "Strings from Buffers" - (buffer-string - :no-eval* (buffer-string)) - (buffer-substring - :eval (buffer-substring (point-min) (+ (point-min) 10))) - (buffer-substring-no-properties - :eval (buffer-substring-no-properties (point-min) (+ (point-min) 10))) - (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") - "Altering Buffers" - (delete-region - :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 - :no-eval "(subst-char-in-region (point-min) (point-max) ?+ ?-)") - (replace-string-in-region - :no-value (replace-string-in-region "foo" "bar")) - "Locking" - (lock-buffer - :no-value (lock-buffer "/tmp/foo")) - (unlock-buffer - :no-value (unlock-buffer))) - -(define-short-documentation-group overlay - "Predicates" - (overlayp - :no-eval (overlayp some-overlay) - :eg-result t) - "Creation and Deletion" - (make-overlay - :args (beg end &optional buffer) - :no-eval (make-overlay 1 10) - :eg-result-string "#") - (delete-overlay - :no-eval (delete-overlay foo) - :eg-result t) - "Searching Overlays" - (overlays-at - :no-eval (overlays-at 15) - :eg-result-string "(#)") - (overlays-in - :no-eval (overlays-in 1 30) - :eg-result-string "(#)") - (next-overlay-change - :no-eval (next-overlay-change 1) - :eg-result 20) - (previous-overlay-change - :no-eval (previous-overlay-change 30) - :eg-result 20) - "Overlay Properties" - (overlay-start - :no-eval (overlay-start foo) - :eg-result 1) - (overlay-end - :no-eval (overlay-end foo) - :eg-result 10) - (overlay-put - :no-eval (overlay-put foo 'happy t) - :eg-result t) - (overlay-get - :no-eval (overlay-get foo 'happy) - :eg-result t) - (overlay-buffer - :no-eval (overlay-buffer foo)) - "Moving Overlays" - (move-overlay - :no-eval (move-overlay foo 5 20) - :eg-result-string "#")) - -(define-short-documentation-group process - (make-process - :no-eval (make-process :name "foo" :command '("cat" "/tmp/foo")) - :eg-result-string "#") - (processp - :eval (processp t)) - (process-status - :no-eval (process-status process) - :eg-result exit) - (delete-process - :no-value (delete-process process)) - (kill-process - :no-value (kill-process process)) - (set-process-sentinel - :no-value (set-process-sentinel process (lambda (proc string)))) - (process-buffer - :no-eval (process-buffer process) - :eg-result-string "#") - (get-buffer-process - :no-eval (get-buffer-process buffer) - :eg-result-string "#") - (process-live-p - :no-eval (process-live-p process) - :eg-result t)) - -(define-short-documentation-group number - "Arithmetic" - (+ - :args (&rest numbers) - :eval (+ 1 2) - :eval (+ 1 2 3 4)) - (- - :args (&rest numbers) - :eval (- 3 2) - :eval (- 6 3 2)) - (* - :args (&rest numbers) - :eval (* 3 4 5)) - (/ - :eval (/ 10 5) - :eval (/ 10 6) - :eval (/ 10.0 6) - :eval (/ 10.0 3 3)) - (% - :eval (% 10 5) - :eval (% 10 6)) - (mod - :eval (mod 10 5) - :eval (mod 10 6) - :eval (mod 10.5 6)) - (1+ - :eval (1+ 2) - :eval (let ((x 2)) (1+ x) x)) - (1- - :eval (1- 4) - :eval (let ((x 4)) (1- x) x)) - (incf - :eval (let ((x 2)) (incf x) x) - :eval (let ((x 2)) (incf x 2) x)) - (decf - :eval (let ((x 4)) (decf x) x) - :eval (let ((x 4)) (decf x 2)) x) - "Predicates" - (= - :args (number &rest numbers) - :eval (= 4 4) - :eval (= 4.0 4.0) - :eval (= 4 4.0) - :eval (= 4 4 4 4)) - (eql - :eval (eql 4 4) - :eval (eql 4.0 4.0)) - (/= - :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)) - (zerop - :eval (zerop 0)) - (natnump - :eval (natnump -1) - :eval (natnump 0) - :eval (natnump 23)) - (plusp - :eval (plusp 0) - :eval (plusp 1)) - (minusp - :eval (minusp 0) - :eval (minusp -1)) - (oddp - :eval (oddp 3)) - (evenp - :eval (evenp 6)) - (bignump - :eval (bignump 4) - :eval (bignump (expt 2 90))) - (fixnump - :eval (fixnump 4) - :eval (fixnump (expt 2 90))) - (floatp - :eval (floatp 5.4)) - (integerp - :eval (integerp 5.4)) - (numberp - :eval (numberp "5.4")) - (cl-digit-char-p - :eval (cl-digit-char-p ?5 10) - :eval (cl-digit-char-p ?f 16)) - "Operations" - (max - :args (number &rest numbers) - :eval (max 7 9 3)) - (min - :args (number &rest numbers) - :eval (min 7 9 3)) - (abs - :eval (abs -4)) - (float - :eval (float 2)) - (truncate - :eval (truncate 1.2) - :eval (truncate -1.2) - :eval (truncate 5.4 2)) - (floor - :eval (floor 1.2) - :eval (floor -1.2) - :eval (floor 5.4 2)) - (ceiling - :eval (ceiling 1.2) - :eval (ceiling -1.2) - :eval (ceiling 5.4 2)) - (round - :eval (round 1.2) - :eval (round -1.2) - :eval (round 5.4 2)) - (random - :eval (random 6)) - "Bit Operations" - (ash - :eval (ash 1 4) - :eval (ash 16 -1)) - (logand - :no-eval "(logand #b10 #b111)" - :result-string "#b10") - (logior - :eval (logior 4 16)) - (logxor - :eval (logxor 4 16)) - (lognot - :eval (lognot 5)) - (logcount - :eval (logcount 5)) - "Floating Point" - (isnan - :eval (isnan 5.0)) - (frexp - :eval (frexp 5.7)) - (ldexp - :eval (ldexp 0.7125 3)) - (logb - :eval (logb 10.5)) - (ffloor - :eval (ffloor 1.2)) - (fceiling - :eval (fceiling 1.2)) - (ftruncate - :eval (ftruncate 1.2)) - (fround - :eval (fround 1.2)) - "Standard Math Functions" - (sin - :eval (sin float-pi)) - (cos - :eval (cos float-pi)) - (tan - :eval (tan float-pi)) - (asin - :eval (asin float-pi)) - (acos - :eval (acos float-pi)) - (atan - :eval (atan float-pi)) - (exp - :eval (exp 4)) - (log - :eval (log 54.59)) - (expt - :eval (expt 2 16)) - (sqrt - :eval (sqrt -1))) - -(define-short-documentation-group text-properties - "Examining Text Properties" - (get-text-property - :eval (get-text-property 0 'foo (propertize "x" 'foo t))) - (get-char-property - :eval (get-char-property 0 'foo (propertize "x" 'foo t))) - (get-pos-property - :eval (get-pos-property 0 'foo (propertize "x" 'foo t))) - (get-char-property-and-overlay - :eval (get-char-property-and-overlay 0 'foo (propertize "x" 'foo t))) - (text-properties-at - :eval (text-properties-at (point))) - "Changing Text Properties" - (put-text-property - :eval (let ((s (copy-sequence "abc"))) (put-text-property 0 1 'foo t s) s) - :no-eval (put-text-property (point) (1+ (point)) 'face 'error)) - (add-text-properties - :no-eval (add-text-properties (point) (1+ (point)) '(face error))) - (remove-text-properties - :no-eval (remove-text-properties (point) (1+ (point)) '(face nil))) - (remove-list-of-text-properties - :no-eval (remove-list-of-text-properties (point) (1+ (point)) '(face font-lock-face))) - (set-text-properties - :no-eval (set-text-properties (point) (1+ (point)) '(face error))) - (add-face-text-property - :no-eval (add-face-text-property START END '(:foreground "green"))) - (propertize - :eval (propertize "foo" 'face 'italic 'mouse-face 'bold-italic)) - "Searching for Text Properties" - (next-property-change - :no-eval (next-property-change (point) (current-buffer))) - (previous-property-change - :no-eval (previous-property-change (point) (current-buffer))) - (next-single-property-change - :no-eval (next-single-property-change (point) 'face (current-buffer))) - (previous-single-property-change - :no-eval (previous-single-property-change (point) 'face (current-buffer))) - ;; TODO: There are some more that could be added here. - (text-property-search-forward - :no-eval (text-property-search-forward 'face nil t)) - (text-property-search-backward - :no-eval (text-property-search-backward 'face nil t))) - -(define-short-documentation-group keymaps - "Defining keymaps or adding bindings to existing keymaps" - (define-keymap - :no-eval (define-keymap "C-c C-c" #'quit-buffer) - :no-eval (define-keymap :keymap ctl-x-map - "C-r" #'recentf-open - "k" #'kill-current-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 "" 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 same-window) - "Pop to a buffer with short documentation summary for functions in GROUP. -Interactively, prompt for GROUP. -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 - "Group of functions for which to show summary: " - (mapcar #'car shortdoc--groups)))) - (when (stringp group) - (setq group (intern group))) - (unless (assq group shortdoc--groups) - (error "No such documentation group %s" group)) - (let ((buf (get-buffer-create (format "*Shortdoc %s*" group)))) - (shortdoc--insert-group-in-buffer group buf) - (funcall (if same-window - #'pop-to-buffer-same-window - #'pop-to-buffer) - buf)) - (goto-char (point-min)) - (when function - (text-property-search-forward 'shortdoc-function function t) - (beginning-of-line))) - -(defun shortdoc--insert-group-in-buffer (group &optional buf) - "Insert a short documentation summary for functions in GROUP in buffer BUF. -BUF defaults to the current buffer if nil or omitted." - (with-current-buffer (or buf (current-buffer)) - (let ((inhibit-read-only t) - (prev nil)) - (erase-buffer) - (shortdoc-mode) - (button-mode) - (mapc - (lambda (data) - (cond - ((stringp data) - (setq prev nil) - (unless (bobp) - (insert "\n")) - (insert (propertize - (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) - ;; This helps with hidden outlines (bug#53981) - (propertize "\n" 'face '(:height 0)))) - (setq prev t) - (shortdoc--display-function data)))) - (cdr (assq group shortdoc--groups)))))) - -;;;###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 'outline-level 2)) - (if (plist-get data :no-manual) - (insert-text-button - (symbol-name function) - 'face 'button - 'action (lambda (_) - (describe-function function)) - 'follow-link t - '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 "mouse-1, RET: show \ -function's documentation in the Info manual")) - (setq arglist-start (point)) - (insert ")\n") - ;; Doc string. - (insert " " - (or (plist-get data :doc) - (car (split-string (or (documentation function) - "Error: missing docstring.") - "\n")))) - (insert "\n") - (add-face-text-property start-section (point) 'shortdoc-section t) - (let ((print-escape-newlines t) - (double-arrow (if (char-displayable-p ?⇒) - "⇒" - "=>")) - (single-arrow (if (char-displayable-p ?→) - "→" - "->")) - (start-example (point))) - (cl-loop for (type value) on data by #'cddr - do - (cl-case type - (:eval - (insert " ") - (if (stringp value) - (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") - (insert " ") - (prin1 value (current-buffer))) - (insert "\n " single-arrow " " - (propertize "[it depends]" - 'face 'shortdoc-section) - "\n")) - (:no-value - (if (stringp value) - (insert " " value) - (insert " ") - (prin1 value (current-buffer))) - (insert "\n")) - (:no-eval - (if (stringp value) - (insert " " value) - (insert " ") - (prin1 value (current-buffer))) - (insert "\n")) - (:result - (insert " " double-arrow " ") - (prin1 value (current-buffer)) - (insert "\n")) - (:result-string - (insert " " double-arrow " ") - (princ value (current-buffer)) - (insert "\n")) - (:eg-result - (insert " e.g. " double-arrow " ") - (prin1 value (current-buffer)) - (insert "\n")) - (:eg-result-string - (insert " e.g. " double-arrow " ") - (princ value (current-buffer)) - (insert "\n")))) - (add-text-properties start-example (point) `(shortdoc-example ,function))) - ;; Insert the arglist after doing the evals, in case that's pulled - ;; in the function definition. - (save-excursion - (goto-char arglist-start) - (dolist (param (or (plist-get data :args) - (help-function-arglist function t))) - (insert " " (symbol-name param))) - (add-face-text-property arglist-start (point) 'shortdoc-section t)))) - -(defun shortdoc-function-examples (function) - "Return all shortdoc examples for FUNCTION. -The result is an alist with items of the form (GROUP . EXAMPLES), -where GROUP is a shortdoc group where FUNCTION appears, and -EXAMPLES is a string with the usage examples of FUNCTION defined -in GROUP. Return nil if FUNCTION is not a function or if it -doesn't has any shortdoc information." - (let ((groups (and (symbolp function) - (shortdoc-function-groups function))) - (examples nil)) - (mapc - (lambda (group) - (with-temp-buffer - (shortdoc--insert-group-in-buffer group) - (goto-char (point-min)) - (let ((match (text-property-search-forward - 'shortdoc-example function t))) - (push `(,group . ,(string-trim - (buffer-substring-no-properties - (prop-match-beginning match) - (prop-match-end match)))) - examples)))) - groups) - examples)) - -(defun shortdoc-help-fns-examples-function (function) - "Insert Emacs Lisp examples for FUNCTION into the current buffer. -You can add this function to the `help-fns-describe-function-functions' -hook to show examples of using FUNCTION in *Help* buffers produced -by \\[describe-function]." - (let* ((examples (shortdoc-function-examples function)) - (num-examples (length examples)) - (times 0)) - (dolist (example examples) - (when (zerop times) - (if (> num-examples 1) - (insert "\n Examples:\n\n") - ;; Some functions have more than one example per group. - ;; Count the number of arrows to know if we need to - ;; pluralize "Example". - (let* ((text (cdr example)) - (count 0) - (pos 0) - (end (length text)) - (double-arrow (if (char-displayable-p ?⇒) - " ⇒" - " =>")) - (double-arrow-example (if (char-displayable-p ?⇒) - " e.g. ⇒" - " e.g. =>")) - (single-arrow (if (char-displayable-p ?→) - " →" - " ->"))) - (while (and (< pos end) - (or (string-match double-arrow text pos) - (string-match double-arrow-example text pos) - (string-match single-arrow text pos))) - (setq count (1+ count) - pos (match-end 0))) - (if (> count 1) - (insert "\n Examples:\n\n") - (insert "\n Example:\n\n"))))) - (setq times (1+ times)) - (insert " ") - (insert (cdr example)) - (insert "\n\n")))) - -(defun shortdoc-function-groups (function) - "Return all shortdoc groups FUNCTION appears in." - (cl-loop for group in shortdoc--groups - when (assq function (cdr group)) - collect (car group))) - -(defun shortdoc-add-function (group section elem) - "Add ELEM to shortdoc GROUP in SECTION. -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\")))" - (let ((glist (assq group shortdoc--groups))) - (unless glist - (setq glist (list group)) - (push glist shortdoc--groups)) - (let ((slist (member section glist))) - (unless slist - (setq slist (list section)) - (nconc glist slist)) - (while (and (cdr slist) - (not (stringp (cadr slist)))) - (setq slist (cdr slist))) - (setcdr slist (cons elem (cdr slist)))))) - -(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 - (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) - (setq arg 1)) - (while (> arg 0) - (funcall - (if reverse 'text-property-search-backward - 'text-property-search-forward) - sym nil t) - (setq arg (1- arg)))) - -(defun shortdoc-next (&optional arg) - "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 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 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 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 -- cgit v1.2.1 From 630af2f2e4f1f2a04c477a20545fa47e386e0b67 Mon Sep 17 00:00:00 2001 From: Jens Schmidt Date: Wed, 25 Mar 2026 16:33:41 +0100 Subject: ; Restore shortdoc.el --- lisp/emacs-lisp/shortdoc.el | 1960 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1960 insertions(+) create mode 100644 lisp/emacs-lisp/shortdoc.el (limited to 'lisp') diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el new file mode 100644 index 00000000000..ea6910c60fc --- /dev/null +++ b/lisp/emacs-lisp/shortdoc.el @@ -0,0 +1,1960 @@ +;;; shortdoc.el --- Short function summaries -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2026 Free Software Foundation, Inc. + +;; Keywords: lisp, help +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; 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) +(require 'text-property-search) +(eval-when-compile (require 'cl-lib)) + +(defgroup shortdoc nil + "Short documentation." + :group 'lisp) + +(defface shortdoc-heading + '((t :inherit variable-pitch :height 1.3 :weight bold)) + "Face used for a heading." + :version "28.1") + +(defface shortdoc-section + '((t :inherit variable-pitch)) + "Face used for a section.") + +;;;###autoload +(defun shortdoc--check (group functions) + (let ((keywords '( :no-manual :args :eval :no-eval :no-value :no-eval* + :result :result-string :eg-result :eg-result-string :doc))) + (dolist (f functions) + (when (consp f) + (dolist (x f) + (when (and (keywordp x) (not (memq x keywords))) + (error "Shortdoc %s function `%s': bad keyword `%s'" + group (car f) x))))))) + +;;;###autoload +(progn + (defvar shortdoc--groups nil) + + (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: + + (FUNC + :no-manual BOOL + :args ARGS + :eval EVAL + :no-eval EXAMPLE-FORM + :no-value EXAMPLE-FORM + :no-eval* EXAMPLE-FORM + :result RESULT-FORM + :result-string RESULT-STRING + :eg-result RESULT-FORM + :eg-result-string RESULT-STRING) + +FUNC is the function being documented. + +NO-MANUAL should be non-nil if FUNC isn't documented in the +manual. + +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. + +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. + +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)) + (shortdoc--check group functions) + `(progn + (setq shortdoc--groups (delq (assq ',group shortdoc--groups) + shortdoc--groups)) + (push (cons ',group ',functions) shortdoc--groups)))) + +(define-short-documentation-group alist + "Alist Basics" + (assoc + :eval (assoc 'foo '((foo . bar) (zot . baz)))) + (rassoc + :eval (rassoc 'bar '((foo . bar) (zot . baz)))) + (assq + :eval (assq 'foo '((foo . bar) (zot . baz)))) + (rassq + :eval (rassq 'bar '((foo . bar) (zot . baz)))) + (assoc-string + :eval (assoc-string "foo" '(("foo" . "bar") ("zot" "baz")))) + "Manipulating Alists" + (assoc-delete-all + :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) + (assq-delete-all + :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) + (rassq-delete-all + :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) + (alist-get + :eval (let ((foo '((bar . baz)))) + (setf (alist-get 'bar foo) 'zot) + foo)) + "Misc" + (assoc-default + :eval (assoc-default "foobar" '(("foo" . baz)) #'string-match)) + (copy-alist + :eval (let* ((old '((foo . bar))) + (new (copy-alist old))) + (eq old new))) + ;; FIXME: Outputs "\.rose" for the symbol `.rose'. It would be + ;; better if that could be cleaned up. + (let-alist + :eval (let ((colors '((rose . red) + (lily . white)))) + (let-alist colors + (if (eq .rose 'red) + .lily))))) + +(define-short-documentation-group map + "Map Basics" + (mapp + :eval (mapp (list 'bar 1 'foo 2 'baz 3)) + :eval (mapp (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (mapp [bar foo baz]) + :eval (mapp "this is a string") + :eval (mapp #s(hash-table data (bar 1 foo 2 baz 3))) + :eval (mapp '()) + :eval (mapp nil) + :eval (mapp (make-char-table 'shortdoc-test))) + (map-empty-p + :args (map) + :eval (map-empty-p nil) + :eval (map-empty-p []) + :eval (map-empty-p '())) + (map-elt + :args (map key) + :eval (map-elt (list 'bar 1 'foo 2 'baz 3) 'foo) + :eval (map-elt (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) + :eval (map-elt [bar foo baz] 1) + :eval (map-elt #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) + (map-contains-key + :args (map key) + :eval (map-contains-key (list 'bar 1 'foo 2 'baz 3) 'foo) + :eval (map-contains-key (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) + :eval (map-contains-key [bar foo baz] 1) + :eval (map-contains-key #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) + (map-put! + (map key value) + :eval +"(let ((map (list 'bar 1 'baz 3))) + (map-put! map 'foo 2) + map)" +;; This signals map-not-inplace when used in shortdoc.el :-( +;; :eval +;; "(let ((map (list '(bar . 1) '(baz . 3)))) +;; (map-put! map 'foo 2) +;; map)" + :eval +"(let ((map [bar bot baz])) + (map-put! map 1 'foo) + map)" + :eval +"(let ((map #s(hash-table data (bar 1 baz 3)))) + (map-put! map 'foo 2) + map)") + (map-insert + :args (map key value) + :eval (map-insert (list 'bar 1 'baz 3 'foo 7) 'foo 2) + :eval (map-insert (list '(bar . 1) '(baz . 3) '(foo . 7)) 'foo 2) + :eval (map-insert [bar bot baz] 1 'foo) + :eval (map-insert #s(hash-table data (bar 1 baz 3 foo 7)) 'foo 2)) + (map-delete + :args (map key) + :eval (map-delete (list 'bar 1 'foo 2 'baz 3) 'foo) + :eval (map-delete (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) + :eval (map-delete [bar foo baz] 1) + :eval (map-delete #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) + (map-keys + :eval (map-keys (list 'bar 1 'foo 2 'baz 3)) + :eval (map-keys (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-keys [bar foo baz]) + :eval (map-keys #s(hash-table data (bar 1 foo 2 baz 3)))) + (map-values + :args (map) + :eval (map-values (list 'bar 1 'foo 2 'baz 3)) + :eval (map-values (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-values [bar foo baz]) + :eval (map-values #s(hash-table data (bar 1 foo 2 baz 3)))) + (map-pairs + :eval (map-pairs (list 'bar 1 'foo 2 'baz 3)) + :eval (map-pairs (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-pairs [bar foo baz]) + :eval (map-pairs #s(hash-table data (bar 1 foo 2 baz 3)))) + (map-length + :args (map) + :eval (map-length (list 'bar 1 'foo 2 'baz 3)) + :eval (map-length (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-length [bar foo baz]) + :eval (map-length #s(hash-table data (bar 1 foo 2 baz 3)))) + (map-copy + :args (map) + :eval (map-copy (list 'bar 1 'foo 2 'baz 3)) + :eval (map-copy (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-copy [bar foo baz]) + :eval (map-copy #s(hash-table data (bar 1 foo 2 baz 3)))) + "Doing things to maps and their contents" + (map-apply + :args (function map) + :eval (map-apply #'+ (list '(1 . 2) '(3 . 4)))) + (map-do + :args (function map) + :eval +"(let ((map (list '(1 . 1) '(2 . 3))) + acc) + (map-do (lambda (k v) (push (+ k v) acc)) map) + (nreverse acc))") + (map-keys-apply + :eval (map-keys-apply #'1+ (list '(1 . 2) '(3 . 4)))) + (map-values-apply + :args (function map) + :eval (map-values-apply #'1+ (list '(1 . 2) '(3 . 4)))) + (map-filter + :eval (map-filter (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) + :eval (map-filter (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) + (map-remove + :eval (map-remove (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) + :eval (map-remove (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) + (map-some + :eval (map-some (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) + :eval (map-some (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) + (map-every-p + :eval (map-every-p (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) + :eval (map-every-p (lambda (k v) (evenp (+ k v))) (list '(1 . 3) '(4 . 6)))) + "Combining and changing maps" + (map-merge + :eval (map-merge 'alist '(1 2 3 4) #s(hash-table data (5 6 7 8))) + :eval (map-merge 'list '(1 2 3 4) #s(hash-table data (5 6 7 8))) + :eval (map-merge 'plist '(1 2 3 4) #s(hash-table data (5 6 7 8))) + :eval (map-merge 'hash-table '(1 2 3 4) #s(hash-table data (5 6 7 8)))) + (map-merge-with + :eval (map-merge-with 'alist #'max '(1 2 3 4) #s(hash-table data (1 1 3 5))) + :eval (map-merge-with 'alist #'min '(1 2 3 4) #s(hash-table data (1 1 3 5))) + :eval (map-merge-with 'hash-table #'min '(1 2 3 4) #s(hash-table data (1 1 3 5)))) + (map-into + :args (map type) + :eval (map-into #s(hash-table data '(5 6 7 8)) 'list) + :eval (map-into '((5 . 6) (7 . 8)) 'plist) + :eval (map-into '((5 . 6) (7 . 8)) 'hash-table))) + +(define-short-documentation-group string + "Making Strings" + (make-string + :args (length init) + :eval "(make-string 5 ?x)") + (string + :eval "(string ?a ?b ?c)") + (concat + :eval (concat "foo" "bar" "zot")) + (string-join + :no-manual t + :eval (string-join '("foo" "bar" "zot") " ")) + (mapconcat + :eval (mapconcat (lambda (a) (concat "[" a "]")) + '("foo" "bar" "zot") " ")) + (string-pad + :eval (string-pad "foo" 5) + :eval (string-pad "foobar" 5) + :eval (string-pad "foo" 5 ?- t)) + (mapcar + :eval (mapcar #'identity "123")) + (format + :eval (format "This number is %d" 4)) + "Manipulating Strings" + (substring + :eval (substring "abcde" 1 3) + :eval (substring "abcde" 2) + :eval (substring "abcde" 1 -1) + :eval (substring "abcde" -4 4)) + (string-limit + :eval (string-limit "foobar" 3) + :eval (string-limit "foobar" 3 t) + :eval (string-limit "foobar" 10) + :eval (string-limit "fo好" 3 nil 'utf-8)) + (truncate-string-to-width + :eval (truncate-string-to-width "foobar" 3) + :eval (truncate-string-to-width "你好bar" 5)) + (split-string + :eval (split-string "foo bar") + :eval (split-string "|foo|bar|" "|") + :eval (split-string "|foo|bar|" "|" t)) + (split-string-and-unquote + :eval (split-string-and-unquote "foo \"bar zot\"")) + (split-string-shell-command + :eval (split-string-shell-command "ls /tmp/'foo bar'")) + (string-lines + :eval (string-lines "foo\n\nbar") + :eval (string-lines "foo\n\nbar" t)) + (string-replace + :eval (string-replace "foo" "bar" "foozot")) + (replace-regexp-in-string + :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) + (string-trim + :args (string) + :doc "Trim STRING of leading and trailing white space." + :eval (string-trim " foo ")) + (string-trim-left + :eval (string-trim-left "oofoo" "o+")) + (string-trim-right + :eval (string-trim-right "barkss" "s+")) + (string-truncate-left + :no-manual t + :eval (string-truncate-left "longstring" 8)) + (string-remove-suffix + :no-manual t + :eval (string-remove-suffix "bar" "foobar")) + (string-remove-prefix + :no-manual t + :eval (string-remove-prefix "foo" "foobar")) + (string-chop-newline + :eval (string-chop-newline "foo\n")) + (string-clean-whitespace + :eval (string-clean-whitespace " foo bar ")) + (string-fill + :eval (string-fill "Three short words" 12) + :eval (string-fill "Long-word" 3)) + (reverse + :eval (reverse "foo")) + (substring-no-properties + :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 "Å")) + (string-glyph-decompose + :eval (string-glyph-decompose "Å")) + "Predicates for Strings" + (string-equal + :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 "")) + (string-blank-p + :no-manual t + :eval (string-blank-p " \n")) + (string-lessp + :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 "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 + :eval (string-suffix-p "bar" "foobar")) + "Case Manipulation" + (upcase + :eval (upcase "foo")) + (downcase + :eval (downcase "FOObar")) + (capitalize + :eval (capitalize "foo bar zot")) + (upcase-initials + :eval (upcase-initials "The CAT in the hAt")) + "Converting Strings" + (string-to-number + :eval (string-to-number "42") + :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 "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 + :eval (assoc-string "foo" '(("a" 1) (foo 2)))) + (seq-position + :eval "(seq-position \"foobarzot\" ?z)")) + +(define-short-documentation-group file-name + "File Name Manipulation" + (file-name-directory + :eval (file-name-directory "/tmp/foo") + :eval (file-name-directory "/tmp/foo/")) + (file-name-nondirectory + :eval (file-name-nondirectory "/tmp/foo") + :eval (file-name-nondirectory "/tmp/foo/")) + (file-name-sans-versions + :args (filename) + :eval (file-name-sans-versions "/tmp/foo~")) + (file-name-extension + :eval (file-name-extension "/tmp/foo.txt")) + (file-name-sans-extension + :eval (file-name-sans-extension "/tmp/foo.txt")) + (file-name-with-extension + :eval (file-name-with-extension "foo.txt" "bin") + :eval (file-name-with-extension "foo" "bin")) + (file-name-base + :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 + :eval (file-name-concat "/tmp/" "foo") + :eval (file-name-concat "/tmp" "foo") + :eval (file-name-concat "/tmp" "foo" "bar/" "zot") + :eval (file-name-concat "/tmp" "~")) + (expand-file-name + :eval (expand-file-name "foo" "/tmp/") + :eval (expand-file-name "foo" "/tmp///") + :eval (expand-file-name "foo" "/tmp/foo/.././") + :eval (expand-file-name "~" "/tmp/")) + (substitute-in-file-name + :eval (substitute-in-file-name "$HOME/foo")) + "Directory Functions" + (file-name-as-directory + :eval (file-name-as-directory "/tmp/foo")) + (directory-file-name + :eval (directory-file-name "/tmp/foo/")) + (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) + :eval (file-name-quote "/tmp/foo")) + (file-name-unquote + :args (name) + :eval (file-name-unquote "/:/tmp/foo")) + "Predicates" + (file-name-absolute-p + :eval (file-name-absolute-p "/tmp/foo") + :eval (file-name-absolute-p "foo")) + (directory-name-p + :eval (directory-name-p "/tmp/foo/")) + (file-name-quoted-p + :eval (file-name-quoted-p "/:/tmp/foo"))) + +(define-short-documentation-group file + "Inserting Contents" + (insert-file-contents + :no-eval (insert-file-contents "/tmp/foo") + :eg-result ("/tmp/foo" 6)) + (insert-file-contents-literally + :no-eval (insert-file-contents-literally "/tmp/foo") + :eg-result ("/tmp/foo" 6)) + (find-file + :no-eval (find-file "/tmp/foo") + :eg-result-string "#") + "Predicates" + (file-symlink-p + :no-eval (file-symlink-p "/tmp/foo") + :eg-result t) + (file-directory-p + :no-eval (file-directory-p "/tmp") + :eg-result t) + (file-regular-p + :no-eval (file-regular-p "/tmp/foo") + :eg-result t) + (file-exists-p + :no-eval (file-exists-p "/tmp/foo") + :eg-result t) + (file-readable-p + :no-eval (file-readable-p "/tmp/foo") + :eg-result t) + (file-writable-p + :no-eval (file-writable-p "/tmp/foo") + :eg-result t) + (file-accessible-directory-p + :no-eval (file-accessible-directory-p "/tmp") + :eg-result t) + (file-executable-p + :no-eval (file-executable-p "/bin/cat") + :eg-result t) + (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) + (file-in-directory-p + :no-eval (file-in-directory-p "/tmp/foo" "/tmp/") + :eg-result t) + (file-locked-p + :no-eval (file-locked-p "/tmp/foo") + :eg-result nil) + "Information" + (file-attributes + :no-eval* (file-attributes "/tmp")) + (file-truename + :no-eval (file-truename "/tmp/foo/bar") + :eg-result "/tmp/foo/zot") + (file-chase-links + :no-eval (file-chase-links "/tmp/foo/bar") + :eg-result "/tmp/foo/zot") + (vc-responsible-backend + :args (file &optional no-error) + :no-eval (vc-responsible-backend "/src/foo/bar.c") + :eg-result Git) + (file-acl + :no-eval (file-acl "/tmp/foo") + :eg-result "user::rw-\ngroup::r--\nother::r--\n") + (file-extended-attributes + :no-eval* (file-extended-attributes "/tmp/foo")) + (file-selinux-context + :no-eval* (file-selinux-context "/tmp/foo")) + (locate-file + :no-eval (locate-file "syslog" '("/var/log" "/usr/bin")) + :eg-result "/var/log/syslog") + (executable-find + :no-eval (executable-find "ls") + :eg-result "/usr/bin/ls") + "Creating" + (make-temp-file + :no-eval (make-temp-file "/tmp/foo-") + :eg-result "/tmp/foo-ZcXFMj") + (make-nearby-temp-file + :no-eval (make-nearby-temp-file "/tmp/foo-") + :eg-result "/tmp/foo-xe8iON") + (write-region + :no-value (write-region (point-min) (point-max) "/tmp/foo")) + "Directories" + (make-directory + :no-value (make-directory "/tmp/bar/zot/" t)) + (directory-files + :no-eval (directory-files "/tmp/") + :eg-result ("." ".." ".ICE-unix" ".Test-unix")) + (directory-files-recursively + :no-eval (directory-files-recursively "/tmp/" "\\.png\\'") + :eg-result ("/tmp/foo.png" "/tmp/zot.png" "/tmp/bar/foobar.png")) + (directory-files-and-attributes + :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") + :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") + (copy-directory + :no-value (copy-directory "/tmp/bar/" "/tmp/barcopy")) + (delete-directory + :no-value (delete-directory "/tmp/bar/")) + "File Operations" + (rename-file + :no-value (rename-file "/tmp/foo" "/tmp/newname")) + (copy-file + :no-value (copy-file "/tmp/foo" "/tmp/foocopy")) + (delete-file + :no-value (delete-file "/tmp/foo")) + (make-empty-file + :no-value (make-empty-file "/tmp/foo")) + (make-symbolic-link + :no-value (make-symbolic-link "/tmp/foo" "/tmp/foosymlink")) + (add-name-to-file + :no-value (add-name-to-file "/tmp/foo" "/tmp/bar")) + (set-file-modes + :no-value "(set-file-modes \"/tmp/foo\" #o644)") + (set-file-times + :no-value (set-file-times "/tmp/foo")) + "File Modes" + (set-default-file-modes + :no-value "(set-default-file-modes #o755)") + (default-file-modes + :no-eval (default-file-modes) + :eg-result-string "#o755") + (file-modes-symbolic-to-number + :no-eval (file-modes-symbolic-to-number "a+r") + :eg-result-string "#o444") + (file-modes-number-to-symbolic + :eval "(file-modes-number-to-symbolic #o444)") + (set-file-extended-attributes + :no-eval (set-file-extended-attributes + "/tmp/foo" '((acl . "group::rxx"))) + :eg-result t) + (set-file-selinux-context + :no-eval (set-file-selinux-context + "/tmp/foo" '(unconfined_u object_r user_home_t s0)) + :eg-result t) + (set-file-acl + :no-eval (set-file-acl "/tmp/foo" "group::rxx") + :eg-result t)) + +(define-short-documentation-group hash-table + "Hash Table Basics" + (make-hash-table + :no-eval (make-hash-table) + :result-string "#s(hash-table ...)") + (puthash + :no-eval (puthash 'key "value" table)) + (gethash + :no-eval (gethash 'key table) + :eg-result "value") + (remhash + :no-eval (remhash 'key table) + :result nil) + (clrhash + :no-eval (clrhash table) + :result-string "#s(hash-table ...)") + (maphash + :no-eval (maphash (lambda (key value) (message value)) table) + :result nil) + "Other Hash Table Functions" + (hash-table-p + :eval (hash-table-p 123)) + (hash-table-contains-p + :no-eval (hash-table-contains-p 'key table)) + (copy-hash-table + :no-eval (copy-hash-table table) + :result-string "#s(hash-table ...)") + (hash-table-count + :no-eval (hash-table-count table) + :eg-result 15)) + +(define-short-documentation-group list + "Making Lists" + (make-list + :eval (make-list 5 'a)) + (cons + :eval (cons 1 '(2 3 4))) + (list + :eval (list 1 2 3)) + (number-sequence + :eval (number-sequence 5 8)) + (ensure-list + :eval (ensure-list "foo") + :eval (ensure-list '(1 2 3)) + :eval (ensure-list '(1 . 2))) + (ensure-proper-list + :eval (ensure-proper-list "foo") + :eval (ensure-proper-list '(1 2 3)) + :eval (ensure-proper-list '(1 . 2))) + "Operations on Lists" + (append + :eval (append '("foo" "bar") '("zot"))) + (copy-tree + :eval (copy-tree '(1 (2 3) 4))) + (flatten-tree + :eval (flatten-tree '(1 (2 3) 4))) + (car + :eval (car '(one two three)) + :eval (car '(one . two)) + :eval (car nil)) + (cdr + :eval (cdr '(one two three)) + :eval (cdr '(one . two)) + :eval (cdr nil)) + (last + :eval (last '(one two three))) + (butlast + :eval (butlast '(one two three))) + (nbutlast + :eval (nbutlast (list 'one 'two 'three))) + (nth + :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))) + (take-while + :eval (take-while #'numberp '(1 2 three 4 five))) + (drop-while + :eval (drop-while #'numberp '(1 2 three 4 five))) + (any + :eval (any #'symbolp '(1 2 three 4 five))) + (all + :eval (all #'symbolp '(one 2 three)) + :eval (all #'symbolp '(one two three))) + (elt + :eval (elt '(one two three) 1)) + (car-safe + :eval (car-safe '(one two three))) + (cdr-safe + :eval (cdr-safe '(one two three))) + (push + :no-eval* (push 'a list)) + (pop + :no-eval* (pop list)) + (setcar + :no-eval (setcar list 'c) + :result c) + (setcdr + :no-eval (setcdr list (list c)) + :result '(c)) + (nconc + :eval (nconc (list 1) (list 2 3 4))) + (delq + :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"))) + (remq + :eval (remq 'b '(a b c))) + (remove + :eval (remove 2 '(1 2 3 4)) + :eval (remove "a" '("a" "b" "c" "d"))) + (delete-dups + :eval (delete-dups (list 1 2 4 3 2 4))) + "Mapping Over Lists" + (mapcar + :eval (mapcar #'list '(1 2 3))) + (mapcan + :eval (mapcan #'list '(1 2 3))) + (mapc + :eval (mapc #'insert '("1" "2" "3"))) + (seq-reduce + :eval (seq-reduce #'+ '(1 2 3) 0)) + (mapconcat + :eval (mapconcat #'identity '("foo" "bar") "|")) + "Predicates" + (listp + :eval (listp '(1 2 3)) + :eval (listp nil) + :eval (listp '(1 . 2))) + (consp + :eval (consp '(1 2 3)) + :eval (consp nil)) + (proper-list-p + :eval (proper-list-p '(1 2 3)) + :eval (proper-list-p nil) + :eval (proper-list-p '(1 . 2))) + (null + :eval (null nil)) + (atom + :eval (atom 'a)) + (nlistp + :eval (nlistp '(1 2 3)) + :eval (nlistp t) + :eval (nlistp '(1 . 2))) + "Finding Elements" + (memq + :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"))) + (member-ignore-case + :eval (member-ignore-case "foo" '("bar" "Foo" "zot"))) + "Association Lists" + (assoc + :eval (assoc "b" '(("a" . 1) ("b" . 2)))) + (rassoc + :eval (rassoc "b" '((1 . "a") (2 . "b")))) + (assq + :eval (assq 'b '((a . 1) (b . 2)))) + (rassq + :eval (rassq 'b '((1 . a) (2 . b)))) + (assoc-string + :eval (assoc-string "foo" '(("a" 1) (foo 2)))) + (alist-get + :eval (alist-get 2 '((1 . a) (2 . b)))) + (assoc-default + :eval (assoc-default 2 '((1 . a) (2 . b) #'=))) + (copy-alist + :eval (copy-alist '((1 . a) (2 . b)))) + (assoc-delete-all + :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) + (assq-delete-all + :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) + (rassq-delete-all + :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) + "Property Lists" + (plist-get + :eval (plist-get '(a 1 b 2 c 3) 'b)) + (plist-put + :no-eval (setq plist (plist-put plist 'd 4)) + :eg-result (a 1 b 2 c 3 d 4)) + (plist-member + :eval (plist-member '(a 1 b 2 c 3) 'b)) + "Data About Lists" + (length + :eval (length '(a b c))) + (length< + :eval (length< '(a b c) 1)) + (length> + :eval (length> '(a b c) 1)) + (length= + :eval (length= '(a b c) 3)) + (safe-length + :eval (safe-length '(a b c)))) + +(define-short-documentation-group symbol + "Making symbols" + (intern + :eval (intern "abc")) + (intern-soft + :eval (intern-soft "list") + :eval (intern-soft "Phooey!")) + (make-symbol + :eval (make-symbol "abc")) + (gensym + :no-eval (gensym) + :eg-result g37) + "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)) + "Obarrays" + (obarray-make + :eval (obarray-make)) + (obarrayp + :eval (obarrayp (obarray-make)) + :eval (obarrayp nil)) + (unintern + :no-eval (unintern "abc" my-obarray) + :eg-result t) + (mapatoms + :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray)) + (obarray-clear + :no-eval (obarray-clear my-obarray))) + +(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" + (make-vector + :eval (make-vector 5 "foo")) + (vector + :eval (vector 1 "b" 3)) + "Operations on Vectors" + (vectorp + :eval (vectorp [1]) + :eval (vectorp "1")) + (vconcat + :eval (vconcat '(1 2) [3 4])) + (append + :eval (append [1 2] nil)) + (length + :eval (length [1 2 3])) + (seq-reduce + :eval (seq-reduce #'+ [1 2 3] 0)) + (seq-subseq + :eval (seq-subseq [1 2 3 4 5] 1 3) + :eval (seq-subseq [1 2 3 4 5] 1)) + (copy-tree + :eval (copy-tree [1 (2 3) [4 5]] t)) + "Mapping Over Vectors" + (mapcar + :eval (mapcar #'identity [1 2 3])) + (mapc + :eval (mapc #'insert ["1" "2" "3"]))) + +(define-short-documentation-group regexp + "Matching Strings" + (replace-regexp-in-string + :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) + (string-match-p + :eval (string-match-p "^[fo]+" "foobar")) + "Looking in Buffers" + (re-search-forward + :no-eval (re-search-forward "^foo$" nil t) + :eg-result 43) + (re-search-backward + :no-eval (re-search-backward "^foo$" nil t) + :eg-result 43) + (looking-at-p + :no-eval (looking-at-p "f[0-9]") + :eg-result t) + "Match Data" + (match-string + :eval (and (string-match "^\\([fo]+\\)b" "foobar") + (match-string 0 "foobar"))) + (match-beginning + :no-eval (match-beginning 1) + :eg-result 0) + (match-end + :no-eval (match-end 1) + :eg-result 3) + (save-match-data + :no-eval (save-match-data ...)) + "Replacing Match" + (replace-match + :no-eval (replace-match "new") + :eg-result nil) + (match-substitute-replacement + :no-eval (match-substitute-replacement "new") + :eg-result "new") + (replace-regexp-in-region + :no-value (replace-regexp-in-region "[0-9]+" "Num \\&")) + "Utilities" + (regexp-quote + :eval (regexp-quote "foo.*bar")) + (regexp-opt + :eval (regexp-opt '("foo" "bar"))) + (regexp-opt-depth + :eval (regexp-opt-depth "\\(a\\(b\\)\\)")) + (regexp-opt-charset + :eval (regexp-opt-charset '(?a ?b ?c ?d ?e))) + "The `rx' Structured Regexp Notation" + (rx + :eval (rx "IP=" (+ digit) (= 3 "." (+ digit)))) + (rx-to-string + :eval (rx-to-string '(| "foo" "bar"))) + (rx-define + :no-eval "(and (rx-define haskell-comment (seq \"--\" (zero-or-more nonl))) + (rx haskell-comment))" + :result "--.*") + (rx-let + :eval "(rx-let ((comma-separated (item) (seq item (0+ \",\" item))) + (number (1+ digit)) + (numbers (comma-separated number))) + (rx \"(\" numbers \")\"))" + :result "([[:digit:]]+\\(?:,[[:digit:]]+\\)*)") + (rx-let-eval + :eval "(rx-let-eval + '((ponder (x) (seq \"Where have all the \" x \" gone?\"))) + (rx-to-string + '(ponder (or \"flowers\" \"cars\" \"socks\"))))" + :result "\\(?:Where have all the \\(?:\\(?:car\\|flower\\|sock\\)s\\) gone\\?\\)")) + +(define-short-documentation-group sequence + "Sequence Predicates" + (seq-contains-p + :eval (seq-contains-p '(a b c) 'b) + :eval (seq-contains-p '(a b c) 'd)) + (seq-every-p + :eval (seq-every-p #'numberp '(1 2 3))) + (seq-empty-p + :eval (seq-empty-p [])) + (seq-set-equal-p + :eval (seq-set-equal-p '(1 2 3) '(3 1 2))) + (seq-some + :eval (seq-some #'floatp '(1 2.0 3))) + "Building Sequences" + (seq-concatenate + :eval (seq-concatenate 'vector '(1 2) '(c d))) + (seq-copy + :eval (seq-copy '(a 2))) + (seq-into + :eval (seq-into '(1 2 3) 'vector)) + "Utility Functions" + (seq-count + :eval (seq-count #'numberp '(1 b c 4))) + (seq-elt + :eval (seq-elt '(a b c) 1)) + (seq-random-elt + :no-eval (seq-random-elt '(a b c)) + :eg-result c) + (seq-find + :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 + :eval (seq-max [1 2 3])) + (seq-min + :eval (seq-min [1 2 3])) + (seq-first + :eval (seq-first [a b c])) + (seq-rest + :eval (seq-rest '[1 2 3])) + (seq-reverse + :eval (seq-reverse '(1 2 3))) + (seq-sort + :eval (seq-sort #'> '(1 2 3))) + (seq-sort-by + :eval (seq-sort-by (lambda (a) (/ 1.0 a)) #'< '(1 2 3))) + "Mapping Over Sequences" + (seq-map + :eval (seq-map #'1+ '(1 2 3))) + (seq-map-indexed + :eval (seq-map-indexed (lambda (a i) (cons i a)) '(a b c))) + (seq-mapcat + :eval (seq-mapcat #'upcase '("a" "b" "c") 'string)) + (seq-doseq + :no-eval (seq-doseq (a '("foo" "bar")) (insert a)) + :eg-result ("foo" "bar")) + (seq-do + :no-eval (seq-do (lambda (a) (insert a)) '("foo" "bar")) + :eg-result ("foo" "bar")) + (seq-do-indexed + :no-eval (seq-do-indexed + (lambda (a index) (message "%s:%s" index a)) + '("foo" "bar")) + :eg-result nil) + (seq-reduce + :eval (seq-reduce #'* [1 2 3] 2)) + "Excerpting Sequences" + (seq-drop + :eval (seq-drop '(a b c) 2)) + (seq-drop-while + :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 #'natnump '(-1 2 3 -4 -5 6))) + (seq-union + :eval (seq-union '(1 2 3) '(3 5))) + (seq-difference + :eval (seq-difference '(1 2 3) '(2 3 4))) + (seq-intersection + :eval (seq-intersection '(1 2 3) '(2 3 4))) + (seq-partition + :eval (seq-partition '(a b c d e f g h) 3)) + (seq-subseq + :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 #'integerp [1 2 3.0 4])) + (seq-uniq + :eval (seq-uniq '(a b d b a c)))) + +(define-short-documentation-group buffer + "Buffer Basics" + (current-buffer + :no-eval (current-buffer) + :eg-result-string "#") + (bufferp + :eval (bufferp 23)) + (buffer-live-p + :no-eval (buffer-live-p some-buffer) + :eg-result t) + (buffer-modified-p + :eval (buffer-modified-p (current-buffer))) + (buffer-name + :eval (buffer-name)) + (window-buffer + :eval (window-buffer)) + "Selecting Buffers" + (get-buffer-create + :no-eval (get-buffer-create "*foo*") + :eg-result-string "#") + (pop-to-buffer + :no-eval (pop-to-buffer "*foo*") + :eg-result-string "#") + (with-current-buffer + :no-eval* (with-current-buffer buffer (buffer-size))) + "Points and Positions" + (point + :eval (point)) + (point-min + :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)) + :eg-result 342) + (search-forward + :no-eval (search-forward "some-string" nil t) + :eg-result 245) + (re-search-forward + :no-eval (re-search-forward "some-s.*g" nil t) + :eg-result 245) + (forward-line + :no-eval (forward-line 1) + :eg-result 0 + :no-eval (forward-line -2) + :eg-result 0) + "Strings from Buffers" + (buffer-string + :no-eval* (buffer-string)) + (buffer-substring + :eval (buffer-substring (point-min) (+ (point-min) 10))) + (buffer-substring-no-properties + :eval (buffer-substring-no-properties (point-min) (+ (point-min) 10))) + (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") + "Altering Buffers" + (delete-region + :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 + :no-eval "(subst-char-in-region (point-min) (point-max) ?+ ?-)") + (replace-string-in-region + :no-value (replace-string-in-region "foo" "bar")) + "Locking" + (lock-buffer + :no-value (lock-buffer "/tmp/foo")) + (unlock-buffer + :no-value (unlock-buffer))) + +(define-short-documentation-group overlay + "Predicates" + (overlayp + :no-eval (overlayp some-overlay) + :eg-result t) + "Creation and Deletion" + (make-overlay + :args (beg end &optional buffer) + :no-eval (make-overlay 1 10) + :eg-result-string "#") + (delete-overlay + :no-eval (delete-overlay foo) + :eg-result t) + "Searching Overlays" + (overlays-at + :no-eval (overlays-at 15) + :eg-result-string "(#)") + (overlays-in + :no-eval (overlays-in 1 30) + :eg-result-string "(#)") + (next-overlay-change + :no-eval (next-overlay-change 1) + :eg-result 20) + (previous-overlay-change + :no-eval (previous-overlay-change 30) + :eg-result 20) + "Overlay Properties" + (overlay-start + :no-eval (overlay-start foo) + :eg-result 1) + (overlay-end + :no-eval (overlay-end foo) + :eg-result 10) + (overlay-put + :no-eval (overlay-put foo 'happy t) + :eg-result t) + (overlay-get + :no-eval (overlay-get foo 'happy) + :eg-result t) + (overlay-buffer + :no-eval (overlay-buffer foo)) + "Moving Overlays" + (move-overlay + :no-eval (move-overlay foo 5 20) + :eg-result-string "#")) + +(define-short-documentation-group process + (make-process + :no-eval (make-process :name "foo" :command '("cat" "/tmp/foo")) + :eg-result-string "#") + (processp + :eval (processp t)) + (process-status + :no-eval (process-status process) + :eg-result exit) + (delete-process + :no-value (delete-process process)) + (kill-process + :no-value (kill-process process)) + (set-process-sentinel + :no-value (set-process-sentinel process (lambda (proc string)))) + (process-buffer + :no-eval (process-buffer process) + :eg-result-string "#") + (get-buffer-process + :no-eval (get-buffer-process buffer) + :eg-result-string "#") + (process-live-p + :no-eval (process-live-p process) + :eg-result t)) + +(define-short-documentation-group number + "Arithmetic" + (+ + :args (&rest numbers) + :eval (+ 1 2) + :eval (+ 1 2 3 4)) + (- + :args (&rest numbers) + :eval (- 3 2) + :eval (- 6 3 2)) + (* + :args (&rest numbers) + :eval (* 3 4 5)) + (/ + :eval (/ 10 5) + :eval (/ 10 6) + :eval (/ 10.0 6) + :eval (/ 10.0 3 3)) + (% + :eval (% 10 5) + :eval (% 10 6)) + (mod + :eval (mod 10 5) + :eval (mod 10 6) + :eval (mod 10.5 6)) + (1+ + :eval (1+ 2) + :eval (let ((x 2)) (1+ x) x)) + (1- + :eval (1- 4) + :eval (let ((x 4)) (1- x) x)) + (incf + :eval (let ((x 2)) (incf x) x) + :eval (let ((x 2)) (incf x 2) x)) + (decf + :eval (let ((x 4)) (decf x) x) + :eval (let ((x 4)) (decf x 2)) x) + "Predicates" + (= + :args (number &rest numbers) + :eval (= 4 4) + :eval (= 4.0 4.0) + :eval (= 4 4.0) + :eval (= 4 4 4 4)) + (eql + :eval (eql 4 4) + :eval (eql 4.0 4.0)) + (/= + :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)) + (zerop + :eval (zerop 0)) + (natnump + :eval (natnump -1) + :eval (natnump 0) + :eval (natnump 23)) + (plusp + :eval (plusp 0) + :eval (plusp 1)) + (minusp + :eval (minusp 0) + :eval (minusp -1)) + (oddp + :eval (oddp 3)) + (evenp + :eval (evenp 6)) + (bignump + :eval (bignump 4) + :eval (bignump (expt 2 90))) + (fixnump + :eval (fixnump 4) + :eval (fixnump (expt 2 90))) + (floatp + :eval (floatp 5.4)) + (integerp + :eval (integerp 5.4)) + (numberp + :eval (numberp "5.4")) + (cl-digit-char-p + :eval (cl-digit-char-p ?5 10) + :eval (cl-digit-char-p ?f 16)) + "Operations" + (max + :args (number &rest numbers) + :eval (max 7 9 3)) + (min + :args (number &rest numbers) + :eval (min 7 9 3)) + (abs + :eval (abs -4)) + (float + :eval (float 2)) + (truncate + :eval (truncate 1.2) + :eval (truncate -1.2) + :eval (truncate 5.4 2)) + (floor + :eval (floor 1.2) + :eval (floor -1.2) + :eval (floor 5.4 2)) + (ceiling + :eval (ceiling 1.2) + :eval (ceiling -1.2) + :eval (ceiling 5.4 2)) + (round + :eval (round 1.2) + :eval (round -1.2) + :eval (round 5.4 2)) + (random + :eval (random 6)) + "Bit Operations" + (ash + :eval (ash 1 4) + :eval (ash 16 -1)) + (logand + :no-eval "(logand #b10 #b111)" + :result-string "#b10") + (logior + :eval (logior 4 16)) + (logxor + :eval (logxor 4 16)) + (lognot + :eval (lognot 5)) + (logcount + :eval (logcount 5)) + "Floating Point" + (isnan + :eval (isnan 5.0)) + (frexp + :eval (frexp 5.7)) + (ldexp + :eval (ldexp 0.7125 3)) + (logb + :eval (logb 10.5)) + (ffloor + :eval (ffloor 1.2)) + (fceiling + :eval (fceiling 1.2)) + (ftruncate + :eval (ftruncate 1.2)) + (fround + :eval (fround 1.2)) + "Standard Math Functions" + (sin + :eval (sin float-pi)) + (cos + :eval (cos float-pi)) + (tan + :eval (tan float-pi)) + (asin + :eval (asin float-pi)) + (acos + :eval (acos float-pi)) + (atan + :eval (atan float-pi)) + (exp + :eval (exp 4)) + (log + :eval (log 54.59)) + (expt + :eval (expt 2 16)) + (sqrt + :eval (sqrt -1))) + +(define-short-documentation-group text-properties + "Examining Text Properties" + (get-text-property + :eval (get-text-property 0 'foo (propertize "x" 'foo t))) + (get-char-property + :eval (get-char-property 0 'foo (propertize "x" 'foo t))) + (get-pos-property + :eval (get-pos-property 0 'foo (propertize "x" 'foo t))) + (get-char-property-and-overlay + :eval (get-char-property-and-overlay 0 'foo (propertize "x" 'foo t))) + (text-properties-at + :eval (text-properties-at (point))) + "Changing Text Properties" + (put-text-property + :eval (let ((s (copy-sequence "abc"))) (put-text-property 0 1 'foo t s) s) + :no-eval (put-text-property (point) (1+ (point)) 'face 'error)) + (add-text-properties + :no-eval (add-text-properties (point) (1+ (point)) '(face error))) + (remove-text-properties + :no-eval (remove-text-properties (point) (1+ (point)) '(face nil))) + (remove-list-of-text-properties + :no-eval (remove-list-of-text-properties (point) (1+ (point)) '(face font-lock-face))) + (set-text-properties + :no-eval (set-text-properties (point) (1+ (point)) '(face error))) + (add-face-text-property + :no-eval (add-face-text-property START END '(:foreground "green"))) + (propertize + :eval (propertize "foo" 'face 'italic 'mouse-face 'bold-italic)) + "Searching for Text Properties" + (next-property-change + :no-eval (next-property-change (point) (current-buffer))) + (previous-property-change + :no-eval (previous-property-change (point) (current-buffer))) + (next-single-property-change + :no-eval (next-single-property-change (point) 'face (current-buffer))) + (previous-single-property-change + :no-eval (previous-single-property-change (point) 'face (current-buffer))) + ;; TODO: There are some more that could be added here. + (text-property-search-forward + :no-eval (text-property-search-forward 'face nil t)) + (text-property-search-backward + :no-eval (text-property-search-backward 'face nil t))) + +(define-short-documentation-group keymaps + "Defining keymaps or adding bindings to existing keymaps" + (define-keymap + :no-eval (define-keymap "C-c C-c" #'quit-buffer) + :no-eval (define-keymap :keymap ctl-x-map + "C-r" #'recentf-open + "k" #'kill-current-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 "" 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 same-window) + "Pop to a buffer with short documentation summary for functions in GROUP. +Interactively, prompt for GROUP. +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 + "Group of functions for which to show summary: " + (mapcar #'car shortdoc--groups)))) + (when (stringp group) + (setq group (intern group))) + (unless (assq group shortdoc--groups) + (error "No such documentation group %s" group)) + (let ((buf (get-buffer-create (format "*Shortdoc %s*" group)))) + (shortdoc--insert-group-in-buffer group buf) + (funcall (if same-window + #'pop-to-buffer-same-window + #'pop-to-buffer) + buf)) + (goto-char (point-min)) + (when function + (text-property-search-forward 'shortdoc-function function t) + (beginning-of-line))) + +(defun shortdoc--insert-group-in-buffer (group &optional buf) + "Insert a short documentation summary for functions in GROUP in buffer BUF. +BUF defaults to the current buffer if nil or omitted." + (with-current-buffer (or buf (current-buffer)) + (let ((inhibit-read-only t) + (prev nil)) + (erase-buffer) + (shortdoc-mode) + (button-mode) + (mapc + (lambda (data) + (cond + ((stringp data) + (setq prev nil) + (unless (bobp) + (insert "\n")) + (insert (propertize + (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) + ;; This helps with hidden outlines (bug#53981) + (propertize "\n" 'face '(:height 0)))) + (setq prev t) + (shortdoc--display-function data)))) + (cdr (assq group shortdoc--groups)))))) + +;;;###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 'outline-level 2)) + (if (plist-get data :no-manual) + (insert-text-button + (symbol-name function) + 'face 'button + 'action (lambda (_) + (describe-function function)) + 'follow-link t + '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 "mouse-1, RET: show \ +function's documentation in the Info manual")) + (setq arglist-start (point)) + (insert ")\n") + ;; Doc string. + (insert " " + (or (plist-get data :doc) + (car (split-string (or (documentation function) + "Error: missing docstring.") + "\n")))) + (insert "\n") + (add-face-text-property start-section (point) 'shortdoc-section t) + (let ((print-escape-newlines t) + (double-arrow (if (char-displayable-p ?⇒) + "⇒" + "=>")) + (single-arrow (if (char-displayable-p ?→) + "→" + "->")) + (start-example (point))) + (cl-loop for (type value) on data by #'cddr + do + (cl-case type + (:eval + (insert " ") + (if (stringp value) + (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") + (insert " ") + (prin1 value (current-buffer))) + (insert "\n " single-arrow " " + (propertize "[it depends]" + 'face 'shortdoc-section) + "\n")) + (:no-value + (if (stringp value) + (insert " " value) + (insert " ") + (prin1 value (current-buffer))) + (insert "\n")) + (:no-eval + (if (stringp value) + (insert " " value) + (insert " ") + (prin1 value (current-buffer))) + (insert "\n")) + (:result + (insert " " double-arrow " ") + (prin1 value (current-buffer)) + (insert "\n")) + (:result-string + (insert " " double-arrow " ") + (princ value (current-buffer)) + (insert "\n")) + (:eg-result + (insert " e.g. " double-arrow " ") + (prin1 value (current-buffer)) + (insert "\n")) + (:eg-result-string + (insert " e.g. " double-arrow " ") + (princ value (current-buffer)) + (insert "\n")))) + (add-text-properties start-example (point) `(shortdoc-example ,function))) + ;; Insert the arglist after doing the evals, in case that's pulled + ;; in the function definition. + (save-excursion + (goto-char arglist-start) + (dolist (param (or (plist-get data :args) + (help-function-arglist function t))) + (insert " " (symbol-name param))) + (add-face-text-property arglist-start (point) 'shortdoc-section t)))) + +(defun shortdoc-function-examples (function) + "Return all shortdoc examples for FUNCTION. +The result is an alist with items of the form (GROUP . EXAMPLES), +where GROUP is a shortdoc group where FUNCTION appears, and +EXAMPLES is a string with the usage examples of FUNCTION defined +in GROUP. Return nil if FUNCTION is not a function or if it +doesn't has any shortdoc information." + (let ((groups (and (symbolp function) + (shortdoc-function-groups function))) + (examples nil)) + (mapc + (lambda (group) + (with-temp-buffer + (shortdoc--insert-group-in-buffer group) + (goto-char (point-min)) + (let ((match (text-property-search-forward + 'shortdoc-example function t))) + (push `(,group . ,(string-trim + (buffer-substring-no-properties + (prop-match-beginning match) + (prop-match-end match)))) + examples)))) + groups) + examples)) + +(defun shortdoc-help-fns-examples-function (function) + "Insert Emacs Lisp examples for FUNCTION into the current buffer. +You can add this function to the `help-fns-describe-function-functions' +hook to show examples of using FUNCTION in *Help* buffers produced +by \\[describe-function]." + (let* ((examples (shortdoc-function-examples function)) + (num-examples (length examples)) + (times 0)) + (dolist (example examples) + (when (zerop times) + (if (> num-examples 1) + (insert "\n Examples:\n\n") + ;; Some functions have more than one example per group. + ;; Count the number of arrows to know if we need to + ;; pluralize "Example". + (let* ((text (cdr example)) + (count 0) + (pos 0) + (end (length text)) + (double-arrow (if (char-displayable-p ?⇒) + " ⇒" + " =>")) + (double-arrow-example (if (char-displayable-p ?⇒) + " e.g. ⇒" + " e.g. =>")) + (single-arrow (if (char-displayable-p ?→) + " →" + " ->"))) + (while (and (< pos end) + (or (string-match double-arrow text pos) + (string-match double-arrow-example text pos) + (string-match single-arrow text pos))) + (setq count (1+ count) + pos (match-end 0))) + (if (> count 1) + (insert "\n Examples:\n\n") + (insert "\n Example:\n\n"))))) + (setq times (1+ times)) + (insert " ") + (insert (cdr example)) + (insert "\n\n")))) + +(defun shortdoc-function-groups (function) + "Return all shortdoc groups FUNCTION appears in." + (cl-loop for group in shortdoc--groups + when (assq function (cdr group)) + collect (car group))) + +(defun shortdoc-add-function (group section elem) + "Add ELEM to shortdoc GROUP in SECTION. +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\")))" + (let ((glist (assq group shortdoc--groups))) + (unless glist + (setq glist (list group)) + (push glist shortdoc--groups)) + (let ((slist (member section glist))) + (unless slist + (setq slist (list section)) + (nconc glist slist)) + (while (and (cdr slist) + (not (stringp (cadr slist)))) + (setq slist (cdr slist))) + (setcdr slist (cons elem (cdr slist)))))) + +(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 + (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) + (setq arg 1)) + (while (> arg 0) + (funcall + (if reverse 'text-property-search-backward + 'text-property-search-forward) + sym nil t) + (setq arg (1- arg)))) + +(defun shortdoc-next (&optional arg) + "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 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 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 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 -- cgit v1.2.1 From f2b9b827c977dee0031e44901cbf3e1111e1cc09 Mon Sep 17 00:00:00 2001 From: Stephen Berman Date: Wed, 25 Mar 2026 20:45:44 +0100 Subject: Fix Dired check for newlines in file names Ensure that Dired does not treat the sequence "\\n" within a file name as a newline (bug#80608). * lisp/dired.el (dired--filename-with-newline-p): Rewrite using 'directory-files' with match for regexp "\n". * test/lisp/dired-tests.el (dired-test--filename-with-backslash-n): New function. (dired-test-filename-with-backslash-n): New test. --- lisp/dired.el | 19 +++++-------------- 1 file changed, 5 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/dired.el b/lisp/dired.el index 4c0d34344c3..4782c691411 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4011,20 +4011,11 @@ Considers buffers closer to the car of `buffer-list' to be more recent." (not (memq buffer1 (memq buffer2 (buffer-list)))))) (defun dired--filename-with-newline-p () - "Check if a file name in this directory has a newline. -Return non-nil if at least one file name in this directory contains -either a literal newline or the string \"\\n\")." - (save-excursion - (goto-char (point-min)) - (catch 'found - (while (not (eobp)) - (when (dired-move-to-filename) - (let ((fn (buffer-substring-no-properties - (point) (dired-move-to-end-of-filename)))) - (when (or (memq 10 (seq-into fn 'list)) - (string-search "\\n" fn)) - (throw 'found t)))) - (forward-line))))) + "Check whether a file name in this directory has a newline. +Return non-nil if at least one file name in this directory contains a +newline character (regardless of whether Dired displays the character as +a literal newline or as \"\\n\")." + (directory-files default-directory nil "\n")) (defun dired--remove-b-switch () "Remove all variants of the `b' switch from `dired-actual-switches'. -- cgit v1.2.1 From 82882db8edc00f8964e5d4561f9fce6a96b6c336 Mon Sep 17 00:00:00 2001 From: Jens Schmidt Date: Wed, 25 Mar 2026 18:05:10 +0100 Subject: Split up shortdoc functions and groups, fix their format Move shortdoc group definitions from shortdoc.el to a separate file shortdoc-doc.el. Document shortdoc group format in a future-proof way and guide package authors on how to use shortdoc groups across past Emacs versions. * lisp/emacs-lisp/shortdoc-doc.el: New file. * lisp/emacs-lisp/shortdoc.el: Document shortdoc group format in a future-proof way. Require 'shortdoc-doc'. (shortdoc--keyword-plist-p): New function. (shortdoc--check): Update to check the documented shortdoc group format. (shortdoc--groups, define-short-documentation-group): Pull out of autoloaded 'progn'. (define-short-documentation-group): Report errors in terms of byte compiler warnings. (alist, map, string, file-name, file, hash-table, list, symbol) (comparison, vector, regexp, sequence, buffer, overlay, process, number) (text-properties, keymaps): Move group to shortdoc-doc.el. (shortdoc): Move alias to after function. (shortdoc-add-function): Add argument checks. * doc/lispref/tips.texi (Documentation Group Tips): New section. * doc/lispref/elisp.texi (Top): * doc/lispref/tips.texi (Tips): Add references to it. * doc/lispref/help.texi (Documentation Groups): Ditto, and add some concept index entries. (bug#80297) --- lisp/emacs-lisp/shortdoc-doc.el | 450 +---------- lisp/emacs-lisp/shortdoc.el | 1648 ++++----------------------------------- 2 files changed, 140 insertions(+), 1958 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/shortdoc-doc.el b/lisp/emacs-lisp/shortdoc-doc.el index ea6910c60fc..40b98811bf0 100644 --- a/lisp/emacs-lisp/shortdoc-doc.el +++ b/lisp/emacs-lisp/shortdoc-doc.el @@ -1,4 +1,4 @@ -;;; shortdoc.el --- Short function summaries -*- lexical-binding: t -*- +;;; shortdoc-doc.el --- Builtin shortdoc groups -*- lexical-binding: t -*- ;; Copyright (C) 2020-2026 Free Software Foundation, Inc. @@ -22,119 +22,16 @@ ;;; Commentary: -;; This package lists functions based on various groupings. +;; This file defines builtin Emacs shortdoc groups. ;; -;; 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. +;; If a shortdoc group describes builtin functions, functions from +;; subr.el or simple.el or otherwise preloaded files, or functions from +;; different files, then you should probably define it in this file. +;; Otherwise, you might as well define the shortdoc group in the file +;; where the documented functions live, like treesit.el does it. ;;; Code: -(require 'seq) -(require 'text-property-search) -(eval-when-compile (require 'cl-lib)) - -(defgroup shortdoc nil - "Short documentation." - :group 'lisp) - -(defface shortdoc-heading - '((t :inherit variable-pitch :height 1.3 :weight bold)) - "Face used for a heading." - :version "28.1") - -(defface shortdoc-section - '((t :inherit variable-pitch)) - "Face used for a section.") - -;;;###autoload -(defun shortdoc--check (group functions) - (let ((keywords '( :no-manual :args :eval :no-eval :no-value :no-eval* - :result :result-string :eg-result :eg-result-string :doc))) - (dolist (f functions) - (when (consp f) - (dolist (x f) - (when (and (keywordp x) (not (memq x keywords))) - (error "Shortdoc %s function `%s': bad keyword `%s'" - group (car f) x))))))) - -;;;###autoload -(progn - (defvar shortdoc--groups nil) - - (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: - - (FUNC - :no-manual BOOL - :args ARGS - :eval EVAL - :no-eval EXAMPLE-FORM - :no-value EXAMPLE-FORM - :no-eval* EXAMPLE-FORM - :result RESULT-FORM - :result-string RESULT-STRING - :eg-result RESULT-FORM - :eg-result-string RESULT-STRING) - -FUNC is the function being documented. - -NO-MANUAL should be non-nil if FUNC isn't documented in the -manual. - -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. - -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. - -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)) - (shortdoc--check group functions) - `(progn - (setq shortdoc--groups (delq (assq ',group shortdoc--groups) - shortdoc--groups)) - (push (cons ',group ',functions) shortdoc--groups)))) - (define-short-documentation-group alist "Alist Basics" (assoc @@ -1626,335 +1523,6 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), (keymap-lookup :eval (keymap-lookup (current-global-map) "C-x x g"))) -;;;###autoload -(defun shortdoc-display-group (group &optional function same-window) - "Pop to a buffer with short documentation summary for functions in GROUP. -Interactively, prompt for GROUP. -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 - "Group of functions for which to show summary: " - (mapcar #'car shortdoc--groups)))) - (when (stringp group) - (setq group (intern group))) - (unless (assq group shortdoc--groups) - (error "No such documentation group %s" group)) - (let ((buf (get-buffer-create (format "*Shortdoc %s*" group)))) - (shortdoc--insert-group-in-buffer group buf) - (funcall (if same-window - #'pop-to-buffer-same-window - #'pop-to-buffer) - buf)) - (goto-char (point-min)) - (when function - (text-property-search-forward 'shortdoc-function function t) - (beginning-of-line))) - -(defun shortdoc--insert-group-in-buffer (group &optional buf) - "Insert a short documentation summary for functions in GROUP in buffer BUF. -BUF defaults to the current buffer if nil or omitted." - (with-current-buffer (or buf (current-buffer)) - (let ((inhibit-read-only t) - (prev nil)) - (erase-buffer) - (shortdoc-mode) - (button-mode) - (mapc - (lambda (data) - (cond - ((stringp data) - (setq prev nil) - (unless (bobp) - (insert "\n")) - (insert (propertize - (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) - ;; This helps with hidden outlines (bug#53981) - (propertize "\n" 'face '(:height 0)))) - (setq prev t) - (shortdoc--display-function data)))) - (cdr (assq group shortdoc--groups)))))) - -;;;###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 'outline-level 2)) - (if (plist-get data :no-manual) - (insert-text-button - (symbol-name function) - 'face 'button - 'action (lambda (_) - (describe-function function)) - 'follow-link t - '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 "mouse-1, RET: show \ -function's documentation in the Info manual")) - (setq arglist-start (point)) - (insert ")\n") - ;; Doc string. - (insert " " - (or (plist-get data :doc) - (car (split-string (or (documentation function) - "Error: missing docstring.") - "\n")))) - (insert "\n") - (add-face-text-property start-section (point) 'shortdoc-section t) - (let ((print-escape-newlines t) - (double-arrow (if (char-displayable-p ?⇒) - "⇒" - "=>")) - (single-arrow (if (char-displayable-p ?→) - "→" - "->")) - (start-example (point))) - (cl-loop for (type value) on data by #'cddr - do - (cl-case type - (:eval - (insert " ") - (if (stringp value) - (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") - (insert " ") - (prin1 value (current-buffer))) - (insert "\n " single-arrow " " - (propertize "[it depends]" - 'face 'shortdoc-section) - "\n")) - (:no-value - (if (stringp value) - (insert " " value) - (insert " ") - (prin1 value (current-buffer))) - (insert "\n")) - (:no-eval - (if (stringp value) - (insert " " value) - (insert " ") - (prin1 value (current-buffer))) - (insert "\n")) - (:result - (insert " " double-arrow " ") - (prin1 value (current-buffer)) - (insert "\n")) - (:result-string - (insert " " double-arrow " ") - (princ value (current-buffer)) - (insert "\n")) - (:eg-result - (insert " e.g. " double-arrow " ") - (prin1 value (current-buffer)) - (insert "\n")) - (:eg-result-string - (insert " e.g. " double-arrow " ") - (princ value (current-buffer)) - (insert "\n")))) - (add-text-properties start-example (point) `(shortdoc-example ,function))) - ;; Insert the arglist after doing the evals, in case that's pulled - ;; in the function definition. - (save-excursion - (goto-char arglist-start) - (dolist (param (or (plist-get data :args) - (help-function-arglist function t))) - (insert " " (symbol-name param))) - (add-face-text-property arglist-start (point) 'shortdoc-section t)))) - -(defun shortdoc-function-examples (function) - "Return all shortdoc examples for FUNCTION. -The result is an alist with items of the form (GROUP . EXAMPLES), -where GROUP is a shortdoc group where FUNCTION appears, and -EXAMPLES is a string with the usage examples of FUNCTION defined -in GROUP. Return nil if FUNCTION is not a function or if it -doesn't has any shortdoc information." - (let ((groups (and (symbolp function) - (shortdoc-function-groups function))) - (examples nil)) - (mapc - (lambda (group) - (with-temp-buffer - (shortdoc--insert-group-in-buffer group) - (goto-char (point-min)) - (let ((match (text-property-search-forward - 'shortdoc-example function t))) - (push `(,group . ,(string-trim - (buffer-substring-no-properties - (prop-match-beginning match) - (prop-match-end match)))) - examples)))) - groups) - examples)) - -(defun shortdoc-help-fns-examples-function (function) - "Insert Emacs Lisp examples for FUNCTION into the current buffer. -You can add this function to the `help-fns-describe-function-functions' -hook to show examples of using FUNCTION in *Help* buffers produced -by \\[describe-function]." - (let* ((examples (shortdoc-function-examples function)) - (num-examples (length examples)) - (times 0)) - (dolist (example examples) - (when (zerop times) - (if (> num-examples 1) - (insert "\n Examples:\n\n") - ;; Some functions have more than one example per group. - ;; Count the number of arrows to know if we need to - ;; pluralize "Example". - (let* ((text (cdr example)) - (count 0) - (pos 0) - (end (length text)) - (double-arrow (if (char-displayable-p ?⇒) - " ⇒" - " =>")) - (double-arrow-example (if (char-displayable-p ?⇒) - " e.g. ⇒" - " e.g. =>")) - (single-arrow (if (char-displayable-p ?→) - " →" - " ->"))) - (while (and (< pos end) - (or (string-match double-arrow text pos) - (string-match double-arrow-example text pos) - (string-match single-arrow text pos))) - (setq count (1+ count) - pos (match-end 0))) - (if (> count 1) - (insert "\n Examples:\n\n") - (insert "\n Example:\n\n"))))) - (setq times (1+ times)) - (insert " ") - (insert (cdr example)) - (insert "\n\n")))) - -(defun shortdoc-function-groups (function) - "Return all shortdoc groups FUNCTION appears in." - (cl-loop for group in shortdoc--groups - when (assq function (cdr group)) - collect (car group))) - -(defun shortdoc-add-function (group section elem) - "Add ELEM to shortdoc GROUP in SECTION. -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\")))" - (let ((glist (assq group shortdoc--groups))) - (unless glist - (setq glist (list group)) - (push glist shortdoc--groups)) - (let ((slist (member section glist))) - (unless slist - (setq slist (list section)) - (nconc glist slist)) - (while (and (cdr slist) - (not (stringp (cadr slist)))) - (setq slist (cdr slist))) - (setcdr slist (cons elem (cdr slist)))))) - -(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 - (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) - (setq arg 1)) - (while (> arg 0) - (funcall - (if reverse 'text-property-search-backward - 'text-property-search-forward) - sym nil t) - (setq arg (1- arg)))) - -(defun shortdoc-next (&optional arg) - "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 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 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 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) +(provide 'shortdoc-doc) -;;; shortdoc.el ends here +;;; shortdoc-doc.el ends here diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index ea6910c60fc..e8ba6ededc0 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -25,8 +25,8 @@ ;; 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. +;; so `M-x shortdoc RET string RET' will give an overview of these and +;; other functions that operate on strings. ;; ;; The documentation groups are created with the ;; `define-short-documentation-group' macro. @@ -50,23 +50,109 @@ '((t :inherit variable-pitch)) "Face used for a section.") -;;;###autoload -(defun shortdoc--check (group functions) - (let ((keywords '( :no-manual :args :eval :no-eval :no-value :no-eval* - :result :result-string :eg-result :eg-result-string :doc))) - (dolist (f functions) - (when (consp f) - (dolist (x f) - (when (and (keywordp x) (not (memq x keywords))) - (error "Shortdoc %s function `%s': bad keyword `%s'" - group (car f) x))))))) + +;; Almost all past Emacs versions (but see note on Emacs 30 below) +;; understand the following shortdoc group structure: +;; +;; (SYMBOL ;; shortdoc group name +;; (:group [:KEYWORD VALUE ...]) ;; group properties +;; STRING ;; shortdoc section title +;; (:section [:KEYWORD VALUE ...]) ;; section properties +;; +;; (SYMBOL ;; shortdoc item +;; [:KEYWORD VALUE ...]) ;; item properties +;; ([:item] FORM ;; generalized shortdoc item +;; [:KEYWORD VALUE ...])) ;; item properties +;; +;; Where: +;; - a group definition must contain at least one section title or item; +;; - group and section properties must occur at most once after the +;; group name and a section title, respectively; +;; - the leading `:item' keyword of a generalized shortdoc item may be +;; omitted if the shortdoc group is not intended to be used on Emacs +;; versions older than Emacs 32; +;; - the group, secion, or item properties may be empty. +;; +;; That does not mean that any such shortdoc group is meaningful. And +;; that does not mean that past Emacs version actually use all the bits +;; available in such a definition. But they will not error out when +;; processing a definition with the format layed out above, they will +;; simply silently ignore those bits unknown to them (specifically +;; unknown keywords) and attempt to make the best out of the rest. +;; +;; Why is this important? Because it gives package authors a guarantee +;; that they can use shortdoc features of newer Emacs versions without +;; older Emacs versions breaking on them. +;; +;; So Emacs developers, please +;; +;; - stick to above structure when extending shortdoc.el (so that past +;; Emacs versions can grok your extensions without breaking); and +;; +;; - do not impose any additional restrictions on the format described +;; above and on the allowed keywords (so that you do not limit the +;; options of future Emacs versions). +;; +;; Emacs 30, for example, had introduced some restrictions on item +;; property keywords. As a result, we need that hack mentioned in the +;; "boilerplate template for Emacs package authors" above. + +(defun shortdoc--keyword-plist-p (object) + "Return non-nil if OBJECT is a plist with keywords as property names." + (let ((ok (proper-list-p object))) + (while (and ok object) + (setq ok (and (keywordp (car object)) (cdr object)) + object (cddr object))) + ok)) + +(defun shortdoc--check (group definition) + "Ensure that (GROUP DEFINITION) is a valid shortdoc group definition. +Signal an error if that is not the case." + (unless (symbolp group) + (signal 'wrong-type-argument (list 'symbolp group))) + (unless (proper-list-p definition) + (signal 'wrong-type-argument (list 'proper-list-p definition))) + (let ((has-content nil) + entry keyword type + (prev-type 'group-name)) + (while definition + (setq entry (car definition) + keyword (car-safe entry) + type (cond + ((and (eq keyword :group) + (shortdoc--keyword-plist-p (cdr entry))) + 'group-properties) + ((stringp entry) 'section-title) + ((and (eq keyword :section) + (shortdoc--keyword-plist-p (cdr entry))) + 'section-properties) + ((and (eq keyword :item) + (shortdoc--keyword-plist-p entry)) + 'item-definition) + ((and (consp entry) + (shortdoc--keyword-plist-p (cdr entry))) + 'item-definition) + (t 'invalid))) + (cond ((memq type '(section-title item-definition)) + (setq has-content t)) + ((and (eq type 'group-properties) + (eq prev-type 'group-name))) + ((and (eq type 'section-properties) + (eq prev-type 'section-title))) + (t + (error "Shortdoc group %s with invalid entry %S" + group entry))) + (setq prev-type type + definition (cdr definition))) + (unless has-content + (error "Shortdoc group %s without content" group)))) ;;;###autoload -(progn - (defvar shortdoc--groups nil) +(defvar shortdoc--groups nil) - (defmacro define-short-documentation-group (group &rest functions) - "Add GROUP to the list of defined documentation groups. +;;;###autoload +(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: (FUNC @@ -128,1504 +214,28 @@ execution of the documented form depends on some conditions. 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)) - (shortdoc--check group functions) - `(progn - (setq shortdoc--groups (delq (assq ',group shortdoc--groups) - shortdoc--groups)) - (push (cons ',group ',functions) shortdoc--groups)))) - -(define-short-documentation-group alist - "Alist Basics" - (assoc - :eval (assoc 'foo '((foo . bar) (zot . baz)))) - (rassoc - :eval (rassoc 'bar '((foo . bar) (zot . baz)))) - (assq - :eval (assq 'foo '((foo . bar) (zot . baz)))) - (rassq - :eval (rassq 'bar '((foo . bar) (zot . baz)))) - (assoc-string - :eval (assoc-string "foo" '(("foo" . "bar") ("zot" "baz")))) - "Manipulating Alists" - (assoc-delete-all - :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) - (assq-delete-all - :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) - (rassq-delete-all - :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) - (alist-get - :eval (let ((foo '((bar . baz)))) - (setf (alist-get 'bar foo) 'zot) - foo)) - "Misc" - (assoc-default - :eval (assoc-default "foobar" '(("foo" . baz)) #'string-match)) - (copy-alist - :eval (let* ((old '((foo . bar))) - (new (copy-alist old))) - (eq old new))) - ;; FIXME: Outputs "\.rose" for the symbol `.rose'. It would be - ;; better if that could be cleaned up. - (let-alist - :eval (let ((colors '((rose . red) - (lily . white)))) - (let-alist colors - (if (eq .rose 'red) - .lily))))) - -(define-short-documentation-group map - "Map Basics" - (mapp - :eval (mapp (list 'bar 1 'foo 2 'baz 3)) - :eval (mapp (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (mapp [bar foo baz]) - :eval (mapp "this is a string") - :eval (mapp #s(hash-table data (bar 1 foo 2 baz 3))) - :eval (mapp '()) - :eval (mapp nil) - :eval (mapp (make-char-table 'shortdoc-test))) - (map-empty-p - :args (map) - :eval (map-empty-p nil) - :eval (map-empty-p []) - :eval (map-empty-p '())) - (map-elt - :args (map key) - :eval (map-elt (list 'bar 1 'foo 2 'baz 3) 'foo) - :eval (map-elt (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) - :eval (map-elt [bar foo baz] 1) - :eval (map-elt #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) - (map-contains-key - :args (map key) - :eval (map-contains-key (list 'bar 1 'foo 2 'baz 3) 'foo) - :eval (map-contains-key (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) - :eval (map-contains-key [bar foo baz] 1) - :eval (map-contains-key #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) - (map-put! - (map key value) - :eval -"(let ((map (list 'bar 1 'baz 3))) - (map-put! map 'foo 2) - map)" -;; This signals map-not-inplace when used in shortdoc.el :-( -;; :eval -;; "(let ((map (list '(bar . 1) '(baz . 3)))) -;; (map-put! map 'foo 2) -;; map)" - :eval -"(let ((map [bar bot baz])) - (map-put! map 1 'foo) - map)" - :eval -"(let ((map #s(hash-table data (bar 1 baz 3)))) - (map-put! map 'foo 2) - map)") - (map-insert - :args (map key value) - :eval (map-insert (list 'bar 1 'baz 3 'foo 7) 'foo 2) - :eval (map-insert (list '(bar . 1) '(baz . 3) '(foo . 7)) 'foo 2) - :eval (map-insert [bar bot baz] 1 'foo) - :eval (map-insert #s(hash-table data (bar 1 baz 3 foo 7)) 'foo 2)) - (map-delete - :args (map key) - :eval (map-delete (list 'bar 1 'foo 2 'baz 3) 'foo) - :eval (map-delete (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) - :eval (map-delete [bar foo baz] 1) - :eval (map-delete #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) - (map-keys - :eval (map-keys (list 'bar 1 'foo 2 'baz 3)) - :eval (map-keys (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-keys [bar foo baz]) - :eval (map-keys #s(hash-table data (bar 1 foo 2 baz 3)))) - (map-values - :args (map) - :eval (map-values (list 'bar 1 'foo 2 'baz 3)) - :eval (map-values (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-values [bar foo baz]) - :eval (map-values #s(hash-table data (bar 1 foo 2 baz 3)))) - (map-pairs - :eval (map-pairs (list 'bar 1 'foo 2 'baz 3)) - :eval (map-pairs (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-pairs [bar foo baz]) - :eval (map-pairs #s(hash-table data (bar 1 foo 2 baz 3)))) - (map-length - :args (map) - :eval (map-length (list 'bar 1 'foo 2 'baz 3)) - :eval (map-length (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-length [bar foo baz]) - :eval (map-length #s(hash-table data (bar 1 foo 2 baz 3)))) - (map-copy - :args (map) - :eval (map-copy (list 'bar 1 'foo 2 'baz 3)) - :eval (map-copy (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-copy [bar foo baz]) - :eval (map-copy #s(hash-table data (bar 1 foo 2 baz 3)))) - "Doing things to maps and their contents" - (map-apply - :args (function map) - :eval (map-apply #'+ (list '(1 . 2) '(3 . 4)))) - (map-do - :args (function map) - :eval -"(let ((map (list '(1 . 1) '(2 . 3))) - acc) - (map-do (lambda (k v) (push (+ k v) acc)) map) - (nreverse acc))") - (map-keys-apply - :eval (map-keys-apply #'1+ (list '(1 . 2) '(3 . 4)))) - (map-values-apply - :args (function map) - :eval (map-values-apply #'1+ (list '(1 . 2) '(3 . 4)))) - (map-filter - :eval (map-filter (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) - :eval (map-filter (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) - (map-remove - :eval (map-remove (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) - :eval (map-remove (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) - (map-some - :eval (map-some (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) - :eval (map-some (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) - (map-every-p - :eval (map-every-p (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) - :eval (map-every-p (lambda (k v) (evenp (+ k v))) (list '(1 . 3) '(4 . 6)))) - "Combining and changing maps" - (map-merge - :eval (map-merge 'alist '(1 2 3 4) #s(hash-table data (5 6 7 8))) - :eval (map-merge 'list '(1 2 3 4) #s(hash-table data (5 6 7 8))) - :eval (map-merge 'plist '(1 2 3 4) #s(hash-table data (5 6 7 8))) - :eval (map-merge 'hash-table '(1 2 3 4) #s(hash-table data (5 6 7 8)))) - (map-merge-with - :eval (map-merge-with 'alist #'max '(1 2 3 4) #s(hash-table data (1 1 3 5))) - :eval (map-merge-with 'alist #'min '(1 2 3 4) #s(hash-table data (1 1 3 5))) - :eval (map-merge-with 'hash-table #'min '(1 2 3 4) #s(hash-table data (1 1 3 5)))) - (map-into - :args (map type) - :eval (map-into #s(hash-table data '(5 6 7 8)) 'list) - :eval (map-into '((5 . 6) (7 . 8)) 'plist) - :eval (map-into '((5 . 6) (7 . 8)) 'hash-table))) - -(define-short-documentation-group string - "Making Strings" - (make-string - :args (length init) - :eval "(make-string 5 ?x)") - (string - :eval "(string ?a ?b ?c)") - (concat - :eval (concat "foo" "bar" "zot")) - (string-join - :no-manual t - :eval (string-join '("foo" "bar" "zot") " ")) - (mapconcat - :eval (mapconcat (lambda (a) (concat "[" a "]")) - '("foo" "bar" "zot") " ")) - (string-pad - :eval (string-pad "foo" 5) - :eval (string-pad "foobar" 5) - :eval (string-pad "foo" 5 ?- t)) - (mapcar - :eval (mapcar #'identity "123")) - (format - :eval (format "This number is %d" 4)) - "Manipulating Strings" - (substring - :eval (substring "abcde" 1 3) - :eval (substring "abcde" 2) - :eval (substring "abcde" 1 -1) - :eval (substring "abcde" -4 4)) - (string-limit - :eval (string-limit "foobar" 3) - :eval (string-limit "foobar" 3 t) - :eval (string-limit "foobar" 10) - :eval (string-limit "fo好" 3 nil 'utf-8)) - (truncate-string-to-width - :eval (truncate-string-to-width "foobar" 3) - :eval (truncate-string-to-width "你好bar" 5)) - (split-string - :eval (split-string "foo bar") - :eval (split-string "|foo|bar|" "|") - :eval (split-string "|foo|bar|" "|" t)) - (split-string-and-unquote - :eval (split-string-and-unquote "foo \"bar zot\"")) - (split-string-shell-command - :eval (split-string-shell-command "ls /tmp/'foo bar'")) - (string-lines - :eval (string-lines "foo\n\nbar") - :eval (string-lines "foo\n\nbar" t)) - (string-replace - :eval (string-replace "foo" "bar" "foozot")) - (replace-regexp-in-string - :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) - (string-trim - :args (string) - :doc "Trim STRING of leading and trailing white space." - :eval (string-trim " foo ")) - (string-trim-left - :eval (string-trim-left "oofoo" "o+")) - (string-trim-right - :eval (string-trim-right "barkss" "s+")) - (string-truncate-left - :no-manual t - :eval (string-truncate-left "longstring" 8)) - (string-remove-suffix - :no-manual t - :eval (string-remove-suffix "bar" "foobar")) - (string-remove-prefix - :no-manual t - :eval (string-remove-prefix "foo" "foobar")) - (string-chop-newline - :eval (string-chop-newline "foo\n")) - (string-clean-whitespace - :eval (string-clean-whitespace " foo bar ")) - (string-fill - :eval (string-fill "Three short words" 12) - :eval (string-fill "Long-word" 3)) - (reverse - :eval (reverse "foo")) - (substring-no-properties - :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 "Å")) - (string-glyph-decompose - :eval (string-glyph-decompose "Å")) - "Predicates for Strings" - (string-equal - :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 "")) - (string-blank-p - :no-manual t - :eval (string-blank-p " \n")) - (string-lessp - :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 "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 - :eval (string-suffix-p "bar" "foobar")) - "Case Manipulation" - (upcase - :eval (upcase "foo")) - (downcase - :eval (downcase "FOObar")) - (capitalize - :eval (capitalize "foo bar zot")) - (upcase-initials - :eval (upcase-initials "The CAT in the hAt")) - "Converting Strings" - (string-to-number - :eval (string-to-number "42") - :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 "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 - :eval (assoc-string "foo" '(("a" 1) (foo 2)))) - (seq-position - :eval "(seq-position \"foobarzot\" ?z)")) - -(define-short-documentation-group file-name - "File Name Manipulation" - (file-name-directory - :eval (file-name-directory "/tmp/foo") - :eval (file-name-directory "/tmp/foo/")) - (file-name-nondirectory - :eval (file-name-nondirectory "/tmp/foo") - :eval (file-name-nondirectory "/tmp/foo/")) - (file-name-sans-versions - :args (filename) - :eval (file-name-sans-versions "/tmp/foo~")) - (file-name-extension - :eval (file-name-extension "/tmp/foo.txt")) - (file-name-sans-extension - :eval (file-name-sans-extension "/tmp/foo.txt")) - (file-name-with-extension - :eval (file-name-with-extension "foo.txt" "bin") - :eval (file-name-with-extension "foo" "bin")) - (file-name-base - :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 - :eval (file-name-concat "/tmp/" "foo") - :eval (file-name-concat "/tmp" "foo") - :eval (file-name-concat "/tmp" "foo" "bar/" "zot") - :eval (file-name-concat "/tmp" "~")) - (expand-file-name - :eval (expand-file-name "foo" "/tmp/") - :eval (expand-file-name "foo" "/tmp///") - :eval (expand-file-name "foo" "/tmp/foo/.././") - :eval (expand-file-name "~" "/tmp/")) - (substitute-in-file-name - :eval (substitute-in-file-name "$HOME/foo")) - "Directory Functions" - (file-name-as-directory - :eval (file-name-as-directory "/tmp/foo")) - (directory-file-name - :eval (directory-file-name "/tmp/foo/")) - (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) - :eval (file-name-quote "/tmp/foo")) - (file-name-unquote - :args (name) - :eval (file-name-unquote "/:/tmp/foo")) - "Predicates" - (file-name-absolute-p - :eval (file-name-absolute-p "/tmp/foo") - :eval (file-name-absolute-p "foo")) - (directory-name-p - :eval (directory-name-p "/tmp/foo/")) - (file-name-quoted-p - :eval (file-name-quoted-p "/:/tmp/foo"))) - -(define-short-documentation-group file - "Inserting Contents" - (insert-file-contents - :no-eval (insert-file-contents "/tmp/foo") - :eg-result ("/tmp/foo" 6)) - (insert-file-contents-literally - :no-eval (insert-file-contents-literally "/tmp/foo") - :eg-result ("/tmp/foo" 6)) - (find-file - :no-eval (find-file "/tmp/foo") - :eg-result-string "#") - "Predicates" - (file-symlink-p - :no-eval (file-symlink-p "/tmp/foo") - :eg-result t) - (file-directory-p - :no-eval (file-directory-p "/tmp") - :eg-result t) - (file-regular-p - :no-eval (file-regular-p "/tmp/foo") - :eg-result t) - (file-exists-p - :no-eval (file-exists-p "/tmp/foo") - :eg-result t) - (file-readable-p - :no-eval (file-readable-p "/tmp/foo") - :eg-result t) - (file-writable-p - :no-eval (file-writable-p "/tmp/foo") - :eg-result t) - (file-accessible-directory-p - :no-eval (file-accessible-directory-p "/tmp") - :eg-result t) - (file-executable-p - :no-eval (file-executable-p "/bin/cat") - :eg-result t) - (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) - (file-in-directory-p - :no-eval (file-in-directory-p "/tmp/foo" "/tmp/") - :eg-result t) - (file-locked-p - :no-eval (file-locked-p "/tmp/foo") - :eg-result nil) - "Information" - (file-attributes - :no-eval* (file-attributes "/tmp")) - (file-truename - :no-eval (file-truename "/tmp/foo/bar") - :eg-result "/tmp/foo/zot") - (file-chase-links - :no-eval (file-chase-links "/tmp/foo/bar") - :eg-result "/tmp/foo/zot") - (vc-responsible-backend - :args (file &optional no-error) - :no-eval (vc-responsible-backend "/src/foo/bar.c") - :eg-result Git) - (file-acl - :no-eval (file-acl "/tmp/foo") - :eg-result "user::rw-\ngroup::r--\nother::r--\n") - (file-extended-attributes - :no-eval* (file-extended-attributes "/tmp/foo")) - (file-selinux-context - :no-eval* (file-selinux-context "/tmp/foo")) - (locate-file - :no-eval (locate-file "syslog" '("/var/log" "/usr/bin")) - :eg-result "/var/log/syslog") - (executable-find - :no-eval (executable-find "ls") - :eg-result "/usr/bin/ls") - "Creating" - (make-temp-file - :no-eval (make-temp-file "/tmp/foo-") - :eg-result "/tmp/foo-ZcXFMj") - (make-nearby-temp-file - :no-eval (make-nearby-temp-file "/tmp/foo-") - :eg-result "/tmp/foo-xe8iON") - (write-region - :no-value (write-region (point-min) (point-max) "/tmp/foo")) - "Directories" - (make-directory - :no-value (make-directory "/tmp/bar/zot/" t)) - (directory-files - :no-eval (directory-files "/tmp/") - :eg-result ("." ".." ".ICE-unix" ".Test-unix")) - (directory-files-recursively - :no-eval (directory-files-recursively "/tmp/" "\\.png\\'") - :eg-result ("/tmp/foo.png" "/tmp/zot.png" "/tmp/bar/foobar.png")) - (directory-files-and-attributes - :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") - :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") - (copy-directory - :no-value (copy-directory "/tmp/bar/" "/tmp/barcopy")) - (delete-directory - :no-value (delete-directory "/tmp/bar/")) - "File Operations" - (rename-file - :no-value (rename-file "/tmp/foo" "/tmp/newname")) - (copy-file - :no-value (copy-file "/tmp/foo" "/tmp/foocopy")) - (delete-file - :no-value (delete-file "/tmp/foo")) - (make-empty-file - :no-value (make-empty-file "/tmp/foo")) - (make-symbolic-link - :no-value (make-symbolic-link "/tmp/foo" "/tmp/foosymlink")) - (add-name-to-file - :no-value (add-name-to-file "/tmp/foo" "/tmp/bar")) - (set-file-modes - :no-value "(set-file-modes \"/tmp/foo\" #o644)") - (set-file-times - :no-value (set-file-times "/tmp/foo")) - "File Modes" - (set-default-file-modes - :no-value "(set-default-file-modes #o755)") - (default-file-modes - :no-eval (default-file-modes) - :eg-result-string "#o755") - (file-modes-symbolic-to-number - :no-eval (file-modes-symbolic-to-number "a+r") - :eg-result-string "#o444") - (file-modes-number-to-symbolic - :eval "(file-modes-number-to-symbolic #o444)") - (set-file-extended-attributes - :no-eval (set-file-extended-attributes - "/tmp/foo" '((acl . "group::rxx"))) - :eg-result t) - (set-file-selinux-context - :no-eval (set-file-selinux-context - "/tmp/foo" '(unconfined_u object_r user_home_t s0)) - :eg-result t) - (set-file-acl - :no-eval (set-file-acl "/tmp/foo" "group::rxx") - :eg-result t)) - -(define-short-documentation-group hash-table - "Hash Table Basics" - (make-hash-table - :no-eval (make-hash-table) - :result-string "#s(hash-table ...)") - (puthash - :no-eval (puthash 'key "value" table)) - (gethash - :no-eval (gethash 'key table) - :eg-result "value") - (remhash - :no-eval (remhash 'key table) - :result nil) - (clrhash - :no-eval (clrhash table) - :result-string "#s(hash-table ...)") - (maphash - :no-eval (maphash (lambda (key value) (message value)) table) - :result nil) - "Other Hash Table Functions" - (hash-table-p - :eval (hash-table-p 123)) - (hash-table-contains-p - :no-eval (hash-table-contains-p 'key table)) - (copy-hash-table - :no-eval (copy-hash-table table) - :result-string "#s(hash-table ...)") - (hash-table-count - :no-eval (hash-table-count table) - :eg-result 15)) - -(define-short-documentation-group list - "Making Lists" - (make-list - :eval (make-list 5 'a)) - (cons - :eval (cons 1 '(2 3 4))) - (list - :eval (list 1 2 3)) - (number-sequence - :eval (number-sequence 5 8)) - (ensure-list - :eval (ensure-list "foo") - :eval (ensure-list '(1 2 3)) - :eval (ensure-list '(1 . 2))) - (ensure-proper-list - :eval (ensure-proper-list "foo") - :eval (ensure-proper-list '(1 2 3)) - :eval (ensure-proper-list '(1 . 2))) - "Operations on Lists" - (append - :eval (append '("foo" "bar") '("zot"))) - (copy-tree - :eval (copy-tree '(1 (2 3) 4))) - (flatten-tree - :eval (flatten-tree '(1 (2 3) 4))) - (car - :eval (car '(one two three)) - :eval (car '(one . two)) - :eval (car nil)) - (cdr - :eval (cdr '(one two three)) - :eval (cdr '(one . two)) - :eval (cdr nil)) - (last - :eval (last '(one two three))) - (butlast - :eval (butlast '(one two three))) - (nbutlast - :eval (nbutlast (list 'one 'two 'three))) - (nth - :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))) - (take-while - :eval (take-while #'numberp '(1 2 three 4 five))) - (drop-while - :eval (drop-while #'numberp '(1 2 three 4 five))) - (any - :eval (any #'symbolp '(1 2 three 4 five))) - (all - :eval (all #'symbolp '(one 2 three)) - :eval (all #'symbolp '(one two three))) - (elt - :eval (elt '(one two three) 1)) - (car-safe - :eval (car-safe '(one two three))) - (cdr-safe - :eval (cdr-safe '(one two three))) - (push - :no-eval* (push 'a list)) - (pop - :no-eval* (pop list)) - (setcar - :no-eval (setcar list 'c) - :result c) - (setcdr - :no-eval (setcdr list (list c)) - :result '(c)) - (nconc - :eval (nconc (list 1) (list 2 3 4))) - (delq - :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"))) - (remq - :eval (remq 'b '(a b c))) - (remove - :eval (remove 2 '(1 2 3 4)) - :eval (remove "a" '("a" "b" "c" "d"))) - (delete-dups - :eval (delete-dups (list 1 2 4 3 2 4))) - "Mapping Over Lists" - (mapcar - :eval (mapcar #'list '(1 2 3))) - (mapcan - :eval (mapcan #'list '(1 2 3))) - (mapc - :eval (mapc #'insert '("1" "2" "3"))) - (seq-reduce - :eval (seq-reduce #'+ '(1 2 3) 0)) - (mapconcat - :eval (mapconcat #'identity '("foo" "bar") "|")) - "Predicates" - (listp - :eval (listp '(1 2 3)) - :eval (listp nil) - :eval (listp '(1 . 2))) - (consp - :eval (consp '(1 2 3)) - :eval (consp nil)) - (proper-list-p - :eval (proper-list-p '(1 2 3)) - :eval (proper-list-p nil) - :eval (proper-list-p '(1 . 2))) - (null - :eval (null nil)) - (atom - :eval (atom 'a)) - (nlistp - :eval (nlistp '(1 2 3)) - :eval (nlistp t) - :eval (nlistp '(1 . 2))) - "Finding Elements" - (memq - :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"))) - (member-ignore-case - :eval (member-ignore-case "foo" '("bar" "Foo" "zot"))) - "Association Lists" - (assoc - :eval (assoc "b" '(("a" . 1) ("b" . 2)))) - (rassoc - :eval (rassoc "b" '((1 . "a") (2 . "b")))) - (assq - :eval (assq 'b '((a . 1) (b . 2)))) - (rassq - :eval (rassq 'b '((1 . a) (2 . b)))) - (assoc-string - :eval (assoc-string "foo" '(("a" 1) (foo 2)))) - (alist-get - :eval (alist-get 2 '((1 . a) (2 . b)))) - (assoc-default - :eval (assoc-default 2 '((1 . a) (2 . b) #'=))) - (copy-alist - :eval (copy-alist '((1 . a) (2 . b)))) - (assoc-delete-all - :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) - (assq-delete-all - :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) - (rassq-delete-all - :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) - "Property Lists" - (plist-get - :eval (plist-get '(a 1 b 2 c 3) 'b)) - (plist-put - :no-eval (setq plist (plist-put plist 'd 4)) - :eg-result (a 1 b 2 c 3 d 4)) - (plist-member - :eval (plist-member '(a 1 b 2 c 3) 'b)) - "Data About Lists" - (length - :eval (length '(a b c))) - (length< - :eval (length< '(a b c) 1)) - (length> - :eval (length> '(a b c) 1)) - (length= - :eval (length= '(a b c) 3)) - (safe-length - :eval (safe-length '(a b c)))) - -(define-short-documentation-group symbol - "Making symbols" - (intern - :eval (intern "abc")) - (intern-soft - :eval (intern-soft "list") - :eval (intern-soft "Phooey!")) - (make-symbol - :eval (make-symbol "abc")) - (gensym - :no-eval (gensym) - :eg-result g37) - "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)) - "Obarrays" - (obarray-make - :eval (obarray-make)) - (obarrayp - :eval (obarrayp (obarray-make)) - :eval (obarrayp nil)) - (unintern - :no-eval (unintern "abc" my-obarray) - :eg-result t) - (mapatoms - :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray)) - (obarray-clear - :no-eval (obarray-clear my-obarray))) - -(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" - (make-vector - :eval (make-vector 5 "foo")) - (vector - :eval (vector 1 "b" 3)) - "Operations on Vectors" - (vectorp - :eval (vectorp [1]) - :eval (vectorp "1")) - (vconcat - :eval (vconcat '(1 2) [3 4])) - (append - :eval (append [1 2] nil)) - (length - :eval (length [1 2 3])) - (seq-reduce - :eval (seq-reduce #'+ [1 2 3] 0)) - (seq-subseq - :eval (seq-subseq [1 2 3 4 5] 1 3) - :eval (seq-subseq [1 2 3 4 5] 1)) - (copy-tree - :eval (copy-tree [1 (2 3) [4 5]] t)) - "Mapping Over Vectors" - (mapcar - :eval (mapcar #'identity [1 2 3])) - (mapc - :eval (mapc #'insert ["1" "2" "3"]))) - -(define-short-documentation-group regexp - "Matching Strings" - (replace-regexp-in-string - :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) - (string-match-p - :eval (string-match-p "^[fo]+" "foobar")) - "Looking in Buffers" - (re-search-forward - :no-eval (re-search-forward "^foo$" nil t) - :eg-result 43) - (re-search-backward - :no-eval (re-search-backward "^foo$" nil t) - :eg-result 43) - (looking-at-p - :no-eval (looking-at-p "f[0-9]") - :eg-result t) - "Match Data" - (match-string - :eval (and (string-match "^\\([fo]+\\)b" "foobar") - (match-string 0 "foobar"))) - (match-beginning - :no-eval (match-beginning 1) - :eg-result 0) - (match-end - :no-eval (match-end 1) - :eg-result 3) - (save-match-data - :no-eval (save-match-data ...)) - "Replacing Match" - (replace-match - :no-eval (replace-match "new") - :eg-result nil) - (match-substitute-replacement - :no-eval (match-substitute-replacement "new") - :eg-result "new") - (replace-regexp-in-region - :no-value (replace-regexp-in-region "[0-9]+" "Num \\&")) - "Utilities" - (regexp-quote - :eval (regexp-quote "foo.*bar")) - (regexp-opt - :eval (regexp-opt '("foo" "bar"))) - (regexp-opt-depth - :eval (regexp-opt-depth "\\(a\\(b\\)\\)")) - (regexp-opt-charset - :eval (regexp-opt-charset '(?a ?b ?c ?d ?e))) - "The `rx' Structured Regexp Notation" - (rx - :eval (rx "IP=" (+ digit) (= 3 "." (+ digit)))) - (rx-to-string - :eval (rx-to-string '(| "foo" "bar"))) - (rx-define - :no-eval "(and (rx-define haskell-comment (seq \"--\" (zero-or-more nonl))) - (rx haskell-comment))" - :result "--.*") - (rx-let - :eval "(rx-let ((comma-separated (item) (seq item (0+ \",\" item))) - (number (1+ digit)) - (numbers (comma-separated number))) - (rx \"(\" numbers \")\"))" - :result "([[:digit:]]+\\(?:,[[:digit:]]+\\)*)") - (rx-let-eval - :eval "(rx-let-eval - '((ponder (x) (seq \"Where have all the \" x \" gone?\"))) - (rx-to-string - '(ponder (or \"flowers\" \"cars\" \"socks\"))))" - :result "\\(?:Where have all the \\(?:\\(?:car\\|flower\\|sock\\)s\\) gone\\?\\)")) - -(define-short-documentation-group sequence - "Sequence Predicates" - (seq-contains-p - :eval (seq-contains-p '(a b c) 'b) - :eval (seq-contains-p '(a b c) 'd)) - (seq-every-p - :eval (seq-every-p #'numberp '(1 2 3))) - (seq-empty-p - :eval (seq-empty-p [])) - (seq-set-equal-p - :eval (seq-set-equal-p '(1 2 3) '(3 1 2))) - (seq-some - :eval (seq-some #'floatp '(1 2.0 3))) - "Building Sequences" - (seq-concatenate - :eval (seq-concatenate 'vector '(1 2) '(c d))) - (seq-copy - :eval (seq-copy '(a 2))) - (seq-into - :eval (seq-into '(1 2 3) 'vector)) - "Utility Functions" - (seq-count - :eval (seq-count #'numberp '(1 b c 4))) - (seq-elt - :eval (seq-elt '(a b c) 1)) - (seq-random-elt - :no-eval (seq-random-elt '(a b c)) - :eg-result c) - (seq-find - :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 - :eval (seq-max [1 2 3])) - (seq-min - :eval (seq-min [1 2 3])) - (seq-first - :eval (seq-first [a b c])) - (seq-rest - :eval (seq-rest '[1 2 3])) - (seq-reverse - :eval (seq-reverse '(1 2 3))) - (seq-sort - :eval (seq-sort #'> '(1 2 3))) - (seq-sort-by - :eval (seq-sort-by (lambda (a) (/ 1.0 a)) #'< '(1 2 3))) - "Mapping Over Sequences" - (seq-map - :eval (seq-map #'1+ '(1 2 3))) - (seq-map-indexed - :eval (seq-map-indexed (lambda (a i) (cons i a)) '(a b c))) - (seq-mapcat - :eval (seq-mapcat #'upcase '("a" "b" "c") 'string)) - (seq-doseq - :no-eval (seq-doseq (a '("foo" "bar")) (insert a)) - :eg-result ("foo" "bar")) - (seq-do - :no-eval (seq-do (lambda (a) (insert a)) '("foo" "bar")) - :eg-result ("foo" "bar")) - (seq-do-indexed - :no-eval (seq-do-indexed - (lambda (a index) (message "%s:%s" index a)) - '("foo" "bar")) - :eg-result nil) - (seq-reduce - :eval (seq-reduce #'* [1 2 3] 2)) - "Excerpting Sequences" - (seq-drop - :eval (seq-drop '(a b c) 2)) - (seq-drop-while - :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 #'natnump '(-1 2 3 -4 -5 6))) - (seq-union - :eval (seq-union '(1 2 3) '(3 5))) - (seq-difference - :eval (seq-difference '(1 2 3) '(2 3 4))) - (seq-intersection - :eval (seq-intersection '(1 2 3) '(2 3 4))) - (seq-partition - :eval (seq-partition '(a b c d e f g h) 3)) - (seq-subseq - :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 #'integerp [1 2 3.0 4])) - (seq-uniq - :eval (seq-uniq '(a b d b a c)))) - -(define-short-documentation-group buffer - "Buffer Basics" - (current-buffer - :no-eval (current-buffer) - :eg-result-string "#") - (bufferp - :eval (bufferp 23)) - (buffer-live-p - :no-eval (buffer-live-p some-buffer) - :eg-result t) - (buffer-modified-p - :eval (buffer-modified-p (current-buffer))) - (buffer-name - :eval (buffer-name)) - (window-buffer - :eval (window-buffer)) - "Selecting Buffers" - (get-buffer-create - :no-eval (get-buffer-create "*foo*") - :eg-result-string "#") - (pop-to-buffer - :no-eval (pop-to-buffer "*foo*") - :eg-result-string "#") - (with-current-buffer - :no-eval* (with-current-buffer buffer (buffer-size))) - "Points and Positions" - (point - :eval (point)) - (point-min - :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)) - :eg-result 342) - (search-forward - :no-eval (search-forward "some-string" nil t) - :eg-result 245) - (re-search-forward - :no-eval (re-search-forward "some-s.*g" nil t) - :eg-result 245) - (forward-line - :no-eval (forward-line 1) - :eg-result 0 - :no-eval (forward-line -2) - :eg-result 0) - "Strings from Buffers" - (buffer-string - :no-eval* (buffer-string)) - (buffer-substring - :eval (buffer-substring (point-min) (+ (point-min) 10))) - (buffer-substring-no-properties - :eval (buffer-substring-no-properties (point-min) (+ (point-min) 10))) - (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") - "Altering Buffers" - (delete-region - :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 - :no-eval "(subst-char-in-region (point-min) (point-max) ?+ ?-)") - (replace-string-in-region - :no-value (replace-string-in-region "foo" "bar")) - "Locking" - (lock-buffer - :no-value (lock-buffer "/tmp/foo")) - (unlock-buffer - :no-value (unlock-buffer))) - -(define-short-documentation-group overlay - "Predicates" - (overlayp - :no-eval (overlayp some-overlay) - :eg-result t) - "Creation and Deletion" - (make-overlay - :args (beg end &optional buffer) - :no-eval (make-overlay 1 10) - :eg-result-string "#") - (delete-overlay - :no-eval (delete-overlay foo) - :eg-result t) - "Searching Overlays" - (overlays-at - :no-eval (overlays-at 15) - :eg-result-string "(#)") - (overlays-in - :no-eval (overlays-in 1 30) - :eg-result-string "(#)") - (next-overlay-change - :no-eval (next-overlay-change 1) - :eg-result 20) - (previous-overlay-change - :no-eval (previous-overlay-change 30) - :eg-result 20) - "Overlay Properties" - (overlay-start - :no-eval (overlay-start foo) - :eg-result 1) - (overlay-end - :no-eval (overlay-end foo) - :eg-result 10) - (overlay-put - :no-eval (overlay-put foo 'happy t) - :eg-result t) - (overlay-get - :no-eval (overlay-get foo 'happy) - :eg-result t) - (overlay-buffer - :no-eval (overlay-buffer foo)) - "Moving Overlays" - (move-overlay - :no-eval (move-overlay foo 5 20) - :eg-result-string "#")) - -(define-short-documentation-group process - (make-process - :no-eval (make-process :name "foo" :command '("cat" "/tmp/foo")) - :eg-result-string "#") - (processp - :eval (processp t)) - (process-status - :no-eval (process-status process) - :eg-result exit) - (delete-process - :no-value (delete-process process)) - (kill-process - :no-value (kill-process process)) - (set-process-sentinel - :no-value (set-process-sentinel process (lambda (proc string)))) - (process-buffer - :no-eval (process-buffer process) - :eg-result-string "#") - (get-buffer-process - :no-eval (get-buffer-process buffer) - :eg-result-string "#") - (process-live-p - :no-eval (process-live-p process) - :eg-result t)) - -(define-short-documentation-group number - "Arithmetic" - (+ - :args (&rest numbers) - :eval (+ 1 2) - :eval (+ 1 2 3 4)) - (- - :args (&rest numbers) - :eval (- 3 2) - :eval (- 6 3 2)) - (* - :args (&rest numbers) - :eval (* 3 4 5)) - (/ - :eval (/ 10 5) - :eval (/ 10 6) - :eval (/ 10.0 6) - :eval (/ 10.0 3 3)) - (% - :eval (% 10 5) - :eval (% 10 6)) - (mod - :eval (mod 10 5) - :eval (mod 10 6) - :eval (mod 10.5 6)) - (1+ - :eval (1+ 2) - :eval (let ((x 2)) (1+ x) x)) - (1- - :eval (1- 4) - :eval (let ((x 4)) (1- x) x)) - (incf - :eval (let ((x 2)) (incf x) x) - :eval (let ((x 2)) (incf x 2) x)) - (decf - :eval (let ((x 4)) (decf x) x) - :eval (let ((x 4)) (decf x 2)) x) - "Predicates" - (= - :args (number &rest numbers) - :eval (= 4 4) - :eval (= 4.0 4.0) - :eval (= 4 4.0) - :eval (= 4 4 4 4)) - (eql - :eval (eql 4 4) - :eval (eql 4.0 4.0)) - (/= - :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)) - (zerop - :eval (zerop 0)) - (natnump - :eval (natnump -1) - :eval (natnump 0) - :eval (natnump 23)) - (plusp - :eval (plusp 0) - :eval (plusp 1)) - (minusp - :eval (minusp 0) - :eval (minusp -1)) - (oddp - :eval (oddp 3)) - (evenp - :eval (evenp 6)) - (bignump - :eval (bignump 4) - :eval (bignump (expt 2 90))) - (fixnump - :eval (fixnump 4) - :eval (fixnump (expt 2 90))) - (floatp - :eval (floatp 5.4)) - (integerp - :eval (integerp 5.4)) - (numberp - :eval (numberp "5.4")) - (cl-digit-char-p - :eval (cl-digit-char-p ?5 10) - :eval (cl-digit-char-p ?f 16)) - "Operations" - (max - :args (number &rest numbers) - :eval (max 7 9 3)) - (min - :args (number &rest numbers) - :eval (min 7 9 3)) - (abs - :eval (abs -4)) - (float - :eval (float 2)) - (truncate - :eval (truncate 1.2) - :eval (truncate -1.2) - :eval (truncate 5.4 2)) - (floor - :eval (floor 1.2) - :eval (floor -1.2) - :eval (floor 5.4 2)) - (ceiling - :eval (ceiling 1.2) - :eval (ceiling -1.2) - :eval (ceiling 5.4 2)) - (round - :eval (round 1.2) - :eval (round -1.2) - :eval (round 5.4 2)) - (random - :eval (random 6)) - "Bit Operations" - (ash - :eval (ash 1 4) - :eval (ash 16 -1)) - (logand - :no-eval "(logand #b10 #b111)" - :result-string "#b10") - (logior - :eval (logior 4 16)) - (logxor - :eval (logxor 4 16)) - (lognot - :eval (lognot 5)) - (logcount - :eval (logcount 5)) - "Floating Point" - (isnan - :eval (isnan 5.0)) - (frexp - :eval (frexp 5.7)) - (ldexp - :eval (ldexp 0.7125 3)) - (logb - :eval (logb 10.5)) - (ffloor - :eval (ffloor 1.2)) - (fceiling - :eval (fceiling 1.2)) - (ftruncate - :eval (ftruncate 1.2)) - (fround - :eval (fround 1.2)) - "Standard Math Functions" - (sin - :eval (sin float-pi)) - (cos - :eval (cos float-pi)) - (tan - :eval (tan float-pi)) - (asin - :eval (asin float-pi)) - (acos - :eval (acos float-pi)) - (atan - :eval (atan float-pi)) - (exp - :eval (exp 4)) - (log - :eval (log 54.59)) - (expt - :eval (expt 2 16)) - (sqrt - :eval (sqrt -1))) - -(define-short-documentation-group text-properties - "Examining Text Properties" - (get-text-property - :eval (get-text-property 0 'foo (propertize "x" 'foo t))) - (get-char-property - :eval (get-char-property 0 'foo (propertize "x" 'foo t))) - (get-pos-property - :eval (get-pos-property 0 'foo (propertize "x" 'foo t))) - (get-char-property-and-overlay - :eval (get-char-property-and-overlay 0 'foo (propertize "x" 'foo t))) - (text-properties-at - :eval (text-properties-at (point))) - "Changing Text Properties" - (put-text-property - :eval (let ((s (copy-sequence "abc"))) (put-text-property 0 1 'foo t s) s) - :no-eval (put-text-property (point) (1+ (point)) 'face 'error)) - (add-text-properties - :no-eval (add-text-properties (point) (1+ (point)) '(face error))) - (remove-text-properties - :no-eval (remove-text-properties (point) (1+ (point)) '(face nil))) - (remove-list-of-text-properties - :no-eval (remove-list-of-text-properties (point) (1+ (point)) '(face font-lock-face))) - (set-text-properties - :no-eval (set-text-properties (point) (1+ (point)) '(face error))) - (add-face-text-property - :no-eval (add-face-text-property START END '(:foreground "green"))) - (propertize - :eval (propertize "foo" 'face 'italic 'mouse-face 'bold-italic)) - "Searching for Text Properties" - (next-property-change - :no-eval (next-property-change (point) (current-buffer))) - (previous-property-change - :no-eval (previous-property-change (point) (current-buffer))) - (next-single-property-change - :no-eval (next-single-property-change (point) 'face (current-buffer))) - (previous-single-property-change - :no-eval (previous-single-property-change (point) 'face (current-buffer))) - ;; TODO: There are some more that could be added here. - (text-property-search-forward - :no-eval (text-property-search-forward 'face nil t)) - (text-property-search-backward - :no-eval (text-property-search-backward 'face nil t))) - -(define-short-documentation-group keymaps - "Defining keymaps or adding bindings to existing keymaps" - (define-keymap - :no-eval (define-keymap "C-c C-c" #'quit-buffer) - :no-eval (define-keymap :keymap ctl-x-map - "C-r" #'recentf-open - "k" #'kill-current-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 "" 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"))) - + (declare (indent defun)) + (let ((err + (condition-case err + (progn (shortdoc--check group functions) nil) + (error err))) + (exp + `(progn + (setq shortdoc--groups (delq (assq ',group shortdoc--groups) + shortdoc--groups)) + (push (cons ',group ',functions) shortdoc--groups)))) + (if (null err) + exp + (macroexp-warn-and-return + (error-message-string err) exp nil t)))) + +;; FIXME: As long as we do not have a better mechanism to load shortdoc +;; definitions on demand, we must require `shortdoc-doc' after above +;; macro to avoid loading cycles. But at least we do not require +;; `shortdoc-doc' while compiling this file, only when loading it. +(if t (require 'shortdoc-doc)) + + ;;;###autoload (defun shortdoc-display-group (group &optional function same-window) "Pop to a buffer with short documentation summary for functions in GROUP. @@ -1650,6 +260,9 @@ If SAME-WINDOW, don't pop to a new window." (text-property-search-forward 'shortdoc-function function t) (beginning-of-line))) +;;;###autoload +(defalias 'shortdoc #'shortdoc-display-group) + (defun shortdoc--insert-group-in-buffer (group &optional buf) "Insert a short documentation summary for functions in GROUP in buffer BUF. BUF defaults to the current buffer if nil or omitted." @@ -1685,9 +298,6 @@ BUF defaults to the current buffer if nil or omitted." (shortdoc--display-function data)))) (cdr (assq group shortdoc--groups)))))) -;;;###autoload -(defalias 'shortdoc #'shortdoc-display-group) - (defun shortdoc--display-function (data) (let ((function (pop data)) (start-section (point)) @@ -1875,6 +485,10 @@ Example: (shortdoc-add-function \\='file \"Predicates\" \\='(file-locked-p :no-eval (file-locked-p \"/tmp\")))" + ;; Rely on `shortdoc--check' checking GROUP. + (unless (stringp section) + (signal 'wrong-type-argument (list 'stringp section))) + (shortdoc--check group (list section elem)) (let ((glist (assq group shortdoc--groups))) (unless glist (setq glist (list group)) -- cgit v1.2.1 From bc276230575c3c21233d3cb992dce8f4f28ba77f Mon Sep 17 00:00:00 2001 From: Jens Schmidt Date: Wed, 25 Mar 2026 22:38:38 +0100 Subject: ; Fix some shortdoc issues unearthed by `shortdoc--check' * lisp/emacs-lisp/shortdoc-doc.el (map, number): Fix issues. * lisp/treesit.el (treesit): Fix issues. --- lisp/emacs-lisp/shortdoc-doc.el | 4 ++-- lisp/treesit.el | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/shortdoc-doc.el b/lisp/emacs-lisp/shortdoc-doc.el index 40b98811bf0..eb642c1600b 100644 --- a/lisp/emacs-lisp/shortdoc-doc.el +++ b/lisp/emacs-lisp/shortdoc-doc.el @@ -100,7 +100,7 @@ :eval (map-contains-key [bar foo baz] 1) :eval (map-contains-key #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) (map-put! - (map key value) + :args (map key value) :eval "(let ((map (list 'bar 1 'baz 3))) (map-put! map 'foo 2) @@ -1301,7 +1301,7 @@ :eval (let ((x 2)) (incf x 2) x)) (decf :eval (let ((x 4)) (decf x) x) - :eval (let ((x 4)) (decf x 2)) x) + :eval (let ((x 4)) (decf x 2) x)) "Predicates" (= :args (number &rest numbers) diff --git a/lisp/treesit.el b/lisp/treesit.el index d7cfe0a9f3f..ebdd2367a52 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -5849,7 +5849,7 @@ language." "Pattern matching" (treesit-query-capture :no-eval (treesit-query-capture node '((identifier) @id "return" @ret)) - :eg-result-string "((id . #) (ret . #))") + :eg-result-string "((id . #) (ret . #))") (treesit-query-compile :no-eval (treesit-query-compile 'c '((identifier) @id "return" @ret)) :eg-result-string "#") -- cgit v1.2.1 From 4f46593668a94a19fd4da843f9b3632ca153ddd9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 26 Mar 2026 11:20:53 +0200 Subject: ; * lisp/tool-bar.el (tool-bar-setup): Adapt to change for bug#80545. --- lisp/tool-bar.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 73df2e0bca8..d9b1f50b40c 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -330,7 +330,7 @@ holds a keymap." :vert-only t) (tool-bar-add-item-from-menu 'menu-find-file-existing "open" nil :label "Open" :vert-only t) - (tool-bar-add-item-from-menu 'dired "diropen" nil :vert-only t) + (tool-bar-add-item-from-menu 'dired-from-menubar "diropen" nil :vert-only t) (tool-bar-add-item-from-menu 'kill-this-buffer "close" nil :vert-only t) (tool-bar-add-item-from-menu 'save-buffer "save" nil :label "Save") -- cgit v1.2.1 From 3c06b7d5234a1cecc8a60b18ac011a080d246e15 Mon Sep 17 00:00:00 2001 From: Naofumi Yasufuku Date: Sun, 16 Feb 2025 21:12:17 +0900 Subject: Don't error on nonexistent ~/.password-store * lisp/auth-source-pass.el (auth-source-pass-search): If auth-source-pass-filename is not a directory, just do nothing to avoid repeated errors raised by directory-files-recursively in auth-source-pass-entries which is called for each search pattern. (Bug#76323) Copyright-paperwork-exempt: yes --- lisp/auth-source-pass.el | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lisp') diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index adaa901612a..625fe94ff9d 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -85,6 +85,9 @@ HOST, USER, PORT, REQUIRE, and MAX." ((null host) ;; Do not build a result, as none will match when HOST is nil nil) + ((not (file-directory-p (expand-file-name auth-source-pass-filename))) + ;; Do nothing if the password-store folder doesn't exist. + nil) (auth-source-pass-extra-query-keywords (auth-source-pass--build-result-many host port user require max)) (t -- cgit v1.2.1 From b5f6bc0072e59ab9ba39ed2bdd83a324b7c6ad4a Mon Sep 17 00:00:00 2001 From: Basil L. Contovounesios Date: Thu, 26 Mar 2026 15:05:22 +0100 Subject: Improve last change to auth-source-pass * lisp/auth-source-pass.el (auth-source-pass-search): Remove redundant expand-file-name. * test/lisp/auth-source-pass-tests.el (auth-source-pass--with-store): Bind auth-source-pass-filename to an existing directory to satisfy the new guard in auth-source-pass-search (bug#76323). --- lisp/auth-source-pass.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 625fe94ff9d..15dfa2f358f 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -85,7 +85,7 @@ HOST, USER, PORT, REQUIRE, and MAX." ((null host) ;; Do not build a result, as none will match when HOST is nil nil) - ((not (file-directory-p (expand-file-name auth-source-pass-filename))) + ((not (file-directory-p auth-source-pass-filename)) ;; Do nothing if the password-store folder doesn't exist. nil) (auth-source-pass-extra-query-keywords -- cgit v1.2.1 From d78000728351986b0083013728dc3ef366112c0b Mon Sep 17 00:00:00 2001 From: Basil L. Contovounesios Date: Wed, 18 Mar 2026 12:42:28 +0100 Subject: Add predicate for initial_terminal This introduces the predicate frame-initial-p, which uses struct frame.output_method or struct terminal.type to detect initial_terminal without relying on its name (bug#80629). For some prior discussion, see: https://lists.gnu.org/r/emacs-devel/2019-12/msg00480.html https://lists.gnu.org/r/emacs-devel/2020-01/msg00120.html * doc/lispref/frames.texi (Frames): Document frame-initial-p. (Finding All Frames): Fix grammar. * etc/NEWS (Lisp Changes in Emacs 31.1): Announce frame-initial-p. * lisp/desktop.el (desktop--check-dont-save): * lisp/emacs-lisp/debug.el (debug): * lisp/frameset.el (frameset-restore): * lisp/menu-bar.el (menu-bar-update-buffers): * lisp/xt-mouse.el (turn-on-xterm-mouse-tracking-on-terminal): Use frame-initial-p instead of checking the "initial_terminal" name. * lisp/emacs-lisp/byte-opt.el: Mark frame-initial-p as error-free. * src/pgtkterm.c (pgtk_focus_changed): Use IS_DAEMON in place of Fdaemonp, thus also accepting a named daemon session. * src/terminal.c (decode_tty_terminal): Clarify commentary. (Fframe_initial_p): New function. (syms_of_terminal): Expose it. (init_initial_terminal): Update commentary now that menu-bar-update-buffers uses frame-initial-p (bug#53740). * test/lisp/xt-mouse-tests.el (with-xterm-mouse-mode): Simulate the lack of an initial terminal by overriding frame-initial-p now that turn-on-xterm-mouse-tracking-on-terminal uses it. * test/src/terminal-tests.el: New file. --- lisp/desktop.el | 8 ++++---- lisp/display-fill-column-indicator.el | 1 + lisp/emacs-lisp/byte-opt.el | 2 ++ lisp/emacs-lisp/debug.el | 3 +-- lisp/emacs-lisp/warnings.el | 1 + lisp/frame.el | 1 + lisp/frameset.el | 10 ++++------ lisp/menu-bar.el | 3 +-- lisp/obsolete/linum.el | 1 + lisp/progmodes/flymake.el | 2 ++ lisp/server.el | 3 +++ lisp/tab-bar.el | 1 + lisp/vc/vc-hooks.el | 1 + lisp/xt-mouse.el | 8 +++----- 14 files changed, 26 insertions(+), 19 deletions(-) (limited to 'lisp') diff --git a/lisp/desktop.el b/lisp/desktop.el index f478cf2307b..0cdd554e295 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -775,6 +775,7 @@ if different)." ;; Don't delete daemon's initial frame, or ;; we'll never be able to close the last ;; client's frame (Bug#26912). + ;; Use `frame-initial-p'? (and (daemonp) (eq frame terminal-frame)) (frame-parameter frame 'desktop-dont-clear)) (delete-frame frame)) @@ -1067,9 +1068,8 @@ DIRNAME must be the directory in which the desktop file will be saved." (and (not (frame-parameter frame 'desktop-dont-save)) ;; Don't save daemon initial frames, since we cannot (and don't ;; need to) restore them. - (not (and (daemonp) - (equal (terminal-name (frame-terminal frame)) - "initial_terminal"))))) + (not (and (daemonp) ;; FIXME: Remove `daemonp'? + (frame-initial-p frame))))) (defconst desktop--app-id `(desktop . ,desktop-file-version)) @@ -1260,7 +1260,7 @@ This function also sets `desktop-dirname' to nil." "True if calling `desktop-restore-frameset' will actually restore it." (and desktop-restore-frames desktop-saved-frameset ;; Don't restore frames when the selected frame is the daemon's - ;; initial frame. + ;; initial frame. Use `frame-initial-p'? (not (and (daemonp) (eq (selected-frame) terminal-frame))) t)) diff --git a/lisp/display-fill-column-indicator.el b/lisp/display-fill-column-indicator.el index 349a470ab41..b661f20e22a 100644 --- a/lisp/display-fill-column-indicator.el +++ b/lisp/display-fill-column-indicator.el @@ -102,6 +102,7 @@ See Info node `Displaying Boundaries' for details." (defun display-fill-column-indicator--turn-on () "Turn on `display-fill-column-indicator-mode'." (unless (or (minibufferp) + ;; Use `frame-initial-p'? (and (daemonp) (eq (selected-frame) terminal-frame))) (display-fill-column-indicator-mode))) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index ce2d8ac47c4..7ed71346451 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1901,6 +1901,8 @@ See Info node `(elisp) Integer Basics'." sqlite-available-p sqlitep ;; syntax.c standard-syntax-table syntax-table syntax-table-p + ;; terminal.c + frame-initial-p ;; thread.c current-thread ;; timefns.c diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 3019ada1bbd..ec2aa0ad728 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -195,8 +195,7 @@ the debugger will not be entered." ;; backtrace to stdout. This happens for example while ;; handling an error in code from early-init.el with ;; --debug-init. - (and (eq t (framep (selected-frame))) - (equal "initial_terminal" (terminal-name))))) + (frame-initial-p))) ;; Don't let `inhibit-message' get in our way (especially important if ;; `non-interactive-frame' evaluated to a non-nil value. (inhibit-message nil) diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index ddf3b594e12..7db316acda7 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -372,6 +372,7 @@ entirely by setting `warning-suppress-types' or (if (bolp) (forward-char -1)) (message "%s" (buffer-substring start (point)))))) + ;; Use `frame-initial-p'? ((and (daemonp) (eq (selected-frame) terminal-frame)) ;; Display daemon startup warnings on the first client frame. (letrec ((afterfun diff --git a/lisp/frame.el b/lisp/frame.el index da48e695297..85b58cee070 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -493,6 +493,7 @@ there (in decreasing order of priority)." (setq parms (append initial-frame-alist window-system-frame-alist default-frame-alist parms nil)) ;; Don't enable tab-bar in daemon's initial frame. + ;; Use `frame-initial-p'? (when (and (daemonp) (eq (selected-frame) terminal-frame)) (setq parms (delq (assq 'tab-bar-lines parms) parms))) parms)) diff --git a/lisp/frameset.el b/lisp/frameset.el index e11a1da7e9b..0dde10869fd 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -1370,12 +1370,10 @@ All keyword parameters default to nil." ;; frame, as that would only trigger ;; warnings. (not - (and (daemonp) - (equal (terminal-name (frame-terminal - frame)) - "initial_terminal")))) - (delete-frame frame))) - cleanup-frames))) + (and (daemonp) ;; FIXME: Remove `daemonp'? + (frame-initial-p frame)))) + (delete-frame frame))) + cleanup-frames))) (maphash (lambda (frame _action) (push frame map)) frameset--action-map) (dolist (frame (sort map ;; Minibufferless frames must go first to avoid diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index b1d7bd83983..f96cd43eca6 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2496,8 +2496,7 @@ It must accept a buffer as its only required argument.") ;; Ignore the initial frame if present. It can happen if ;; Emacs was started as a daemon. (bug#53740) (dolist (frame (frame-list)) - (unless (equal (terminal-name (frame-terminal frame)) - "initial_terminal") + (unless (frame-initial-p frame) (push frame frames))) ;; Make the menu of buffers proper. (setq buffers-menu diff --git a/lisp/obsolete/linum.el b/lisp/obsolete/linum.el index 5a0a67ebff0..9b0efaf223a 100644 --- a/lisp/obsolete/linum.el +++ b/lisp/obsolete/linum.el @@ -129,6 +129,7 @@ Linum mode is a buffer-local minor mode." ;; Note that nowadays, this actually doesn't show line ;; numbers in client frames at all, because we visit the ;; file before creating the client frame. See bug#35726. + ;; Use `frame-initial-p'? (and (daemonp) (eq (selected-frame) terminal-frame))) (linum-mode 1))) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 4e828eba8a0..f62f9f5ce3c 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1330,6 +1330,8 @@ Interactively, with a prefix arg, FORCE is t." (buffer (current-buffer))) (cl-labels ((visible-buffer-window () + ;; This can use `frame-initial-p' once + ;; we can assume Emacs 31 or later. (and (or (not (daemonp)) (not (eq (selected-frame) terminal-frame))) (get-buffer-window (current-buffer)))) diff --git a/lisp/server.el b/lisp/server.el index fcfc6c01972..f5dea9c590f 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -706,6 +706,7 @@ the `server-process' variable." ;; when we can't get user input, which may happen when ;; doing emacsclient --eval "(kill-emacs)" in daemon mode. (cond + ;; Use `frame-initial-p'? ((and (daemonp) (null (cdr (frame-list))) (eq (selected-frame) terminal-frame)) @@ -1429,6 +1430,7 @@ The following commands are accepted by the client: (or (eq use-current-frame 'always) ;; We can't use the Emacs daemon's ;; terminal frame. + ;; Use `frame-initial-p'? (not (and (daemonp) (null (cdr (frame-list))) (eq (selected-frame) @@ -1453,6 +1455,7 @@ The following commands are accepted by the client: ;; If there won't be a current frame to use, fall ;; back to trying to create a new one. ((and use-current-frame + ;; Use `frame-initial-p'? (daemonp) (null (cdr (frame-list))) (eq (selected-frame) terminal-frame) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index ad749557987..3399e5ef93e 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -292,6 +292,7 @@ a list of frames to update." (and (eq auto-resize-tab-bars 'grow-only) (> (frame-parameter frame 'tab-bar-lines) 1)) ;; Don't enable tab-bar in daemon's initial frame. + ;; Use `frame-initial-p'? (and (daemonp) (eq frame terminal-frame))) (set-frame-parameter frame 'tab-bar-lines (tab-bar--tab-bar-lines-for-frame frame))))) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 042733f4c61..2dcae7362b7 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -977,6 +977,7 @@ In the latter case, VC mode is deactivated for this buffer." noninteractive ;; Copied from server-start. Seems like there should ;; be a better way to ask "can we get user input?"... + ;; Use `frame-initial-p'? (and (daemonp) (null (cdr (frame-list))) (eq (selected-frame) terminal-frame)) diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 67c475d563a..b93d914380f 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -509,16 +509,14 @@ enable, ?l to disable)." "Enable xterm mouse tracking on TERMINAL." (when (and xterm-mouse-mode (eq t (terminal-live-p terminal)) ;; Avoid the initial terminal which is not a termcap device. - ;; FIXME: is there more elegant way to detect the initial - ;; terminal? - (not (string= (terminal-name terminal) "initial_terminal"))) + (not (frame-initial-p terminal))) (unless (terminal-parameter terminal 'xterm-mouse-mode) ;; Simulate selecting a terminal by selecting one of its frames ;; so that we can set the terminal-local `input-decode-map'. ;; Use the tty-top-frame to avoid accidentally making an invisible ;; child frame visible by selecting it (bug#79960). - ;; The test for match mode is here because xt-mouse-tests run in - ;; match mode, and there is no top-frame in that case. + ;; The test for batch mode is here because xt-mouse-tests run in + ;; batch mode, and there is no top-frame in that case. (with-selected-frame (if noninteractive (car (frame-list)) (tty-top-frame terminal)) -- cgit v1.2.1 From 0b0cee07d2b14d61fbc64b29dc8df0109b021b3b Mon Sep 17 00:00:00 2001 From: YugaEgo Date: Mon, 23 Mar 2026 11:41:03 +0200 Subject: * lisp/textmodes/css-mode.el (css-pseudo-class-ids): Add 'has' (bug#80664). --- lisp/textmodes/css-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index a56fc018e18..b8071748eb5 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -66,7 +66,7 @@ (defconst css-pseudo-class-ids '("active" "checked" "default" "disabled" "empty" "enabled" "first" - "first-child" "first-of-type" "focus" "focus-within" "hover" + "first-child" "first-of-type" "focus" "focus-within" "has" "hover" "in-range" "indeterminate" "invalid" "lang" "last-child" "last-of-type" "left" "link" "not" "nth-child" "nth-last-child" "nth-last-of-type" "nth-of-type" "only-child" "only-of-type" -- cgit v1.2.1 From 9b5a9c90d28fa80884d725741610f80993291748 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 27 Mar 2026 10:24:45 +0300 Subject: ; * lisp/textmodes/css-mode.el: Update maintainer's email address. --- lisp/textmodes/css-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index b8071748eb5..355555df090 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2006-2026 Free Software Foundation, Inc. ;; Author: Stefan Monnier -;; Maintainer: Simen Heggestøyl +;; Maintainer: Simen Heggestøyl ;; Keywords: hypermedia ;; This file is part of GNU Emacs. -- cgit v1.2.1 From db412283d6b4fb8ea9d48629add952bf8fe2f423 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 27 Mar 2026 08:43:39 -0400 Subject: (kmacro-end-call-mouse): Make obsolete * lisp/kmacro.el (kmacro-end-and-call-macro): Add EVENT argument. (kmacro-end-call-mouse): Define as obsolete alias of `kmacro-end-and-call-macro`. --- lisp/kmacro.el | 32 +++++++++++--------------------- 1 file changed, 11 insertions(+), 21 deletions(-) (limited to 'lisp') diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 982ae38f47d..b88c716f0b3 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -219,7 +219,7 @@ macro to be executed before appending to it." ;;;###autoload (autoload 'kmacro-keymap "kmacro" "Keymap for keyboard macro commands." t 'keymap) (if kmacro-call-mouse-event - (global-set-key (vector kmacro-call-mouse-event) #'kmacro-end-call-mouse)) + (global-set-key (vector kmacro-call-mouse-event) #'kmacro-end-and-call-macro)) ;;; Called from keyboard-quit @@ -742,8 +742,8 @@ With numeric ARG, repeat the macro that many times, counting the definition just completed as the first repetition. An argument of zero means repeat until error." (interactive "p") - ;; Isearch may push the kmacro-end-macro key sequence onto the macro. - ;; Just ignore it when executing the macro. + ;; Isearch may push the kmacro-end-macro key sequence onto the macro. + ;; Just ignore it when executing the macro. FIXME: When?Why? (unless executing-kbd-macro (end-kbd-macro arg #'kmacro-loop-setup-function) (when (and last-kbd-macro (= (length last-kbd-macro) 0)) @@ -880,35 +880,25 @@ With \\[universal-argument], call second macro in macro ring." ;;;###autoload -(defun kmacro-end-and-call-macro (arg &optional no-repeat) +(defun kmacro-end-and-call-macro (arg &optional no-repeat event) "Call last keyboard macro, ending it first if currently being defined. With numeric prefix ARG, repeat macro that many times. Zero argument means repeat until there is an error. +If triggered via a mouse EVENT, moves point to the position clicked +with the mouse before calling the macro. To give a macro a name, so you can call it even after defining other macros, use \\[kmacro-name-last-macro]." - (interactive "p") + (interactive (list current-prefix-arg nil + (if (consp last-input-event) last-input-event))) (if defining-kbd-macro (kmacro-end-macro nil)) + (if event (mouse-set-point event)) (kmacro-call-macro arg no-repeat)) - ;;;###autoload -(defun kmacro-end-call-mouse (event) - "Move point to the position clicked with the mouse and call last kbd macro. -If kbd macro currently being defined end it before activating it." - (interactive "e") - (when defining-kbd-macro - (end-kbd-macro) - (when (and last-kbd-macro (= (length last-kbd-macro) 0)) - (setq last-kbd-macro nil) - (message "Ignore empty macro") - ;; Don't call `kmacro-ring-empty-p' to avoid its messages. - (while (and (null last-kbd-macro) kmacro-ring) - (kmacro-pop-ring1)))) - (mouse-set-point event) - (kmacro-call-macro nil t)) - +(define-obsolete-function-alias 'kmacro-end-call-mouse + #'kmacro-end-and-call-macro "31.1") ;;; Misc. commands -- cgit v1.2.1 From de381366eac4ac956f80fbb38167fa57878e115f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 27 Mar 2026 09:56:55 -0400 Subject: (c++-ts-mode): Fix bug#80682 * lisp/progmodes/c-ts-mode.el (c++-ts-mode): Set `editorconfig-indent-size-vars` since it can't be guessed. --- lisp/progmodes/c-ts-mode.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 87273ec91c0..be67e8db78f 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1567,6 +1567,7 @@ recommended to enable `electric-pair-mode' with this mode." (funcall c-ts-mode-indent-style) (c-ts-mode--simple-indent-rules 'cpp c-ts-mode-indent-style))) + (setq-local editorconfig-indent-size-vars '(c-ts-indent-offset)) ;; Font-lock. (setq-local treesit-font-lock-settings -- cgit v1.2.1 From 3b7d9e37ce0c27d942ee583526bd5c96cbdd6f1e Mon Sep 17 00:00:00 2001 From: Stephen Berman Date: Fri, 27 Mar 2026 16:36:16 +0100 Subject: Implement new Dired handling of errors from 'ls' The error messages are now displayed in a popped up buffer instead of being output in the Dired buffer and signalling an error. The file name bounds in Dired entries are now determined solely by the offsets calculated by 'ls' with the --dired option and consequently Dired now reliably recognizes file names that contain a newline (bug#80499). * etc/NEWS: Announce new Dired handling of errors from 'ls'. * lisp/dired.el (dired-internal-noselect): Check Dired buffer for file entries and if there are none kill the buffer to prevent displaying a Dired buffer with no file entries. (dired--ls-error-buffer): New variable. (dired--display-ls-error): New function. (dired, dired-other-window, dired-other-frame, dired-other-tab): Use it to pop up buffer with error message emitted by 'ls'. * lisp/files.el (insert-directory-clean): Remove the code that treats lines beginning at column 0 in a Dired buffer as error lines and consequently also remove the code using these lines to adjust the offsets specifying the bounds of the file name in the Dired entries. If the buffer contains a //DIRED-OPTIONS// line output by --dired, delete this line even when it is at BOB. (insert-directory): Remove the code that checks the return value of 'ls' and signals an error based on that value. Write any error message emitted by 'ls' to a temporary file and insert its content into a buffer, which will be popped when invoking a Dired command results in the 'ls' error. Adjust the comment above this function to accommodate file names containing a newline in Dired entries. (insert-directory-adj-pos): Remove this now unused function. * test/lisp/dired-tests.el (dired-test-filename-with-newline-1) (dired-test-filename-with-newline-2) (dired-test-ls-error-message): New tests. * test/lisp/files-tests.el (files-tests-file-name-non-special-insert-directory): Adjust test to use of 'ls' error buffer instead of signaling an error. --- lisp/dired.el | 40 +++++++-- lisp/files.el | 276 ++++++++++++++++++++-------------------------------------- 2 files changed, 128 insertions(+), 188 deletions(-) (limited to 'lisp') diff --git a/lisp/dired.el b/lisp/dired.el index 4782c691411..4aded86e40d 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -649,6 +649,10 @@ The match starts at the beginning of the line and ends after the end of the line. Subexpression 2 must end right before the \\n.") +(defvar dired--ls-error-buffer nil + "Non-nil if the current dired invocation yields an `ls' error. +The non-nil value is the buffer containing the error message.") + ;;; Faces @@ -1230,7 +1234,8 @@ Type \\[describe-mode] after entering Dired for more info. If DIRNAME is already in a Dired buffer, that buffer is used without refresh." ;; Cannot use (interactive "D") because of wildcards. (interactive (dired-read-dir-and-switches "")) - (pop-to-buffer-same-window (dired-noselect dirname switches))) + (prog1 (pop-to-buffer-same-window (dired-noselect dirname switches)) + (dired--display-ls-error))) ;; This is needed to let clicks on the menu bar invoke Dired even if ;; some feature remaps the Dired command to another command. @@ -1248,21 +1253,24 @@ If this command needs to split the current window, it by default obeys the user options `split-height-threshold' and `split-width-threshold', when it decides whether to split the window horizontally or vertically." (interactive (dired-read-dir-and-switches "in other window ")) - (switch-to-buffer-other-window (dired-noselect dirname switches))) + (prog1 (switch-to-buffer-other-window (dired-noselect dirname switches)) + (dired--display-ls-error))) ;;;###autoload (keymap-set ctl-x-5-map "d" #'dired-other-frame) ;;;###autoload (defun dired-other-frame (dirname &optional switches) "\"Edit\" directory DIRNAME. Like `dired' but make a new frame." (interactive (dired-read-dir-and-switches "in other frame ")) - (switch-to-buffer-other-frame (dired-noselect dirname switches))) + (prog1 (switch-to-buffer-other-frame (dired-noselect dirname switches)) + (dired--display-ls-error))) ;;;###autoload (keymap-set tab-prefix-map "d" #'dired-other-tab) ;;;###autoload (defun dired-other-tab (dirname &optional switches) "\"Edit\" directory DIRNAME. Like `dired' but make a new tab." (interactive (dired-read-dir-and-switches "in other tab ")) - (switch-to-buffer-other-tab (dired-noselect dirname switches))) + (prog1 (switch-to-buffer-other-tab (dired-noselect dirname switches)) + (dired--display-ls-error))) ;;;###autoload (defun dired-noselect (dir-or-list &optional switches) @@ -1447,10 +1455,19 @@ The return value is the target column for the file names." (let ((failed t)) (unwind-protect (progn (dired-readin) - (setq failed nil)) - ;; dired-readin can fail if parent directories are inaccessible. - ;; Don't leave an empty buffer around in that case. - (if failed (kill-buffer buffer)))) + ;; Check for file entries (they are listed below the + ;; directory name and (if present) wildcard lines). + (while (and (skip-syntax-forward "\s") + (looking-at "\\(.+:$\\|wildcard\\)")) + (forward-line)) + (unless (eobp) + (setq failed nil))) + ;; No file entries indicates an `ls' error, and `dired-readin' + ;; can fail if parent directories are inaccessible. In either + ;; case don't leave the Dired buffer around. + (when failed + (kill-buffer buffer) + (setq buffer nil)))) (goto-char (point-min)) (dired-initial-position dirname)) (when (consp dired-directory) @@ -4093,6 +4110,13 @@ See `%s' for other alternatives and more information.")) (set-window-point (get-buffer-window) (search-backward "Warning (dired)"))))) +(defun dired--display-ls-error () + "Pop up a buffer displaying the current `ls' error, if any." + (when dired--ls-error-buffer + (let* ((errwin (display-buffer dired--ls-error-buffer))) + (fit-window-to-buffer errwin)) + (setq dired--ls-error-buffer nil))) + ;;; Deleting files diff --git a/lisp/files.el b/lisp/files.el index f9af75187cb..ebbbd7ff1b6 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -8320,41 +8320,24 @@ Valid wildcards are `*', `?', `[abc]' and `[a-z]'." (forward-line -1)) (if (let ((case-fold-search nil)) (looking-at "//DIRED//")) (let ((end (line-end-position)) - (linebeg (point)) - error-lines) - ;; Find all the lines that are error messages, - ;; and record the bounds of each one. - (goto-char beg) - (while (< (point) linebeg) - (or (eql (following-char) ?\s) - (push (list (point) (line-end-position)) error-lines)) - (forward-line 1)) - (setq error-lines (nreverse error-lines)) - ;; Now read the numeric positions of file names. + (linebeg (point))) + ;; Read the numeric positions of file names. (goto-char linebeg) (forward-word-strictly 1) (forward-char 3) (while (< (point) end) - (let ((start (insert-directory-adj-pos - (+ beg (read (current-buffer))) - error-lines)) - (end (insert-directory-adj-pos - (+ beg (read (current-buffer))) - error-lines))) - (if (memq (char-after end) '(?\n ?\s ?/ ?* ?@ ?% ?= ?|)) - ;; End is followed by \n or by output of -F. - (put-text-property start end 'dired-filename t) - ;; It seems that we can't trust ls's output as to - ;; byte positions of filenames. - (put-text-property beg (point) 'dired-filename nil) - (end-of-line)))) + (let ((start (+ beg (read (current-buffer)))) + (end (+ beg (read (current-buffer))))) + (when (memq (char-after end) '(?\n ?\s ?/ ?* ?@ ?% ?= ?|)) + ;; End is followed by \n or by output of -F. + (put-text-property start end 'dired-filename t)))) (goto-char end) (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point)))) ;; Take care of the case where the ls output contains a ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line ;; and we went one line too far back (see above). - (forward-line 1)) + (unless (bobp) (forward-line 1))) (if (let ((case-fold-search nil)) (looking-at "//DIRED-OPTIONS//")) (delete-region (point) (progn (forward-line 1) (point)))))) @@ -8363,12 +8346,12 @@ Valid wildcards are `*', `?', `[abc]' and `[a-z]'." ;; FULL-DIRECTORY-P is nil. ;; The single line of output must display FILE's name as it was ;; given, namely, an absolute path name. -;; - must insert exactly one line for each file if WILDCARD or +;; - must insert exactly one entry for each file if WILDCARD or ;; FULL-DIRECTORY-P is t, plus one optional "total" line ;; before the file lines, plus optional text after the file lines. -;; Lines are delimited by "\n", so filenames containing "\n" are not -;; allowed. -;; File lines should display the basename. +;; Entries are delimited by "\n", but file names containing "\n" are +;; allowed and by default the "\n" is displayed as a literal newline. +;; File entries should display the basename. ;; - must be consistent with ;; - functions dired-move-to-filename, (these two define what a file line is) ;; dired-move-to-end-of-filename, @@ -8410,10 +8393,10 @@ normally equivalent short `-D' option is just passed on to (declare-function ls-lisp--insert-directory "ls-lisp") (ls-lisp--insert-directory file switches wildcard full-directory-p)) (t - (let (result (beg (point))) + (let ((beg (point)) + (errfile (make-temp-file "lserr"))) ;; Read the actual directory using `insert-directory-program'. - ;; RESULT gets the status code. (let* (;; We at first read by no-conversion, then after ;; putting text property `dired-filename, decode one ;; bunch by one to preserve that property. @@ -8423,143 +8406,88 @@ normally equivalent short `-D' option is just passed on to (and enable-multibyte-characters (or file-name-coding-system default-file-name-coding-system)))) - (setq result - (if wildcard - ;; If the wildcard is just in the file part, then run ls in - ;; the directory part of the file pattern using the last - ;; component as argument. Otherwise, run ls in the longest - ;; subdirectory of the directory part free of wildcards; use - ;; the remaining of the file pattern as argument. - (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p file)) - (default-directory - (cond (dir-wildcard (car dir-wildcard)) - (t - (if (file-name-absolute-p file) - (file-name-directory file) - (file-name-directory (expand-file-name file)))))) - (pattern (if dir-wildcard (cdr dir-wildcard) (file-name-nondirectory file)))) - ;; NB since switches is passed to the shell, be - ;; careful of malicious values, eg "-l;reboot". - ;; See eg dired-safe-switches-p. - (call-process - shell-file-name nil t nil - shell-command-switch - (concat (if (memq system-type '(ms-dos windows-nt)) - "" - "\\") ; Disregard Unix shell aliases! - insert-directory-program - " -d " - ;; Quote switches that require quoting - ;; such as "--block-size='1". But don't - ;; quote switches that use patterns - ;; such as "--ignore=PATTERN" (bug#71935). - (mapconcat #'shell-quote-wildcard-pattern - (if (stringp switches) - (split-string-and-unquote switches) - switches) - " ") - " -- " - ;; Quote some characters that have - ;; special meanings in shells; but - ;; don't quote the wildcards--we want - ;; them to be special. We also - ;; currently don't quote the quoting - ;; characters in case people want to - ;; use them explicitly to quote - ;; wildcard characters. - (shell-quote-wildcard-pattern pattern)))) - ;; SunOS 4.1.3, SVr4 and others need the "." to list the - ;; directory if FILE is a symbolic link. - (unless full-directory-p - (setq switches - (cond - ((stringp switches) (concat switches " -d")) - ((member "-d" switches) switches) - (t (append switches '("-d")))))) - (if (string-match "\\`~" file) - (setq file (expand-file-name file))) - (apply #'call-process - insert-directory-program nil t nil - (append - (if (listp switches) switches - (unless (equal switches "") - ;; Split the switches at any spaces so we can - ;; pass separate options as separate args. - (split-string-and-unquote switches))) - ;; Avoid lossage if FILE starts with `-'. - '("--") - (list file)))))) - - ;; If we got "//DIRED//" in the output, it means we got a real - ;; directory listing, even if `ls' returned nonzero. - ;; So ignore any errors. - (when (if (stringp switches) - (string-match "--dired\\>" switches) - (member "--dired" switches)) - (save-excursion - (let ((case-fold-search nil)) - (forward-line -2) - (when (looking-at "//SUBDIRED//") - (forward-line -1)) - (if (looking-at "//DIRED//") - (setq result 0))))) - - (when (and (not (eq 0 result)) - (eq insert-directory-ls-version 'unknown)) - ;; The first time ls returns an error, - ;; find the version numbers of ls, - ;; and set insert-directory-ls-version - ;; to > if it is more than 5.2.1, < if it is less, nil if it - ;; is equal or if the info cannot be obtained. - ;; (That can mean it isn't GNU ls.) - (let ((version-out - (with-temp-buffer - (call-process "ls" nil t nil "--version") - (buffer-string)))) - (setq insert-directory-ls-version - (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out) - (let* ((version (match-string 1 version-out)) - (split (split-string version "[.]")) - (numbers (mapcar #'string-to-number split)) - (min '(5 2 1)) - comparison) - (while (and (not comparison) (or numbers min)) - (cond ((null min) - (setq comparison #'>)) - ((null numbers) - (setq comparison #'<)) - ((> (car numbers) (car min)) - (setq comparison #'>)) - ((< (car numbers) (car min)) - (setq comparison #'<)) - (t - (setq numbers (cdr numbers) - min (cdr min))))) - (or comparison #'=)) - nil)))) - - ;; For GNU ls versions 5.2.2 and up, ignore minor errors. - (when (and (eq 1 result) (eq insert-directory-ls-version #'>)) - (setq result 0)) - - ;; If `insert-directory-program' failed, signal an error. - (unless (eq 0 result) - ;; Delete the error message it may have output. - (delete-region beg (point)) - ;; On non-Posix systems, we cannot open a directory, so - ;; don't even try, because that will always result in - ;; the ubiquitous "Access denied". Instead, show the - ;; command line so the user can try to guess what went wrong. - (if (and (file-directory-p file) - (memq system-type '(ms-dos windows-nt))) - (error - "Reading directory: \"%s %s -- %s\" exited with status %s" - insert-directory-program - (if (listp switches) (concat switches) switches) - file result) - ;; Unix. Access the file to get a suitable error. - (access-file file "Reading directory") - (error "Listing directory failed but `access-file' worked"))) + (if wildcard + ;; If the wildcard is just in the file part, then run ls in + ;; the directory part of the file pattern using the last + ;; component as argument. Otherwise, run ls in the longest + ;; subdirectory of the directory part free of wildcards; use + ;; the remaining of the file pattern as argument. + (let* ((dir-wildcard + (insert-directory-wildcard-in-dir-p file)) + (default-directory + (cond (dir-wildcard (car dir-wildcard)) + (t + (if (file-name-absolute-p file) + (file-name-directory file) + (file-name-directory + (expand-file-name file)))))) + (pattern (if dir-wildcard + (cdr dir-wildcard) + (file-name-nondirectory file)))) + ;; NB since switches is passed to the shell, be + ;; careful of malicious values, eg "-l;reboot". + ;; See eg dired-safe-switches-p. + (call-process + shell-file-name nil (list t errfile) nil + shell-command-switch + (concat (if (memq system-type '(ms-dos windows-nt)) + "" + "\\") ; Disregard Unix shell aliases! + insert-directory-program + " -d " + ;; Quote switches that require quoting + ;; such as "--block-size='1". But don't + ;; quote switches that use patterns + ;; such as "--ignore=PATTERN" (bug#71935). + (mapconcat #'shell-quote-wildcard-pattern + (if (stringp switches) + (split-string-and-unquote switches) + switches) + " ") + " -- " + ;; Quote some characters that have + ;; special meanings in shells; but + ;; don't quote the wildcards--we want + ;; them to be special. We also + ;; currently don't quote the quoting + ;; characters in case people want to + ;; use them explicitly to quote + ;; wildcard characters. + (shell-quote-wildcard-pattern pattern)))) + ;; SunOS 4.1.3, SVr4 and others need the "." to list the + ;; directory if FILE is a symbolic link. + (unless full-directory-p + (setq switches + (cond + ((stringp switches) (concat switches " -d")) + ((member "-d" switches) switches) + (t (append switches '("-d")))))) + (if (string-match "\\`~" file) + (setq file (expand-file-name file))) + (apply #'call-process + insert-directory-program nil (list t errfile) nil + (append + (if (listp switches) switches + (unless (equal switches "") + ;; Split the switches at any spaces so we can + ;; pass separate options as separate args. + (split-string-and-unquote switches))) + ;; Avoid lossage if FILE starts with `-'. + '("--") + (list file))))) + + ;; If `ls' emits an error message, copy it to a buffer that will + ;; be displayed when a Dired invocation results in the `ls' + ;; error. + (when (> (file-attribute-size (file-attributes errfile)) 0) + (defvar dired--ls-error-buffer) ; Pacify byte-compiler. + (let ((errbuf (get-buffer-create "*ls error*"))) + (with-current-buffer errbuf + (erase-buffer) + (insert-file-contents errfile)) + (setq dired--ls-error-buffer errbuf))) + (delete-file errfile) + (insert-directory-clean beg switches) ;; Now decode what read if necessary. (let ((coding (or coding-system-for-read @@ -8594,18 +8522,6 @@ normally equivalent short `-D' option is just passed on to (put-text-property pos (point) 'dired-filename t)))))))))))) -(defun insert-directory-adj-pos (pos error-lines) - "Convert `ls --dired' file name position value POS to a buffer position. -File name position values returned in ls --dired output -count only stdout; they don't count the error messages sent to stderr. -So this function converts to them to real buffer positions. -ERROR-LINES is a list of buffer positions of error message lines, -of the form (START END)." - (while (and error-lines (< (caar error-lines) pos)) - (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines))))) - (pop error-lines)) - pos) - (defun insert-directory-safely (file switches &optional wildcard full-directory-p) "Insert directory listing for FILE, formatted according to SWITCHES. -- cgit v1.2.1 From 57b119b296ed1cefaad6b7e42c1e4c37ba23cdf8 Mon Sep 17 00:00:00 2001 From: Emil Ingelman Sahlén Date: Fri, 27 Mar 2026 19:48:02 +0100 Subject: Fix recombination of side windows (Bug#80665) * lisp/window.el (window--make-major-side-window): Protect the sibling (the main-window group) from recombination. Without this, deleting a side window can flatten the group into the root, causing subsequent side windows on other sides to be placed incorrectly (Bug#80665). Copyright-paperwork-exempt: yes --- lisp/window.el | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'lisp') diff --git a/lisp/window.el b/lisp/window.el index 1f7ae726f49..be92a695b2b 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1010,6 +1010,14 @@ and may be called only if no window on SIDE exists yet." (cons `(dedicated . ,(or display-buffer-mark-dedicated 'side)) alist)))) (when window + ;; Protect the sibling (the main-window group) from recombination. + ;; Without this, deleting a side window can flatten the group into + ;; the root, causing subsequent side windows on other sides to be + ;; placed incorrectly (Bug#80665). + (when-let* ((sibling (or (window-prev-sibling window) + (window-next-sibling window))) + (window-child sibling)) + (set-window-combination-limit sibling t)) ;; Initialize `window-side' parameter of new window to SIDE and ;; make that parameter persistent. (set-window-parameter window 'window-side side) -- cgit v1.2.1 From c8b956dc32af58a7ef55d9f40a442bec302be27f Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Fri, 27 Mar 2026 23:35:24 +0100 Subject: ; Fix last fix to 'window--make-major-side-window' * lisp/window.el (window--make-major-side-window): Fix last fix which was broken by the committer. --- lisp/window.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/window.el b/lisp/window.el index be92a695b2b..bd0653fe0d4 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1016,7 +1016,7 @@ and may be called only if no window on SIDE exists yet." ;; placed incorrectly (Bug#80665). (when-let* ((sibling (or (window-prev-sibling window) (window-next-sibling window))) - (window-child sibling)) + ((window-child sibling))) (set-window-combination-limit sibling t)) ;; Initialize `window-side' parameter of new window to SIDE and ;; make that parameter persistent. -- cgit v1.2.1 From 0de3844f80822ad5eadaf94d4dd0308674353778 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 28 Mar 2026 09:50:00 +0100 Subject: Fix file-name-all-completions for symlinked directories in Tramp * lisp/net/tramp.el (tramp-skeleton-file-name-all-completions): * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions): * lisp/net/tramp-crypt.el (tramp-crypt-handle-file-name-all-completions): * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): * lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions): * lisp/net/tramp-smb.el (tramp-smb-handle-file-name-all-completions): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-name-all-completions): Simplify. * tramp-tests.el (tramp-test32-shell-command): Adapt test. * lisp/net/tramp-ftp.el (tramp-disable-ange-ftp): Use `seq-difference'. * lisp/net/tramp-gvfs.el (tramp-gvfs-monitor-process-filter): Use `thread-last'. * lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory): Use `seq-difference'. (tramp-sh-gio-monitor-process-filter): Use `thread-last'. * lisp/net/tramp-smb.el (tramp-smb-get-file-entries): Do not add virtual entry ""; it isn't needed anymore. * lisp/net/tramp.el (tramp-make-tramp-hop-name): Use `thread-last'. (tramp-completion-handle-file-directory-p): Use `tramp-prefix-format'. (tramp-fnac-add-trailing-slash): New defvar. (tramp-skeleton-file-name-all-completions): Handle also symlinked directories. (tramp-skeleton-directory-files): Use `tramp-fnac-add-trailing-slash'. (tramp-handle-file-name-completion): Use `seq-difference'. (tramp-handle-make-process): Handle "%w" format specifier. * test/lisp/net/tramp-tests.el (tramp-test26-file-name-completion) (tramp-test32-shell-command, tramp-test36-vc-registered): Adapt tests. --- lisp/net/tramp-adb.el | 22 ++--- lisp/net/tramp-crypt.el | 22 ++--- lisp/net/tramp-ftp.el | 2 +- lisp/net/tramp-fuse.el | 5 +- lisp/net/tramp-gvfs.el | 26 ++---- lisp/net/tramp-sh.el | 89 +++++++++--------- lisp/net/tramp-smb.el | 19 +--- lisp/net/tramp-sudoedit.el | 28 ++---- lisp/net/tramp.el | 223 ++++++++++++++++++++++++++------------------- 9 files changed, 206 insertions(+), 230 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index c20b5df9b59..f6bfd9ebbea 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -451,21 +451,13 @@ Emacs dired can't find files." (defun tramp-adb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (when (tramp-adb-do-ls v "-a" localname) - (mapcar - (lambda (f) - (if (file-directory-p (expand-file-name f directory)) - (file-name-as-directory f) - f)) - (with-current-buffer (tramp-get-buffer v) - (mapcar - (lambda (l) - (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string (buffer-string) "\n" 'omit)))))))))) + (with-parsed-tramp-file-name (expand-file-name directory) nil + (when (tramp-adb-do-ls v "-a" localname) + (with-current-buffer (tramp-get-buffer v) + (mapcar + (lambda (l) + (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string (buffer-string) "\n" 'omit))))))) (defun tramp-adb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 59e4cea2edb..4400f4fecd3 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -741,18 +741,16 @@ absolute file names." (defun tramp-crypt-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (all-completions - filename - (let* (completion-regexp-list - tramp-crypt-enabled - (directory (file-name-as-directory directory)) - (enc-dir (tramp-crypt-encrypt-file-name directory))) - (mapcar - (lambda (x) - (substring - (tramp-crypt-decrypt-file-name (concat enc-dir x)) - (length directory))) - (file-name-all-completions "" enc-dir)))))) + (let* (completion-regexp-list + tramp-crypt-enabled + (directory (file-name-as-directory directory)) + (enc-dir (tramp-crypt-encrypt-file-name directory))) + (mapcar + (lambda (x) + (substring + (tramp-crypt-decrypt-file-name (concat enc-dir x)) + (length directory))) + (file-name-all-completions "" enc-dir))))) (defun tramp-crypt-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 7e140a0e372..601690befd6 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -49,7 +49,7 @@ present for backward compatibility." (let ((a1 (rassq 'ange-ftp-hook-function file-name-handler-alist)) (a2 (rassq 'ange-ftp-completion-hook-function file-name-handler-alist))) (setq file-name-handler-alist - (delete a1 (delete a2 file-name-handler-alist))))) + (seq-difference file-name-handler-alist (list a1 a2))))) (with-eval-after-load 'ange-ftp (tramp-disable-ange-ftp)) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index b3e59063cd8..f7abddab1a1 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -102,10 +102,7 @@ "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory (tramp-fuse-remove-hidden-files - (all-completions - filename - (file-name-all-completions - filename (tramp-fuse-local-file-name directory)))))) + (file-name-all-completions "" (tramp-fuse-local-file-name directory))))) ;; This function isn't used. (defun tramp-fuse-handle-insert-directory diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 0f68e4d768a..a5919e071c3 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1479,19 +1479,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (unless (string-search "/" filename) - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (let (result) - ;; Get a list of directories and files. - (dolist (item - (tramp-gvfs-get-directory-attributes directory) - result) - (if (string-equal (cdr (assoc "type" item)) "directory") - (push (file-name-as-directory (car item)) result) - (push (car item) result)))))))))) + (mapcar #'car (tramp-gvfs-get-directory-attributes directory)))) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) "Like `file-notify-add-watch' for Tramp files." @@ -1545,11 +1533,13 @@ If FILE-SYSTEM is non-nil, return file system attributes." (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) - (setq string (concat rest-string string) - ;; Fix action names. - string (string-replace "attributes changed" "attribute-changed" string) - string (string-replace "changes done" "changes-done-hint" string) - string (string-replace "renamed to" "moved" string)) + (setq string + (thread-last + (concat rest-string string) + ;; Fix action names. + (string-replace "attributes changed" "attribute-changed") + (string-replace "changes done" "changes-done-hint") + (string-replace "renamed to" "moved"))) ;; https://bugs.launchpad.net/bugs/1742946 (when (string-match-p diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index c83a7a9978d..08a44c81f08 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1993,48 +1993,39 @@ ID-FORMAT valid values are `string' and `integer'." "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory (with-parsed-tramp-file-name (expand-file-name directory) nil - (when (and (not (string-search "/" filename)) - (tramp-connectable-p v)) - (unless (string-search "/" filename) - (all-completions - filename - (with-tramp-file-property v localname "file-name-all-completions" - (let (result) - ;; Get a list of directories and files, including - ;; reliably tagging the directories with a trailing "/". - ;; Because I rock. --daniel@danann.net - (if (tramp-get-remote-perl v) - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (tramp-maybe-send-script - v tramp-shell-file-name-all-completions - "tramp_shell_file_name_all_completions")) - - (dolist - (elt - (tramp-send-command-and-read - v (format - "%s %s" - (if (tramp-get-remote-perl v) - "tramp_perl_file_name_all_completions" - "tramp_shell_file_name_all_completions") - (tramp-shell-quote-argument localname)) - 'noerror) - result) - ;; Don't cache "." and "..". - (when (string-match-p - directory-files-no-dot-files-regexp - (file-name-nondirectory (car elt))) - (tramp-set-file-property v (car elt) "file-exists-p" (nth 1 elt)) - (tramp-set-file-property v (car elt) "file-readable-p" (nth 2 elt)) - (tramp-set-file-property v (car elt) "file-directory-p" (nth 3 elt)) - (tramp-set-file-property v (car elt) "file-executable-p" (nth 4 elt))) - - (push - (concat - (file-name-nondirectory (car elt)) (and (nth 3 elt) "/")) - result)))))))))) + (let (result) + ;; Get a list of directories and files, including reliably + ;; tagging the directories with a trailing "/". + ;; Because I rock. --daniel@danann.net + (if (tramp-get-remote-perl v) + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + (tramp-maybe-send-script + v tramp-shell-file-name-all-completions + "tramp_shell_file_name_all_completions")) + + (dolist + (elt + (tramp-send-command-and-read + v (format + "%s %s" + (if (tramp-get-remote-perl v) + "tramp_perl_file_name_all_completions" + "tramp_shell_file_name_all_completions") + (tramp-shell-quote-argument localname)) + 'noerror) + result) + ;; Don't cache "." and "..". + (when (string-match-p + directory-files-no-dot-files-regexp + (file-name-nondirectory (car elt))) + (tramp-set-file-property v (car elt) "file-exists-p" (nth 1 elt)) + (tramp-set-file-property v (car elt) "file-readable-p" (nth 2 elt)) + (tramp-set-file-property v (car elt) "file-directory-p" (nth 3 elt)) + (tramp-set-file-property v (car elt) "file-executable-p" (nth 4 elt))) + + (push (file-name-nondirectory (car elt)) result)))))) ;; cp, mv and ln @@ -2803,7 +2794,7 @@ The method used must be an out-of-band method." (append switches (split-string (tramp-sh--quoting-style-options v)) (when dired `(,dired)))) (unless dired - (setq switches (delete "-N" (delete "--dired" switches))))) + (setq switches (seq-difference switches '("-N" "--dired"))))) (when wildcard (setq wildcard (tramp-run-real-handler #'file-name-nondirectory (list localname))) @@ -3917,11 +3908,13 @@ Fall back to normal file name handler if no Tramp handler exists." (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) - (setq string (concat rest-string string) - ;; Fix action names. - string (string-replace "attributes changed" "attribute-changed" string) - string (string-replace "changes done" "changes-done-hint" string) - string (string-replace "renamed to" "moved" string)) + (setq string + (thread-last + (concat rest-string string) + ;; Fix action names. + (string-replace "attributes changed" "attribute-changed") + (string-replace "changes done" "changes-done-hint") + (string-replace "renamed to" "moved"))) (catch 'doesnt-work ;; https://bugs.launchpad.net/bugs/1742946 diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 554aa354c00..bda033b7838 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1068,18 +1068,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (all-completions - filename - (when (file-directory-p directory) - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (mapcar - (lambda (x) - (list - (if (string-search "d" (nth 1 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - (tramp-smb-get-file-entries directory)))))))) + (mapcar #'car (tramp-smb-get-file-entries directory)))) (defun tramp-smb-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." @@ -1752,9 +1741,6 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." (unless share (tramp-set-connection-property v "share-cache" res))) - ;; Add directory itself. - (push '("" "drwxrwxrwx" 0 (0 0)) res) - ;; Return entries. (delq nil res))))) @@ -2295,9 +2281,6 @@ SHARE will be passed to the call of `tramp-smb-get-localname'." ;; * Return more comprehensive file permission string. ;; -;; * Try to remove the inclusion of dummy "" directory. Seems to be at -;; several places, especially in `tramp-smb-handle-insert-directory'. -;; ;; * Keep a separate connection process per share. ;; ;; * Keep a permanent connection process for `process-file'. diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 9511c899b2b..8bf6a9f50b0 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -498,24 +498,16 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (tramp-sudoedit-send-command - v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" - (if (tramp-string-empty-or-nil-p localname) - "" (file-name-unquote localname))) - (mapcar - (lambda (f) - (if (ignore-errors (file-directory-p (expand-file-name f directory))) - (file-name-as-directory f) - f)) - (mapcar - (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string - (tramp-get-buffer-string (tramp-get-connection-buffer v)) - "\n" 'omit)))))))) + (with-parsed-tramp-file-name (expand-file-name directory) nil + (tramp-sudoedit-send-command + v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" + (if (tramp-string-empty-or-nil-p localname) + "" (file-name-unquote localname))) + (mapcar + (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string + (tramp-get-buffer-string (tramp-get-connection-buffer v)) + "\n" 'omit))))) (defun tramp-sudoedit-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5441a26d7a0..d67d77fadc6 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2002,12 +2002,11 @@ expected to be a string, which will be used." "Construct a Tramp hop name from VEC." (concat (tramp-file-name-hop vec) - (replace-regexp-in-string - tramp-prefix-regexp "" - (replace-regexp-in-string - (rx (regexp tramp-postfix-host-regexp) eos) - tramp-postfix-hop-format - (tramp-make-tramp-file-name (tramp-file-name-unify vec)))))) + (thread-last + (replace-regexp-in-string + (rx (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format + (tramp-make-tramp-file-name (tramp-file-name-unify vec))) + (replace-regexp-in-string tramp-prefix-regexp "")))) (defun tramp-completion-make-tramp-file-name (method user host localname) "Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME. @@ -2957,7 +2956,7 @@ not in completion mode." (or (and (cond ;; Completion styles like `flex' and `substring' check for ;; the file name "/". This does exist. - ((string-equal filename "/")) + ((string-equal filename tramp-prefix-format)) ;; Is it a valid method? ((and (not (string-empty-p tramp-postfix-method-format)) (string-match @@ -3001,30 +3000,59 @@ not in completion mode." (tramp-run-real-handler #'file-exists-p (list filename)))) +(defvar tramp-fnac-add-trailing-slash t + "Whether `file-name-all-completions' shall add a trailing slash. +This is not desired, if that function is used in `directory-files', or +in `tramp-completion-handle-file-name-all-completions'.") + (defmacro tramp-skeleton-file-name-all-completions (filename directory &rest body) "Skeleton for `tramp-*-handle-filename-all-completions'. BODY is the backend specific code." (declare (indent 2) (debug t)) `(ignore-error file-missing - (seq-uniq (delq nil (delete "" - (let* ((case-fold-search read-file-name-completion-ignore-case) - (result (progn ,@body))) - ;; Some storage systems do not return "." and "..". - (when (tramp-tramp-file-p ,directory) - (dolist (elt '(".." ".")) - (when (string-prefix-p ,filename elt) - (setq result (cons (concat elt "/") result))))) - (if (consp completion-regexp-list) - ;; Discriminate over `completion-regexp-list'. - (mapcar - (lambda (x) - (when (stringp x) - (catch 'match - (dolist (elt completion-regexp-list x) - (unless (string-match-p elt x) (throw 'match nil)))))) - result) - result))))))) + (all-completions + ,filename + (when (file-directory-p ,directory) + (seq-uniq (delq nil + (let* ((case-fold-search read-file-name-completion-ignore-case) + (result + (if (tramp-tramp-file-p ,directory) + (with-parsed-tramp-file-name + (expand-file-name ,directory) nil + (when (and (not (string-search "/" ,filename)) + (tramp-connectable-p v)) + (with-tramp-file-property + v localname + (format + "file-name-all-completions-%s" + tramp-fnac-add-trailing-slash) + ;; Mark symlinked directories. Other + ;; directories are already marked. + (mapcar + (lambda (x) + (let ((f (file-name-concat ,directory x))) + (if (and tramp-fnac-add-trailing-slash + (not (string-suffix-p "/" x)) + (file-directory-p + (if (file-symlink-p f) + (file-truename f) f))) + (concat x "/") x))) + ;; Some storage systems do not return "." and "..". + (seq-union + (seq-difference (progn ,@body) '("." "..")) + '("./" "../")))))) + ,@body))) + ;; Discriminate over `completion-regexp-list'. + (if (consp completion-regexp-list) + (mapcar + (lambda (x) + (when (stringp x) + (catch 'match + (dolist (elt completion-regexp-list x) + (unless (string-match-p elt x) (throw 'match nil)))))) + result) + result)))))))) (defvar tramp--last-hop-directory nil "Tracks the directory from which to run login programs.") @@ -3035,72 +3063,74 @@ BODY is the backend specific code." ;; completions. (defun tramp-completion-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for partial Tramp files." - (tramp-skeleton-file-name-all-completions filename directory - (let ((fullname - (tramp-drop-volume-letter (expand-file-name filename directory))) - (directory (tramp-drop-volume-letter directory)) - tramp--last-hop-directory hop result result1) + (let (tramp-fnac-add-trailing-slash) + (tramp-skeleton-file-name-all-completions filename directory + (let ((fullname + (tramp-drop-volume-letter (expand-file-name filename directory))) + (directory (tramp-drop-volume-letter directory)) + tramp--last-hop-directory hop result result1) + + ;; Suppress hop from completion. + (when (string-match + (rx + (regexp tramp-prefix-regexp) + (group (+ (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)))) + fullname) + (setq hop (match-string 1 fullname) + fullname (replace-match "" nil nil fullname 1) + tramp--last-hop-directory + (tramp-make-tramp-file-name (tramp-dissect-hop-name hop)))) + + (let (tramp-default-user tramp-default-user-alist + tramp-default-host tramp-default-host-alist) + + ;; Possible completion structures. + (dolist (elt (tramp-completion-dissect-file-name fullname)) + (let* ((method (tramp-file-name-method elt)) + (user (tramp-file-name-user elt)) + (host (tramp-file-name-host elt)) + (localname (tramp-file-name-localname elt)) + (m (tramp-find-method method user host)) + all-user-hosts) + + (unless localname ;; Nothing to complete. + (if (or user host) + ;; Method dependent user / host combinations. + (progn + (mapc + (lambda (x) + (setq all-user-hosts + (append all-user-hosts + (funcall (nth 0 x) (nth 1 x))))) + (tramp-get-completion-function m)) - ;; Suppress hop from completion. - (when (string-match - (rx - (regexp tramp-prefix-regexp) - (group (+ (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-hop-regexp)))) - fullname) - (setq hop (match-string 1 fullname) - fullname (replace-match "" nil nil fullname 1) - tramp--last-hop-directory - (tramp-make-tramp-file-name (tramp-dissect-hop-name hop)))) - - (let (tramp-default-user tramp-default-user-alist - tramp-default-host tramp-default-host-alist) - - ;; Possible completion structures. - (dolist (elt (tramp-completion-dissect-file-name fullname)) - (let* ((method (tramp-file-name-method elt)) - (user (tramp-file-name-user elt)) - (host (tramp-file-name-host elt)) - (localname (tramp-file-name-localname elt)) - (m (tramp-find-method method user host)) - all-user-hosts) - - (unless localname ;; Nothing to complete. - (if (or user host) - ;; Method dependent user / host combinations. - (progn - (mapc - (lambda (x) - (setq all-user-hosts - (append all-user-hosts - (funcall (nth 0 x) (nth 1 x))))) - (tramp-get-completion-function m)) - - (setq result - (append result - (mapcar - (lambda (x) - (tramp-get-completion-user-host - method user host (nth 0 x) (nth 1 x))) - all-user-hosts)))) - - ;; Possible methods. - (setq result - (append result (tramp-get-completion-methods m hop))))))) - - ;; Add hop. - (dolist (elt result) - (when elt - (setq elt (replace-regexp-in-string - tramp-prefix-regexp (concat tramp-prefix-format hop) elt)) - (push (substring elt (length directory)) result1))) - - ;; Complete local parts. - (append - result1 - (ignore-errors - (tramp-run-real-handler - #'file-name-all-completions (list filename directory)))))))) + (setq result + (append result + (mapcar + (lambda (x) + (tramp-get-completion-user-host + method user host (nth 0 x) (nth 1 x))) + all-user-hosts)))) + + ;; Possible methods. + (setq result + (append result (tramp-get-completion-methods m hop))))))) + + ;; Add hop. + (dolist (elt result) + (when elt + (setq elt (replace-regexp-in-string + tramp-prefix-regexp + (concat tramp-prefix-format hop) elt)) + (push (substring elt (length directory)) result1))) + + ;; Complete local parts. + (append + result1 + (ignore-errors + (tramp-run-real-handler + #'file-name-all-completions (list filename directory))))))))) ;; Method, host name and user name completion for a file. (defun tramp-completion-handle-file-name-completion @@ -3659,9 +3689,10 @@ BODY is the backend specific code." (signal 'error nil) (setf ,directory (file-name-as-directory (expand-file-name ,directory))) - (let ((temp - (with-tramp-file-property v localname "directory-files" ,@body)) - result item) + (let* (tramp-fnac-add-trailing-slash + (temp + (with-tramp-file-property v localname "directory-files" ,@body)) + result item) (while temp (setq item (directory-file-name (pop temp))) (when (or (null ,match) (string-match-p ,match item)) @@ -4496,8 +4527,8 @@ Let-bind it when necessary.") ;; "." and ".." are never interesting as completions, and are ;; actually in the way in a directory with only one file. See ;; file_name_completion() in dired.c. - (when (and (consp fnac) (length= (delete "./" (delete "../" fnac)) 1)) - (setq fnac (delete "./" (delete "../" fnac)))) + (when (and (consp fnac) (length= (seq-difference fnac '("./" "../")) 1)) + (setq fnac (seq-difference fnac '("./" "../")))) (or (try-completion filename fnac @@ -5487,7 +5518,7 @@ processes." v 'tramp-login-args nil ?h (or host "") ?u (or user "") ?p (or port "") ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) - ?d (or device "") ?a (or pta "") ?l "")))) + ?w "" ?d (or device "") ?a (or pta "") ?l "")))) ;; Suppress `internal-default-process-sentinel', which is set ;; when :sentinel is nil. (Bug#71049) p (make-process -- cgit v1.2.1 From a481b5807e134df69305268dd3407d0d1d8e06f5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 28 Mar 2026 09:54:40 +0100 Subject: Fix tramp-smb-handle-copy-file * lisp/net/tramp-smb.el (tramp-smb-handle-copy-file): Suppress `jka-compr-handler'. Reported by Seppo Ronkainen . (Bug#80667) --- lisp/net/tramp-smb.el | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index bda033b7838..8eec0e1bd08 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -603,12 +603,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (copy-directory filename newname keep-date 'parents 'copy-contents) (tramp-barf-if-file-missing v filename - ;; `file-local-copy' returns a file name also for a local - ;; file with `jka-compr-handler', so we cannot trust its - ;; result as indication for a remote file name. - (if-let* ((tmpfile - (and (tramp-tramp-file-p filename) - (file-local-copy filename)))) + ;; Suppress `jka-compr-handler'. + (if-let* ((jka-compr-inhibit t) + (tmpfile (file-local-copy filename))) ;; Remote filename. (condition-case err (rename-file tmpfile newname ok-if-already-exists) -- cgit v1.2.1 From f932a683e8163824931b11ba2b7b2271128223e5 Mon Sep 17 00:00:00 2001 From: Adam Sjøgren Date: Mon, 16 Mar 2026 21:08:31 +0100 Subject: Gnus: Accept date and time when specifying delay of a new article * lisp/gnus/gnus-delay.el (gnus-delay-article): Accept YYYY-MM-DD hh:mm(:ss) as a valid format. (Bug#80637) Copyright-paperwork-exempt: yes --- lisp/gnus/gnus-delay.el | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) (limited to 'lisp') diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index b8fefabacbb..e11977d6403 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -70,6 +70,9 @@ DELAY is a string, giving the length of the time. Possible values are: * YYYY-MM-DD for a specific date. The time of day is given by the variable `gnus-delay-default-hour', minute and second are zero. +* YYYY-MM-DD hh:mm(:ss) for a specific date and time. If seconds are left + out, they will be zero. + * hh:mm for a specific time. Use 24h format. If it is later than this time, then the deadline is tomorrow, else today. @@ -84,6 +87,19 @@ generated when the article is sent." (run-hooks 'message-send-hook) (let (num unit year month day hour minute deadline) ;; days (cond ((string-match + "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\) \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\):?\\([0-9]\\{2\\}\\)?" + delay) + (setq year (string-to-number (match-string 1 delay)) + month (string-to-number (match-string 2 delay)) + day (string-to-number (match-string 3 delay)) + hour (string-to-number (match-string 4 delay)) + minute (string-to-number (match-string 5 delay)) + second (if (match-string 6 delay) (string-to-number (match-string 6 delay)) 0)) + (setq deadline + (message-make-date + (encode-time second minute hour + day month year)))) + ((string-match "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)" delay) (setq year (string-to-number (match-string 1 delay)) -- cgit v1.2.1 From 74e771d816a994f9dd11249cc5bb9191a03e0dbd Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 28 Mar 2026 12:16:11 +0300 Subject: ; * lisp/gnus/gnus-delay.el (gnus-delay-article): Fix last change. --- lisp/gnus/gnus-delay.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index e11977d6403..d3088b4001f 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -70,7 +70,7 @@ DELAY is a string, giving the length of the time. Possible values are: * YYYY-MM-DD for a specific date. The time of day is given by the variable `gnus-delay-default-hour', minute and second are zero. -* YYYY-MM-DD hh:mm(:ss) for a specific date and time. If seconds are left +* YYYY-MM-DD hh:mm(:ss) for a specific date and time. If seconds are left out, they will be zero. * hh:mm for a specific time. Use 24h format. If it is later than this @@ -85,7 +85,7 @@ generated when the article is sent." message-mode) ;; Allow spell checking etc. (run-hooks 'message-send-hook) - (let (num unit year month day hour minute deadline) ;; days + (let (num unit year month day hour minute deadline second) ;; days (cond ((string-match "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\) \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\):?\\([0-9]\\{2\\}\\)?" delay) -- cgit v1.2.1 From f6c1421d1b6196e47b8e5f88913d646b98b2b6c2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 28 Mar 2026 13:13:19 +0300 Subject: Better support for anonymous faces in Enriched Text mode * lisp/textmodes/enriched.el (enriched-face-ans): Support :underline, :weight, and :slant in anonymous faces. Suggested by Madhu . --- lisp/textmodes/enriched.el | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'lisp') diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index a269cae0c9b..c5ae2a15557 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -390,6 +390,16 @@ which can be the value of the `face' text property." (list (list "x-color" (cadr face)))) ((and (listp face) (eq (car face) :background)) (list (list "x-bg-color" (cadr face)))) + ((and (listp face) (eq (car face) :underline)) + (list (list "underline"))) + ((and (listp face) + (eq (car face) :weight) + (eq (cadr face) 'bold)) + (list (list "bold"))) + ((and (listp face) + (eq (car face) :slant) + (memq (cadr face) '(italic oblique))) + (list (list "italic"))) ((listp face) (apply #'append (mapcar #'enriched-face-ans face))) ((let* ((fg (face-attribute face :foreground)) -- cgit v1.2.1 From 5346417d16a036418fd467f842e97a8bc7e21c63 Mon Sep 17 00:00:00 2001 From: Richard Lawrence Date: Tue, 16 Dec 2025 10:39:19 +0100 Subject: Update gnus-icalendar to use new iCalendar library This change updates gnus-icalendar.el to use the new iCalendar library instead of obsolete functions from icalendar.el. * lisp/gnus/gnus-icalendar.el (gnus-icalendar-event) (gnus-icalendar-event:recurring-p) (gnus-icalendar-event:recurring-interval) (gnus-icalendar-event:recurring-days) (gnus-icalendar-event--find-attendee) (gnus-icalendar-event-from-ical) (gnus-icalendar-event-from-buffer) (gnus-icalendar-event--build-reply) (gnus-icalendar-event-reply-from-buffer) (gnus-icalendar-event:org-repeat): Reimplement using new iCalendar functions. (gnus-icalendar-event--attendees-by-type): Rename from `gnus-icalendar-event--get-attendee-names'. (gnus-icalendar-event--build-reply): Rename from `gnus-icalendar-event--build-reply-event-body'. (gnus-icalendar--format-participant-list): Expect list of `icalendar-attendee's. Add docstring. (Bug#80426) * test/lisp/gnus/gnus-icalendar-tests.el: Update tests. --- lisp/gnus/gnus-icalendar.el | 472 +++++++++++++++++++------------------------- 1 file changed, 205 insertions(+), 267 deletions(-) (limited to 'lisp') diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index ad1c4c2731a..0097f590b43 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -36,6 +36,10 @@ ;;; Code: (require 'icalendar) +(require 'icalendar-parser) +(eval-when-compile (require 'icalendar-macs)) +(require 'icalendar-ast) +(require 'icalendar-utils) (require 'eieio) (require 'gmm-utils) (require 'mm-decode) @@ -82,8 +86,8 @@ :type (or null t)) (recur :initarg :recur :accessor gnus-icalendar-event:recur - :initform "" - :type (or null string)) + :initform nil + :type (or null list)) (uid :initarg :uid :accessor gnus-icalendar-event:uid :type string) @@ -127,295 +131,212 @@ (cl-defmethod gnus-icalendar-event:recurring-freq ((event gnus-icalendar-event)) "Return recurring frequency of EVENT." - (let ((rrule (gnus-icalendar-event:recur event))) - (string-match "FREQ=\\([[:alpha:]]+\\)" rrule) - (match-string 1 rrule))) + (ical:recur-freq (gnus-icalendar-event:recur event))) (cl-defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event)) "Return recurring interval of EVENT." - (let ((rrule (gnus-icalendar-event:recur event)) - (default-interval "1")) - - (if (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule) - (match-string 1 rrule) - default-interval))) + (ical:recur-interval-size (gnus-icalendar-event:recur event))) (cl-defmethod gnus-icalendar-event:recurring-days ((event gnus-icalendar-event)) "Return, when available, the week day numbers on which the EVENT recurs." - (let ((rrule (gnus-icalendar-event:recur event)) - (weekday-map '(("SU" . 0) - ("MO" . 1) - ("TU" . 2) - ("WE" . 3) - ("TH" . 4) - ("FR" . 5) - ("SA" . 6)))) - (when (and rrule (string-match "BYDAY=\\([^;]+\\)" rrule)) - (let ((bydays (split-string (match-string 1 rrule) ","))) - (seq-map - (lambda (x) (cdr (assoc x weekday-map))) - (seq-filter (lambda (x) (string-match "^[A-Z]\\{2\\}$" x)) bydays)))))) + (let ((rrule (gnus-icalendar-event:recur event))) + (when rrule + (mapcar (lambda (el) (if (consp el) (car el) el)) + (ical:recur-by* 'BYDAY rrule))))) (cl-defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event))) -(defun gnus-icalendar-event--decode-datefield (event field zone-map) - (let* ((dtdate (icalendar--get-event-property event field)) - (dtdate-zone (icalendar--find-time-zone - (icalendar--get-event-property-attributes - event field) zone-map)) - (dtdate-dec (icalendar--decode-isodatetime dtdate nil dtdate-zone))) - (when dtdate-dec (encode-time dtdate-dec)))) - -(defun gnus-icalendar-event--find-attendee (ical name-or-email) - (let* ((event (car (icalendar--all-events ical))) - (event-props (caddr event))) - (cl-labels ((attendee-name (att) (plist-get (cadr att) 'CN)) - (attendee-email - (att) - (replace-regexp-in-string "^.*MAILTO:" "" (caddr att))) - (attendee-prop-matches-p - (prop) - (and (eq (car prop) 'ATTENDEE) - (or (member (attendee-name prop) name-or-email) - (let ((att-email (attendee-email prop))) - (gnus-icalendar-find-if - (lambda (str-or-fun) - (if (functionp str-or-fun) - (funcall str-or-fun att-email) - (string-match str-or-fun att-email))) - name-or-email)))))) - (gnus-icalendar-find-if #'attendee-prop-matches-p event-props)))) - -(defun gnus-icalendar-event--get-attendee-names (ical) - (let* ((event (car (icalendar--all-events ical))) - (attendee-props (seq-filter - (lambda (p) (eq (car p) 'ATTENDEE)) - (caddr event)))) - - (cl-labels - ((attendee-role (prop) - ;; RFC5546: default ROLE is REQ-PARTICIPANT - (and prop - (or (plist-get (cadr prop) 'ROLE) - "REQ-PARTICIPANT"))) - (attendee-name - (prop) - (or (plist-get (cadr prop) 'CN) - (replace-regexp-in-string "^.*MAILTO:" "" (caddr prop)))) - (attendees-by-type (type) - (seq-filter - (lambda (p) (string= (attendee-role p) type)) - attendee-props)) - (attendee-names-by-type - (type) - (mapcar #'attendee-name (attendees-by-type type)))) - (list - (attendee-names-by-type "REQ-PARTICIPANT") - (attendee-names-by-type "OPT-PARTICIPANT"))))) - -(defun gnus-icalendar-event-from-ical (ical &optional attendee-name-or-email) - (let* ((event (car (icalendar--all-events ical))) - (organizer (replace-regexp-in-string - "^.*MAILTO:" "" - (or (icalendar--get-event-property event 'ORGANIZER) ""))) - (prop-map '((summary . SUMMARY) - (description . DESCRIPTION) - (location . LOCATION) - (recur . RRULE) - (uid . UID))) - (method (caddr (assoc 'METHOD (caddr (car (nreverse ical)))))) - (attendee (when attendee-name-or-email - (gnus-icalendar-event--find-attendee - ical attendee-name-or-email))) - (attendee-names (gnus-icalendar-event--get-attendee-names ical)) +(defun gnus-icalendar-event--find-attendee (attendees ids) + "Return the first `icalendar-attendee' in ATTENDEES matching IDS. +IDS should be a list of strings. The first attendee is returned whose +name (as `icalendar-cnparam') or email address (without \"mailto:\") +is a member of IDS." + (catch 'found + (dolist (attendee attendees) + (ical:with-property attendee ((ical:cnparam :value name)) + (let ((email (ical:strip-mailto value))) + (when (or (member name ids) + (member email ids)) + (throw 'found attendee))))))) + +(defun gnus-icalendar-event--attendees-by-type (attendees) + "Return lists of required and optional participants in ATTENDEES. +ATTENDEES must be a list of `icalendar-attendee' nodes. The returned +list has the form (REQUIRED OPTIONAL), where each is a list of +`icalendar-attendee' nodes." + (let (required optional) + (dolist (attendee attendees) + (ical:with-property attendee ((ical:roleparam :value role)) + (when (or (null role) ; "REQ-PARTICIPANT" is the default + (equal role "REQ-PARTICIPANT")) + (push attendee required)) + (when (equal role "OPT-PARTICIPANT") + (push attendee optional)))) + (list (nreverse required) + (nreverse optional)))) + +(defun gnus-icalendar-event-from-ical (vcalendar &optional ids) + "Initialize an event instance with the first `icalendar-vevent' in VCALENDAR. +IDS should be a list of strings representing names and email addresses +by which to identify an `icalendar-attendee' in the event as the +recipient." + (ical:with-component vcalendar + ((ical:vevent vevent) + (ical:method :value method)) + (ical:with-component vevent + ((ical:organizer :value organizer) + (ical:attendee :all attendees) + (ical:summary :value summary) + (ical:description :value description) + (ical:dtstart :value dtstart) + (ical:dtend :value dtend) + (ical:location :value location) + (ical:rrule :value rrule) + (ical:uid :value uid)) + + (let* ((attendee (when ids (gnus-icalendar-event--find-attendee attendees ids))) + (rsvp-p (ical:with-param-of attendee 'ical:rsvpparam)) ;; RFC5546: default ROLE is REQ-PARTICIPANT - (role (and attendee - (or (plist-get (cadr attendee) 'ROLE) - "REQ-PARTICIPANT"))) + (role (when attendee + (or (ical:with-param-of attendee 'ical:roleparam) + "REQ-PARTICIPANT"))) (participation-type (pcase role ("REQ-PARTICIPANT" 'required) ("OPT-PARTICIPANT" 'optional) (_ 'non-participant))) - (zone-map (icalendar--convert-all-timezones ical)) + (req/opt (gnus-icalendar-event--attendees-by-type attendees)) (args (list :method method - :organizer organizer - :start-time (gnus-icalendar-event--decode-datefield - event 'DTSTART zone-map) - :end-time (gnus-icalendar-event--decode-datefield - event 'DTEND zone-map) - :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE") + :organizer (when organizer (ical:strip-mailto organizer)) + :summary summary + :description description + :location location + :recur rrule + :start-time (encode-time dtstart) + :end-time (encode-time dtend) + :rsvp rsvp-p :participation-type participation-type - :req-participants (car attendee-names) - :opt-participants (cadr attendee-names))) - (event-class - (cond - ((string= method "REQUEST") 'gnus-icalendar-event-request) - ((string= method "CANCEL") 'gnus-icalendar-event-cancel) - ((string= method "REPLY") 'gnus-icalendar-event-reply) - (t 'gnus-icalendar-event)))) - (cl-labels - ((map-property - (prop) - (let ((value (icalendar--get-event-property event prop))) - (when value - ;; ugly, but cannot get - ;;replace-regexp-in-string work with "\\" as - ;;REP, plus we should also handle "\\;" - (string-replace - "\\," "," - (string-replace - "\\n" "\n" (substring-no-properties value)))))) - (accumulate-args - (mapping) - (cl-destructuring-bind (slot . ical-property) mapping - (setq args (append (list - (intern (concat ":" (symbol-name slot))) - (map-property ical-property)) - args))))) - (mapc #'accumulate-args prop-map) - (apply - #'make-instance - event-class - (cl-loop for slot in (eieio-class-slots event-class) - for keyword = (intern - (format ":%s" (eieio-slot-descriptor-name slot))) - when (plist-member args keyword) - append (list keyword - (if (eq keyword :uid) - ;; The UID has to be a string. - (or (plist-get args keyword) "") - (plist-get args keyword)))))))) - -(defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email) + :req-participants (car req/opt) + :opt-participants (cadr req/opt) + :uid (or uid ""))) ; UID must be a string + (event-class (pcase method + ("REQUEST" 'gnus-icalendar-event-request) + ("CANCEL" 'gnus-icalendar-event-cancel) + ("REPLY" 'gnus-icalendar-event-reply) + (_ 'gnus-icalendar-event)))) + ;; Initialize and return the instance: + (apply + #'make-instance + event-class + (cl-loop for slot in (eieio-class-slots event-class) + for keyword = (intern + (format ":%s" (eieio-slot-descriptor-name slot))) + when (plist-member args keyword) + append (list keyword (plist-get args keyword)))))))) + +(defun gnus-icalendar-event-from-buffer (buf &optional ids) "Parse RFC5545 iCalendar in buffer BUF and return an event object. Return a gnus-icalendar-event object representing the first event contained in the invitation. Return nil for calendars without an event entry. -ATTENDEE-NAME-OR-EMAIL is a list of strings that will be matched -against the event's attendee names and emails. Invitation rsvp -status will be retrieved from the first matching attendee record." - (let ((ical (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) - (goto-char (point-min)) - (icalendar--read-element nil nil)))) - - (when ical - (gnus-icalendar-event-from-ical ical attendee-name-or-email)))) +IDS is a list of strings that identify the recipient +`icalendar-attendee' by name or email address. Invitation rsvp status +will be retrieved from the first matching attendee record." + (let ((vcalendar (ical:parse buf))) + (when vcalendar + (gnus-icalendar-event-from-ical vcalendar ids)))) ;;; ;;; gnus-icalendar-event-reply ;;; -(defun gnus-icalendar-event--build-reply-event-body (ical-request status identities &optional comment) +(defun gnus-icalendar-event--build-reply (vcalendar status ids &optional comment) + "Return an `icalendar-vcalendar' based on VCALENDAR with updated STATUS. +STATUS should one of \\='accepted, \\='declined, or \\='tentative. The +recipient whose participation status is updated to STATUS is identified +in EVENT by finding an `icalendar-attendee' whose name or email address +matches one of the strings in IDS. If no such attendee is found, a new +`icalendar-attendee' is added from the values of `user-mail-address' and +`user-full-name'. COMMENT, if provided, will be added as an +`icalendar-comment' to the returned event." (let ((summary-status (capitalize (symbol-name status))) (attendee-status (upcase (symbol-name status))) - reply-event-lines) - (cl-labels - ((update-summary - (line) - (if (string-match "^[^:]+:" line) - (replace-match (format "\\&%s: " summary-status) t nil line) - line)) - (update-comment - (line) - (if comment (format "COMMENT:%s" comment) - line)) - (update-dtstamp () - (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) - (attendee-matches-identity - (line) - (gnus-icalendar-find-if (lambda (name) (string-match-p name line)) - identities)) - (update-attendee-status - (line) - (when (and (attendee-matches-identity line) - (string-match "\\(PARTSTAT=\\)[^;]+" line)) - (replace-match (format "\\1%s" attendee-status) t nil line))) - (process-event-line - (line) - (when (string-match "^\\([^;:]+\\)" line) - (let* ((key (match-string 0 line)) - ;; NOTE: not all of the below fields are mandatory, - ;; but they are often present in other clients' - ;; replies. Can be helpful for debugging, too. - (new-line - (cond - ((string= key "ATTENDEE") (update-attendee-status line)) - ((string= key "SUMMARY") (update-summary line)) - ((string= key "COMMENT") (update-comment line)) - ((string= key "DTSTAMP") (update-dtstamp)) - ((member key '("ORGANIZER" "DTSTART" "DTEND" - "LOCATION" "DURATION" "SEQUENCE" - "RECURRENCE-ID" "UID")) - line) - (t nil)))) - (when new-line - (push new-line reply-event-lines)))))) - - (mapc #'process-event-line (split-string ical-request "\n")) - - ;; RFC5546 refers to uninvited attendees as "party crashers". - ;; This situation is common if the invitation is sent to a group - ;; of people via a mailing list. - (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x)) - reply-event-lines) - (lwarn 'gnus-icalendar :warning - "Could not find an event attendee matching given identity") - (push (format "ATTENDEE;RSVP=TRUE;PARTSTAT=%s;CN=%s:MAILTO:%s" - attendee-status user-full-name user-mail-address) - reply-event-lines)) - - ;; add comment line if not existing - (when (and comment - (not (gnus-icalendar-find-if - (lambda (x) - (string-match "^COMMENT" x)) - reply-event-lines))) - (push (format "COMMENT:%s" comment) reply-event-lines)) - - (mapconcat #'identity `("BEGIN:VEVENT" - ,@(nreverse reply-event-lines) - "END:VEVENT") - "\n")))) - -(defun gnus-icalendar-event-reply-from-buffer (buf status identities &optional comment) + recipient) + (ical:with-component vcalendar + ((ical:vtimezone :all tz-nodes) + (ical:vevent :first vevent)) + (ical:with-component vevent + ((ical:summary :value summary) + (ical:attendee :all attendees) + (ical:uid :value uid) + (ical:comment :value old-comment) + ;; The nodes below are copied unchanged to the reply. Not all + ;; of them are mandatory, but they are often present in other + ;; clients' replies. Can be helpful for debugging, too. + (ical:organizer :first organizer-node) + (ical:dtstart :first dtstart-node) + (ical:dtend :first dtend-node) + (ical:duration :first duration-node) + (ical:location :first location-node) + (ical:sequence :first sequence-node) + (ical:recurrence-id :first recid-node)) + + (setq recipient (gnus-icalendar-event--find-attendee attendees ids)) + (if recipient + (ical:with-property recipient + ((ical:partstatparam :first partstat-node)) + (ical:ast-node-set-value partstat-node attendee-status)) + ;; RFC5546 refers to uninvited attendees as "party crashers". + ;; This situation is common if the invitation is sent to a group + ;; of people via a mailing list. + (lwarn 'gnus-icalendar :warning + "Could not find a matching event attendee; creating new.") + (setq recipient + (ical:make-property ical:attendee + (concat "mailto:" user-mail-address) + (ical:partstatparam attendee-status) + (ical:cnparam user-full-name))) + (push recipient attendees)) + + ;; Build the reply: + (ical:make-vcalendar + (ical:method "REPLY") + (@ tz-nodes) + (ical:vevent + (ical:uid uid) + recid-node + sequence-node + organizer-node + dtstart-node + dtend-node + duration-node + location-node + (ical:summary + (if (string-match "^[^:]+:" summary) + (replace-match (format "\\&%s: " summary-status) t nil summary) + summary)) + (ical:comment (or comment old-comment)) + (@ attendees))))))) + +(defun gnus-icalendar-event-reply-from-buffer (buf status ids + &optional comment) "Build a calendar event reply for request contained in BUF. -The reply will have STATUS (`accepted', `tentative' or `declined'). -The reply will be composed for attendees matching any entry -on the IDENTITIES list. -Optional argument COMMENT will be placed in the comment field of the -reply. -" - (cl-labels - ((extract-block - (blockname) - (save-excursion - (let ((block-start-re (format "^BEGIN:%s" blockname)) - (block-end-re (format "^END:%s" blockname)) - start) - (when (re-search-forward block-start-re nil t) - (setq start (line-beginning-position)) - (re-search-forward block-end-re) - (buffer-substring-no-properties start (line-end-position))))))) - (let (zone event) - (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) - (goto-char (point-min)) - (setq zone (extract-block "VTIMEZONE") - event (extract-block "VEVENT"))) - - (when event - (let ((contents (list "BEGIN:VCALENDAR" - "METHOD:REPLY" - "PRODID:Gnus" - "VERSION:2.0" - zone - (gnus-icalendar-event--build-reply-event-body event status identities comment) - "END:VCALENDAR"))) - - (mapconcat #'identity (delq nil contents) "\n")))))) +The reply will have STATUS (`accepted', `tentative' or `declined'). The +reply will be composed for attendees matching any entry in the +IDS list. Optional argument COMMENT will be placed in the +comment field of the reply." + (let (vcalendar reply) + (with-current-buffer (ical:unfolded-buffer-from-buffer (get-buffer buf)) + (setq vcalendar (ical:parse)) + (unless vcalendar + (error "Could not parse invitation; see buffer %s" + (buffer-name (ical:error-buffer)))) + (setq reply + (gnus-icalendar-event--build-reply vcalendar status ids comment)) + (ical:print-calendar-node reply)))) ;;; ;;; gnus-icalendar-org @@ -455,15 +376,17 @@ reply. "Return `org-mode' timestamp repeater string for recurring EVENT. Return nil for non-recurring EVENT." (when (gnus-icalendar-event:recurring-p event) - (let* ((freq-map '(("HOURLY" . "h") - ("DAILY" . "d") - ("WEEKLY" . "w") - ("MONTHLY" . "m") - ("YEARLY" . "y"))) - (org-freq (cdr (assoc (gnus-icalendar-event:recurring-freq event) freq-map)))) + (let* ((freq-map '((HOURLY . "h") + (DAILY . "d") + (WEEKLY . "w") + (MONTHLY . "m") + (YEARLY . "y"))) + (org-freq + (alist-get (gnus-icalendar-event:recurring-freq event) freq-map)) + (interval-size (gnus-icalendar-event:recurring-interval event))) (when org-freq - (format "+%s%s" (gnus-icalendar-event:recurring-interval event) org-freq))))) + (format "+%d%s" interval-size org-freq))))) (defun gnus-icalendar--find-day (start-date end-date day) (let ((time-1-day 86400)) @@ -550,7 +473,18 @@ Return nil for non-recurring EVENT." (defun gnus-icalendar--format-participant-list (participants) - (mapconcat #'identity participants ", ")) + "Format PARTICIPANTS as a comma-separated list. + +Each `icalendar-attendee' in PARTICIPANTS will be represented like + A. Person +or simply: , if no `icalendar-cnparam' is present." + (mapconcat + (lambda (attendee) + (ical:with-property attendee ((ical:cnparam :value cn)) + (if cn + (format "%s <%s>" cn value) + (format "<%s>" value)))) + participants ", ")) ;; TODO: make the template customizable (cl-defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status) @@ -1110,3 +1044,7 @@ means prompt for a comment to include in the reply." (provide 'gnus-icalendar) ;;; gnus-icalendar.el ends here + +;; Local Variables: +;; read-symbol-shorthands: (("ical:" . "icalendar-")) +;; End: -- cgit v1.2.1 From 85811885008693b1f74cd14eef935215e704f938 Mon Sep 17 00:00:00 2001 From: Ulrich Müller Date: Sat, 28 Mar 2026 14:06:26 +0100 Subject: Fix typos in char-acronym-table * lisp/international/characters.el (c0-acronyms): Fix #x1c "FS". (c1-acronyms): Fix #x8d "RI", #x8f "SS3", and #x9a "SCI". Leave #x99 alone because standards use both "SGCI" and "SGC". --- lisp/international/characters.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/international/characters.el b/lisp/international/characters.el index ba994daa852..d19802c46fd 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -1782,15 +1782,15 @@ Setup `char-width-table' appropriate for non-CJK language environment." (let ((c0-acronyms '("NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" "BEL" "BS" nil nil "VT" "FF" "CR" "SO" "SI" "DLE" "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB" - "CAN" "EM" "SUB" "ESC" "FC" "GS" "RS" "US"))) + "CAN" "EM" "SUB" "ESC" "FS" "GS" "RS" "US"))) (dotimes (i 32) (aset char-acronym-table i (car c0-acronyms)) (setq c0-acronyms (cdr c0-acronyms)))) (let ((c1-acronyms '("PAD" "HOP" "BPH" "NBH" "IND" "NEL" "SSA" "ESA" - "HTS" "HTJ" "VTS" "PLD" "PLU" "R1" "SS2" "SS1" + "HTS" "HTJ" "VTS" "PLD" "PLU" "RI" "SS2" "SS3" "DCS" "PU1" "PU2" "STS" "CCH" "MW" "SPA" "EPA" - "SOS" "SGCI" "SC1" "CSI" "ST" "OSC" "PM" "APC"))) + "SOS" "SGCI" "SCI" "CSI" "ST" "OSC" "PM" "APC"))) (dotimes (i 32) (aset char-acronym-table (+ #x0080 i) (car c1-acronyms)) (setq c1-acronyms (cdr c1-acronyms)))) -- cgit v1.2.1 From 9c75d761a570c0dff63886987448be507a658430 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 30 Mar 2026 08:18:00 +0200 Subject: Allow format specifiers in `tramp-login-program' * doc/misc/tramp.texi (Extension packages): Explain how to use own format specifiers. * lisp/net/tramp.el (tramp-expand-args): Make DEFAULT argument optional. Handle also ARGS being an atom. (tramp-handle-make-process): * lisp/net/tramp-container.el (tramp-skeleton-completion-function): * lisp/net/tramp-sh.el (tramp-ssh-or-plink-options) (tramp-maybe-open-connection): * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-process-file): Call `tramp-expand-args' for `tramp-login-program'. --- lisp/net/tramp-container.el | 9 ++++----- lisp/net/tramp-sh.el | 4 ++-- lisp/net/tramp-sshfs.el | 2 +- lisp/net/tramp.el | 18 ++++++++++-------- 4 files changed, 17 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 91d9b239a70..fec2e16a624 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -266,7 +266,7 @@ BODY is the backend specific code." tramp--last-hop-directory) tramp-compat-temporary-file-directory)) (program (let ((tramp-verbose 0)) - (tramp-get-method-parameter + (tramp-expand-args (make-tramp-file-name :method ,method) 'tramp-login-program))) (vec (when (tramp-tramp-file-p default-directory) @@ -656,10 +656,9 @@ see its function help for a description of the format." '((tramp-config-check . tramp-kubernetes--current-context-data) ;; This variable will be eval'ed in `tramp-expand-args'. (tramp-extra-expand-args - . (?a (tramp-kubernetes--container (car tramp-current-connection)) - ?h (tramp-kubernetes--pod (car tramp-current-connection)) - ?x (tramp-kubernetes--context-namespace - (car tramp-current-connection))))) + ?a (tramp-kubernetes--container (car tramp-current-connection)) + ?h (tramp-kubernetes--pod (car tramp-current-connection)) + ?x (tramp-kubernetes--context-namespace (car tramp-current-connection)))) "Default connection-local variables for remote kubernetes connections.") (connection-local-set-profile-variables diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 08a44c81f08..9aec9e38f65 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5037,7 +5037,7 @@ Goes through the list `tramp-inline-compress-commands'." ;; Use plink options. ((string-match-p (rx "plink" (? ".exe") eol) - (tramp-get-method-parameter vec 'tramp-login-program)) + (tramp-expand-args vec 'tramp-login-program)) (concat (if (eq tramp-use-connection-share 'suppress) "-noshare" "-share") @@ -5398,7 +5398,7 @@ connection if a previous connection has died for some reason." hop 'tramp-connection-timeout tramp-connection-timeout)) (command - (tramp-get-method-parameter + (tramp-expand-args hop 'tramp-login-program)) ;; We don't create the temporary file. In ;; fact, it is just a prefix for the diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 2cb5b5b1ed1..f4073158683 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -269,7 +269,7 @@ arguments to pass to the OPERATION." (setq ret (apply #'tramp-call-process - v (tramp-get-method-parameter v 'tramp-login-program) + v (tramp-expand-args v 'tramp-login-program) nil outbuf display (tramp-expand-args v 'tramp-login-args nil diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index d67d77fadc6..8b393e7a07f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -5325,7 +5325,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (defvar tramp-extra-expand-args nil "Method specific arguments.") -(defun tramp-expand-args (vec parameter default &rest spec-list) +(defun tramp-expand-args (vec parameter &optional default &rest spec-list) "Expand login arguments as given by PARAMETER in `tramp-methods'. PARAMETER is a symbol like `tramp-login-args', denoting a list of list of strings from `tramp-methods', containing %-sequences for @@ -5348,12 +5348,14 @@ a connection-local variable." (setq spec-list (cddr spec-list))) (setq spec (apply #'format-spec-make extra-spec-list)) ;; Expand format spec. - (flatten-tree - (mapcar - (lambda (x) - (setq x (mapcar (lambda (y) (tramp-format-spec y spec)) x)) - (unless (member "" x) x)) - args)))) + (if (atom args) + (tramp-format-spec args spec) + (flatten-tree + (mapcar + (lambda (x) + (setq x (mapcar (lambda (y) (tramp-format-spec y spec)) x)) + (unless (member "" x) x)) + args))))) (defun tramp-post-process-creation (proc vec) "Apply actions after creation of process PROC." @@ -5476,7 +5478,7 @@ processes." `(,(string-join command " "))) command)) (login-program - (tramp-get-method-parameter v 'tramp-login-program)) + (tramp-expand-args v 'tramp-login-program)) ;; We don't create the temporary file. In fact, it is just ;; a prefix for the ControlPath option of ssh; the real ;; temporary file has another name, and it is created and -- cgit v1.2.1 From d88bcc5e2e396ecbc13d207c58bc5c68acf7bb53 Mon Sep 17 00:00:00 2001 From: Stephen Gildea Date: Mon, 30 Mar 2026 08:40:56 -0700 Subject: ; time-stamp: doc strings updates * lisp/time-stamp.el (time-stamp-format): Spelling fix. (time-stamp-formatz-from-parsed-options): Document as internal. --- lisp/time-stamp.el | 60 ++++++++++++++++++++++++++++++------------------------ 1 file changed, 33 insertions(+), 27 deletions(-) (limited to 'lisp') diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index b7f72f2619c..671cf5a1547 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -53,7 +53,7 @@ with %, which are converted as follows: %H 24-hour clock hour %I 12-hour clock hour %m month number %M minute -%p meridian indicator: `AM', `PM' +%p meridiem indicator: `AM', `PM' %S seconds %w day number of week, Sunday is 0 %Y 4-digit year %y 2-digit year @@ -1039,39 +1039,45 @@ This is an internal function called by `time-stamp'." offset-secs) "Format a time offset according to a %z variation. -With no flags, the output includes hours and minutes: +-HHMM -unless there is a non-zero seconds part, in which case the seconds -are included: +-HHMMSS - -FLAG-MINIMIZE is whether \"-\" was specified. If non-nil, the -output may be limited to hours if minutes and seconds are zero. - -FLAG-PAD-SPACES-ONLY is whether \"_\" was specified. If non-nil, -seconds must be output, so that any padding can be spaces only. - -FLAG-PAD-ZEROS-FIRST is whether \"0\" was specified. If non-nil, -padding to the requested FIELD-WIDTH (if any) is done by adding -00 seconds before padding with spaces. - -COLON-COUNT is the number of colons preceding the \"z\" (0-3). One or -two colons put that many colons in the output (+-HH:MM or +-HH:MM:SS). -Three colons outputs only hours if minutes and seconds are zero and -includes colon separators if minutes and seconds are output. - -FIELD-WIDTH is a whole number giving the minimum number of characters -in the output; 0 specifies no minimum. Additional characters will be -added on the right if necessary. The added characters will be spaces -unless FLAG-PAD-ZEROS-FIRST is non-nil. - -OFFSET-SECS is the time zone offset (in seconds east of UTC) to be -formatted according to the preceding parameters. +Format parts FLAG-MINIMIZE, FLAG-PAD-SPACES-ONLY, +FLAG-PAD-ZEROS-FIRST, COLON-COUNT, and FIELD-WIDTH +are used to format time zone offset OFFSET-SECS. This is an internal function used by `time-stamp'." + ;; Callers of this function need to have already parsed the %z ;; format string; this function accepts just the parts of the format. ;; `time-stamp-string-preprocess' is the full-fledged parser normally ;; used. The unit test (in time-stamp-tests.el) defines the simpler ;; parser `format-time-offset'. + + ;; OFFSET-SECS is the time zone offset (in seconds east of UTC) to be + ;; formatted according to the following parameters. + + ;; FLAG-MINIMIZE is whether \"-\" was specified. If non-nil, the + ;; output may be limited to hours if minutes and seconds are zero. + + ;; FLAG-PAD-SPACES-ONLY is whether \"_\" was specified. If non-nil, + ;; seconds must be output, so that any padding can be spaces only. + + ;; FLAG-PAD-ZEROS-FIRST is whether \"0\" was specified. If non-nil, + ;; padding to the requested FIELD-WIDTH (if any) is done by adding + ;; 00 seconds before padding with spaces. + + ;; COLON-COUNT is the number of colons preceding the \"z\" (0-3). One or + ;; two colons put that many colons in the output (+-HH:MM or +-HH:MM:SS). + ;; Three colons outputs only hours if minutes and seconds are zero and + ;; includes colon separators if minutes and seconds are output. + + ;; FIELD-WIDTH is a whole number giving the minimum number of characters + ;; in the output; 0 specifies no minimum. Additional characters will be + ;; added on the right if necessary. The added characters will be spaces + ;; unless FLAG-PAD-ZEROS-FIRST is non-nil. + + ;; With no flags set, the output includes hours and minutes: +-HHMM + ;; unless there is a non-zero seconds part, in which case the seconds + ;; are included: +-HHMMSS + (let ((hrs (/ (abs offset-secs) 3600)) (mins (/ (% (abs offset-secs) 3600) 60)) (secs (% (abs offset-secs) 60)) -- cgit v1.2.1 From c1c08f3c9f6ffc6d113af3c0267c4ee5bfae72c0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 30 Mar 2026 13:05:15 -0400 Subject: (treesit--font-lock-level-setter): Work a bit more lazily * lisp/treesit.el (treesit--font-lock-level-setter): Use `font-lock-flush` (as discused in bug#80626). (treesit-font-lock-fontify-region): Simplify a bit. --- lisp/treesit.el | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index ebdd2367a52..5a1b9b287ae 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1437,8 +1437,7 @@ fontification is enabled." ;; `treesit-font-lock-recompute-features') is lost. (when treesit-font-lock-settings (treesit-font-lock-recompute-features) - (treesit-font-lock-fontify-region - (point-min) (point-max))))))) + (font-lock-flush)))))) (defcustom treesit-font-lock-level 3 "Decoration level to be used by tree-sitter fontifications. @@ -2050,9 +2049,8 @@ If LOUDLY is non-nil, display some debugging information." (pcase-let ((`(,max-depth ,max-width) (treesit-subtree-stat (treesit-buffer-root-node language)))) - (if (or (> max-depth 100) (> max-width 4000)) - (setq treesit--font-lock-fast-mode t) - (setq treesit--font-lock-fast-mode nil)))) + (setq treesit--font-lock-fast-mode + (or (> max-depth 100) (> max-width 4000))))) ;; Only activate if ENABLE flag is t. (when-let* -- cgit v1.2.1 From 38a6b22a6c92019939a154588086781cac19769d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 31 Mar 2026 10:01:15 +0200 Subject: Improve file name handler usage in epa-file.el * lisp/epa-file.el (epa-file-insert-file-contents): Handle other file name handlers. (Bug#80641) --- lisp/epa-file.el | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/epa-file.el b/lisp/epa-file.el index b2a89907867..34d9af33f63 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -232,7 +232,20 @@ encryption is used." (epa-file-decode-and-insert string file visit beg end replace)))) (if visit - (set-visited-file-modtime)))) + (set-visited-file-modtime))) + ;; The decoded file could still need another massage from a + ;; file name handler, for example a file like + ;; "folder.sym.tar.gz.gpg". (Bug#80641) + (when (find-file-name-handler + (file-name-sans-extension buffer-file-name) + 'insert-file-contents) + (let ((tmpfile (concat (make-temp-name temporary-file-directory) + (file-name-base buffer-file-name)))) + (let (file-name-handler-alist) (write-region nil nil tmpfile)) + (erase-buffer) + (insert-file-contents tmpfile) + (setq length (- (point-max) (point-min))) + (delete-file tmpfile)))) (if (and local-copy (file-exists-p local-copy)) (delete-file local-copy))) -- cgit v1.2.1 From f898d94c7b117b77f66d9472f9103961b5f6b6af Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 31 Mar 2026 20:10:56 +0200 Subject: * lisp/epa-file.el (epa-file-insert-file-contents): Fix last change. --- lisp/epa-file.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/epa-file.el b/lisp/epa-file.el index 34d9af33f63..6529f32273e 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -237,10 +237,10 @@ encryption is used." ;; file name handler, for example a file like ;; "folder.sym.tar.gz.gpg". (Bug#80641) (when (find-file-name-handler - (file-name-sans-extension buffer-file-name) + (file-name-sans-extension file) 'insert-file-contents) (let ((tmpfile (concat (make-temp-name temporary-file-directory) - (file-name-base buffer-file-name)))) + (file-name-base file)))) (let (file-name-handler-alist) (write-region nil nil tmpfile)) (erase-buffer) (insert-file-contents tmpfile) -- cgit v1.2.1 From cda65ffa58e1280fabfdf3eb7340f429b2aedd4d Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Tue, 31 Mar 2026 19:30:33 +0300 Subject: Add xref-edit-mode (bug#80616) Based on the existing grep-edit-mode code. * lisp/progmodes/xref.el (xref-edit--prepare-buffer): New function. (xref-edit-mode-map, xref-edit-mode-hook): New variables. (xref-edit-mode, xref-change-to-xref-edit-mode) (xref-edit-save-changes): New functions. (xref--xref-buffer-mode-map): New binding ("e"). * doc/emacs/maintaining.texi (Identifier Search): Mention xref-change-to-xref-edit-mode. * etc/NEWS: Describe the addition. --- lisp/progmodes/xref.el | 87 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) (limited to 'lisp') diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index ebf8df9f795..b69a4c7fdde 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -73,6 +73,7 @@ (require 'cl-lib) (require 'ring) (require 'project) +(require 'text-property-search) (eval-and-compile (when (version< emacs-version "28.0.60") @@ -1004,6 +1005,7 @@ point." (define-key map (kbd ".") #'xref-next-line) (define-key map (kbd ",") #'xref-prev-line) (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack) + (define-key map (kbd "e") #'xref-change-to-xref-edit-mode) map)) (declare-function outline-search-text-property "outline" @@ -1471,6 +1473,91 @@ between them by typing in the minibuffer with completion." 'xref--show-defs-minibuffer #'xref-show-definitions-completing-read "28.1") +(defun xref-edit--prepare-buffer () + "Mark relevant regions read-only, and add relevant occur text-properties." + (save-excursion + (goto-char (point-min)) + (let ((inhibit-read-only t) + match) + (while (setq match (text-property-search-forward 'xref-group)) + (add-text-properties (prop-match-beginning match) (prop-match-end match) + '(read-only t))) + (goto-char (point-min)) + (while (setq match (text-property-search-forward 'xref-item)) + (let ((line-number-end (save-excursion + (forward-line 0) + (and (looking-at " *[0-9]+:") + (match-end 0)))) + (m (xref-location-marker (xref-item-location (prop-match-value match ))))) + (when line-number-end + (add-text-properties (prop-match-beginning match) line-number-end + '(read-only t occur-prefix t))) + (add-text-properties (prop-match-beginning match) + (1+ (pos-eol)) + `(occur-target ((,m . ,m))))))))) + +(defvar xref-edit-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") #'xref-edit-save-changes) + (define-key map (kbd "RET") #'xref-goto-xref) + (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack) + (define-key map (kbd "C-o") #'xref-show-location-at-point) + map) + "Keymap for `xref-edit-mode'.") + +(defvar xref-edit-mode-hook nil + "Hooks run when changing to Xref-Edit mode.") + +(defun xref-edit-mode () + "Major mode for editing *xref* buffers. +In this mode, changes to the *xref* buffer are applied to the +originating files. +\\ +Type \\[xref-edit-save-changes] to exit Xref-Edit mode, return to Xref +mode. + +The only editable texts in an Xref-Edit buffer are the match results." + (interactive) + (error "This mode can be enabled only by `xref-change-to-xref-edit-mode'")) +(put 'xref-edit-mode 'mode-class 'special) + +(defun xref-change-to-xref-edit-mode () + "Switch to `xref-edit-mode' to edit *xref* buffer." + (interactive) + (unless (derived-mode-p 'xref--xref-buffer-mode) + (error "Not an Xref buffer")) + (use-local-map xref-edit-mode-map) + (xref-edit--prepare-buffer) + (setq buffer-read-only nil) + (setq major-mode 'xref-edit-mode) + (setq mode-name "Xref-Edit") + (buffer-enable-undo) + (set-buffer-modified-p nil) + (setq buffer-undo-list nil) + (add-hook 'after-change-functions #'occur-after-change-function nil t) + (run-mode-hooks 'xref-edit-mode-hook) + (message (substitute-command-keys + "Editing: Type \\[xref-edit-save-changes] to return to Xref mode"))) + +(defun xref-edit-save-changes () + "Switch back to Xref mode." + (interactive) + (unless (derived-mode-p 'xref-edit-mode) + (error "Not a Xref-Edit buffer")) + (remove-hook 'after-change-functions #'occur-after-change-function t) + (use-local-map xref--xref-buffer-mode-map) + (setq buffer-read-only t) + (setq major-mode 'xref--xref-buffer-mode) + (setq mode-name "XREF") + (force-mode-line-update) + (buffer-disable-undo) + (setq buffer-undo-list t) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) + '(occur-target nil occur-prefix nil))) + (message "Switching to Xref mode")) + + (defcustom xref-show-xrefs-function 'xref--show-xref-buffer "Function to display a list of search results. -- cgit v1.2.1 From aacf510fe5c6635f6b39bc0a3c19d6e973d2b591 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 1 Apr 2026 03:35:51 +0300 Subject: Change "XREF" to "Xref" in mode lighter * lisp/progmodes/xref.el (xref--xref-buffer-mode) (xref--transient-buffer-mode, xref-edit-save-changes): Change "XREF" to "Xref" for internal consistency. * doc/emacs/maintaining.texi (Xref Commands): Same. --- lisp/progmodes/xref.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index b69a4c7fdde..71599fc0e2b 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -629,7 +629,7 @@ If SELECT is non-nil, select the target window." (run-hooks 'xref-after-jump-hook))) -;;; XREF buffer (part of the UI) +;;; Xref buffer (part of the UI) ;; The xref buffer is used to display a set of xrefs. (defconst xref-buffer-name "*xref*" @@ -1011,7 +1011,7 @@ point." (declare-function outline-search-text-property "outline" (property &optional value bound move backward looking-at)) -(define-derived-mode xref--xref-buffer-mode special-mode "XREF" +(define-derived-mode xref--xref-buffer-mode special-mode "Xref" "Mode for displaying cross-references." (setq buffer-read-only t) (setq next-error-function #'xref--next-error-function) @@ -1041,7 +1041,7 @@ point." (define-derived-mode xref--transient-buffer-mode xref--xref-buffer-mode - "XREF Transient.") + "Xref Transient") (defun xref--imenu-prev-index-position () "Move point to previous line in `xref' buffer. @@ -1548,7 +1548,7 @@ The only editable texts in an Xref-Edit buffer are the match results." (use-local-map xref--xref-buffer-mode-map) (setq buffer-read-only t) (setq major-mode 'xref--xref-buffer-mode) - (setq mode-name "XREF") + (setq mode-name "Xref") (force-mode-line-update) (buffer-disable-undo) (setq buffer-undo-list t) -- cgit v1.2.1 From f55df442d3c03aeacfe137740ffc67c9880be8e1 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 1 Apr 2026 03:39:00 +0300 Subject: xref-edit-mode: Compute 'occur-target' markers lazily * lisp/progmodes/xref.el (xref-edit--before-change-function): New function (bug#80616). (xref-change-to-xref-edit-mode, xref-edit-save-changes): Use it in before-change-functions hook. (xref-edit--prepare-buffer): Don't add 'occur-target' here. --- lisp/progmodes/xref.el | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 71599fc0e2b..38199860c9e 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1487,14 +1487,10 @@ between them by typing in the minibuffer with completion." (let ((line-number-end (save-excursion (forward-line 0) (and (looking-at " *[0-9]+:") - (match-end 0)))) - (m (xref-location-marker (xref-item-location (prop-match-value match ))))) + (match-end 0))))) (when line-number-end (add-text-properties (prop-match-beginning match) line-number-end - '(read-only t occur-prefix t))) - (add-text-properties (prop-match-beginning match) - (1+ (pos-eol)) - `(occur-target ((,m . ,m))))))))) + '(read-only t occur-prefix t)))))))) (defvar xref-edit-mode-map (let ((map (make-sparse-keymap))) @@ -1534,6 +1530,7 @@ The only editable texts in an Xref-Edit buffer are the match results." (buffer-enable-undo) (set-buffer-modified-p nil) (setq buffer-undo-list nil) + (add-hook 'before-change-functions #'xref-edit--before-change-function nil t) (add-hook 'after-change-functions #'occur-after-change-function nil t) (run-mode-hooks 'xref-edit-mode-hook) (message (substitute-command-keys @@ -1544,6 +1541,7 @@ The only editable texts in an Xref-Edit buffer are the match results." (interactive) (unless (derived-mode-p 'xref-edit-mode) (error "Not a Xref-Edit buffer")) + (remove-hook 'before-change-functions #'xref-edit--before-change-function t) (remove-hook 'after-change-functions #'occur-after-change-function t) (use-local-map xref--xref-buffer-mode-map) (setq buffer-read-only t) @@ -1557,6 +1555,17 @@ The only editable texts in an Xref-Edit buffer are the match results." '(occur-target nil occur-prefix nil))) (message "Switching to Xref mode")) +(defun xref-edit--before-change-function (_beg _end) + (when (and (not (get-text-property (pos-bol) 'occur-target)) + (get-text-property (pos-bol) 'occur-prefix)) + (let ((m (xref-location-marker (xref-item-location + (get-text-property (pos-bol) 'xref-item)))) + (inhibit-read-only t) + (inhibit-modification-hooks t) + (buffer-undo-list t)) + (add-text-properties (pos-bol) (pos-eol) + `(occur-target ((,m . ,m))))))) + (defcustom xref-show-xrefs-function 'xref--show-xref-buffer "Function to display a list of search results. -- cgit v1.2.1 From 1e807c53766de295acabe7e88c0bd02b0c8924c9 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 1 Apr 2026 04:33:37 +0300 Subject: xref-edit--prepare-buffer: Fix text insertion behavior around prefix * lisp/progmodes/xref.el (xref-edit--prepare-buffer): Fix text insertion behavior before and after the line-number prefix. --- lisp/progmodes/xref.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 38199860c9e..8018e99e7f3 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1490,7 +1490,12 @@ between them by typing in the minibuffer with completion." (match-end 0))))) (when line-number-end (add-text-properties (prop-match-beginning match) line-number-end - '(read-only t occur-prefix t)))))))) + '( read-only t + occur-prefix t + ;; Allow insertion of text right + ;; after prefix, but not before. + front-sticky t + rear-nonsticky t)))))))) (defvar xref-edit-mode-map (let ((map (make-sparse-keymap))) -- cgit v1.2.1 From ded80d0d499cb3d61deaed6fa84d8850fc21c960 Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Wed, 1 Apr 2026 06:28:51 +0200 Subject: Fix text visibility issue with show-paren--show-context-in-overlay * lisp/paren.el (show-paren--show-context-in-overlay): Fix issue where the overlay's text was hardly visible in certain cases (bug#59527). --- lisp/paren.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/paren.el b/lisp/paren.el index 1ab3f9a32cf..10c72dadc79 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -434,9 +434,10 @@ It is the default value of `show-paren-data-function'." (overlay-put show-paren--context-overlay 'priority show-paren-priority) (overlay-put show-paren--context-overlay - 'face `(:box - ( :line-width (1 . -1) - :color ,(face-attribute 'shadow :foreground)))) + 'face `( :inherit default + :box + ( :line-width (1 . -1) + :color ,(face-attribute 'shadow :foreground)))) (add-hook 'post-command-hook #'show-paren--delete-context-overlay nil 'local)) -- cgit v1.2.1 From b90153d18c2645b5ea8a1660c88e273e5bb866d5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 1 Apr 2026 16:23:27 +0200 Subject: Make epa-file-insert-file-contents more secure * lisp/epa-file.el (epa-file-insert-file-contents): Use `make-temp-file' instead of `make-temp-name'. --- lisp/epa-file.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/epa-file.el b/lisp/epa-file.el index 6529f32273e..3b8f7c51c7d 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -239,8 +239,11 @@ encryption is used." (when (find-file-name-handler (file-name-sans-extension file) 'insert-file-contents) - (let ((tmpfile (concat (make-temp-name temporary-file-directory) - (file-name-base file)))) + (let ((tmpfile + (with-file-modes #o0600 + (make-temp-file + nil nil + (file-name-extension (file-name-base file) 'period))))) (let (file-name-handler-alist) (write-region nil nil tmpfile)) (erase-buffer) (insert-file-contents tmpfile) -- cgit v1.2.1 From 56df32fefaf591e35bb635bbb9f923e610c8b4d3 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 1 Apr 2026 16:48:09 +0200 Subject: Fix last change --- lisp/epa-file.el | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/epa-file.el b/lisp/epa-file.el index 3b8f7c51c7d..95202851544 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -240,10 +240,9 @@ encryption is used." (file-name-sans-extension file) 'insert-file-contents) (let ((tmpfile - (with-file-modes #o0600 - (make-temp-file - nil nil - (file-name-extension (file-name-base file) 'period))))) + (make-temp-file + nil nil + (file-name-extension (file-name-base file) 'period)))) (let (file-name-handler-alist) (write-region nil nil tmpfile)) (erase-buffer) (insert-file-contents tmpfile) -- cgit v1.2.1 From 985a674cee9f0c57af3bfe6b2780d0b1fa6348a2 Mon Sep 17 00:00:00 2001 From: João Távora Date: Wed, 1 Apr 2026 20:45:21 +0100 Subject: Eglot: revert part of last change * lisp/progmodes/eglot.el (eglot--sig-info): Go back to adding 1, so it's clear that parlabel's are off-by-one. --- lisp/progmodes/eglot.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index a4f076a6197..5ff44e92b79 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -4092,7 +4092,7 @@ for which LSP on-type-formatting should be requested." parameter ;; ...perhaps highlight it in the formals list (when (eq i active-param) - (save-excursion ;; FIXME: Sink into the `if' or hoist out of loop? + (save-excursion (goto-char (point-min)) (pcase-let ((`(,beg ,end) @@ -4100,8 +4100,7 @@ for which LSP on-type-formatting should be requested." (let ((case-fold-search nil)) (and (search-forward parlabel (line-end-position) t) (list (match-beginning 0) (match-end 0)))) - (list (+ (point-min) (aref parlabel 0)) - (+ (point-min) (aref parlabel 1)))))) + (list (1+ (aref parlabel 0)) (1+ (aref parlabel 1)))))) (if (and beg end) (add-face-text-property beg end -- cgit v1.2.1 From b93591551eba854967c3484481f6ff21ddfde793 Mon Sep 17 00:00:00 2001 From: João Távora Date: Wed, 1 Apr 2026 22:37:01 +0100 Subject: Eglot: release version 1.22 * lisp/progmodes/eglot.el (Version): Bump to 1.22. (Package-Requires): Bump eldoc to 1.16.0, flymake to 1.4.5, jsonrpc to 1.0.27, xref to 1.7.0. * etc/EGLOT-NEWS: Announce new version. --- lisp/progmodes/eglot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 5ff44e92b79..20df8bd62d3 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2,12 +2,12 @@ ;; Copyright (C) 2018-2026 Free Software Foundation, Inc. -;; Version: 1.21 +;; Version: 1.22 ;; Author: João Távora ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (eldoc "1.14.0") (external-completion "0.1") (flymake "1.4.2") (jsonrpc "1.0.26") (project "0.11.2") (seq "2.23") (xref "1.6.2")) +;; Package-Requires: ((emacs "26.3") (eldoc "1.16.0") (external-completion "0.1") (flymake "1.4.5") (jsonrpc "1.0.27") (project "0.11.2") (seq "2.23") (xref "1.7.0")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any -- cgit v1.2.1 From cdf3f811415ba49103c2a1ab9db564285dbdee1c Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 2 Apr 2026 11:53:08 +0100 Subject: Eglot: unbreak eglot-report-progress when set to 'messages' (bug#80653) * lisp/progmodes/eglot.el (eglot-mode-line-progress): Fix cl-loop thinko. --- lisp/progmodes/eglot.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 20df8bd62d3..a6d348edbbf 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2710,10 +2710,11 @@ still unanswered LSP requests to the server\n")))) (defconst eglot-mode-line-progress '(:eval - (when-let ((server (eglot-current-server))) + (when-let ((s (eglot-current-server))) (cl-loop - for pr hash-values of (eglot--progress-reporters server) - when (eq (car pr) 'eglot--mode-line-reporter) + for pr in (cl-delete 'eglot--mode-line-reporter + (hash-table-values (eglot--progress-reporters s)) + :key #'car :test-not #'eq) for v = (nth 4 pr) when v sum 1 into n and sum v into acc collect (format "(%s) %s %s" (nth 1 pr) (nth 2 pr) (nth 3 pr)) -- cgit v1.2.1 From f0fcc87a34c27f7d214107dc0a8d1ed96e6baf3b Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 2 Apr 2026 18:31:09 +0100 Subject: Jsonrpc: release version 1.0.28 (Version): Bump to 1.0.28. --- lisp/jsonrpc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index fca00dd2fc7..e8930fd2d4e 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -4,7 +4,7 @@ ;; Author: João Távora ;; Keywords: processes, languages, extensions -;; Version: 1.0.27 +;; Version: 1.0.28 ;; Package-Requires: ((emacs "25.2")) ;; This is a GNU ELPA :core package. Avoid functionality that is not -- cgit v1.2.1 From dc7c36ea1290c295f77ded998f72a0d9f992bef7 Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 2 Apr 2026 18:32:42 +0100 Subject: Eglot: release version 1.23 * lisp/progmodes/eglot.el (Version): Bump to 1.23. * etc/EGLOT-NEWS: Announce new version. --- lisp/progmodes/eglot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index a6d348edbbf..0e1ed519b43 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2,12 +2,12 @@ ;; Copyright (C) 2018-2026 Free Software Foundation, Inc. -;; Version: 1.22 +;; Version: 1.23 ;; Author: João Távora ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (eldoc "1.16.0") (external-completion "0.1") (flymake "1.4.5") (jsonrpc "1.0.27") (project "0.11.2") (seq "2.23") (xref "1.7.0")) +;; Package-Requires: ((emacs "26.3") (eldoc "1.16.0") (external-completion "0.1") (flymake "1.4.5") (jsonrpc "1.0.28") (project "0.11.2") (seq "2.23") (xref "1.7.0")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any -- cgit v1.2.1 From 5032b2167d462ee869ce43d004abef45a8490320 Mon Sep 17 00:00:00 2001 From: Roi Martin Date: Thu, 2 Apr 2026 16:21:25 +0200 Subject: Assume wide chars may span any number of columns during semlf filling * lisp/textmodes/fill.el (fill-region-as-paragraph-semlf): Use `most-positive-fixnum' as the fill-column value during the unfill phase. --- lisp/textmodes/fill.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 9445b4a6b9a..c1ccdf2ec5f 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -1700,7 +1700,7 @@ and URL `https://rhodesmill.org/brandon/2012/one-sentence-per-line/'." (to (copy-marker (max from to) t)) pfx) (goto-char from) - (let ((fill-column (* 2 (point-max)))) ; Wide characters span up to two columns. + (let ((fill-column most-positive-fixnum)) (setq pfx (or (save-excursion (fill-region-as-paragraph-default (point) to -- cgit v1.2.1 From faf1932875754c446361106cd8035c85fcc598f3 Mon Sep 17 00:00:00 2001 From: Stéphane Marks Date: Wed, 1 Apr 2026 06:58:18 -0400 Subject: New macro setopt-local and function set-local (bug#80709) 'setopt-local' is the buffer local equivalent of 'setopt'. Unify 'setopt', 'setopt-local', 'setq-local', 'buffer-local-set-state' with 'setq' to signal 'wrong-number-of-arguments'. * lisp/cus-edit.el (setopt): Change error signal to 'wrong-number-of-arguments'. (setopt-local): New macro. (setopt--set-local): New function. * lisp/subr.el (set-local): New function. (setq-local, buffer-local-set-state): Signal 'wrong-number-of-arguments' rather than 'error'. * doc/emacs/custom.texi (Examining): Document 'setopt-local'. * etc/NEWS: Announce the new macro and function. --- lisp/cus-edit.el | 48 +++++++++++++++++++++++++++++++++++++++++++++--- lisp/subr.el | 8 ++++++-- 2 files changed, 51 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 52677f435ee..87d8ecade54 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1084,7 +1084,7 @@ even if it doesn't match the type.) \(fn [VARIABLE VALUE]...)" (declare (debug setq)) (unless (evenp (length pairs)) - (error "PAIRS must have an even number of variable/value members")) + (signal 'wrong-number-of-arguments (list 'setopt (length pairs)))) (let ((expr nil)) (while pairs (unless (symbolp (car pairs)) @@ -1100,11 +1100,53 @@ even if it doesn't match the type.) ;; Check that the type is correct. (when-let* ((type (get variable 'custom-type))) (unless (widget-apply (widget-convert type) :match value) - (warn "Value `%S' for variable `%s' does not match its type \"%s\"" - value variable type))) + (warn "Value does not match %S's type `%S': %S" variable type value))) (put variable 'custom-check-value (list value)) (funcall (or (get variable 'custom-set) #'set-default) variable value)) +;;;###autoload +(defmacro setopt-local (&rest pairs) + "Set buffer local VARIABLE/VALUE pairs, and return the final VALUE. +This is like `setq-local', but is meant for user options instead of +plain variables. This means that `setopt-local' will execute any +`custom-set' form associated with VARIABLE. Unlike `setopt', +`setopt-local' does not affect a user option's global value. + +Note that `setopt-local' will emit a warning if the type of a VALUE does +not match the type of the corresponding VARIABLE as declared by +`defcustom'. (VARIABLE will be assigned the value even if it doesn't +match the type.) + +Signal an error if a `custom-set' form does not support the +`buffer-local' argument. + +\(fn [VARIABLE VALUE]...)" + (declare (debug setq)) + (unless (evenp (length pairs)) + (signal 'wrong-number-of-arguments (list 'setopt-local (length pairs)))) + (let ((expr nil)) + (while pairs + (unless (symbolp (car pairs)) + (error "Attempting to set a non-symbol: %s" (car pairs))) + (push `(setopt--set-local ',(car pairs) ,(cadr pairs)) + expr) + (setq pairs (cddr pairs))) + (macroexp-progn (nreverse expr)))) + +;;;###autoload +(defun setopt--set-local (variable value) + (custom-load-symbol variable) + ;; Check that the type is correct. + (when-let* ((type (get variable 'custom-type))) + (unless (widget-apply (widget-convert type) :match value) + (warn "Value does not match %S's type `%S': %S" variable type value))) + (condition-case _ + (funcall (or (get variable 'custom-set) + (lambda (x v &optional _) (set-local x v))) + variable value 'buffer-local) + (wrong-number-of-arguments + (error "The setter of %S does not support setopt-local" variable)))) + ;;;###autoload (defun customize-save-variable (variable value &optional comment) "Set the default for VARIABLE to VALUE, and save it for future sessions. diff --git a/lisp/subr.el b/lisp/subr.el index 7a5412d3fb7..b0e04bc5f99 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -160,6 +160,10 @@ of previous VARs. (push `(set-default ',(pop args) ,(pop args)) exps)) `(progn . ,(nreverse exps)))) +(defun set-local (variable value) + "Make VARIABLE buffer local and set it to VALUE." + (set (make-local-variable variable) value)) + (defmacro setq-local (&rest pairs) "Make each VARIABLE local to current buffer and set it to corresponding VALUE. @@ -181,7 +185,7 @@ In some corner cases you may need to resort to \(fn [VARIABLE VALUE]...)" (declare (debug setq)) (unless (evenp (length pairs)) - (error "PAIRS must have an even number of variable/value members")) + (signal 'wrong-number-of-arguments (list 'setq-local (length pairs)))) (let ((expr nil)) (while pairs (unless (symbolp (car pairs)) @@ -229,7 +233,7 @@ in order to restore the state of the local variables set via this macro. \(fn [VARIABLE VALUE]...)" (declare (debug setq)) (unless (evenp (length pairs)) - (error "PAIRS must have an even number of variable/value members")) + (signal 'wrong-number-of-arguments (list 'buffer-local-set-state (length pairs)))) (let ((vars nil) (tmp pairs)) (while tmp (push (car tmp) vars) (setq tmp (cddr tmp))) -- cgit v1.2.1 From e6d97dfbe1898f5de10a739dffe28c54c3611b92 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 2 Apr 2026 15:50:59 -0400 Subject: lisp/help.el (help-function-arglist): Handle advised aliases (bug#80725) --- lisp/help.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/help.el b/lisp/help.el index 49d4659ab02..1ff1f0c312d 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -2356,11 +2356,13 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." "Return a formal argument list for the function DEF. If PRESERVE-NAMES is non-nil, return a formal arglist that uses the same names as used in the original source code, when possible." - (let ((orig-def def) - ;; Advice wrappers have "catch all" args, so fetch the actual underlying - ;; function to find the real arguments. - (def (advice--cd*r - (indirect-function def)))) ;; Follow aliases to other symbols. + (let ((orig-def def)) + (let ((seen nil)) + ;; Advice wrappers have "catch all" args, so fetch the actual underlying + ;; function to find the real arguments. Also follow aliases. + (while (and (symbolp def) (not (memq def seen))) + (push def seen) + (setq def (advice--cd*r (indirect-function def))))) ;; If definition is a macro, find the function inside it. (if (eq (car-safe def) 'macro) (setq def (cdr def))) (cond -- cgit v1.2.1 From 99f2e353e7f1b169c52fe9cd767b97b175c88d13 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 2 Apr 2026 15:53:40 -0400 Subject: lisp/help.el (help-function-arglist): Fix last change --- lisp/help.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/help.el b/lisp/help.el index 1ff1f0c312d..1576fb61dc8 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -2360,7 +2360,7 @@ the same names as used in the original source code, when possible." (let ((seen nil)) ;; Advice wrappers have "catch all" args, so fetch the actual underlying ;; function to find the real arguments. Also follow aliases. - (while (and (symbolp def) (not (memq def seen))) + (while (not (memq def seen)) (push def seen) (setq def (advice--cd*r (indirect-function def))))) ;; If definition is a macro, find the function inside it. -- cgit v1.2.1 From 02c95dd92cebcb71436472ce544dda5bd32af1e4 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 2 Apr 2026 01:49:26 +0300 Subject: xref-edit--prepare-buffer: Prohibit insertion before group headers too * lisp/progmodes/xref.el (xref-edit--prepare-buffer): Do the previous change for group headers as well (no insertion in front). --- lisp/progmodes/xref.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 8018e99e7f3..2c21d08d448 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1481,7 +1481,8 @@ between them by typing in the minibuffer with completion." match) (while (setq match (text-property-search-forward 'xref-group)) (add-text-properties (prop-match-beginning match) (prop-match-end match) - '(read-only t))) + '( read-only t + front-sticky t))) (goto-char (point-min)) (while (setq match (text-property-search-forward 'xref-item)) (let ((line-number-end (save-excursion -- cgit v1.2.1 From 9d5a24cfac3a4e89b161ecedddbf68b83eb22f13 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 3 Apr 2026 04:38:59 +0300 Subject: grep-edit--prepare-buffer: Fix allowed insertion positions * lisp/progmodes/grep.el (grep-edit--prepare-buffer): Fix allowed insertion positions, like previously in xref-edit--prepare-buffer. --- lisp/progmodes/grep.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 128952a2dd4..72a05a082bb 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1089,11 +1089,15 @@ list is empty)." match) (while (setq match (text-property-search-forward 'compilation-annotation)) (add-text-properties (prop-match-beginning match) (prop-match-end match) - '(read-only t))) + '(read-only t front-sticky t))) (goto-char (point-min)) (while (setq match (text-property-search-forward 'compilation-message)) (add-text-properties (prop-match-beginning match) (prop-match-end match) - '(read-only t occur-prefix t)) + '( read-only t occur-prefix t + ;; Allow insertion of text right + ;; after prefix, but not before. + front-sticky t + rear-nonsticky t)) (let ((loc (compilation--message->loc (prop-match-value match))) m) ;; Update the markers if necessary. -- cgit v1.2.1 From 5fdeb3c881962c3fffb1806cf4352f342d8bcf6b Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Thu, 2 Apr 2026 23:30:08 -0700 Subject: Filter out some range settings in markdown-ts-mode * lisp/textmodes/markdown-ts-mode.el: (markdown-ts--add-config-for-mode): Filter out functional queries. --- lisp/textmodes/markdown-ts-mode.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/textmodes/markdown-ts-mode.el b/lisp/textmodes/markdown-ts-mode.el index cc3eaf03e15..657d6bc466d 100644 --- a/lisp/textmodes/markdown-ts-mode.el +++ b/lisp/textmodes/markdown-ts-mode.el @@ -40,6 +40,7 @@ (require 'treesit) (require 'subr-x) (require 'outline) +(require 'seq) (treesit-declare-unavailable-functions) @@ -296,7 +297,12 @@ the same features enabled in MODE." (plist-get configs :simple-indent))) (setq treesit-range-settings (append treesit-range-settings - (plist-get configs :range))) + ;; Filter out function queries, because they are + ;; usually some hack and might escape the code block. + ;; Case in point: c-ts-mode's range setting. + (seq-filter (lambda (setting) + (not (functionp (car setting)))) + (plist-get configs :range)))) (setq-local indent-line-function #'treesit-indent) (setq-local indent-region-function #'treesit-indent-region))) -- cgit v1.2.1 From 86efaec00e01af1e9171c7fa9eb7904af3be0eb3 Mon Sep 17 00:00:00 2001 From: Stéphane Marks Date: Thu, 2 Apr 2026 15:50:38 -0400 Subject: Support setopt-local in treesit--font-lock-level-setter (bug#80731) * lisp/treesit.el (treesit--font-lock-level-setter): Add buffer-local behavior as invoked by 'setopt-local'. --- lisp/treesit.el | 34 ++++++++++++++++++++++------------ 1 file changed, 22 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 5a1b9b287ae..227a930ba1d 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1423,21 +1423,31 @@ LANGUAGE is the language of QUERY.") (setf (nth 1 new-setting) t) new-setting)) -(defun treesit--font-lock-level-setter (sym val) +(defun treesit--font-lock-level-setter (sym val &optional buffer-local) "Custom setter for `treesit-font-lock-level'. Set the default value of SYM to VAL, recompute fontification features and refontify for every buffer where tree-sitter-based -fontification is enabled." - (set-default sym val) - (when (treesit-available-p) - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - ;; FIXME: This doesn't re-run major mode hooks, meaning any - ;; customization done in major mode hooks (e.g., with - ;; `treesit-font-lock-recompute-features') is lost. - (when treesit-font-lock-settings - (treesit-font-lock-recompute-features) - (font-lock-flush)))))) +fontification is enabled. + +If optional BUFFER-LOCAL is non-nil, only affect the current buffer. Set +SYM buffer locally and refontify." + ;; FIXME: This doesn't re-run major mode hooks, meaning any + ;; customization done in major mode hooks (e.g., with + ;; `treesit-font-lock-recompute-features') may be overridden. + (cond (buffer-local + (set-local sym val) + (when (and (treesit-available-p) + treesit-font-lock-settings) + (treesit-font-lock-recompute-features) + (font-lock-flush))) + (t + (set-default sym val) + (when (treesit-available-p) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when treesit-font-lock-settings + (treesit-font-lock-recompute-features) + (font-lock-flush)))))))) (defcustom treesit-font-lock-level 3 "Decoration level to be used by tree-sitter fontifications. -- cgit v1.2.1 From e19dd2d84814328fb6d4621e480aca5a34c332ab Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 3 Apr 2026 13:57:26 +0300 Subject: ; * lisp/treesit.el (treesit--font-lock-level-setter): Fix whitespace. --- lisp/treesit.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 227a930ba1d..14c05b0dd16 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1429,8 +1429,8 @@ Set the default value of SYM to VAL, recompute fontification features and refontify for every buffer where tree-sitter-based fontification is enabled. -If optional BUFFER-LOCAL is non-nil, only affect the current buffer. Set -SYM buffer locally and refontify." +If optional BUFFER-LOCAL is non-nil, only affect the current buffer. +Set SYM buffer locally and refontify." ;; FIXME: This doesn't re-run major mode hooks, meaning any ;; customization done in major mode hooks (e.g., with ;; `treesit-font-lock-recompute-features') may be overridden. -- cgit v1.2.1 From a5d6b9099960ad9e45874aac80a5af2384811c5d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 3 Apr 2026 15:44:38 +0300 Subject: ; Fix 2 defcustoms in printing.el * lisp/printing.el (pr-txt-printer-alist, pr-ps-printer-alist): Fix doc strings and :type. (Bug#80737) --- lisp/printing.el | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/printing.el b/lisp/printing.el index b6be982f5cb..3f31472d176 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1431,7 +1431,7 @@ COMMAND Name of the program for printing a text file. On MS-DOS and specially, using NAME as the destination for output; any other program is treated like `lpr' except that an explicit filename is given as the last argument. - If COMMAND is nil, it's used the default printing program: + If COMMAND is nil, it stands for the default printing program: `print' for Windows system, `lp' for lp system and `lpr' for all other systems. See also `pr-path-alist'. Examples: @@ -1506,7 +1506,10 @@ Useful links: :type '(repeat (list :tag "Text Printer" (symbol :tag "Printer Symbol Name") - (string :tag "Printer Command") + (choice :menu-tag "Printer Command" + :tag "Printer Command" + (const :tag "Default print command" nil) + (string :tag "Explicit print command")) (repeat :tag "Printer Switches" (sexp :tag "Switch" :value "")) (choice :menu-tag "Printer Name" @@ -1577,7 +1580,7 @@ COMMAND Name of the program for printing a PostScript file. On MS-DOS specially, using NAME as the destination for output; any other program is treated like `lpr' except that an explicit filename is given as the last argument. - If COMMAND is nil, it's used the default printing program: + If COMMAND is nil, it stands for the default printing program: `print' for Windows system, `lp' for lp system and `lpr' for all other systems. See also `pr-path-alist'. Examples: @@ -1756,7 +1759,10 @@ Useful links: (list :tag "PostScript Printer" (symbol :tag "Printer Symbol Name") - (string :tag "Printer Command") + (choice :menu-tag "Printer Command" + :tag "Printer Command" + (const :tag "Default print command" nil) + (string :tag "Explicit print command")) (repeat :tag "Printer Switches" (sexp :tag "Switch" :value "")) (choice :menu-tag "Printer Name Switch" -- cgit v1.2.1 From e7751405d024134a0073e0ac47caef2b71418a1b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 4 Apr 2026 09:56:32 +0300 Subject: ; Improve documentation of 'make-temp-file' * doc/lispref/files.texi (Unique File Names): * lisp/files.el (make-temp-file): * src/fileio.c (Fmake_temp_file_internal): Doc fixes. --- lisp/files.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/files.el b/lisp/files.el index ebbbd7ff1b6..e05a4b99497 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1790,7 +1790,10 @@ If DIR-FLAG is non-nil, create a new empty directory instead of a file. If SUFFIX is non-nil, add that at the end of the file name. If TEXT is a string, insert it into the new file; DIR-FLAG should be nil. -Otherwise the file will be empty." +Otherwise the file will be empty. + +On Posix systems, the file/directory is created with access mode bits +that limit access to the current user." (let ((absolute-prefix (if (or (zerop (length prefix)) (member prefix '("." ".."))) (concat (file-name-as-directory temporary-file-directory) prefix) -- cgit v1.2.1 From 6e7b254715f7119bdbc3546605c071afa944fed2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 4 Apr 2026 10:34:07 +0300 Subject: ; * lisp/international/emoji.el (emoji-list): Doc fix (bug#80733). --- lisp/international/emoji.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index d8e779f7d8d..56a8134be81 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -155,9 +155,13 @@ and also consults the `emoji-alternate-names' alist." ;;;###autoload (defun emoji-list () - "List emojis and allow selecting and inserting one of them. + "List Emoji and allow selecting and inserting one of them. +If you are displaying Emoji on a text-only terminal, and some +of them look incorrect, or there are display artifacts when +scrolling the display, turn off `auto-composition-mode'. + Select the emoji by typing \\\\[emoji-list-select] on its picture. -The glyph will be inserted into the buffer that was current +The selected glyph will be inserted into the buffer that was current when the command was invoked." (interactive) (let ((buf (current-buffer))) -- cgit v1.2.1 From 070d11ad0d3f1eb4b630e3f7df47ccc529f6882a Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 4 Apr 2026 10:27:30 +0200 Subject: * lisp/net/tramp.el (tramp-expand-args): Handle ARGS being nil. --- lisp/net/tramp.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8b393e7a07f..03089dffb55 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -5348,14 +5348,15 @@ a connection-local variable." (setq spec-list (cddr spec-list))) (setq spec (apply #'format-spec-make extra-spec-list)) ;; Expand format spec. - (if (atom args) - (tramp-format-spec args spec) + (cond + ((consp args) (flatten-tree (mapcar (lambda (x) (setq x (mapcar (lambda (y) (tramp-format-spec y spec)) x)) (unless (member "" x) x)) - args))))) + args))) + (args (tramp-format-spec args spec))))) (defun tramp-post-process-creation (proc vec) "Apply actions after creation of process PROC." @@ -5477,8 +5478,7 @@ processes." (tramp-get-method-parameter v 'tramp-direct-async) `(,(string-join command " "))) command)) - (login-program - (tramp-expand-args v 'tramp-login-program)) + (login-program (tramp-expand-args v 'tramp-login-program)) ;; We don't create the temporary file. In fact, it is just ;; a prefix for the ControlPath option of ssh; the real ;; temporary file has another name, and it is created and -- cgit v1.2.1 From b049078aef413a21a1fb4b6afa479ebb05b7a8c7 Mon Sep 17 00:00:00 2001 From: Arash Esbati Date: Wed, 25 Mar 2026 12:00:30 +0100 Subject: ; Fix quotation of some symbols * lisp/outline.el (outline-minor-mode-use-buttons) (outline-minor-mode-highlight): Fix quotation of some symbols (bug#80672). --- lisp/outline.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/outline.el b/lisp/outline.el index 4fb953b0f7c..ea66ee5c8e9 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -326,10 +326,10 @@ non-nil and point is located on the heading line.") (defcustom outline-minor-mode-use-buttons nil "Whether to display clickable buttons on the headings. These buttons can be used to hide and show the body under the heading. -When the value is `insert', additional placeholders for buttons are +When the value is \\+`insert', additional placeholders for buttons are inserted to the buffer, so buttons are not only clickable, but also typing `RET' on them can hide and show the body. -Using the value `insert' is not recommended in editable +Using the value \\+`insert' is not recommended in editable buffers because it modifies them. When the value is `in-margins', then clickable buttons are displayed in the margins before the headings. @@ -513,7 +513,7 @@ font-lock faces defined by the major mode. Thus, a non-nil value will work well only when there's no such conflict. If the value is t, use outline faces only if there are no major mode's font-lock faces on headings. When `override', completely overwrite major -mode's font-lock faces with outline faces. When `append', try to append +mode's font-lock faces with outline faces. When \\+`append', try to append outline font-lock faces to those of major mode." :type '(choice (const :tag "Do not use outline font-lock highlighting" nil) (const :tag "Overwrite major mode font-lock faces" override) -- cgit v1.2.1 From 524e8b007c49221e253a2a54971a3c988d662ea6 Mon Sep 17 00:00:00 2001 From: Jens Lechtenbörger Date: Sun, 29 Mar 2026 13:54:33 +0200 Subject: Avoid line breaks in IMAP AUTHENTICATE PLAIN * lisp/net/imap.el (imap-plain-auth): Avoid line breaks in AUTHENTICATE PLAIN command (bug#80687). --- lisp/net/imap.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/net/imap.el b/lisp/net/imap.el index bb298d11d3c..a09cd730c0f 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -870,7 +870,8 @@ t if it successfully authenticates, nil otherwise." (base64-encode-string (format "\000%s\000%s" (imap-quote-specials user) - (imap-quote-specials passwd))))))))) + (imap-quote-specials passwd)) + t))))))) (defun imap-anonymous-p (_buffer) t) -- cgit v1.2.1