diff options
Diffstat (limited to 'lisp')
177 files changed, 4531 insertions, 4520 deletions
diff --git a/lisp/allout.el b/lisp/allout.el index 7fcf41c4304..3981fdd785f 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -75,9 +75,6 @@ (declare-function epa-passphrase-callback-function "epa" (context key-id handback)) -;;;_* Dependency loads -(require 'overlay) - ;;;_* USER CUSTOMIZATION VARIABLES: ;;;_ > defgroup allout, allout-keybindings diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 6df935fef8a..340c926f8d6 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -117,8 +117,7 @@ This is set by the prefix argument to `buffer-menu' and related commands.") (defvar Buffer-menu-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap))) + (let ((map (make-sparse-keymap))) (set-keymap-parent map tabulated-list-mode-map) (define-key map "v" 'Buffer-menu-select) (define-key map "2" 'Buffer-menu-2-window) @@ -152,82 +151,63 @@ commands.") (define-key map [mouse-2] 'Buffer-menu-mouse-select) (define-key map [follow-link] 'mouse-face) - - (define-key map [menu-bar Buffer-menu-mode] (cons (purecopy "Buffer-Menu") menu-map)) - (bindings--define-key menu-map [quit] - '(menu-item "Quit" quit-window - :help "Remove the buffer menu from the display")) - (bindings--define-key menu-map [rev] - '(menu-item "Refresh" revert-buffer - :help "Refresh the *Buffer List* buffer contents")) - (bindings--define-key menu-map [s0] menu-bar-separator) - (bindings--define-key menu-map [tf] - '(menu-item "Show Only File Buffers" Buffer-menu-toggle-files-only - :button (:toggle . Buffer-menu-files-only) - :help "Toggle whether the current buffer-menu displays only file buffers")) - (bindings--define-key menu-map [s1] menu-bar-separator) - ;; FIXME: The "Select" entries could use better names... - (bindings--define-key menu-map [sel] - '(menu-item "Select Marked" Buffer-menu-select - :help "Select this line's buffer; also display buffers marked with `>'")) - (bindings--define-key menu-map [bm2] - '(menu-item "Select Two" Buffer-menu-2-window - :help "Select this line's buffer, with previous buffer in second window")) - (bindings--define-key menu-map [bm1] - '(menu-item "Select Current" Buffer-menu-1-window - :help "Select this line's buffer, alone, in full frame")) - (bindings--define-key menu-map [ow] - '(menu-item "Select in Other Window" Buffer-menu-other-window - :help "Select this line's buffer in other window, leaving buffer menu visible")) - (bindings--define-key menu-map [tw] - '(menu-item "Select in Current Window" Buffer-menu-this-window - :help "Select this line's buffer in this window")) - (bindings--define-key menu-map [s2] menu-bar-separator) - (bindings--define-key menu-map [is] - '(menu-item "Regexp Isearch Marked Buffers..." Buffer-menu-isearch-buffers-regexp - :help "Search for a regexp through all marked buffers using Isearch")) - (bindings--define-key menu-map [ir] - '(menu-item "Isearch Marked Buffers..." Buffer-menu-isearch-buffers - :help "Search for a string through all marked buffers using Isearch")) - (bindings--define-key menu-map [mo] - '(menu-item "Multi Occur Marked Buffers..." Buffer-menu-multi-occur - :help "Show lines matching a regexp in marked buffers using Occur")) - (bindings--define-key menu-map [s3] menu-bar-separator) - (bindings--define-key menu-map [by] - '(menu-item "Bury" Buffer-menu-bury - :help "Bury the buffer listed on this line")) - (bindings--define-key menu-map [vt] - '(menu-item "Set Unmodified" Buffer-menu-not-modified - :help "Mark buffer on this line as unmodified (no changes to save)")) - (bindings--define-key menu-map [ex] - '(menu-item "Execute" Buffer-menu-execute - :help "Save and/or delete buffers marked with s or k commands")) - (bindings--define-key menu-map [s4] menu-bar-separator) - (bindings--define-key menu-map [delb] - '(menu-item "Mark for Delete and Move Backwards" Buffer-menu-delete-backwards - :help "Mark buffer on this line to be deleted by x command and move up one line")) - (bindings--define-key menu-map [del] - '(menu-item "Mark for Delete" Buffer-menu-delete - :help "Mark buffer on this line to be deleted by x command")) - - (bindings--define-key menu-map [sv] - '(menu-item "Mark for Save" Buffer-menu-save - :help "Mark buffer on this line to be saved by x command")) - (bindings--define-key menu-map [umk] - '(menu-item "Unmark" Buffer-menu-unmark - :help "Cancel all requested operations on buffer on this line and move down")) - (bindings--define-key menu-map [umkab] - '(menu-item "Remove marks..." Buffer-menu-unmark-all-buffers - :help "Cancel a requested operation on all buffers")) - (bindings--define-key menu-map [umka] - '(menu-item "Unmark all" Buffer-menu-unmark-all - :help "Cancel all requested operations on buffers")) - (bindings--define-key menu-map [mk] - '(menu-item "Mark" Buffer-menu-mark - :help "Mark buffer on this line for being displayed by v command")) map) "Local keymap for `Buffer-menu-mode' buffers.") +(easy-menu-define Buffer-menu-mode-menu Buffer-menu-mode-map + "Menu for `Buffer-menu-mode' buffers." + '("Buffer-Menu" + ["Mark" Buffer-menu-mark + :help "Mark buffer on this line for being displayed by v command"] + ["Unmark all" Buffer-menu-unmark-all + :help "Cancel all requested operations on buffers"] + ["Remove marks..." Buffer-menu-unmark-all-buffers + :help "Cancel a requested operation on all buffers"] + ["Unmark" Buffer-menu-unmark + :help "Cancel all requested operations on buffer on this line and move down"] + ["Mark for Save" Buffer-menu-save + :help "Mark buffer on this line to be saved by x command"] + ["Mark for Delete" Buffer-menu-delete + :help "Mark buffer on this line to be deleted by x command"] + ["Mark for Delete and Move Backwards" Buffer-menu-delete-backwards + :help "Mark buffer on this line to be deleted by x command and move up one line"] + "---" + ["Execute" Buffer-menu-execute + :help "Save and/or delete buffers marked with s or k commands"] + ["Set Unmodified" Buffer-menu-not-modified + :help "Mark buffer on this line as unmodified (no changes to save)"] + ["Bury" Buffer-menu-bury + :help "Bury the buffer listed on this line"] + "---" + ["Multi Occur Marked Buffers..." Buffer-menu-multi-occur + :help "Show lines matching a regexp in marked buffers using Occur"] + ["Isearch Marked Buffers..." Buffer-menu-isearch-buffers + :help "Search for a string through all marked buffers using Isearch"] + ["Regexp Isearch Marked Buffers..." Buffer-menu-isearch-buffers-regexp + :help "Search for a regexp through all marked buffers using Isearch"] + "---" + ;; FIXME: The "Select" entries could use better names... + ["Select in Current Window" Buffer-menu-this-window + :help "Select this line's buffer in this window"] + ["Select in Other Window" Buffer-menu-other-window + :help "Select this line's buffer in other window, leaving buffer menu visible"] + ["Select Current" Buffer-menu-1-window + :help "Select this line's buffer, alone, in full frame"] + ["Select Two" Buffer-menu-2-window + :help "Select this line's buffer, with previous buffer in second window"] + ["Select Marked" Buffer-menu-select + :help "Select this line's buffer; also display buffers marked with `>'"] + "---" + ["Show Only File Buffers" Buffer-menu-toggle-files-only + :help "Toggle whether the current buffer-menu displays only file buffers" + :style toggle + :selected Buffer-menu-files-only] + "---" + ["Refresh" revert-buffer + :help "Refresh the *Buffer List* buffer contents"] + ["Quit" quit-window + :help "Remove the buffer menu from the display"])) + (define-derived-mode Buffer-menu-mode tabulated-list-mode "Buffer Menu" "Major mode for Buffer Menu buffers. The Buffer Menu is invoked by the commands \\[list-buffers], diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index f4ddb840b50..24781ed6c86 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -2565,9 +2565,9 @@ If X is not an error form, return 1." ;;; True if A is numerically equal to the integer B. [P N S] [Public] ;;; B must not be a multiple of 10. (defun math-equal-int (a b) - (or (eq a b) + (or (eql a b) (and (eq (car-safe a) 'float) - (eq (nth 1 a) b) + (eql (nth 1 a) b) (= (nth 2 a) 0)))) diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 3097b09b013..dd221457f83 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -1985,22 +1985,37 @@ Redefine the corresponding command." (cons 'quote (math-define-lambda (nth 1 exp) math-exp-env)) exp)) - ((memq func '(let let* for foreach)) - (let ((head (nth 1 exp)) - (body (cdr (cdr exp)))) - (if (memq func '(let let*)) - () - (setq func (cdr (assq func '((for . math-for) - (foreach . math-foreach))))) - (if (not (listp (car head))) - (setq head (list head)))) - (macroexpand - (cons func - (cons (math-define-let head) - (math-define-body body - (nconc - (math-define-let-env head) - math-exp-env))))))) + ((eq func 'let) + (let ((bindings (nth 1 exp)) + (body (cddr exp))) + `(let ,(math-define-let bindings) + ,@(math-define-body + body (append (math-define-let-env bindings) + math-exp-env))))) + ((eq func 'let*) + ;; Rewrite in terms of `let'. + (let ((bindings (nth 1 exp)) + (body (cddr exp))) + (math-define-exp + (if (> (length bindings) 1) + `(let ,(list (car bindings)) + (let* ,(cdr bindings) ,@body)) + `(let ,bindings ,@body))))) + ((memq func '(for foreach)) + (let ((bindings (nth 1 exp)) + (body (cddr exp))) + (if (> (length bindings) 1) + ;; Rewrite as nested loops. + (math-define-exp + `(,func ,(list (car bindings)) + (,func ,(cdr bindings) ,@body))) + (let ((mac (cdr (assq func '((for . math-for) + (foreach . math-foreach)))))) + (macroexpand + `(,mac ,(math-define-let bindings) + ,@(math-define-body + body (append (math-define-let-env bindings) + math-exp-env)))))))) ((and (memq func '(setq setf)) (math-complicated-lhs (cdr exp))) (if (> (length exp) 3) @@ -2017,7 +2032,7 @@ Redefine the corresponding command." (math-define-cond (cdr exp)))) ((and (consp func) ; ('spam a b) == force use of plain spam (eq (car func) 'quote)) - (cons func (math-define-list (cdr exp)))) + (cons (cadr func) (math-define-list (cdr exp)))) ((symbolp func) (let ((args (math-define-list (cdr exp))) (prim (assq func math-prim-funcs))) @@ -2276,20 +2291,16 @@ Redefine the corresponding command." (defun math-handle-foreach (head body) (let ((var (nth 0 (car head))) + (loop-var (gensym "foreach")) (data (nth 1 (car head))) (body (if (cdr head) (list (math-handle-foreach (cdr head) body)) body))) - (cons 'let - (cons (list (list var data)) - (list - (cons 'while - (cons var - (append body - (list (list 'setq - var - (list 'cdr var))))))))))) - + `(let ((,loop-var ,data)) + (while ,loop-var + (let ((,var (car ,loop-var))) + ,@(append body + `((setq ,loop-var (cdr ,loop-var))))))))) (defun math-body-refers-to (body thing) (or (equal body thing) diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el index 75a69db0a8c..4d4a9f78d5d 100644 --- a/lisp/cedet/cedet-cscope.el +++ b/lisp/cedet/cedet-cscope.el @@ -26,8 +26,6 @@ ;;; Code: -(declare-function inversion-check-version "inversion") - (defvar cedet-cscope-min-version "15.7" "Minimum version of CScope required.") @@ -139,7 +137,6 @@ If optional programmatic argument NOERROR is non-nil, then instead of throwing an error if CScope isn't available, return nil." (interactive) - (require 'inversion) (let ((b (condition-case nil (cedet-cscope-call (list "-V")) (error nil))) @@ -153,7 +150,7 @@ return nil." (goto-char (point-min)) (re-search-forward "cscope: version \\([0-9.]+\\)" nil t) (setq rev (match-string 1)) - (if (inversion-check-version rev nil cedet-cscope-min-version) + (if (version< rev cedet-cscope-min-version) (if noerror nil (error "Version of CScope is %s. Need at least %s" diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el index 5878ec1f485..77b44744399 100644 --- a/lisp/cedet/cedet-global.el +++ b/lisp/cedet/cedet-global.el @@ -24,8 +24,6 @@ ;; ;; Basic support for calling GNU Global, and testing version numbers. -(declare-function inversion-check-version "inversion") - (defvar cedet-global-min-version "5.0" "Minimum version of GNU Global required.") @@ -143,7 +141,6 @@ If optional programmatic argument NOERROR is non-nil, then instead of throwing an error if Global isn't available, return nil." (interactive) - (require 'inversion) (let ((b (condition-case nil (cedet-gnu-global-call (list "--version")) (error nil))) @@ -157,7 +154,7 @@ return nil." (goto-char (point-min)) (re-search-forward "(?GNU GLOBAL)? \\([0-9.]+\\)" nil t) (setq rev (match-string 1)) - (if (inversion-check-version rev nil cedet-global-min-version) + (if (version< rev cedet-global-min-version) (if noerror nil (error "Version of GNU Global is %s. Need at least %s" diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el index fc5e05af88e..3e3d6a5e949 100644 --- a/lisp/cedet/cedet-idutils.el +++ b/lisp/cedet/cedet-idutils.el @@ -29,8 +29,6 @@ ;;; Code: -(declare-function inversion-check-version "inversion") - (defvar cedet-idutils-min-version "4.0" "Minimum version of ID Utils required.") @@ -167,7 +165,6 @@ If optional programmatic argument NOERROR is non-nil, then instead of throwing an error if Global isn't available, return nil." (interactive) - (require 'inversion) (let ((b (condition-case nil (cedet-idutils-fnid-call (list "--version")) (error nil))) @@ -182,7 +179,7 @@ return nil." (if (re-search-forward "fnid - \\([0-9.]+\\)" nil t) (setq rev (match-string 1)) (setq rev "0")) - (if (inversion-check-version rev nil cedet-idutils-min-version) + (if (version< rev cedet-idutils-min-version) (if noerror nil (error "Version of ID Utils is %s. Need at least %s" diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el index caaec473a2c..5d98a1939d7 100644 --- a/lisp/cedet/cedet.el +++ b/lisp/cedet/cedet.el @@ -85,6 +85,7 @@ for the specified PACKAGE. LOADED VERSION is the version of PACKAGE currently loaded in Emacs memory and (presumably) running in this Emacs instance. Value is X if the package has not been loaded." + (declare (obsolete emacs-version "28.1")) (interactive) (require 'inversion) (with-output-to-temp-buffer "*CEDET*" diff --git a/lisp/cedet/ede/custom.el b/lisp/cedet/ede/custom.el index aada872cd0a..a128f9e1241 100644 --- a/lisp/cedet/ede/custom.el +++ b/lisp/cedet/ede/custom.el @@ -53,7 +53,7 @@ (setq-local eieio-ede-old-variables ov))) ;;;###autoload -(defalias 'customize-project 'ede-customize-project) +(defalias 'customize-project #'ede-customize-project) ;;;###autoload (defun ede-customize-current-target() @@ -65,7 +65,7 @@ (ede-customize-target ede-object)) ;;;###autoload -(defalias 'customize-target 'ede-customize-current-target) +(defalias 'customize-target #'ede-customize-current-target) (defun ede-customize-target (obj) "Edit fields of the current target through EIEIO & Custom. diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el index 7eb42ed9de8..8b9eae0b430 100644 --- a/lisp/cedet/ede/dired.el +++ b/lisp/cedet/ede/dired.el @@ -30,7 +30,6 @@ ;;; Code: -(require 'easymenu) (require 'dired) (require 'ede) diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el index 4f86558c626..d9811ce52f9 100644 --- a/lisp/cedet/ede/make.el +++ b/lisp/cedet/ede/make.el @@ -30,8 +30,6 @@ ;;; Code: -(declare-function inversion-check-version "inversion") - (defsubst ede--find-executable (exec) "Return an expanded file name for a program EXEC on the exec path." (declare (obsolete locate-file "28.1")) @@ -60,8 +58,7 @@ If NOERROR is nil, then throw an error on failure. Return t otherwise." (let ((b (get-buffer-create "*EDE Make Version*")) (cd default-directory) (rev nil) - (ans nil) - ) + (ans nil)) (with-current-buffer b ;; Setup, and execute make. (setq default-directory cd) @@ -70,18 +67,18 @@ If NOERROR is nil, then throw an error on failure. Return t otherwise." "--version") ;; Check the buffer for the string (goto-char (point-min)) - (when (looking-at "GNU Make\\(?: version\\)? \\([0-9][^,]+\\),") + (when (looking-at "GNU Make\\(?: version\\)? \\([0-9][^,[:space:]]+\\),?") (setq rev (match-string 1)) - (require 'inversion) - (setq ans (not (inversion-check-version rev nil ede-make-min-version)))) + (setq ans (not (version< rev ede-make-min-version)))) ;; Answer reporting. (when (and (called-interactively-p 'interactive) ans) (message "GNU Make version %s. Good enough for CEDET." rev)) (when (and (not noerror) (not ans)) - (error "EDE requires GNU Make version %s or later. Configure `ede-make-command' to fix" - ede-make-min-version)) + (error "EDE requires GNU Make version %s or later (found %s). Configure `ede-make-command' to fix" + ede-make-min-version + rev)) ans))) (provide 'ede/make) diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 44bd4b0cd82..797ff753a6c 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -57,6 +57,7 @@ excluded if a released version is required. It is assumed that if the current version is newer than that specified, everything passes. Exceptions occur when known incompatibilities are introduced." + (declare (obsolete emacs-version "28.1")) (require 'inversion) (inversion-test 'semantic (concat major "." minor diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el index c0a054dafc3..1a4be11c789 100644 --- a/lisp/cedet/semantic/analyze.el +++ b/lisp/cedet/semantic/analyze.el @@ -1,4 +1,4 @@ -;;; semantic/analyze.el --- Analyze semantic tags against local context +;;; semantic/analyze.el --- Analyze semantic tags against local context -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc. @@ -167,7 +167,7 @@ of the parent function.") ;; Simple methods against the context classes. ;; (cl-defmethod semantic-analyze-type-constraint - ((context semantic-analyze-context) &optional desired-type) + ((_context semantic-analyze-context) &optional desired-type) "Return a type constraint for completing :prefix in CONTEXT. Optional argument DESIRED-TYPE may be a non-type tag to analyze." (when (semantic-tag-p desired-type) @@ -344,8 +344,8 @@ This function knows of flags: (setq tagtype (cons tmptype tagtype)) (when miniscope (let ((rawscope - (apply 'append - (mapcar 'semantic-tag-type-members tagtype)))) + (apply #'append + (mapcar #'semantic-tag-type-members tagtype)))) (oset miniscope fullscope rawscope))) ) (setq s (cdr s))) @@ -437,6 +437,8 @@ to provide a large number of non-cached analysis for filtering symbols." (:override))) ) +(defvar semantic--prefixtypes) + (defun semantic-analyze-current-symbol-default (analyzehookfcn position) "Call ANALYZEHOOKFCN on the analyzed symbol at POSITION." (let* ((semantic-analyze-error-stack nil) @@ -453,14 +455,14 @@ to provide a large number of non-cached analysis for filtering symbols." (catch 'unfindable ;; If debug on error is on, allow debugging in this fcn. (setq prefix (semantic-analyze-find-tag-sequence - prefix scope 'prefixtypes 'unfindable))) + prefix scope 'semantic--prefixtypes 'unfindable))) ;; Debug on error is off. Capture errors and move on (condition-case err ;; NOTE: This line is duplicated in ;; semantic-analyzer-debug-global-symbol ;; You will need to update both places. (setq prefix (semantic-analyze-find-tag-sequence - prefix scope 'prefixtypes)) + prefix scope 'semantic--prefixtypes)) (error (semantic-analyze-push-error err)))) ;;(message "Analysis took %.2f sec" (semantic-elapsed-time LLstart nil)) @@ -531,7 +533,7 @@ Returns an object based on symbol `semantic-analyze-context'." (bounds (nth 2 prefixandbounds)) ;; @todo - vv too early to really know this answer! vv (prefixclass (semantic-ctxt-current-class-list)) - (prefixtypes nil) + (semantic--prefixtypes nil) (scope (semantic-calculate-scope position)) (function nil) (fntag nil) @@ -611,13 +613,13 @@ Returns an object based on symbol `semantic-analyze-context'." (if debug-on-error (catch 'unfindable (setq prefix (semantic-analyze-find-tag-sequence - prefix scope 'prefixtypes 'unfindable)) + prefix scope 'semantic--prefixtypes 'unfindable)) ;; If there's an alias, dereference it and analyze ;; sequence again. (when (setq newseq (semantic-analyze-dereference-alias prefix)) (setq prefix (semantic-analyze-find-tag-sequence - newseq scope 'prefixtypes 'unfindable)))) + newseq scope 'semantic--prefixtypes 'unfindable)))) ;; Debug on error is off. Capture errors and move on (condition-case err ;; NOTE: This line is duplicated in @@ -625,11 +627,11 @@ Returns an object based on symbol `semantic-analyze-context'." ;; You will need to update both places. (progn (setq prefix (semantic-analyze-find-tag-sequence - prefix scope 'prefixtypes)) + prefix scope 'semantic--prefixtypes)) (when (setq newseq (semantic-analyze-dereference-alias prefix)) (setq prefix (semantic-analyze-find-tag-sequence - newseq scope 'prefixtypes)))) + newseq scope 'semantic--prefixtypes)))) (error (semantic-analyze-push-error err)))) ) @@ -650,7 +652,7 @@ Returns an object based on symbol `semantic-analyze-context'." :prefix prefix :prefixclass prefixclass :bounds bounds - :prefixtypes prefixtypes + :prefixtypes semantic--prefixtypes :errors semantic-analyze-error-stack))) ;; No function, try assignment @@ -670,7 +672,7 @@ Returns an object based on symbol `semantic-analyze-context'." :bounds bounds :prefix prefix :prefixclass prefixclass - :prefixtypes prefixtypes + :prefixtypes semantic--prefixtypes :errors semantic-analyze-error-stack))) ;; TODO: Identify return value condition. @@ -686,7 +688,7 @@ Returns an object based on symbol `semantic-analyze-context'." :bounds bounds :prefix prefix :prefixclass prefixclass - :prefixtypes prefixtypes + :prefixtypes semantic--prefixtypes :errors semantic-analyze-error-stack))) (t (setq context-return nil)) @@ -750,7 +752,7 @@ Some useful functions are found in `semantic-format-tag-functions'." :group 'semantic :type semantic-format-tag-custom-list) -(defun semantic-analyze-princ-sequence (sequence &optional prefix buff) +(defun semantic-analyze-princ-sequence (sequence &optional prefix _buff) "Send the tag SEQUENCE to standard out. Use PREFIX as a label. Use BUFF as a source of override methods." diff --git a/lisp/cedet/semantic/analyze/complete.el b/lisp/cedet/semantic/analyze/complete.el index e8139ab1aea..ccf405d62e2 100644 --- a/lisp/cedet/semantic/analyze/complete.el +++ b/lisp/cedet/semantic/analyze/complete.el @@ -1,4 +1,4 @@ -;;; semantic/analyze/complete.el --- Smart Completions +;;; semantic/analyze/complete.el --- Smart Completions -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -45,7 +45,7 @@ "For the tag TYPE, return any constant symbols of TYPE. Used as options when completing.") -(defun semantic-analyze-type-constants-default (type) +(defun semantic-analyze-type-constants-default (_type) "Do nothing with TYPE." nil) @@ -54,7 +54,7 @@ Used as options when completing.") (let ((origc tags)) ;; Accept only tags that are of the datatype specified by ;; the desired classes. - (setq tags (apply 'nconc ;; All input lists are permutable. + (setq tags (apply #'nconc ;; All input lists are permutable. (mapcar (lambda (class) (semantic-find-tags-by-class class origc)) classlist))) @@ -109,6 +109,8 @@ in a buffer." (when (called-interactively-p 'any) (error "Buffer was not parsed by Semantic.")))) +(defvar semantic--prefixtypes) + (defun semantic-analyze-possible-completions-default (context &optional flags) "Default method for producing smart completions. Argument CONTEXT is an object specifying the locally derived context. @@ -121,14 +123,14 @@ FLAGS can be any number of: (desired-type (semantic-analyze-type-constraint a)) (desired-class (oref a prefixclass)) (prefix (oref a prefix)) - (prefixtypes (oref a prefixtypes)) + (semantic--prefixtypes (oref a prefixtypes)) (completetext nil) (completetexttype nil) (scope (oref a scope)) (localvar (when scope (oref scope localvar))) (origc nil) (c nil) - (any nil) + ;; (any nil) (do-typeconstraint (not (memq 'no-tc flags))) (do-longprefix (not (memq 'no-longprefix flags))) (do-unique (not (memq 'no-unique flags))) @@ -138,7 +140,7 @@ FLAGS can be any number of: ;; If we are not doing the long prefix, shorten all the key ;; elements. (setq prefix (list (car (reverse prefix))) - prefixtypes nil)) + semantic--prefixtypes nil)) ;; Calculate what our prefix string is so that we can ;; find all our matching text. @@ -155,7 +157,7 @@ FLAGS can be any number of: ;; The prefixtypes should always be at least 1 less than ;; the prefix since the type is never looked up for the last ;; item when calculating a sequence. - (setq completetexttype (car (reverse prefixtypes))) + (setq completetexttype (car (reverse semantic--prefixtypes))) (when (or (not completetexttype) (not (and (semantic-tag-p completetexttype) (eq (semantic-tag-class completetexttype) 'type)))) diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el index 4947368757e..58d6644f9a9 100644 --- a/lisp/cedet/semantic/analyze/debug.el +++ b/lisp/cedet/semantic/analyze/debug.el @@ -1,4 +1,4 @@ -;;; semantic/analyze/debug.el --- Debug the analyzer +;;; semantic/analyze/debug.el --- Debug the analyzer -*- lexical-binding: t; -*- ;;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -109,11 +109,11 @@ Argument COMP are possible completions here." (condition-case err (with-current-buffer origbuf (let* ((position (or (cdr-safe (oref ctxt bounds)) (point))) - (prefixtypes nil) ; Used as type return + ;; (semantic--prefixtypes nil) ; Used as type return (scope (semantic-calculate-scope position)) ) (semantic-analyze-find-tag-sequence - (list prefix "") scope 'prefixtypes) + (list prefix "") scope) ;; 'semantic--prefixtypes ) ) (error (setq finderr err))) @@ -149,7 +149,7 @@ path was setup incorrectly.\n") (semantic-analyzer-debug-add-buttons) )) -(defun semantic-analyzer-debug-missing-datatype (ctxt idx comp) +(defun semantic-analyzer-debug-missing-datatype (ctxt idx _comp) "Debug why we can't find a datatype entry for CTXT prefix at IDX. Argument COMP are possible completions here." (let* ((prefixitem (nth idx (oref ctxt prefix))) diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el index 10d11c33ebb..d47e8976e58 100644 --- a/lisp/cedet/semantic/analyze/fcn.el +++ b/lisp/cedet/semantic/analyze/fcn.el @@ -1,4 +1,4 @@ -;;; semantic/analyze/fcn.el --- Analyzer support functions. +;;; semantic/analyze/fcn.el --- Analyzer support functions. -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -55,7 +55,7 @@ Return the string representing the compound name.") (defun semantic-analyze-unsplit-name-default (namelist) "Concatenate the names in NAMELIST with a . between." - (mapconcat 'identity namelist ".")) + (mapconcat #'identity namelist ".")) ;;; SELECTING ;; diff --git a/lisp/cedet/semantic/analyze/refs.el b/lisp/cedet/semantic/analyze/refs.el index a39ff6f6736..31cbb9e1173 100644 --- a/lisp/cedet/semantic/analyze/refs.el +++ b/lisp/cedet/semantic/analyze/refs.el @@ -1,4 +1,4 @@ -;;; semantic/analyze/refs.el --- Analysis of the references between tags. +;;; semantic/analyze/refs.el --- Analysis of the references between tags. -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -296,7 +296,7 @@ Only works for tags in the global namespace." (let* ((classmatch (semantic-tag-class tag)) (RES (semanticdb-find-tags-collector - (lambda (table tags) + (lambda (_table tags) (semantic-find-tags-by-class classmatch tags) ;; @todo - Add parent check also. ) diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el index 3bc0e4dd618..b585e387fed 100644 --- a/lisp/cedet/semantic/bovine.el +++ b/lisp/cedet/semantic/bovine.el @@ -1,4 +1,4 @@ -;;; semantic/bovine.el --- LL Parser/Analyzer core. +;;; semantic/bovine.el --- LL Parser/Analyzer core -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2004, 2006-2007, 2009-2021 Free Software ;; Foundation, Inc. @@ -54,6 +54,7 @@ Use this to detect infinite recursion during a parse.") "Create a lambda expression to return a list including RETURN-VAL. The return list is a lambda expression to be used in a bovine table." `(lambda (vals start end) + (ignore vals) (append ,@return-val (list start end)))) ;;; Semantic Bovination @@ -283,7 +284,7 @@ list of semantic tokens found." ;; Make it the default parser ;;;###autoload -(defalias 'semantic-parse-stream-default 'semantic-bovinate-stream) +(defalias 'semantic-parse-stream-default #'semantic-bovinate-stream) (provide 'semantic/bovine) diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el index 4914ec9b124..e3df7b12ab6 100644 --- a/lisp/cedet/semantic/bovine/grammar.el +++ b/lisp/cedet/semantic/bovine/grammar.el @@ -1,4 +1,4 @@ -;;; semantic/bovine/grammar.el --- Bovine's input grammar mode +;;; semantic/bovine/grammar.el --- Bovine's input grammar mode -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. ;; @@ -243,7 +243,8 @@ QUOTEMODE is the mode in which quoted symbols are slurred." (insert "\n") (cond ((eq (car sexp) 'EXPAND) - (insert ",(lambda (vals start end)") + (insert ",(lambda (vals start end)" + "\n(ignore vals start end)") ;; The EXPAND macro definition is mandatory (bovine-grammar-expand-form (apply (cdr (assq 'EXPAND bovine--grammar-macros)) (cdr sexp)) @@ -520,7 +521,8 @@ Menu items are appended to the common grammar menu.") (goto-char (point-min)) (delete-region (point-min) (line-end-position)) (insert ";;; " packagename - " --- Generated parser support file") + " --- Generated parser support file " + "-*- lexical-binding:t -*-") (delete-trailing-whitespace) (re-search-forward ";;; \\(.*\\) ends here") (replace-match packagename nil nil nil 1))))) diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index 59e9db9cc0a..d99b94f49eb 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -154,8 +154,6 @@ If DIRECTORY doesn't exist, create a new one." ;;; File IO -(declare-function inversion-test "inversion") - (defun semanticdb-load-database (filename) "Load the database FILENAME." (condition-case foo @@ -163,32 +161,19 @@ If DIRECTORY doesn't exist, create a new one." 'semanticdb-project-database-file)) (c (semanticdb-get-database-tables r)) (tv (oref r semantic-tag-version)) - (fv (oref r semanticdb-version)) - ) + (fv (oref r semanticdb-version))) ;; Restore the parent-db connection (while c (oset (car c) parent-db r) (setq c (cdr c))) (unless (and (equal semanticdb-file-version fv) (equal semantic-tag-version tv)) - ;; Try not to load inversion unless we need it: - (require 'inversion) - (if (not (inversion-test 'semanticdb-file fv)) - (when (inversion-test 'semantic-tag tv) - ;; Incompatible version. Flush tables. - (semanticdb-flush-database-tables r) - ;; Reset the version to new version. - (oset r semantic-tag-version semantic-tag-version) - ;; Warn user - (message "Semanticdb file is old. Starting over for %s" - filename)) - ;; Version is not ok. Flush whole system - (message "semanticdb file is old. Starting over for %s" - filename) - ;; This database is so old, we need to replace it. - ;; We also need to delete it from the instance tracker. - (delete-instance r) - (setq r nil))) + ;; Version is not ok. Flush whole system + (message "semanticdb file is old. Starting over for %s" filename) + ;; This database is so old, we need to replace it. + ;; We also need to delete it from the instance tracker. + (delete-instance r) + (setq r nil)) r) (error (message "Cache Error: [%s] %s, Restart" filename foo) diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el index bd0795acbd6..64fc07fe1bb 100644 --- a/lisp/cedet/semantic/ede-grammar.el +++ b/lisp/cedet/semantic/ede-grammar.el @@ -162,10 +162,9 @@ Lays claim to all -by.el, and -wy.el files." "Insert variables needed by target THIS." (ede-proj-makefile-insert-loadpath-items (ede-proj-elisp-packages-to-loadpath - (list "eieio" "semantic" "inversion" "ede"))) + (list "eieio" "semantic" "ede"))) ;; eieio for object system needed in ede ;; semantic because it is - ;; Inversion for versioning system. ;; ede for project regeneration (ede-pmake-insert-variable-shared (concat (ede-pmake-varname this) "_SEMANTIC_GRAMMAR_EL") @@ -174,8 +173,7 @@ Lays claim to all -by.el, and -wy.el files." (with-current-buffer (find-file-noselect src) (concat (semantic-grammar-package) ".el"))) (oref this source) - " "))) - ) + " ")))) (cl-defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar)) "Insert rules needed by THIS target. diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el index f39cc093cc9..4594d7f6969 100644 --- a/lisp/cedet/semantic/edit.el +++ b/lisp/cedet/semantic/edit.el @@ -828,8 +828,7 @@ This function is for internal use by `semantic-edits-incremental-parser'." ;; Make it the default changes parser ;;;###autoload -(defalias 'semantic-parse-changes-default - 'semantic-edits-incremental-parser) +(defalias 'semantic-parse-changes-default #'semantic-edits-incremental-parser) ;;; Cache Splicing ;; diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el index 12c9c047fc5..9a7f393072f 100644 --- a/lisp/cedet/semantic/grammar-wy.el +++ b/lisp/cedet/semantic/grammar-wy.el @@ -1,6 +1,6 @@ -;;; semantic/grammar-wy.el --- Generated parser support file +;;; semantic/grammar-wy.el --- Generated parser support file -*- lexical-binding:t -*- -;; Copyright (C) 2002-2004, 2009-2021 Free Software Foundation, Inc. +;; Copyright (C) 2002-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -23,8 +23,9 @@ ;;; Code: -(require 'semantic) - +(require 'semantic/lex) +(eval-when-compile (require 'semantic/bovine)) + ;;; Prologue ;; (defvar semantic-grammar-lex-c-char-re) @@ -36,16 +37,20 @@ ;;; Declarations ;; +(eval-and-compile (defconst semantic-grammar-wy--expected-conflicts + nil + "The number of expected shift/reduce conflicts in this grammar.")) + (defconst semantic-grammar-wy--keyword-table (semantic-lex-make-keyword-table '(("%default-prec" . DEFAULT-PREC) ("%no-default-prec" . NO-DEFAULT-PREC) ("%keyword" . KEYWORD) - ("%expectedconflicts" . EXPECTEDCONFLICTS) ("%languagemode" . LANGUAGEMODE) ("%left" . LEFT) ("%nonassoc" . NONASSOC) ("%package" . PACKAGE) + ("%expectedconflicts" . EXPECTEDCONFLICTS) ("%provide" . PROVIDE) ("%prec" . PREC) ("%put" . PUT) @@ -111,239 +116,239 @@ (eval-when-compile (require 'semantic/wisent/comp)) (wisent-compile-grammar - '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE EXPECTEDCONFLICTS LEFT NONASSOC PACKAGE PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT) + '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE EXPECTEDCONFLICTS PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT) nil (grammar - ((prologue)) - ((epilogue)) - ((declaration)) - ((nonterminal)) - ((PERCENT_PERCENT))) + ((prologue)) + ((epilogue)) + ((declaration)) + ((nonterminal)) + ((PERCENT_PERCENT))) (prologue - ((PROLOGUE) - (wisent-raw-tag + ((PROLOGUE) + (wisent-raw-tag (semantic-tag-new-code "prologue" nil)))) (epilogue - ((EPILOGUE) - (wisent-raw-tag + ((EPILOGUE) + (wisent-raw-tag (semantic-tag-new-code "epilogue" nil)))) (declaration - ((decl) - (eval $1))) + ((decl) + (eval $1))) (decl - ((default_prec_decl)) - ((no_default_prec_decl)) - ((languagemode_decl)) - ((expectedconflicts_decl)) - ((package_decl)) - ((provide_decl)) - ((precedence_decl)) - ((put_decl)) - ((quotemode_decl)) - ((scopestart_decl)) - ((start_decl)) - ((keyword_decl)) - ((token_decl)) - ((type_decl)) - ((use_macros_decl))) + ((default_prec_decl)) + ((no_default_prec_decl)) + ((languagemode_decl)) + ((package_decl)) + ((expectedconflicts_decl)) + ((provide_decl)) + ((precedence_decl)) + ((put_decl)) + ((quotemode_decl)) + ((scopestart_decl)) + ((start_decl)) + ((keyword_decl)) + ((token_decl)) + ((type_decl)) + ((use_macros_decl))) (default_prec_decl - ((DEFAULT-PREC) + ((DEFAULT-PREC) `(wisent-raw-tag (semantic-tag "default-prec" 'assoc :value '("t"))))) (no_default_prec_decl - ((NO-DEFAULT-PREC) - `(wisent-raw-tag + ((NO-DEFAULT-PREC) + `(wisent-raw-tag (semantic-tag "default-prec" 'assoc :value - '("nil"))))) + '("nil"))))) (languagemode_decl - ((LANGUAGEMODE symbols) - `(wisent-raw-tag - (semantic-tag ',(car $2) - 'languagemode :rest ',(cdr $2))))) - (expectedconflicts_decl - ((EXPECTEDCONFLICTS symbols) - `(wisent-raw-tag + ((LANGUAGEMODE symbols) + `(wisent-raw-tag (semantic-tag ',(car $2) - 'expectedconflicts :rest ',(cdr $2))))) + 'languagemode :rest ',(cdr $2))))) (package_decl - ((PACKAGE SYMBOL) - `(wisent-raw-tag + ((PACKAGE SYMBOL) + `(wisent-raw-tag (semantic-tag-new-package ',$2 nil)))) + (expectedconflicts_decl + ((EXPECTEDCONFLICTS symbols) + `(wisent-raw-tag + (semantic-tag ',(car $2) + 'expectedconflicts :rest ',(cdr $2))))) (provide_decl - ((PROVIDE SYMBOL) - `(wisent-raw-tag + ((PROVIDE SYMBOL) + `(wisent-raw-tag (semantic-tag ',$2 'provide)))) (precedence_decl - ((associativity token_type_opt items) - `(wisent-raw-tag + ((associativity token_type_opt items) + `(wisent-raw-tag (semantic-tag ',$1 'assoc :type ',$2 :value ',$3)))) (associativity - ((LEFT) - (progn "left")) - ((RIGHT) - (progn "right")) - ((NONASSOC) - (progn "nonassoc"))) + ((LEFT) + (progn "left")) + ((RIGHT) + (progn "right")) + ((NONASSOC) + (progn "nonassoc"))) (put_decl - ((PUT put_name put_value) - `(wisent-raw-tag + ((PUT put_name put_value) + `(wisent-raw-tag (semantic-tag ',$2 'put :value ',(list $3)))) - ((PUT put_name put_value_list) - `(wisent-raw-tag + ((PUT put_name put_value_list) + `(wisent-raw-tag (semantic-tag ',$2 'put :value ',$3))) - ((PUT put_name_list put_value) - `(wisent-raw-tag + ((PUT put_name_list put_value) + `(wisent-raw-tag (semantic-tag ',(car $2) - 'put :rest ',(cdr $2) - :value ',(list $3)))) - ((PUT put_name_list put_value_list) - `(wisent-raw-tag + 'put :rest ',(cdr $2) + :value ',(list $3)))) + ((PUT put_name_list put_value_list) + `(wisent-raw-tag (semantic-tag ',(car $2) - 'put :rest ',(cdr $2) - :value ',$3)))) + 'put :rest ',(cdr $2) + :value ',$3)))) (put_name_list - ((BRACE_BLOCK) - (mapcar 'semantic-tag-name - (semantic-parse-region + ((BRACE_BLOCK) + (mapcar 'semantic-tag-name + (semantic-parse-region (car $region1) (cdr $region1) 'put_names 1)))) (put_names - ((LBRACE) - nil) - ((RBRACE) - nil) - ((put_name) - (wisent-raw-tag + ((LBRACE) + nil) + ((RBRACE) + nil) + ((put_name) + (wisent-raw-tag (semantic-tag $1 'put-name)))) (put_name - ((SYMBOL)) - ((token_type))) + ((SYMBOL)) + ((token_type))) (put_value_list - ((BRACE_BLOCK) - (mapcar 'semantic-tag-code-detail - (semantic-parse-region + ((BRACE_BLOCK) + (mapcar 'semantic-tag-code-detail + (semantic-parse-region (car $region1) (cdr $region1) 'put_values 1)))) (put_values - ((LBRACE) - nil) - ((RBRACE) - nil) - ((put_value) - (wisent-raw-tag + ((LBRACE) + nil) + ((RBRACE) + nil) + ((put_value) + (wisent-raw-tag (semantic-tag-new-code "put-value" $1)))) (put_value - ((SYMBOL any_value) - (cons $1 $2))) + ((SYMBOL any_value) + (cons $1 $2))) (scopestart_decl - ((SCOPESTART SYMBOL) - `(wisent-raw-tag + ((SCOPESTART SYMBOL) + `(wisent-raw-tag (semantic-tag ',$2 'scopestart)))) (quotemode_decl - ((QUOTEMODE SYMBOL) - `(wisent-raw-tag + ((QUOTEMODE SYMBOL) + `(wisent-raw-tag (semantic-tag ',$2 'quotemode)))) (start_decl - ((START symbols) - `(wisent-raw-tag + ((START symbols) + `(wisent-raw-tag (semantic-tag ',(car $2) - 'start :rest ',(cdr $2))))) + 'start :rest ',(cdr $2))))) (keyword_decl - ((KEYWORD SYMBOL string_value) - `(wisent-raw-tag + ((KEYWORD SYMBOL string_value) + `(wisent-raw-tag (semantic-tag ',$2 'keyword :value ',$3)))) (token_decl - ((TOKEN token_type_opt SYMBOL string_value) - `(wisent-raw-tag + ((TOKEN token_type_opt SYMBOL string_value) + `(wisent-raw-tag (semantic-tag ',$3 ',(if $2 'token 'keyword) - :type ',$2 :value ',$4))) - ((TOKEN token_type_opt symbols) - `(wisent-raw-tag + :type ',$2 :value ',$4))) + ((TOKEN token_type_opt symbols) + `(wisent-raw-tag (semantic-tag ',(car $3) - 'token :type ',$2 :rest ',(cdr $3))))) + 'token :type ',$2 :rest ',(cdr $3))))) (token_type_opt - (nil) - ((token_type))) + (nil) + ((token_type))) (token_type - ((LT SYMBOL GT) - (progn $2))) + ((LT SYMBOL GT) + (progn $2))) (type_decl - ((TYPE token_type plist_opt) - `(wisent-raw-tag + ((TYPE token_type plist_opt) + `(wisent-raw-tag (semantic-tag ',$2 'type :value ',$3)))) (plist_opt - (nil) - ((plist))) + (nil) + ((plist))) (plist - ((plist put_value) - (append + ((plist put_value) + (append (list $2) $1)) - ((put_value) - (list $1))) + ((put_value) + (list $1))) (use_name_list - ((BRACE_BLOCK) - (mapcar 'semantic-tag-name - (semantic-parse-region + ((BRACE_BLOCK) + (mapcar 'semantic-tag-name + (semantic-parse-region (car $region1) (cdr $region1) 'use_names 1)))) (use_names - ((LBRACE) - nil) - ((RBRACE) - nil) - ((SYMBOL) - (wisent-raw-tag + ((LBRACE) + nil) + ((RBRACE) + nil) + ((SYMBOL) + (wisent-raw-tag (semantic-tag $1 'use-name)))) (use_macros_decl - ((USE-MACROS SYMBOL use_name_list) - `(wisent-raw-tag + ((USE-MACROS SYMBOL use_name_list) + `(wisent-raw-tag (semantic-tag "macro" 'macro :type ',$2 :value ',$3)))) (string_value - ((STRING) - (read $1))) + ((STRING) + (read $1))) (any_value - ((SYMBOL)) - ((STRING)) - ((PAREN_BLOCK)) - ((PREFIXED_LIST)) - ((SEXP))) + ((SYMBOL)) + ((STRING)) + ((PAREN_BLOCK)) + ((PREFIXED_LIST)) + ((SEXP))) (symbols - ((lifo_symbols) - (nreverse $1))) + ((lifo_symbols) + (nreverse $1))) (lifo_symbols - ((lifo_symbols SYMBOL) - (cons $2 $1)) - ((SYMBOL) - (list $1))) + ((lifo_symbols SYMBOL) + (cons $2 $1)) + ((SYMBOL) + (list $1))) (nonterminal - ((SYMBOL + ((SYMBOL (setq semantic-grammar-wy--nterm $1 semantic-grammar-wy--rindx 0) COLON rules SEMI) - (wisent-raw-tag + (wisent-raw-tag (semantic-tag $1 'nonterminal :children $4)))) (rules - ((lifo_rules) - (apply 'nconc - (nreverse $1)))) + ((lifo_rules) + (apply 'nconc + (nreverse $1)))) (lifo_rules - ((lifo_rules OR rule) - (cons $3 $1)) - ((rule) - (list $1))) + ((lifo_rules OR rule) + (cons $3 $1)) + ((rule) + (list $1))) (rule - ((rhs) - (let* + ((rhs) + (let* ((nterm semantic-grammar-wy--nterm) (rindx semantic-grammar-wy--rindx) (rhs $1) comps prec action elt) (setq semantic-grammar-wy--rindx - (1+ semantic-grammar-wy--rindx)) + (1+ semantic-grammar-wy--rindx)) (while rhs (setq elt (car rhs) @@ -359,10 +364,10 @@ (if (or action comps) (setq comps - (cons elt comps) - semantic-grammar-wy--rindx - (1+ semantic-grammar-wy--rindx)) - (setq action + (cons elt comps) + semantic-grammar-wy--rindx + (1+ semantic-grammar-wy--rindx)) + (setq action (car elt)))) (t (setq comps @@ -375,46 +380,46 @@ (if comps "group" "empty") :value comps :prec prec :expr action)))))) (rhs - (nil) - ((rhs item) - (cons $2 $1)) - ((rhs action) - (cons + (nil) + ((rhs item) + (cons $2 $1)) + ((rhs action) + (cons (list $2) $1)) - ((rhs PREC item) - (cons + ((rhs PREC item) + (cons (vector $3) $1))) (action - ((PAREN_BLOCK)) - ((PREFIXED_LIST)) - ((BRACE_BLOCK) - (format "(progn\n%s)" - (let + ((PAREN_BLOCK)) + ((PREFIXED_LIST)) + ((BRACE_BLOCK) + (format "(progn\n%s)" + (let ((s $1)) (if - (string-match "^{[\r\n\t ]*" s) + (string-match "^{[
\n ]*" s) (setq s (substring s - (match-end 0)))) + (match-end 0)))) (if - (string-match "[\r\n\t ]*}$" s) + (string-match "[
\n ]*}$" s) (setq s (substring s 0 - (match-beginning 0)))) + (match-beginning 0)))) s)))) (items - ((lifo_items) - (nreverse $1))) + ((lifo_items) + (nreverse $1))) (lifo_items - ((lifo_items item) - (cons $2 $1)) - ((item) - (list $1))) + ((lifo_items item) + (cons $2 $1)) + ((item) + (list $1))) (item - ((SYMBOL)) - ((CHARACTER)))) + ((SYMBOL)) + ((CHARACTER)))) '(grammar prologue epilogue declaration nonterminal rule put_names put_values use_names))) "Parser table.") @@ -423,25 +428,26 @@ (semantic-install-function-overrides '((semantic-parse-stream . wisent-parse-stream))) (setq semantic-parser-name "LALR" - semantic--parse-table semantic-grammar-wy--parse-table - semantic-debug-parser-source "grammar.wy" - semantic-flex-keywords-obarray semantic-grammar-wy--keyword-table - semantic-lex-types-obarray semantic-grammar-wy--token-table) + semantic--parse-table semantic-grammar-wy--parse-table + semantic-debug-parser-source "grammar.wy" + semantic-flex-keywords-obarray semantic-grammar-wy--keyword-table + semantic-lex-types-obarray semantic-grammar-wy--token-table) ;; Collect unmatched syntax lexical tokens (add-hook 'wisent-discarding-token-functions - 'wisent-collect-unmatched-syntax nil t)) + 'wisent-collect-unmatched-syntax nil t)) ;;; Analyzers ;; -(define-lex-block-type-analyzer semantic-grammar-wy--<block>-block-analyzer - "block analyzer for <block> tokens." - "\\s(\\|\\s)" - '((("(" LPAREN PAREN_BLOCK) - ("{" LBRACE BRACE_BLOCK)) - (")" RPAREN) - ("}" RBRACE)) - ) +(define-lex-regex-type-analyzer semantic-grammar-wy--<symbol>-regexp-analyzer + "regexp analyzer for <symbol> tokens." + ":?\\(\\sw\\|\\s_\\)+" + '((PERCENT_PERCENT . "\\`%%\\'")) + 'SYMBOL) + +(define-lex-keyword-type-analyzer semantic-grammar-wy--<keyword>-keyword-analyzer + "keyword analyzer for <keyword> tokens." + "\\(\\sw\\|\\s_\\)+") (define-lex-regex-type-analyzer semantic-grammar-wy--<char>-regexp-analyzer "regexp analyzer for <char> tokens." @@ -449,21 +455,19 @@ nil 'CHARACTER) -(define-lex-regex-type-analyzer semantic-grammar-wy--<symbol>-regexp-analyzer - "regexp analyzer for <symbol> tokens." - ":?\\(\\sw\\|\\s_\\)+" - '((PERCENT_PERCENT . "\\`%%\\'")) - 'SYMBOL) - (define-lex-sexp-type-analyzer semantic-grammar-wy--<qlist>-sexp-analyzer "sexp analyzer for <qlist> tokens." "\\s'\\s-*(" 'PREFIXED_LIST) -(define-lex-sexp-type-analyzer semantic-grammar-wy--<string>-sexp-analyzer - "sexp analyzer for <string> tokens." - "\\s\"" - 'STRING) +(define-lex-block-type-analyzer semantic-grammar-wy--<block>-block-analyzer + "block analyzer for <block> tokens." + "\\s(\\|\\s)" + '((("(" LPAREN PAREN_BLOCK) + ("{" LBRACE BRACE_BLOCK)) + (")" RPAREN) + ("}" RBRACE)) + ) (define-lex-string-type-analyzer semantic-grammar-wy--<punctuation>-string-analyzer "string analyzer for <punctuation> tokens." @@ -475,9 +479,10 @@ (COLON . ":")) 'punctuation) -(define-lex-keyword-type-analyzer semantic-grammar-wy--<keyword>-keyword-analyzer - "keyword analyzer for <keyword> tokens." - "\\(\\sw\\|\\s_\\)+") +(define-lex-sexp-type-analyzer semantic-grammar-wy--<string>-sexp-analyzer + "sexp analyzer for <string> tokens." + "\\s\"" + 'STRING) (define-lex-sexp-type-analyzer semantic-grammar-wy--<sexp>-sexp-analyzer "sexp analyzer for <sexp> tokens." @@ -493,4 +498,9 @@ (provide 'semantic/grammar-wy) +;; Local Variables: +;; version-control: never +;; no-update-autoloads: t +;; End: + ;;; semantic/grammar-wy.el ends here diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 5af4607abb8..0f997474ded 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -47,8 +47,6 @@ ;; For the semantic-find-tags-by-name macro. (eval-when-compile (require 'semantic/find)) -(defvar eldoc-last-message) -(declare-function eldoc-message "eldoc") (declare-function semantic-analyze-unsplit-name "semantic/analyze/fcn") (declare-function semantic-complete-analyze-inline-idle "semantic/complete") (declare-function semanticdb-deep-find-tags-by-name "semantic/db-find") @@ -730,8 +728,8 @@ specific to a major mode. For example, in jde mode: :group 'semantic :type 'hook) -(defun semantic-idle-summary-idle-function () - "Display a tag summary of the lexical token under the cursor. +(defun semantic--eldoc-info (_callback &rest _) + "Return the eldoc info for the current symbol. Call `semantic-idle-summary-current-symbol-info' for getting the current tag to display information." (or (eq major-mode 'emacs-lisp-mode) @@ -741,21 +739,7 @@ current tag to display information." ((semantic-tag-p found) (funcall semantic-idle-summary-function found nil t))))) - ;; Show the message with eldoc functions - (unless (and str (boundp 'eldoc-echo-area-use-multiline-p) - eldoc-echo-area-use-multiline-p) - (let ((w (1- (window-width (minibuffer-window))))) - (if (> (length str) w) - (setq str (substring str 0 w))))) - ;; I borrowed some bits from eldoc to shorten the - ;; message. - (when semantic-idle-truncate-long-summaries - (let ((ea-width (1- (window-width (minibuffer-window)))) - (strlen (length str))) - (when (> strlen ea-width) - (setq str (substring str 0 ea-width))))) - ;; Display it - (eldoc-message str)))) + str))) (define-minor-mode semantic-idle-summary-mode "Toggle Semantic Idle Summary mode. @@ -764,30 +748,16 @@ When this minor mode is enabled, the echo area displays a summary of the lexical token at point whenever Emacs is idle." :group 'semantic :group 'semantic-modes - (if semantic-idle-summary-mode - ;; Enable the mode - (progn - (unless (and (featurep 'semantic) (semantic-active-p)) - ;; Disable minor mode if semantic stuff not available - (setq semantic-idle-summary-mode nil) - (error "Buffer %s was not set up for parsing" - (buffer-name))) - (require 'eldoc) - (semantic-idle-scheduler-add 'semantic-idle-summary-idle-function) - (add-hook 'pre-command-hook 'semantic-idle-summary-refresh-echo-area t)) - ;; Disable the mode - (semantic-idle-scheduler-remove 'semantic-idle-summary-idle-function) - (remove-hook 'pre-command-hook 'semantic-idle-summary-refresh-echo-area t))) - -(defun semantic-idle-summary-refresh-echo-area () - (and semantic-idle-summary-mode - eldoc-last-message - (if (and (not executing-kbd-macro) - (not (and (boundp 'edebug-active) edebug-active)) - (not cursor-in-echo-area) - (not (eq (selected-window) (minibuffer-window)))) - (eldoc-message eldoc-last-message) - (setq eldoc-last-message nil)))) + (remove-hook 'eldoc-documentation-functions #'semantic--eldoc-info t) + (when semantic-idle-summary-mode + ;; Enable the mode + (unless (and (featurep 'semantic) (semantic-active-p)) + ;; Disable minor mode if semantic stuff not available + (setq semantic-idle-summary-mode nil) + (error "Buffer %s was not set up for parsing" + (buffer-name))) + (add-hook 'eldoc-documentation-functions #'semantic--eldoc-info nil t) + (eldoc-mode 1))) (semantic-add-minor-mode 'semantic-idle-summary-mode "") @@ -1092,7 +1062,7 @@ be called." ;; mouse-3 pops up a context menu (define-key map [ header-line mouse-3 ] - 'semantic-idle-breadcrumbs--popup-menu) + #'semantic-idle-breadcrumbs--popup-menu) map) "Keymap for semantic idle breadcrumbs minor mode.") diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index 3d7bce8657a..a99e2ab279b 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -229,6 +229,28 @@ See also the function `semantic-ctxt-current-mode'." (require 'semantic/ctxt) (semantic-ctxt-current-mode))))) +;; Is this function still necessary? +(defun semantic-tag-make-plist (args) + "Create a property list with ARGS. +Args is a property list of the form (KEY1 VALUE1 ... KEYN VALUEN). +Where KEY is a symbol, and VALUE is the value for that symbol. +The return value will be a new property list, with these KEY/VALUE +pairs eliminated: + + - KEY associated to nil VALUE. + - KEY associated to an empty string VALUE. + - KEY associated to a zero VALUE." + (let (plist key val) + (while args + (setq key (car args) + val (nth 1 args) + args (nthcdr 2 args)) + (or (member val '("" nil)) + (and (numberp val) (zerop val)) + (setq plist (cons key (cons val plist))))) + ;; It is not useful to reverse the new plist. + plist)) + (defsubst semantic--tag-attributes-cdr (tag) "Return the cons cell whose car is the ATTRIBUTES part of TAG. That function is for internal use only." @@ -441,28 +463,6 @@ class to store those methods." ;;; Tag creation ;; -;; Is this function still necessary? -(defun semantic-tag-make-plist (args) - "Create a property list with ARGS. -Args is a property list of the form (KEY1 VALUE1 ... KEYN VALUEN). -Where KEY is a symbol, and VALUE is the value for that symbol. -The return value will be a new property list, with these KEY/VALUE -pairs eliminated: - - - KEY associated to nil VALUE. - - KEY associated to an empty string VALUE. - - KEY associated to a zero VALUE." - (let (plist key val) - (while args - (setq key (car args) - val (nth 1 args) - args (nthcdr 2 args)) - (or (member val '("" nil)) - (and (numberp val) (zerop val)) - (setq plist (cons key (cons val plist))))) - ;; It is not useful to reverse the new plist. - plist)) - (defsubst semantic-tag (name class &rest attributes) "Create a generic semantic tag. NAME is a string representing the name of this tag. diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el index cfd4899186b..edc5c5c7029 100644 --- a/lisp/cedet/semantic/wisent/grammar.el +++ b/lisp/cedet/semantic/wisent/grammar.el @@ -1,4 +1,4 @@ -;;; semantic/wisent/grammar.el --- Wisent's input grammar mode +;;; semantic/wisent/grammar.el --- Wisent's input grammar mode -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. ;; @@ -228,7 +228,7 @@ Keep order of declaration in the WY file without duplicates." Return the expanded expression." (if (or (atom expr) (semantic-grammar-quote-p (car expr))) expr ;; Just return atom or quoted expression. - (let* ((expr (mapcar 'wisent-grammar-expand-macros expr)) + (let* ((expr (mapcar #'wisent-grammar-expand-macros expr)) (macro (assq (car expr) wisent--grammar-macros))) (if macro ;; Expand Semantic built-in. (apply (cdr macro) (cdr expr)) @@ -514,7 +514,8 @@ Menu items are appended to the common grammar menu.") (goto-char (point-min)) (delete-region (point-min) (line-end-position)) (insert ";;; " packagename - " --- Generated parser support file") + " --- Generated parser support file " + "-*- lexical-binding:t -*-") (re-search-forward ";;; \\(.*\\) ends here") (replace-match packagename nil nil nil 1) (delete-trailing-whitespace)))))) diff --git a/lisp/cedet/srecode/args.el b/lisp/cedet/srecode/args.el index 24c5f22f2e7..79d2700c5d9 100644 --- a/lisp/cedet/srecode/args.el +++ b/lisp/cedet/srecode/args.el @@ -1,4 +1,4 @@ -;;; srecode/args.el --- Provide some simple template arguments +;;; srecode/args.el --- Provide some simple template arguments -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el index 7146b643836..36df1da9e33 100644 --- a/lisp/cedet/srecode/compile.el +++ b/lisp/cedet/srecode/compile.el @@ -1,4 +1,4 @@ -;;; srecode/compile --- Compilation of srecode template files. +;;; srecode/compile --- Compilation of srecode template files. -*- lexical-binding: t; -*- ;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc. @@ -499,7 +499,7 @@ PROPS are additional properties that might need to be passed to the inserter constructor." ;;(message "Compile: %s %S" name props) (if (not key) - (apply 'srecode-template-inserter-variable name props) + (apply #'make-instance 'srecode-template-inserter-variable name props) (let ((classes (eieio-class-children 'srecode-template-inserter)) (new nil)) ;; Loop over the various subclasses and @@ -510,7 +510,7 @@ to the inserter constructor." (when (and (not (class-abstract-p (car classes))) (equal (oref-default (car classes) key) key)) ;; Create the new class, and apply state. - (setq new (apply (car classes) name props)) + (setq new (apply #'make-instance (car classes) name props)) (srecode-inserter-apply-state new STATE) ) (setq classes (cdr classes))) diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el index 1b9610f3f1b..3f66898c9cc 100644 --- a/lisp/cedet/srecode/cpp.el +++ b/lisp/cedet/srecode/cpp.el @@ -1,4 +1,4 @@ -;;; srecode/cpp.el --- C++ specific handlers for Semantic Recoder +;;; srecode/cpp.el --- C++ specific handlers for Semantic Recoder -*- lexical-binding: t; -*- ;; Copyright (C) 2007, 2009-2021 Free Software Foundation, Inc. @@ -44,7 +44,6 @@ A dictionary entry of the named PREFIX_NAMESPACE with the value NAMESPACE:: is created for each namespace unless the current buffer contains a using NAMESPACE; statement." - :group 'srecode-cpp :type '(repeat string)) ;;; :c ARGUMENT HANDLING diff --git a/lisp/cedet/srecode/ctxt.el b/lisp/cedet/srecode/ctxt.el index 20334f95838..c49237b94cf 100644 --- a/lisp/cedet/srecode/ctxt.el +++ b/lisp/cedet/srecode/ctxt.el @@ -1,4 +1,4 @@ -;;; srecode/ctxt.el --- Derive a context from the source buffer. +;;; srecode/ctxt.el --- Derive a context from the source buffer. -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el index c1fe4b2c34e..5da045e17f1 100644 --- a/lisp/cedet/srecode/dictionary.el +++ b/lisp/cedet/srecode/dictionary.el @@ -1,4 +1,4 @@ -;;; srecode/dictionary.el --- Dictionary code for the semantic recoder. +;;; srecode/dictionary.el --- Dictionary code for the semantic recoder. -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -443,8 +443,8 @@ The root dictionary is usually for a current or active insertion." ;; for use in converting the compound value into something insertable. (cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value) - function - dictionary) + _function + _dictionary) "Convert the compound dictionary value CP to a string. If FUNCTION is non-nil, then FUNCTION is somehow applied to an aspect of the compound value. The FUNCTION could be a fraction @@ -457,14 +457,15 @@ standard out is a buffer, and using `insert'." (eieio-object-name cp)) (cl-defmethod srecode-dump ((cp srecode-dictionary-compound-value) - &optional indent) + &optional _indent) "Display information about this compound value." (princ (eieio-object-name cp)) ) -(cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable) - function - dictionary) +(cl-defmethod srecode-compound-toString + ((cp srecode-dictionary-compound-variable) + _function + dictionary) "Convert the compound dictionary variable value CP into a string. FUNCTION and DICTIONARY are as for the baseclass." (require 'srecode/insert) @@ -606,9 +607,9 @@ STATE is the current compiler state." (require 'srecode/find) (let* ((modesym major-mode) (start (current-time)) - (junk (or (progn (srecode-load-tables-for-mode modesym) - (srecode-get-mode-table modesym)) - (error "No table found for mode %S" modesym))) + (_ (or (progn (srecode-load-tables-for-mode modesym) + (srecode-get-mode-table modesym)) + (error "No table found for mode %S" modesym))) (dict (srecode-create-dictionary (current-buffer))) ) (message "Creating a dictionary took %.2f seconds." diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el index 0d1a4c01d3c..270b80d9013 100644 --- a/lisp/cedet/srecode/document.el +++ b/lisp/cedet/srecode/document.el @@ -1,4 +1,4 @@ -;;; srecode/document.el --- Documentation (comment) generation +;;; srecode/document.el --- Documentation (comment) generation -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -88,7 +88,6 @@ versions of names. This is an alist with each element of the form: (MATCH . RESULT) MATCH is a regexp to match in the type field. RESULT is a string." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -144,7 +143,6 @@ A string may end in a space, in which case, last-alist is searched to see how best to describe what can be returned. Doesn't always work correctly, but that is just because English doesn't always work correctly." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -175,7 +173,6 @@ versions of names. This is an alist with each element of the form: (MATCH . RESULT) MATCH is a regexp to match in the type field. RESULT is a string." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -192,7 +189,6 @@ This is an alist with each element of the form: (MATCH . RESULT) MATCH is a regexp to match in the type field. RESULT is a string." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -213,7 +209,6 @@ This is an alist with each element of the form: MATCH is a regexp to match in the type field. RESULT is a string, which can contain %s, which is replaced with `match-string' 1." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -233,7 +228,6 @@ MATCH is a regexp to match in the type field. RESULT is a string of text to use to describe MATCH. When one is encountered, document-insert-parameters will automatically place this comment after the parameter name." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -258,7 +252,6 @@ This is an alist with each element of the form: (MATCH . RESULT) MATCH is a regexp to match in the type field. RESULT is a string." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -716,7 +709,7 @@ allocating something based on its type." (setq al (cdr al))))) news)) -(defun srecode-document-parameter-comment (param &optional commentlist) +(defun srecode-document-parameter-comment (param &optional _commentlist) "Convert tag or string PARAM into a name,comment pair. Optional COMMENTLIST is list of previously existing comments to use instead in alist form. If the name doesn't appear in the list of diff --git a/lisp/cedet/srecode/el.el b/lisp/cedet/srecode/el.el index 7e9dd10fd42..974a4fac727 100644 --- a/lisp/cedet/srecode/el.el +++ b/lisp/cedet/srecode/el.el @@ -1,4 +1,4 @@ -;;; srecode/el.el --- Emacs Lisp specific arguments +;;; srecode/el.el --- Emacs Lisp specific arguments -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/srecode/expandproto.el b/lisp/cedet/srecode/expandproto.el index cdb29d16b71..a40d5aec24d 100644 --- a/lisp/cedet/srecode/expandproto.el +++ b/lisp/cedet/srecode/expandproto.el @@ -1,4 +1,4 @@ -;;; srecode/expandproto.el --- Expanding prototypes. +;;; srecode/expandproto.el --- Expanding prototypes. -*- lexical-binding: t; -*- ;; Copyright (C) 2007, 2009-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/srecode/extract.el b/lisp/cedet/srecode/extract.el index 625b854b776..9e6a98fd769 100644 --- a/lisp/cedet/srecode/extract.el +++ b/lisp/cedet/srecode/extract.el @@ -1,4 +1,4 @@ -;;; srecode/extract.el --- Extract content from previously inserted macro. +;;; srecode/extract.el --- Extract content from previously inserted macro. -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -139,24 +139,24 @@ Uses STATE to maintain the current extraction state." ;;; Inserter Base Extractors ;; -(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter)) +(cl-defmethod srecode-inserter-do-extract-p ((_ins srecode-template-inserter)) "Return non-nil if this inserter can extract values." nil) -(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter) - start end dict state) +(cl-defmethod srecode-inserter-extract ((_ins srecode-template-inserter) + _start _end _dict _state) "Extract text from START/END and store in DICT. Return nil as this inserter will extract nothing." nil) ;;; Variable extractor is simple and can extract later. ;; -(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-variable)) +(cl-defmethod srecode-inserter-do-extract-p ((_ins srecode-template-inserter-variable)) "Return non-nil if this inserter can extract values." 'later) (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable) - start end vdict state) + start end vdict _state) "Extract text from START/END and store in VDICT. Return t if something was extracted. Return nil if this inserter doesn't need to extract anything." @@ -168,12 +168,12 @@ Return nil if this inserter doesn't need to extract anything." ;;; Section Inserter ;; -(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-section-start)) +(cl-defmethod srecode-inserter-do-extract-p ((_ins srecode-template-inserter-section-start)) "Return non-nil if this inserter can extract values." 'now) (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-section-start) - start end indict state) + _start _end indict state) "Extract text from START/END and store in INDICT. Return the starting location of the first plain-text match. Return nil if nothing was extracted." @@ -201,12 +201,12 @@ Return nil if nothing was extracted." ;;; Include Extractor must extract now. ;; -(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-include)) +(cl-defmethod srecode-inserter-do-extract-p ((_ins srecode-template-inserter-include)) "Return non-nil if this inserter can extract values." 'now) (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-include) - start end dict state) + start _end dict state) "Extract text from START/END and store in DICT. Return the starting location of the first plain-text match. Return nil if nothing was extracted." diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el index 71613bcc2a3..e65e3194320 100644 --- a/lisp/cedet/srecode/fields.el +++ b/lisp/cedet/srecode/fields.el @@ -1,4 +1,4 @@ -;;; srecode/fields.el --- Handling type-in fields in a buffer. +;;; srecode/fields.el --- Handling type-in fields in a buffer. -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. ;; @@ -193,7 +193,7 @@ If SET-TO is a string, then replace the text of OLAID with SET-TO." "Manage a buffer region in which fields exist.") (cl-defmethod initialize-instance ((ir srecode-template-inserted-region) - &rest args) + &rest _args) "Initialize IR, capturing the active fields, and creating the overlay." ;; Fill in the fields (oset ir fields srecode-field-archive) @@ -221,7 +221,7 @@ If SET-TO is a string, then replace the text of OLAID with SET-TO." (oset ir active-region ir) ;; Setup the post command hook. - (add-hook 'post-command-hook 'srecode-field-post-command t t) + (add-hook 'post-command-hook #'srecode-field-post-command t t) ) (cl-defmethod srecode-delete ((ir srecode-template-inserted-region)) @@ -229,12 +229,11 @@ If SET-TO is a string, then replace the text of OLAID with SET-TO." ;; Clear us out of the baseclass. (oset ir active-region nil) ;; Clear our fields. - (mapc 'srecode-delete (oref ir fields)) + (mapc #'srecode-delete (oref ir fields)) ;; Call to our base (cl-call-next-method) ;; Clear our hook. - (remove-hook 'post-command-hook 'srecode-field-post-command t) - ) + (remove-hook 'post-command-hook #'srecode-field-post-command t)) (defsubst srecode-active-template-region () "Return the active region for template fields." @@ -246,7 +245,7 @@ If SET-TO is a string, then replace the text of OLAID with SET-TO." ) (if (not ar) ;; Find a bug and fix it. - (remove-hook 'post-command-hook 'srecode-field-post-command t) + (remove-hook 'post-command-hook #'srecode-field-post-command t) (if (srecode-point-in-region-p ar) nil ;; Keep going ;; We moved out of the template. Cancel the edits. @@ -277,16 +276,16 @@ Try to use this to provide useful completion when available.") (defvar srecode-field-keymap (let ((km (make-sparse-keymap))) - (define-key km "\C-i" 'srecode-field-next) - (define-key km "\M-\C-i" 'srecode-field-prev) - (define-key km "\C-e" 'srecode-field-end) - (define-key km "\C-a" 'srecode-field-start) - (define-key km "\M-m" 'srecode-field-start) - (define-key km "\C-c\C-c" 'srecode-field-exit-ask) + (define-key km "\C-i" #'srecode-field-next) + (define-key km "\M-\C-i" #'srecode-field-prev) + (define-key km "\C-e" #'srecode-field-end) + (define-key km "\C-a" #'srecode-field-start) + (define-key km "\M-m" #'srecode-field-start) + (define-key km "\C-c\C-c" #'srecode-field-exit-ask) km) "Keymap applied to field overlays.") -(cl-defmethod initialize-instance ((field srecode-field) &optional args) +(cl-defmethod initialize-instance ((field srecode-field) &optional _args) "Initialize FIELD, being sure it archived." (add-to-list 'srecode-field-archive field t) (cl-call-next-method) @@ -327,7 +326,7 @@ Try to use this to provide useful completion when available.") (defvar srecode-field-replication-max-size 100 "Maximum size of a field before canceling replication.") -(defun srecode-field-mod-hook (ol after start end &optional pre-len) +(defun srecode-field-mod-hook (ol after _start _end &optional _pre-len) "Modification hook for the field overlay. OL is the overlay. AFTER is non-nil if it is called after the change. @@ -374,7 +373,7 @@ AFTER is non-nil if it is called after the change. START and END are the bounds of the change. PRE-LEN is used in the after mode for the length of the changed text." (when after - (let* ((field (overlay-get ol 'srecode)) + (let* (;; (field (overlay-get ol 'srecode)) ) (move-overlay ol (overlay-start ol) end) (srecode-field-mod-hook ol after start end pre-len)) diff --git a/lisp/cedet/srecode/filters.el b/lisp/cedet/srecode/filters.el index 4a996cf6f12..b76ce2c94bf 100644 --- a/lisp/cedet/srecode/filters.el +++ b/lisp/cedet/srecode/filters.el @@ -1,4 +1,4 @@ -;;; srecode/filters.el --- Filters for use in template variables. +;;; srecode/filters.el --- Filters for use in template variables. -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el index aec73dce5a5..1c208d0f328 100644 --- a/lisp/cedet/srecode/find.el +++ b/lisp/cedet/srecode/find.el @@ -1,4 +1,4 @@ -;;;; srecode/find.el --- Tools for finding templates in the database. +;;;; srecode/find.el --- Tools for finding templates in the database. -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -58,17 +58,14 @@ See `srecode-get-maps' for more. APPNAME is the name of an application. In this case, all template files for that application will be loaded." (let ((files - (if appname - (apply 'append - (mapcar + (apply #'append + (mapcar + (if appname (lambda (map) (srecode-map-entries-for-app-and-mode map appname mmode)) - (srecode-get-maps))) - (apply 'append - (mapcar (lambda (map) - (srecode-map-entries-for-mode map mmode)) - (srecode-get-maps))))) + (srecode-map-entries-for-mode map mmode))) + (srecode-get-maps)))) ) ;; Don't recurse if we are already the 'default state. (when (not (eq mmode 'default)) @@ -112,8 +109,8 @@ If TAB is nil, then always return t." ;; Find a given template based on name, and features of the current ;; buffer. (cl-defmethod srecode-template-get-table ((tab srecode-template-table) - template-name &optional - context application) + template-name &optional + context _application) "Find in the template in table TAB, the template with TEMPLATE-NAME. Optional argument CONTEXT specifies that the template should part of a particular context. @@ -218,7 +215,7 @@ tables that do not belong to an application will be searched." (defvar srecode-read-template-name-history nil "History for completing reads for template names.") -(defun srecode-user-template-p (template) +(defun srecode-user-template-p (_template) "Non-nil if TEMPLATE is intended for user insertion. Templates not matching this predicate are used for code generation or other internal purposes." @@ -264,7 +261,7 @@ with `srecode-calculate-context'." ;; the prefix for the completing read (concat (nth 0 ctxt) ":")))) -(defun srecode-read-template-name (prompt &optional initial hist default) +(defun srecode-read-template-name (prompt &optional initial hist _default) "Completing read for Semantic Recoder template names. PROMPT is used to query for the name of the template desired. INITIAL is the initial string to use. diff --git a/lisp/cedet/srecode/getset.el b/lisp/cedet/srecode/getset.el index 1e4888655f9..ce4c818c709 100644 --- a/lisp/cedet/srecode/getset.el +++ b/lisp/cedet/srecode/getset.el @@ -1,4 +1,4 @@ -;;; srecode/getset.el --- Package for inserting new get/set methods. +;;; srecode/getset.el --- Package for inserting new get/set methods. -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -33,6 +33,8 @@ (defvar srecode-insert-getset-fully-automatic-flag nil "Non-nil means accept choices srecode comes up with without asking.") +(defvar srecode-semantic-selected-tag) + ;;;###autoload (defun srecode-insert-getset (&optional class-in field-in) "Insert get/set methods for the current class. diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el index 768d48a7c5b..0f0a80ee299 100644 --- a/lisp/cedet/srecode/java.el +++ b/lisp/cedet/srecode/java.el @@ -1,4 +1,4 @@ -;;; srecode/java.el --- Srecode Java support +;;; srecode/java.el --- Srecode Java support -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el index a94db0bb8d9..254b15e6e04 100644 --- a/lisp/cedet/srecode/map.el +++ b/lisp/cedet/srecode/map.el @@ -1,4 +1,4 @@ -;;; srecode/map.el --- Manage a template file map +;;; srecode/map.el --- Manage a template file map -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -245,7 +245,7 @@ Optional argument RESET forces a reset of the current map." (princ "\n") )) -(defun srecode-map-file-still-valid-p (filename map) +(defun srecode-map-file-still-valid-p (filename _map) "Return t if FILENAME should be in MAP still." (let ((valid nil)) (and (file-exists-p filename) @@ -407,7 +407,7 @@ Return non-nil if the map changed." "Global load path for SRecode template files." :group 'srecode :type '(repeat file) - :set 'srecode-map-load-path-set) + :set #'srecode-map-load-path-set) (provide 'srecode/map) diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el index 159dc7a999b..022a5db8f2b 100644 --- a/lisp/cedet/srecode/mode.el +++ b/lisp/cedet/srecode/mode.el @@ -1,4 +1,4 @@ -;;; srecode/mode.el --- Minor mode for managing and using SRecode templates +;;; srecode/mode.el --- Minor mode for managing and using SRecode templates -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -54,14 +54,14 @@ (defvar srecode-prefix-map (let ((km (make-sparse-keymap))) ;; Basic template codes - (define-key km "/" 'srecode-insert) - (define-key km [insert] 'srecode-insert) - (define-key km "." 'srecode-insert-again) - (define-key km "E" 'srecode-edit) + (define-key km "/" #'srecode-insert) + (define-key km [insert] #'srecode-insert) + (define-key km "." #'srecode-insert-again) + (define-key km "E" #'srecode-edit) ;; Template indirect binding (let ((k ?a)) (while (<= k ?z) - (define-key km (format "%c" k) 'srecode-bind-insert) + (define-key km (format "%c" k) #'srecode-bind-insert) (setq k (1+ k)))) km) "Keymap used behind the srecode prefix key in srecode minor mode.") @@ -141,16 +141,17 @@ non-nil if the minor mode is enabled. ;; this mode first. (if srecode-minor-mode (if (not (apply - 'append + #'append (mapcar (lambda (map) (srecode-map-entries-for-mode map major-mode)) (srecode-get-maps)))) (setq srecode-minor-mode nil) ;; Else, we have success, do stuff - (add-hook 'cedet-m3-menu-do-hooks 'srecode-m3-items nil t) - ) - (remove-hook 'cedet-m3-menu-do-hooks 'srecode-m3-items t) - ) + ;; FIXME: Where are `cedet-m3-menu-do-hooks' nor `srecode-m3-items'? + (when (fboundp 'srecode-m3-items) + (add-hook 'cedet-m3-menu-do-hooks #'srecode-m3-items nil t))) + (when (fboundp 'srecode-m3-items) + (remove-hook 'cedet-m3-menu-do-hooks #'srecode-m3-items t))) ;; Run hooks if we are turning this on. (when srecode-minor-mode (run-hooks 'srecode-minor-mode-hook)) @@ -170,7 +171,7 @@ non-nil if the minor mode is enabled. ;;; Menu Filters ;; -(defun srecode-minor-mode-templates-menu (menu-def) +(defun srecode-minor-mode-templates-menu (_menu-def) "Create a menu item of cascading filters active for this mode. MENU-DEF is the menu to bind this into." ;; Doing this SEGVs Emacs on windows. @@ -246,7 +247,7 @@ MENU-DEF is the menu to bind this into." (defvar srecode-minor-mode-generators nil "List of code generators to be displayed in the srecoder menu.") -(defun srecode-minor-mode-generate-menu (menu-def) +(defun srecode-minor-mode-generate-menu (_menu-def) "Create a menu item of cascading filters active for this mode. MENU-DEF is the menu to bind this into." ;; Doing this SEGVs Emacs on windows. diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el index bbe1e5e469c..71579158494 100644 --- a/lisp/cedet/srecode/srt-mode.el +++ b/lisp/cedet/srecode/srt-mode.el @@ -1,4 +1,4 @@ -;;; srecode/srt-mode.el --- Major mode for writing screcode macros +;;; srecode/srt-mode.el --- Major mode for writing screcode macros -*- lexical-binding: t; -*- ;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc. @@ -181,9 +181,9 @@ we can tell font lock about them.") (defvar srecode-template-mode-map (let ((km (make-sparse-keymap))) - (define-key km "\C-c\C-c" 'srecode-compile-templates) - (define-key km "\C-c\C-m" 'srecode-macro-help) - (define-key km "/" 'srecode-self-insert-complete-end-macro) + (define-key km "\C-c\C-c" #'srecode-compile-templates) + (define-key km "\C-c\C-m" #'srecode-macro-help) + (define-key km "/" #'srecode-self-insert-complete-end-macro) km) "Keymap used in srecode mode.") @@ -205,7 +205,7 @@ we can tell font lock about them.") ((?_ . "w") (?- . "w"))))) ;;;###autoload -(defalias 'srt-mode 'srecode-template-mode) +(defalias 'srt-mode #'srecode-template-mode) ;;; Template Commands ;; @@ -436,7 +436,7 @@ Moves to the end of one named section." (when point (goto-char (point))) (let* ((tag (semantic-current-tag)) (args (semantic-tag-function-arguments tag)) - (argsym (mapcar 'intern args)) + (argsym (mapcar #'intern args)) (argvars nil) ;; Create a temporary dictionary in which the ;; arguments can be resolved so we can extract @@ -475,7 +475,7 @@ section or ? for an ask variable." (ee (regexp-quote (srecode-template-get-escape-end))) (start (point)) (macrostart nil) - (raw nil) + ;; (raw nil) ) (when (and tag (semantic-tag-of-class-p tag 'function) (srecode-in-macro-p point) @@ -627,7 +627,7 @@ section or ? for an ask variable." context-return))) (define-mode-local-override semantic-analyze-possible-completions - srecode-template-mode (context &rest flags) + srecode-template-mode (context &rest _flags) "Return a list of possible completions based on NONTEXT." (with-current-buffer (oref context buffer) (let* ((prefix (car (last (oref context prefix)))) diff --git a/lisp/cedet/srecode/srt.el b/lisp/cedet/srecode/srt.el index e222997708b..161b5105b51 100644 --- a/lisp/cedet/srecode/srt.el +++ b/lisp/cedet/srecode/srt.el @@ -1,4 +1,4 @@ -;;; srecode/srt.el --- argument handlers for SRT files +;;; srecode/srt.el --- argument handlers for SRT files -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -43,7 +43,7 @@ DEFAULT is the default if RET is hit." (currfcn (semantic-current-tag)) ) (srecode-resolve-argument-list - (mapcar 'read + (mapcar #'read (semantic-tag-get-attribute currfcn :arguments)) newdict) @@ -56,7 +56,7 @@ DEFAULT is the default if RET is hit." (defvar srecode-read-major-mode-history nil "History for `srecode-read-variable-name'.") -(defun srecode-read-major-mode-name (prompt &optional initial hist default) +(defun srecode-read-major-mode-name (prompt &optional initial hist _default) "Read in the name of a desired `major-mode'. PROMPT is the prompt to use. INITIAL is the initial string. @@ -64,7 +64,7 @@ HIST is the history value, otherwise `srecode-read-variable-name-history' is used. DEFAULT is the default if RET is hit." (completing-read prompt obarray - (lambda (s) (string-match "-mode$" (symbol-name s))) + (lambda (s) (string-match "-mode\\'" (symbol-name s))) nil initial (or hist 'srecode-read-major-mode-history)) ) diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el index 60a466f89d9..7ce5cc73b61 100644 --- a/lisp/cedet/srecode/table.el +++ b/lisp/cedet/srecode/table.el @@ -1,4 +1,4 @@ -;;; srecode/table.el --- Tables of Semantic Recoders +;;; srecode/table.el --- Tables of Semantic Recoders -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -169,7 +169,7 @@ calculate all inherited templates from parent modes." :modetables nil :tables nil))) ;; Save this new mode table in that mode's variable. - (eval `(setq-mode-local ,mode srecode-table ,new)) + (eval `(setq-mode-local ,mode srecode-table ,new) t) new)))) @@ -184,7 +184,7 @@ INIT are the initialization parameters for the new template table." (let* ((mt (srecode-make-mode-table mode)) (old (srecode-mode-table-find mt file)) (attr (file-attributes file)) - (new (apply 'srecode-template-table + (new (apply #'srecode-template-table (file-name-nondirectory file) :file file :filesize (file-attribute-size attr) diff --git a/lisp/cedet/srecode/template.el b/lisp/cedet/srecode/template.el index e9e5115128f..4f7eaffeb47 100644 --- a/lisp/cedet/srecode/template.el +++ b/lisp/cedet/srecode/template.el @@ -1,4 +1,4 @@ -;;; srecode/template.el --- SRecoder template language parser support. +;;; srecode/template.el --- SRecoder template language parser support. -*- lexical-binding: t; -*- ;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/srecode/texi.el b/lisp/cedet/srecode/texi.el index 892ae4e2e31..1312a55a898 100644 --- a/lisp/cedet/srecode/texi.el +++ b/lisp/cedet/srecode/texi.el @@ -1,4 +1,4 @@ -;;; srecode/texi.el --- Srecode texinfo support. +;;; srecode/texi.el --- Srecode texinfo support. -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -224,7 +224,7 @@ Takes a few very generic guesses as to what the formatting is." ;; Return our modified doc string. docstring)) -(defun srecode-texi-massage-to-texinfo (tag buffer string) +(defun srecode-texi-massage-to-texinfo (_tag buffer string) "Massage TAG's documentation from BUFFER as STRING. This is to take advantage of TeXinfo's markup symbols." (save-excursion diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 7b05f5796a4..b7afef6516d 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -36,7 +36,7 @@ (defun minibuffer-prompt-properties--setter (symbol value) (set-default symbol value) (if (memq 'cursor-intangible value) - (add-hook 'minibuffer-setup-hook 'cursor-intangible-mode) + (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode) ;; Removing it is a bit trickier since it could have been added by someone ;; else as well, so let's just not bother. )) diff --git a/lisp/custom.el b/lisp/custom.el index 833810718b7..85e5d65ffb2 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1200,6 +1200,32 @@ property `theme-feature' (which is usually a symbol created by (custom-check-theme theme) (provide (get theme 'theme-feature))) +(defun require-theme (feature &optional noerror) + "Load FEATURE from a file along `custom-theme-load-path'. + +This function is like `require', but searches along +`custom-theme-load-path' instead of `load-path'. It can be used +by Custom themes to load supporting Lisp files when `require' is +unsuitable. + +If FEATURE is not already loaded, search for a file named FEATURE +with an added `.elc' or `.el' suffix, in that order, in the +directories specified by `custom-theme-load-path'. + +Return FEATURE if the file is successfully found and loaded, or +if FEATURE was already loaded. If the file fails to load, signal +an error. If optional argument NOERROR is non-nil, return nil +instead of signaling an error. If the file loads but does not +provide FEATURE, signal an error. This cannot be suppressed." + (cond + ((featurep feature) feature) + ((let* ((path (custom-theme--load-path)) + (file (locate-file (symbol-name feature) path '(".elc" ".el")))) + (and file (require feature (file-name-sans-extension file) noerror)))) + ((not noerror) + (signal 'file-missing `("Cannot open load file" "No such file or directory" + ,(symbol-name feature)))))) + (defcustom custom-safe-themes '(default) "Themes that are considered safe to load. If the value is a list, each element should be either the SHA-256 diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index a94bdf5b42e..d5f49108767 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1072,8 +1072,13 @@ To kill an entire subdirectory \(without killing its line in the parent directory), go to its directory header line and use this command with a prefix argument (the value does not matter). -To undo the killing, the undo command can be used as normally." - ;; Returns count of killed lines. FMT="" suppresses message. +To undo the killing, the undo command can be used as normally. + +This function returns the number of killed lines. + +FMT is a format string used for messaging the user about the +killed lines, and defaults to \"Killed %d line%s.\" if not +present. A FMT of \"\" will suppress the messaging." (interactive "P") (if arg (if (dired-get-subdir) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 1199de183fb..5f31bc402ff 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -236,8 +236,6 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." ;;; MENU BINDINGS -(require 'easymenu) - (when-let ((menu (lookup-key dired-mode-map [menu-bar]))) (easy-menu-add-item menu '("Operate") ["Find Files" dired-do-find-marked-files diff --git a/lisp/dired.el b/lisp/dired.el index 4f1c3ded092..11df93ec3bb 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1966,328 +1966,217 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map ":s" 'epa-dired-do-sign) (define-key map ":e" 'epa-dired-do-encrypt) - ;; Make menu bar items. - ;; No need to do this, now that top-level items are fewer. ;;;; ;; Get rid of the Edit menu bar item to save space. ;(define-key map [menu-bar edit] 'undefined) - (define-key map [menu-bar subdir] - (cons "Subdir" (make-sparse-keymap "Subdir"))) - - (define-key map [menu-bar subdir hide-all] - '(menu-item "Hide All" dired-hide-all - :help "Hide all subdirectories, leave only header lines")) - (define-key map [menu-bar subdir hide-subdir] - '(menu-item "Hide/UnHide Subdir" dired-hide-subdir - :help "Hide or unhide current directory listing")) - (define-key map [menu-bar subdir tree-down] - '(menu-item "Tree Down" dired-tree-down - :help "Go to first subdirectory header down the tree")) - (define-key map [menu-bar subdir tree-up] - '(menu-item "Tree Up" dired-tree-up - :help "Go to first subdirectory header up the tree")) - (define-key map [menu-bar subdir up] - '(menu-item "Up Directory" dired-up-directory - :help "Edit the parent directory")) - (define-key map [menu-bar subdir prev-subdir] - '(menu-item "Prev Subdir" dired-prev-subdir - :help "Go to previous subdirectory header line")) - (define-key map [menu-bar subdir next-subdir] - '(menu-item "Next Subdir" dired-next-subdir - :help "Go to next subdirectory header line")) - (define-key map [menu-bar subdir prev-dirline] - '(menu-item "Prev Dirline" dired-prev-dirline - :help "Move to next directory-file line")) - (define-key map [menu-bar subdir next-dirline] - '(menu-item "Next Dirline" dired-next-dirline - :help "Move to previous directory-file line")) - (define-key map [menu-bar subdir insert] - '(menu-item "Insert This Subdir" dired-maybe-insert-subdir - :help "Insert contents of subdirectory" - :enable (let ((f (dired-get-filename nil t))) - (and f (file-directory-p f))))) - (define-key map [menu-bar immediate] - (cons "Immediate" (make-sparse-keymap "Immediate"))) - - (define-key map - [menu-bar immediate image-dired-dired-display-external] - '(menu-item "Display Image Externally" image-dired-dired-display-external - :help "Display image in external viewer")) - (define-key map - [menu-bar immediate image-dired-dired-display-image] - '(menu-item "Display Image" image-dired-dired-display-image - :help "Display sized image in a separate window")) - (define-key map - [menu-bar immediate image-dired-dired-toggle-marked-thumbs] - '(menu-item "Toggle Image Thumbnails in This Buffer" image-dired-dired-toggle-marked-thumbs - :help "Add or remove image thumbnails in front of marked file names")) - - (define-key map [menu-bar immediate hide-details] - '(menu-item "Hide Details" dired-hide-details-mode - :help "Hide details in buffer" - :button (:toggle . dired-hide-details-mode))) - (define-key map [menu-bar immediate revert-buffer] - '(menu-item "Refresh" revert-buffer - :help "Update contents of shown directories")) - (define-key map [menu-bar immediate dired-number-of-marked-files] - '(menu-item "#Marked Files" dired-number-of-marked-files - :help "Display the number and size of the marked files")) - - (define-key map [menu-bar immediate dashes] - '("--")) - - (define-key map [menu-bar immediate isearch-filenames-regexp] - '(menu-item "Isearch Regexp in File Names..." dired-isearch-filenames-regexp - :help "Incrementally search for regexp in file names only")) - (define-key map [menu-bar immediate isearch-filenames] - '(menu-item "Isearch in File Names..." dired-isearch-filenames - :help "Incrementally search for string in file names only.")) - (define-key map [menu-bar immediate compare-directories] - '(menu-item "Compare Directories..." dired-compare-directories - :help "Mark files with different attributes in two Dired buffers")) - (define-key map [menu-bar immediate backup-diff] - '(menu-item "Compare with Backup" dired-backup-diff - :help "Diff file at cursor with its latest backup")) - (define-key map [menu-bar immediate diff] - '(menu-item "Diff..." dired-diff - :help "Compare file at cursor with another file")) - (define-key map [menu-bar immediate view] - '(menu-item "View This File" dired-view-file - :help "Examine file at cursor in read-only mode")) - (define-key map [menu-bar immediate display] - '(menu-item "Display in Other Window" dired-display-file - :help "Display file at cursor in other window")) - (define-key map [menu-bar immediate find-file-other-window] - '(menu-item "Find in Other Window" dired-find-file-other-window - :help "Edit file at cursor in other window")) - (define-key map [menu-bar immediate find-file] - '(menu-item "Find This File" dired-find-file - :help "Edit file at cursor")) - (define-key map [menu-bar immediate create-directory] - '(menu-item "Create Directory..." dired-create-directory - :help "Create a directory")) - (define-key map [menu-bar immediate create-empty-file] - '(menu-item "Create Empty file..." dired-create-empty-file - :help "Create an empty file")) - (define-key map [menu-bar immediate wdired-mode] - '(menu-item "Edit File Names" wdired-change-to-wdired-mode - :help "Put a Dired buffer in a mode in which filenames are editable" - :keys "C-x C-q" - :filter (lambda (x) (if (eq major-mode 'dired-mode) x)))) - - (define-key map [menu-bar regexp] - (cons "Regexp" (make-sparse-keymap "Regexp"))) - - (define-key map - [menu-bar regexp image-dired-mark-tagged-files] - '(menu-item "Mark From Image Tag..." image-dired-mark-tagged-files - :help "Mark files whose image tags matches regexp")) - - (define-key map [menu-bar regexp dashes-1] - '("--")) - - (define-key map [menu-bar regexp downcase] - '(menu-item "Downcase" dired-downcase - ;; When running on plain MS-DOS, there's only one - ;; letter-case for file names. - :enable (or (not (fboundp 'msdos-long-file-names)) - (msdos-long-file-names)) - :help "Rename marked files to lower-case name")) - (define-key map [menu-bar regexp upcase] - '(menu-item "Upcase" dired-upcase - :enable (or (not (fboundp 'msdos-long-file-names)) - (msdos-long-file-names)) - :help "Rename marked files to upper-case name")) - (define-key map [menu-bar regexp hardlink] - '(menu-item "Hardlink..." dired-do-hardlink-regexp - :help "Make hard links for files matching regexp")) - (define-key map [menu-bar regexp symlink] - '(menu-item "Symlink..." dired-do-symlink-regexp - :visible (fboundp 'make-symbolic-link) - :help "Make symbolic links for files matching regexp")) - (define-key map [menu-bar regexp rename] - '(menu-item "Rename..." dired-do-rename-regexp - :help "Rename marked files matching regexp")) - (define-key map [menu-bar regexp copy] - '(menu-item "Copy..." dired-do-copy-regexp - :help "Copy marked files matching regexp")) - (define-key map [menu-bar regexp flag] - '(menu-item "Flag..." dired-flag-files-regexp - :help "Flag files matching regexp for deletion")) - (define-key map [menu-bar regexp mark] - '(menu-item "Mark..." dired-mark-files-regexp - :help "Mark files matching regexp for future operations")) - (define-key map [menu-bar regexp mark-cont] - '(menu-item "Mark Containing..." dired-mark-files-containing-regexp - :help "Mark files whose contents matches regexp")) - - (define-key map [menu-bar mark] - (cons "Mark" (make-sparse-keymap "Mark"))) - - (define-key map [menu-bar mark prev] - '(menu-item "Previous Marked" dired-prev-marked-file - :help "Move to previous marked file")) - (define-key map [menu-bar mark next] - '(menu-item "Next Marked" dired-next-marked-file - :help "Move to next marked file")) - (define-key map [menu-bar mark marks] - '(menu-item "Change Marks..." dired-change-marks - :help "Replace marker with another character")) - (define-key map [menu-bar mark unmark-all] - '(menu-item "Unmark All" dired-unmark-all-marks)) - (define-key map [menu-bar mark symlinks] - '(menu-item "Mark Symlinks" dired-mark-symlinks - :visible (fboundp 'make-symbolic-link) - :help "Mark all symbolic links")) - (define-key map [menu-bar mark directories] - '(menu-item "Mark Directories" dired-mark-directories - :help "Mark all directories except `.' and `..'")) - (define-key map [menu-bar mark directory] - '(menu-item "Mark Old Backups" dired-clean-directory - :help "Flag old numbered backups for deletion")) - (define-key map [menu-bar mark executables] - '(menu-item "Mark Executables" dired-mark-executables - :help "Mark all executable files")) - (define-key map [menu-bar mark garbage-files] - '(menu-item "Flag Garbage Files" dired-flag-garbage-files - :help "Flag unneeded files for deletion")) - (define-key map [menu-bar mark backup-files] - '(menu-item "Flag Backup Files" dired-flag-backup-files - :help "Flag all backup files for deletion")) - (define-key map [menu-bar mark auto-save-files] - '(menu-item "Flag Auto-save Files" dired-flag-auto-save-files - :help "Flag auto-save files for deletion")) - (define-key map [menu-bar mark deletion] - '(menu-item "Flag" dired-flag-file-deletion - :help "Flag current line's file for deletion")) - (define-key map [menu-bar mark unmark] - '(menu-item "Unmark" dired-unmark - :help "Unmark or unflag current line's file")) - (define-key map [menu-bar mark mark] - '(menu-item "Mark" dired-mark - :help "Mark current line's file for future operations")) - (define-key map [menu-bar mark toggle-marks] - '(menu-item "Toggle Marks" dired-toggle-marks - :help "Mark unmarked files, unmark marked ones")) - - (define-key map [menu-bar operate] - (cons "Operate" (make-sparse-keymap "Operate"))) - - (define-key map - [menu-bar operate image-dired-delete-tag] - '(menu-item "Delete Image Tag..." image-dired-delete-tag - :help "Delete image tag from current or marked files")) - (define-key map - [menu-bar operate image-dired-tag-files] - '(menu-item "Add Image Tags..." image-dired-tag-files - :help "Add image tags to current or marked files")) - (define-key map - [menu-bar operate image-dired-dired-comment-files] - '(menu-item "Add Image Comment..." image-dired-dired-comment-files - :help "Add image comment to current or marked files")) - (define-key map - [menu-bar operate image-dired-display-thumbs] - '(menu-item "Display Image Thumbnails" image-dired-display-thumbs - :help "Display image thumbnails for current or marked image files")) - - (define-key map [menu-bar operate dashes-4] - '("--")) - - (define-key map - [menu-bar operate epa-dired-do-decrypt] - '(menu-item "Decrypt..." epa-dired-do-decrypt - :help "Decrypt current or marked files")) - - (define-key map - [menu-bar operate epa-dired-do-verify] - '(menu-item "Verify" epa-dired-do-verify - :help "Verify digital signature of current or marked files")) - - (define-key map - [menu-bar operate epa-dired-do-sign] - '(menu-item "Sign..." epa-dired-do-sign - :help "Create digital signature of current or marked files")) - - (define-key map - [menu-bar operate epa-dired-do-encrypt] - '(menu-item "Encrypt..." epa-dired-do-encrypt - :help "Encrypt current or marked files")) - - (define-key map [menu-bar operate dashes-3] - '("--")) - - (define-key map [menu-bar operate query-replace] - '(menu-item "Query Replace in Files..." dired-do-find-regexp-and-replace - :help "Replace regexp matches in marked files")) - (define-key map [menu-bar operate search] - '(menu-item "Search Files..." dired-do-find-regexp - :help "Search marked files for matches of regexp")) - (define-key map [menu-bar operate isearch-regexp] - '(menu-item "Isearch Regexp Files..." dired-do-isearch-regexp - :help "Incrementally search marked files for regexp")) - (define-key map [menu-bar operate isearch] - '(menu-item "Isearch Files..." dired-do-isearch - :help "Incrementally search marked files for string")) - (define-key map [menu-bar operate chown] - '(menu-item "Change Owner..." dired-do-chown - :visible (not (memq system-type '(ms-dos windows-nt))) - :help "Change the owner of marked files")) - (define-key map [menu-bar operate chgrp] - '(menu-item "Change Group..." dired-do-chgrp - :visible (not (memq system-type '(ms-dos windows-nt))) - :help "Change the group of marked files")) - (define-key map [menu-bar operate chmod] - '(menu-item "Change Mode..." dired-do-chmod - :help "Change mode (attributes) of marked files")) - (define-key map [menu-bar operate touch] - '(menu-item "Change Timestamp..." dired-do-touch - :help "Change timestamp of marked files")) - (define-key map [menu-bar operate load] - '(menu-item "Load" dired-do-load - :help "Load marked Emacs Lisp files")) - (define-key map [menu-bar operate compile] - '(menu-item "Byte-compile" dired-do-byte-compile - :help "Byte-compile marked Emacs Lisp files")) - (define-key map [menu-bar operate compress] - '(menu-item "Compress" dired-do-compress - :help "Compress/uncompress marked files")) - (define-key map [menu-bar operate print] - '(menu-item "Print..." dired-do-print - :help "Ask for print command and print marked files")) - (define-key map [menu-bar operate hardlink] - '(menu-item "Hardlink to..." dired-do-hardlink - :help "Make hard links for current or marked files")) - (define-key map [menu-bar operate symlink] - '(menu-item "Symlink to..." dired-do-symlink - :visible (fboundp 'make-symbolic-link) - :help "Make symbolic links for current or marked files")) - (define-key map [menu-bar operate async-command] - '(menu-item "Asynchronous Shell Command..." dired-do-async-shell-command - :help "Run a shell command asynchronously on current or marked files")) - (define-key map [menu-bar operate command] - '(menu-item "Shell Command..." dired-do-shell-command - :help "Run a shell command on current or marked files")) - (define-key map [menu-bar operate delete] - `(menu-item "Delete" - ,(let ((menu (make-sparse-keymap "Delete"))) - (define-key menu [delete-flagged] - '(menu-item "Delete Flagged Files" dired-do-flagged-delete - :help "Delete all files flagged for deletion (D)")) - (define-key menu [delete-marked] - '(menu-item "Delete Marked (Not Flagged) Files" dired-do-delete - :help "Delete current file or all marked files (excluding flagged files)")) - menu))) - (define-key map [menu-bar operate rename] - '(menu-item "Rename to..." dired-do-rename - :help "Rename current file or move marked files")) - (define-key map [menu-bar operate copy] - '(menu-item "Copy to..." dired-do-copy - :help "Copy current file or all marked files")) - map) "Local keymap for Dired mode buffers.") + +(easy-menu-define dired-mode-subdir-menu dired-mode-map + "Subdir menu for Dired mode." + '("Subdir" + ["Insert This Subdir" dired-maybe-insert-subdir + :help "Insert contents of subdirectory" + :enable (let ((f (dired-get-filename nil t))) + (and f (file-directory-p f)))] + ["Next Dirline" dired-next-dirline + :help "Move to previous directory-file line"] + ["Prev Dirline" dired-prev-dirline + :help "Move to next directory-file line"] + ["Next Subdir" dired-next-subdir + :help "Go to next subdirectory header line"] + ["Prev Subdir" dired-prev-subdir + :help "Go to previous subdirectory header line"] + ["Up Directory" dired-up-directory + :help "Edit the parent directory"] + ["Tree Up" dired-tree-up + :help "Go to first subdirectory header up the tree"] + ["Tree Down" dired-tree-down + :help "Go to first subdirectory header down the tree"] + ["Hide/UnHide Subdir" dired-hide-subdir + :help "Hide or unhide current directory listing"] + ["Hide All" dired-hide-all + :help "Hide all subdirectories, leave only header lines"])) + +(easy-menu-define dired-mode-immediate-menu dired-mode-map + "Immediate menu for Dired mode." + '("Immediate" + ["Edit File Names" wdired-change-to-wdired-mode + :help "Put a Dired buffer in a mode in which filenames are editable" + :keys "C-x C-q" + :filter (lambda (x) (if (eq major-mode 'dired-mode) x))] + ["Create Empty file..." dired-create-empty-file + :help "Create an empty file"] + ["Create Directory..." dired-create-directory + :help "Create a directory"] + ["Find This File" dired-find-file + :help "Edit file at cursor"] + ["Find in Other Window" dired-find-file-other-window + :help "Edit file at cursor in other window"] + ["Display in Other Window" dired-display-file + :help "Display file at cursor in other window"] + ["View This File" dired-view-file + :help "Examine file at cursor in read-only mode"] + ["Diff..." dired-diff + :help "Compare file at cursor with another file"] + ["Compare with Backup" dired-backup-diff + :help "Diff file at cursor with its latest backup"] + ["Compare Directories..." dired-compare-directories + :help "Mark files with different attributes in two Dired buffers"] + ["Isearch in File Names..." dired-isearch-filenames + :help "Incrementally search for string in file names only."] + ["Isearch Regexp in File Names..." dired-isearch-filenames-regexp + :help "Incrementally search for regexp in file names only"] + "---" + ["#Marked Files" dired-number-of-marked-files + :help "Display the number and size of the marked files"] + ["Refresh" revert-buffer + :help "Update contents of shown directories"] + ["Hide Details" dired-hide-details-mode + :help "Hide details in buffer" + :style toggle + :selected dired-hide-details-mode] + ["Toggle Image Thumbnails in This Buffer" image-dired-dired-toggle-marked-thumbs + :help "Add or remove image thumbnails in front of marked file names"] + ["Display Image" image-dired-dired-display-image + :help "Display sized image in a separate window"] + ["Display Image Externally" image-dired-dired-display-external + :help "Display image in external viewer"])) + +(easy-menu-define dired-mode-regexp-menu dired-mode-map + "Regexp menu for Dired mode." + '("Regexp" + ["Mark Containing..." dired-mark-files-containing-regexp + :help "Mark files whose contents matches regexp"] + ["Mark..." dired-mark-files-regexp + :help "Mark files matching regexp for future operations"] + ["Flag..." dired-flag-files-regexp + :help "Flag files matching regexp for deletion"] + ["Copy..." dired-do-copy-regexp + :help "Copy marked files matching regexp"] + ["Rename..." dired-do-rename-regexp + :help "Rename marked files matching regexp"] + ["Symlink..." dired-do-symlink-regexp + :visible (fboundp 'make-symbolic-link) + :help "Make symbolic links for files matching regexp"] + ["Hardlink..." dired-do-hardlink-regexp + :help "Make hard links for files matching regexp"] + ["Upcase" dired-upcase + :enable (or (not (fboundp 'msdos-long-file-names)) + (msdos-long-file-names)) + :help "Rename marked files to upper-case name"] + ["Downcase" dired-downcase + ;; When running on plain MS-DOS, there's only one + ;; letter-case for file names. + :enable (or (not (fboundp 'msdos-long-file-names)) + (msdos-long-file-names)) + :help "Rename marked files to lower-case name"] + "---" + ["Mark From Image Tag..." image-dired-mark-tagged-files + :help "Mark files whose image tags matches regexp"])) + +(easy-menu-define dired-mode-mark-menu dired-mode-map + "Mark menu for Dired mode." + '("Mark" + ["Toggle Marks" dired-toggle-marks + :help "Mark unmarked files, unmark marked ones"] + ["Mark" dired-mark + :help "Mark current line's file for future operations"] + ["Unmark" dired-unmark + :help "Unmark or unflag current line's file"] + ["Flag" dired-flag-file-deletion + :help "Flag current line's file for deletion"] + ["Flag Auto-save Files" dired-flag-auto-save-files + :help "Flag auto-save files for deletion"] + ["Flag Backup Files" dired-flag-backup-files + :help "Flag all backup files for deletion"] + ["Flag Garbage Files" dired-flag-garbage-files + :help "Flag unneeded files for deletion"] + ["Mark Executables" dired-mark-executables + :help "Mark all executable files"] + ["Mark Old Backups" dired-clean-directory + :help "Flag old numbered backups for deletion"] + ["Mark Directories" dired-mark-directories + :help "Mark all directories except `.' and `..'"] + ["Mark Symlinks" dired-mark-symlinks + :visible (fboundp 'make-symbolic-link) + :help "Mark all symbolic links"] + ["Unmark All" dired-unmark-all-marks] + ["Change Marks..." dired-change-marks + :help "Replace marker with another character"] + ["Next Marked" dired-next-marked-file + :help "Move to next marked file"] + ["Previous Marked" dired-prev-marked-file + :help "Move to previous marked file"])) + +(easy-menu-define dired-mode-operate-menu dired-mode-map + "Operate menu for Dired mode." + '("Operate" + ["Copy to..." dired-do-copy + :help "Copy current file or all marked files"] + ["Rename to..." dired-do-rename + :help "Rename current file or move marked files"] + ("Delete" + ["Delete Flagged Files" dired-do-flagged-delete + :help "Delete all files flagged for deletion (D)"] + ["Delete Marked (Not Flagged) Files" dired-do-delete + :help "Delete current file or all marked files (excluding flagged files)"]) + ["Shell Command..." dired-do-shell-command + :help "Run a shell command on current or marked files"] + ["Asynchronous Shell Command..." dired-do-async-shell-command + :help "Run a shell command asynchronously on current or marked files"] + ["Symlink to..." dired-do-symlink + :visible (fboundp 'make-symbolic-link) + :help "Make symbolic links for current or marked files"] + ["Hardlink to..." dired-do-hardlink + :help "Make hard links for current or marked files"] + ["Print..." dired-do-print + :help "Ask for print command and print marked files"] + ["Compress" dired-do-compress + :help "Compress/uncompress marked files"] + ["Byte-compile" dired-do-byte-compile + :help "Byte-compile marked Emacs Lisp files"] + ["Load" dired-do-load + :help "Load marked Emacs Lisp files"] + ["Change Timestamp..." dired-do-touch + :help "Change timestamp of marked files"] + ["Change Mode..." dired-do-chmod + :help "Change mode (attributes) of marked files"] + ["Change Group..." dired-do-chgrp + :visible (not (memq system-type '(ms-dos windows-nt))) + :help "Change the group of marked files"] + ["Change Owner..." dired-do-chown + :visible (not (memq system-type '(ms-dos windows-nt))) + :help "Change the owner of marked files"] + ["Isearch Files..." dired-do-isearch + :help "Incrementally search marked files for string"] + ["Isearch Regexp Files..." dired-do-isearch-regexp + :help "Incrementally search marked files for regexp"] + ["Search Files..." dired-do-find-regexp + :help "Search marked files for matches of regexp"] + ["Query Replace in Files..." dired-do-find-regexp-and-replace + :help "Replace regexp matches in marked files"] + "---" + ["Encrypt..." epa-dired-do-encrypt + :help "Encrypt current or marked files"] + ["Sign..." epa-dired-do-sign + :help "Create digital signature of current or marked files"] + ["Verify" epa-dired-do-verify + :help "Verify digital signature of current or marked files"] + ["Decrypt..." epa-dired-do-decrypt + :help "Decrypt current or marked files"] + "---" + ["Display Image Thumbnails" image-dired-display-thumbs + :help "Display image thumbnails for current or marked image files"] + ["Add Image Comment..." image-dired-dired-comment-files + :help "Add image comment to current or marked files"] + ["Add Image Tags..." image-dired-tag-files + :help "Add image tags to current or marked files"] + ["Delete Image Tag..." image-dired-delete-tag + :help "Delete image tag from current or marked files"])) + ;; Dired mode is suitable only for specially formatted data. (put 'dired-mode 'mode-class 'special) @@ -4240,7 +4129,8 @@ Possible values: * `as-is': Show full switches. * Integer: Show only the first N chars of full switches. * Function: Pass `dired-actual-switches' as arg and show result." - :group 'Dired-Plus + :group 'dired + :version "28.1" :type '(choice (const :tag "Indicate by name or date, else full" nil) (const :tag "Show full switches" as-is) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index b1b2144e3de..98994963e3e 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -62,39 +62,40 @@ ;; struct data item[/* items */]; ;; }; ;; -;; The corresponding Lisp bindat specification looks like this: +;; The corresponding Lisp bindat specification could look like this: +;; +;; (bindat-defmacro ip () '(vec 4 byte)) ;; ;; (setq header-bindat-spec -;; (bindat-spec +;; (bindat-type ;; (dest-ip ip) ;; (src-ip ip) -;; (dest-port u16) -;; (src-port u16))) +;; (dest-port uint 16) +;; (src-port uint 16))) ;; ;; (setq data-bindat-spec -;; (bindat-spec +;; (bindat-type ;; (type u8) ;; (opcode u8) -;; (length u32r) ;; little endian order +;; (length uintr 32) ;; little endian order ;; (id strz 8) -;; (data vec (length)) -;; (align 4))) +;; (data vec length) +;; (_ align 4))) ;; ;; (setq packet-bindat-spec -;; (bindat-spec -;; (header struct header-bindat-spec) -;; (items u8) -;; (fill 3) -;; (item repeat (items) -;; (struct data-bindat-spec)))) -;; +;; (bindat-type +;; (header type header-bindat-spec) +;; (nitems u8) +;; (_ fill 3) +;; (items repeat nitems type data-bindat-spec))) ;; ;; A binary data representation may look like ;; [ 192 168 1 100 192 168 1 101 01 28 21 32 2 0 0 0 ;; 2 3 5 0 ?A ?B ?C ?D ?E ?F 0 0 1 2 3 4 5 0 0 0 ;; 1 4 7 0 ?B ?C ?D ?E ?F ?G 0 0 6 7 8 9 10 11 12 0 ] ;; -;; The corresponding decoded structure looks like +;; The corresponding decoded structure returned by `bindat-unpack' (or taken +;; by `bindat-pack') looks like: ;; ;; ((header ;; (dest-ip . [192 168 1 100]) @@ -114,94 +115,28 @@ ;; (type . 1)))) ;; ;; To access a specific value in this structure, use the function -;; bindat-get-field with the structure as first arg followed by a list +;; `bindat-get-field' with the structure as first arg followed by a list ;; of field names and array indexes, e.g. using the data above, ;; (bindat-get-field decoded-structure 'item 1 'id) ;; returns "BCDEFG". -;; Binary Data Structure Specification Format -;; ------------------------------------------ - -;; We recommend using names that end in `-bindat-spec'; such names -;; are recognized automatically as "risky" variables. - -;; The data specification is formatted as follows: - -;; SPEC ::= ( ITEM... ) - -;; ITEM ::= ( FIELD TYPE ) -;; | ( [FIELD] eval FORM ) -- eval FORM for side-effect only -;; | ( [FIELD] fill LEN ) -- skip LEN bytes -;; | ( [FIELD] align LEN ) -- skip to next multiple of LEN bytes -;; | ( [FIELD] struct SPEC_NAME ) -;; | ( [FIELD] union TAG_VAL (TAG SPEC)... [(t SPEC)] ) -;; | ( FIELD repeat ARG ITEM... ) - -;; -- In (eval EXPR), the value of the last field is available in -;; the dynamically bound variable `last' and all the previous -;; ones in the variable `struct'. - -;; TYPE ::= ( eval EXPR ) -- interpret result as TYPE -;; | u8 | byte -- length 1 -;; | u16 | word | short -- length 2, network byte order -;; | u24 -- 3-byte value -;; | u32 | dword | long -- length 4, network byte order -;; | u64 -- length 8, network byte order -;; | u16r | u24r | u32r | u64r - little endian byte order. -;; | str LEN -- LEN byte string -;; | strz LEN -- LEN byte (zero-terminated) string -;; | vec LEN [TYPE] -- vector of LEN items of TYPE (default: u8) -;; | ip -- 4 byte vector -;; | bits LEN -- bit vector using LEN bytes. -;; -;; -- Example: `bits 2' will unpack 0x28 0x1c to (2 3 4 11 13) -;; and 0x1c 0x28 to (3 5 10 11 12). - -;; FIELD ::= ( eval EXPR ) -- use result as NAME -;; | NAME - -;; LEN ::= ARG -;; | <omitted> | nil -- LEN = 1 - - -;; TAG_VAL ::= ARG - -;; TAG ::= LISP_CONSTANT -;; | ( eval EXPR ) -- return non-nil if tag match; -;; current TAG_VAL in `tag'. - -;; ARG ::= ( eval EXPR ) -- interpret result as ARG -;; | INTEGER_CONSTANT -;; | DEREF - -;; DEREF ::= ( [NAME | INTEGER]... ) -- Field NAME or Array index relative -;; to current structure spec. -;; -- see bindat-get-field - -;; A `union' specification -;; ([FIELD] union TAG_VAL (TAG SPEC) ... [(t SPEC)]) -;; is interpreted by evalling TAG_VAL and then comparing that to -;; each TAG using equal; if a match is found, the corresponding SPEC -;; is used. -;; If TAG is a form (eval EXPR), EXPR is eval'ed with `tag' bound to the -;; value of TAG_VAL; the corresponding SPEC is used if the result is non-nil. -;; Finally, if TAG is t, the corresponding SPEC is used unconditionally. -;; -;; An `eval' specification -;; ([FIELD] eval FORM) -;; is interpreted by evalling FORM for its side effects only. -;; If FIELD is specified, the value is bound to that field. -;; The FORM may access and update `bindat-raw' and `bindat-idx' (see `bindat-unpack'). - ;;; Code: ;; Helper functions for structure unpacking. ;; Relies on dynamic binding of `bindat-raw' and `bindat-idx'. +(eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'subr-x)) ;For `named-let'. + +(cl-defstruct (bindat--type + (:predicate nil) + (:constructor bindat--make)) + le ue pe) + (defvar bindat-raw) (defvar bindat-idx) -(defun bindat--unpack-u8 () +(defsubst bindat--unpack-u8 () (prog1 (aref bindat-raw bindat-idx) (setq bindat-idx (1+ bindat-idx)))) @@ -215,9 +150,6 @@ (defun bindat--unpack-u32 () (logior (ash (bindat--unpack-u16) 16) (bindat--unpack-u16))) -(defun bindat--unpack-u64 () - (logior (ash (bindat--unpack-u32) 32) (bindat--unpack-u32))) - (defun bindat--unpack-u16r () (logior (bindat--unpack-u8) (ash (bindat--unpack-u8) 8))) @@ -227,50 +159,48 @@ (defun bindat--unpack-u32r () (logior (bindat--unpack-u16r) (ash (bindat--unpack-u16r) 16))) -(defun bindat--unpack-u64r () - (logior (bindat--unpack-u32r) (ash (bindat--unpack-u32r) 32))) +(defun bindat--unpack-str (len) + (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len)))) + (setq bindat-idx (+ bindat-idx len)) + (if (stringp s) s + (apply #'unibyte-string s)))) + +(defun bindat--unpack-strz (len) + (let ((i 0) s) + (while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0)) + (setq i (1+ i))) + (setq s (substring bindat-raw bindat-idx (+ bindat-idx i))) + (setq bindat-idx (+ bindat-idx len)) + (if (stringp s) s + (apply #'unibyte-string s)))) + +(defun bindat--unpack-bits (len) + (let ((bits nil) (bnum (1- (* 8 len))) j m) + (while (>= bnum 0) + (if (= (setq m (bindat--unpack-u8)) 0) + (setq bnum (- bnum 8)) + (setq j 128) + (while (> j 0) + (if (/= 0 (logand m j)) + (setq bits (cons bnum bits))) + (setq bnum (1- bnum) + j (ash j -1))))) + bits)) (defun bindat--unpack-item (type len &optional vectype) (if (eq type 'ip) (setq type 'vec len 4)) (pcase type - ((or 'u8 'byte) - (bindat--unpack-u8)) - ((or 'u16 'word 'short) - (bindat--unpack-u16)) + ((or 'u8 'byte) (bindat--unpack-u8)) + ((or 'u16 'word 'short) (bindat--unpack-u16)) ('u24 (bindat--unpack-u24)) - ((or 'u32 'dword 'long) - (bindat--unpack-u32)) - ('u64 (bindat--unpack-u64)) + ((or 'u32 'dword 'long) (bindat--unpack-u32)) ('u16r (bindat--unpack-u16r)) ('u24r (bindat--unpack-u24r)) ('u32r (bindat--unpack-u32r)) - ('u64r (bindat--unpack-u64r)) - ('bits - (let ((bits nil) (bnum (1- (* 8 len))) j m) - (while (>= bnum 0) - (if (= (setq m (bindat--unpack-u8)) 0) - (setq bnum (- bnum 8)) - (setq j 128) - (while (> j 0) - (if (/= 0 (logand m j)) - (setq bits (cons bnum bits))) - (setq bnum (1- bnum) - j (ash j -1))))) - bits)) - ('str - (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len)))) - (setq bindat-idx (+ bindat-idx len)) - (if (stringp s) s - (apply #'unibyte-string s)))) - ('strz - (let ((i 0) s) - (while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0)) - (setq i (1+ i))) - (setq s (substring bindat-raw bindat-idx (+ bindat-idx i))) - (setq bindat-idx (+ bindat-idx len)) - (if (stringp s) s - (apply #'unibyte-string s)))) + ('bits (bindat--unpack-bits len)) + ('str (bindat--unpack-str len)) + ('strz (bindat--unpack-strz len)) ('vec (let ((v (make-vector len 0)) (vlen 1)) (if (consp vectype) @@ -283,7 +213,15 @@ v)) (_ nil))) +(defsubst bindat--align (n len) + (* len (/ (+ n (1- len)) len))) ;Isn't there a simpler way? + (defun bindat--unpack-group (spec) + ;; FIXME: Introduce a new primitive so we can mark `bindat-unpack' + ;; as obsolete (maybe that primitive should be a macro which takes + ;; a bindat type *expression* as argument). + (if (cl-typep spec 'bindat--type) + (funcall (bindat--type-ue spec)) (with-suppressed-warnings ((lexical struct last)) (defvar struct) (defvar last)) (let (struct last) @@ -317,8 +255,7 @@ ('fill (setq bindat-idx (+ bindat-idx len))) ('align - (while (/= (% bindat-idx len) 0) - (setq bindat-idx (1+ bindat-idx)))) + (setq bindat-idx (bindat--align bindat-idx len))) ('struct (setq data (bindat--unpack-group (eval len t)))) ('repeat @@ -345,7 +282,7 @@ (setq struct (if field (cons (cons field data) struct) (append data struct)))))) - struct)) + struct))) (defun bindat-unpack (spec raw &optional idx) "Return structured data according to SPEC for binary data in RAW. @@ -366,9 +303,8 @@ An integer value in the field list is taken as an array index, e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (while (and struct field) (setq struct (if (integerp (car field)) - (nth (car field) struct) - (let ((val (assq (car field) struct))) - (if (consp val) (cdr val))))) + (elt struct (car field)) + (cdr (assq (car field) struct)))) (setq field (cdr field))) struct) @@ -379,10 +315,11 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (u16 . 2) (u16r . 2) (word . 2) (short . 2) (u24 . 3) (u24r . 3) (u32 . 4) (u32r . 4) (dword . 4) (long . 4) - (u64 . 8) (u64r . 8) (ip . 4))) (defun bindat--length-group (struct spec) + (if (cl-typep spec 'bindat--type) + (funcall (bindat--type-le spec) struct) (with-suppressed-warnings ((lexical struct last)) (defvar struct) (defvar last)) (let ((struct struct) last) @@ -421,8 +358,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." ('fill (setq bindat-idx (+ bindat-idx len))) ('align - (while (/= (% bindat-idx len) 0) - (setq bindat-idx (1+ bindat-idx)))) + (setq bindat-idx (bindat--align bindat-idx len))) ('struct (bindat--length-group (if field (bindat-get-field struct field) struct) (eval len t))) @@ -449,7 +385,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq len (* len (cdr type)))) (if field (setq last (bindat-get-field struct field))) - (setq bindat-idx (+ bindat-idx len)))))))) + (setq bindat-idx (+ bindat-idx len))))))))) (defun bindat-length (spec struct) "Calculate `bindat-raw' length for STRUCT according to bindat SPEC." @@ -460,7 +396,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." ;;;; Pack structured data into bindat-raw -(defun bindat--pack-u8 (v) +(defsubst bindat--pack-u8 (v) (aset bindat-raw bindat-idx (logand v 255)) (setq bindat-idx (1+ bindat-idx))) @@ -498,42 +434,39 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (bindat--pack-u32r v) (bindat--pack-u32r (ash v -32))) +(defun bindat--pack-str (len v) + (dotimes (i (min len (length v))) + (aset bindat-raw (+ bindat-idx i) (aref v i))) + (setq bindat-idx (+ bindat-idx len))) + +(defun bindat--pack-bits (len v) + (let ((bnum (1- (* 8 len))) j m) + (while (>= bnum 0) + (setq m 0) + (if (null v) + (setq bnum (- bnum 8)) + (setq j 128) + (while (> j 0) + (if (memq bnum v) + (setq m (logior m j))) + (setq bnum (1- bnum) + j (ash j -1)))) + (bindat--pack-u8 m)))) + (defun bindat--pack-item (v type len &optional vectype) (if (eq type 'ip) (setq type 'vec len 4)) (pcase type - ((guard (null v)) - (setq bindat-idx (+ bindat-idx len))) - ((or 'u8 'byte) - (bindat--pack-u8 v)) - ((or 'u16 'word 'short) - (bindat--pack-u16 v)) - ('u24 - (bindat--pack-u24 v)) - ((or 'u32 'dword 'long) - (bindat--pack-u32 v)) - ('u64 (bindat--pack-u64 v)) + ((guard (null v)) (setq bindat-idx (+ bindat-idx len))) + ((or 'u8 'byte) (bindat--pack-u8 v)) + ((or 'u16 'word 'short) (bindat--pack-u16 v)) + ('u24 (bindat--pack-u24 v)) + ((or 'u32 'dword 'long) (bindat--pack-u32 v)) ('u16r (bindat--pack-u16r v)) ('u24r (bindat--pack-u24r v)) ('u32r (bindat--pack-u32r v)) - ('u64r (bindat--pack-u64r v)) - ('bits - (let ((bnum (1- (* 8 len))) j m) - (while (>= bnum 0) - (setq m 0) - (if (null v) - (setq bnum (- bnum 8)) - (setq j 128) - (while (> j 0) - (if (memq bnum v) - (setq m (logior m j))) - (setq bnum (1- bnum) - j (ash j -1)))) - (bindat--pack-u8 m)))) - ((or 'str 'strz) - (dotimes (i (min len (length v))) - (aset bindat-raw (+ bindat-idx i) (aref v i))) - (setq bindat-idx (+ bindat-idx len))) + ('bits (bindat--pack-bits len v)) + ((or 'str 'strz) (bindat--pack-str len v)) ('vec (let ((l (length v)) (vlen 1)) (if (consp vectype) @@ -548,6 +481,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq bindat-idx (+ bindat-idx len))))) (defun bindat--pack-group (struct spec) + (if (cl-typep spec 'bindat--type) + (funcall (bindat--type-pe spec) struct) (with-suppressed-warnings ((lexical struct last)) (defvar struct) (defvar last)) (let ((struct struct) last) @@ -580,8 +515,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." ('fill (setq bindat-idx (+ bindat-idx len))) ('align - (while (/= (% bindat-idx len) 0) - (setq bindat-idx (1+ bindat-idx)))) + (setq bindat-idx (bindat--align bindat-idx len))) ('struct (bindat--pack-group (if field (bindat-get-field struct field) struct) (eval len t))) @@ -606,7 +540,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (_ (setq last (bindat-get-field struct field)) (bindat--pack-item last type len vectype) - )))))) + ))))))) (defun bindat-pack (spec struct &optional raw idx) "Return binary data packed according to SPEC for structured data STRUCT. @@ -622,52 +556,6 @@ Optional fourth arg IDX is the starting offset into RAW." (bindat--pack-group struct spec) (if raw nil bindat-raw))) -;;;; Debugging support - -(def-edebug-elem-spec 'bindat-spec '(&rest bindat-item)) - - -(def-edebug-elem-spec 'bindat--item-aux - ;; Field types which can come without a field label. - '(&or ["eval" form] - ["fill" bindat-len] - ["align" bindat-len] - ["struct" form] ;A reference to another bindat-spec. - ["union" bindat-tag-val &rest (bindat-tag bindat-spec)])) - -(def-edebug-elem-spec 'bindat-item - '((&or bindat--item-aux ;Without label.. - [bindat-field ;..or with label - &or bindat--item-aux - ["repeat" bindat-arg bindat-spec] - bindat-type]))) - -(def-edebug-elem-spec 'bindat-type - '(&or ("eval" form) - ["str" bindat-len] - ["strz" bindat-len] - ["vec" bindat-len &optional bindat-type] - ["bits" bindat-len] - symbolp)) - -(def-edebug-elem-spec 'bindat-field - '(&or ("eval" form) symbolp)) - -(def-edebug-elem-spec 'bindat-len '(&or [] "nil" bindat-arg)) - -(def-edebug-elem-spec 'bindat-tag-val '(bindat-arg)) - -(def-edebug-elem-spec 'bindat-tag '(&or ("eval" form) atom)) - -(def-edebug-elem-spec 'bindat-arg - '(&or ("eval" form) integerp (&rest symbolp integerp))) - -(defmacro bindat-spec (&rest fields) - "Build the bindat spec described by FIELDS." - (declare (indent 0) (debug (bindat-spec))) - ;; FIXME: We should really "compile" this to a triplet of functions! - `',fields) - ;;;; Misc. format conversions (defun bindat-format-vector (vect fmt sep &optional len) @@ -696,6 +584,384 @@ The port (if any) is omitted. IP can be a string, as well." (format "%d.%d.%d.%d" (aref ip 0) (aref ip 1) (aref ip 2) (aref ip 3)))) +;;;; New approach based on macro-expansion + +;; Further improvements suggested by reading websocket.el: +;; - Support for bit-sized fields? +;; +;; - Add some way to verify redundant/checksum fields's contents without +;; having to provide a complete `:unpack-val' expression. +;; The `:pack-val' thingy can work nicely to compute checksum fields +;; based on previous fields's contents (without impacting or being impacted +;; by the unpacked representation), but if we want to verify +;; those checksums when unpacking, we have to use the :unpack-val +;; and build the whole object by hand instead of being able to focus +;; just on the checksum field. +;; Maybe this could be related to `unit' type fields where we might like +;; to make sure that the "value" we write into it is the same as the +;; value it holds (tho those checks don't happen at the same time (pack +;; vs unpack). +;; +;; - Support for packing/unpacking to/from something else than +;; a unibyte string, e.g. from a buffer. Problems to do that are: +;; - the `str' and `strz' types which use `substring' rather than reading +;; one byte at a time. +;; - the `align' and `fill' which just want to skip without reading/writing +;; - the `pack-uint' case, which would prefer writing the LSB first. +;; - the `align' case needs to now the current position in order to know +;; how far to advance +;; +;; - Don't write triple code when the type is only ever used at a single place +;; (e.g. to unpack). + +(defun bindat--unpack-uint (bitlen) + (let ((v 0) (bitsdone 0)) + (while (< bitsdone bitlen) + (setq v (logior (ash v 8) (bindat--unpack-u8))) + (setq bitsdone (+ bitsdone 8))) + v)) + +(defun bindat--unpack-uintr (bitlen) + (let ((v 0) (bitsdone 0)) + (while (< bitsdone bitlen) + (setq v (logior v (ash (bindat--unpack-u8) bitsdone))) + (setq bitsdone (+ bitsdone 8))) + v)) + +(defun bindat--pack-uint (bitlen v) + (let* ((len (/ bitlen 8)) + (shift (- (* 8 (1- len))))) + (dotimes (_ len) + (bindat--pack-u8 (logand 255 (ash v shift))) + (setq shift (+ 8 shift))))) + +(defun bindat--pack-uintr (bitlen v) + (let* ((len (/ bitlen 8))) + (dotimes (_ len) + (bindat--pack-u8 (logand v 255)) + (setq v (ash v -8))))) + +(defmacro bindat--pcase (&rest args) + "Like `pcase' but optimize the code under the assumption that it's exhaustive." + (declare (indent 1) (debug pcase)) + `(pcase ,@args (pcase--dontcare nil))) + +(cl-defgeneric bindat--type (op head &rest args) + "Return the code for the operation OP of the Bindat type (HEAD . ARGS). +OP can be one of: unpack', (pack VAL), or (length VAL) where VAL +is the name of a variable that will hold the value we need to pack.") + +(cl-defmethod bindat--type (op (_ (eql byte))) + (bindat--pcase op + ('unpack `(bindat--unpack-u8)) + (`(length . ,_) `(cl-incf bindat-idx 1)) + (`(pack . ,args) `(bindat--pack-u8 . ,args)))) + +(cl-defmethod bindat--type (op (_ (eql uint)) n) + (if (eq n 8) (bindat--type op 'byte) + (bindat--pcase op + ('unpack `(bindat--unpack-uint ,n)) + (`(length . ,_) `(cl-incf bindat-idx (/ ,n 8))) + (`(pack . ,args) `(bindat--pack-uint ,n . ,args))))) + +(cl-defmethod bindat--type (op (_ (eql uintr)) n) + (if (eq n 8) (bindat--type op 'byte) + (bindat--pcase op + ('unpack `(bindat--unpack-uintr ,n)) + (`(length . ,_) `(cl-incf bindat-idx (/ ,n 8))) + (`(pack . ,args) `(bindat--pack-uintr ,n . ,args))))) + +(cl-defmethod bindat--type (op (_ (eql str)) len) + (bindat--pcase op + ('unpack `(bindat--unpack-str ,len)) + (`(length . ,_) `(cl-incf bindat-idx ,len)) + (`(pack . ,args) `(bindat--pack-str ,len . ,args)))) + +(cl-defmethod bindat--type (op (_ (eql strz)) len) + (bindat--pcase op + ('unpack `(bindat--unpack-strz ,len)) + (`(length . ,_) `(cl-incf bindat-idx ,len)) + ;; Here we don't add the terminating zero because we rely + ;; on the fact that `bindat-raw' was presumably initialized with + ;; all-zeroes before we started. + (`(pack . ,args) `(bindat--pack-str ,len . ,args)))) + +(cl-defmethod bindat--type (op (_ (eql bits)) len) + (bindat--pcase op + ('unpack `(bindat--unpack-bits ,len)) + (`(length . ,_) `(cl-incf bindat-idx ,len)) + (`(pack . ,args) `(bindat--pack-bits ,len . ,args)))) + +(cl-defmethod bindat--type (_op (_ (eql fill)) len) + `(progn (cl-incf bindat-idx ,len) nil)) + +(cl-defmethod bindat--type (_op (_ (eql align)) len) + `(progn (cl-callf bindat--align bindat-idx ,len) nil)) + +(cl-defmethod bindat--type (op (_ (eql type)) exp) + (bindat--pcase op + ('unpack `(funcall (bindat--type-ue ,exp))) + (`(length . ,args) `(funcall (bindat--type-le ,exp) . ,args)) + (`(pack . ,args) `(funcall (bindat--type-pe ,exp) . ,args)))) + +(cl-defmethod bindat--type (op (_ (eql vec)) count &rest type) + (unless type (setq type '(byte))) + (let ((fun (macroexpand-all (bindat--fun type) macroexpand-all-environment))) + (bindat--pcase op + ('unpack + `(let* ((bindat--len ,count) + (bindat--v (make-vector bindat--len 0))) + (dotimes (bindat--i bindat--len) + (aset bindat--v bindat--i (funcall ,fun))) + bindat--v)) + ((and `(length . ,_) + ;; FIXME: Improve the pattern match to recognize more complex + ;; "constant" functions? + (let `#'(lambda (,val) (setq bindat-idx (+ bindat-idx ,len))) fun) + (guard (not (macroexp--fgrep `((,val)) len)))) + ;; Optimize the case where the size of each element is constant. + `(cl-incf bindat-idx (* ,count ,len))) + ;; FIXME: It's tempting to use `(mapc (lambda (,val) ,exp) ,val)' + ;; which would be more efficient when `val' is a list, + ;; but that's only right if length of `val' is indeed `count'. + (`(,_ ,val) + `(dotimes (bindat--i ,count) + (funcall ,fun (elt ,val bindat--i))))))) + +(cl-defmethod bindat--type (op (_ (eql unit)) val) + (pcase op ('unpack val) (_ nil))) + +(cl-defmethod bindat--type (op (_ (eql struct)) &rest args) + (apply #'bindat--type op args)) + +(cl-defmethod bindat--type (op (_ (eql :pack-var)) var &rest fields) + (unless (consp (cdr fields)) + (error "`:pack-var VAR' needs to be followed by fields")) + (bindat--pcase op + ((or 'unpack (guard (null var))) + (apply #'bindat--type op fields)) + (`(,_ ,val) + `(let ((,var ,val)) ,(apply #'bindat--type op fields))))) + +(cl-defmethod bindat--type (op (field cons) &rest fields) + (named-let loop + ((fields (cons field fields)) + (labels ())) + (bindat--pcase fields + ('nil + (bindat--pcase op + ('unpack + (let ((exp ())) + (pcase-dolist (`(,label . ,labelvar) labels) + (setq exp + (if (eq label '_) + (if exp `(nconc ,labelvar ,exp) labelvar) + `(cons (cons ',label ,labelvar) ,exp)))) + exp)) + (_ nil))) + (`(:unpack-val ,exp) + ;; Make it so `:kwd nil' is the same as the absence of the keyword arg. + (if exp (pcase op ('unpack exp)) (loop nil labels))) + + (`((,label . ,type) . ,fields) + (let* ((get-field-val + (let ((tail (memq :pack-val type))) + ;; FIXME: This `TYPE.. :pack EXP' syntax doesn't work well + ;; when TYPE is a struct (a list of fields) or with extensions + ;; such as allowing TYPE to be `if ...'. + (if tail + (prog1 (cadr tail) + (setq type (butlast type (length tail))))))) + (fieldvar (make-symbol (format "field%d" (length fields)))) + (labelvar + (cond + ((eq label '_) fieldvar) + ((keywordp label) + (intern (substring (symbol-name label) 1))) + (t label))) + (field-fun (bindat--fun type)) + (rest-exp (loop fields `((,label . ,labelvar) . ,labels)))) + (bindat--pcase op + ('unpack + (let ((code + `(let ((,labelvar (funcall ,field-fun))) + ,rest-exp))) + (if (or (eq label '_) (not (assq label labels))) + code + (macroexp-warn-and-return + (format "Duplicate label: %S" label) + code)))) + (`(,_ ,val) + ;; `cdr-safe' is easier to optimize (can't signal an error). + `(let ((,fieldvar ,(or get-field-val + (if (eq label '_) val + `(cdr-safe (assq ',label ,val)))))) + (funcall ,field-fun ,fieldvar) + ,@(when rest-exp + `((let ,(unless (eq labelvar fieldvar) + `((,labelvar ,fieldvar))) + (ignore ,labelvar) + ,rest-exp)))))))) + (_ (error "Unrecognized format in bindat fields: %S" fields))))) + +(def-edebug-elem-spec 'bindat-struct + '([&rest (symbolp bindat-type &optional ":pack-val" def-form)] + &optional ":unpack-val" def-form)) + +(def-edebug-elem-spec 'bindat-type + '(&or ["uint" def-form] + ["uintr" def-form] + ["str" def-form] + ["strz" def-form] + ["bits" def-form] + ["fill" def-form] + ["align" def-form] + ["vec" def-form bindat-type] + ["repeat" def-form bindat-type] + ["type" def-form] + ["struct" bindat-struct] + ["unit" def-form] + [":pack-var" symbolp bindat-type] + symbolp ;; u8, u16, etc... + bindat-struct)) + +(defmacro bindat-type (&rest type) + "Return the Bindat type value to pack&unpack TYPE. +TYPE is a Bindat type expression. It can take the following forms: + + uint BITLEN - Big-endian unsigned integer + uintr BITLEN - Little-endian unsigned integer + str LEN - Byte string + strz LEN - Zero-terminated byte-string + bits LEN - Bit vector (LEN is counted in bytes) + fill LEN - Just a filler + align LEN - Fill up to the next multiple of LEN bytes + vec COUNT TYPE - COUNT repetitions of TYPE + type EXP - Indirection; EXP should return a Bindat type value + unit EXP - 0-width type holding the value returned by EXP + struct FIELDS... - A composite type + +When the context makes it clear, the symbol `struct' can be omitted. +A composite type is a list of FIELDS where each FIELD is of the form + + (LABEL TYPE) + +where LABEL can be `_' if the field should not deserve a name. + +Composite types get normally packed/unpacked to/from alists, but this can be +controlled in the following way: +- If the list of fields ends with `:unpack-val EXP', then unpacking will + return the value of EXP (which has the previous fields in its scope). +- If a field's TYPE is followed by `:pack-val EXP', then the value placed + into this field will be that returned by EXP instead of looking up the alist. +- If the list of fields is preceded with `:pack-var VAR' then the object to + be packed is bound to VAR when evaluating the EXPs of `:pack-val'. + +All the above BITLEN, LEN, COUNT, and EXP are ELisp expressions evaluated +in the current lexical context extended with the previous fields. + +TYPE can additionally be one of the Bindat type macros defined with +`bindat-defmacro' (and listed below) or an ELisp expression which returns +a bindat type expression." + (declare (indent 0) (debug (bindat-type))) + `(progn + (defvar bindat-idx) + (bindat--make :ue ,(bindat--toplevel 'unpack type) + :le ,(bindat--toplevel 'length type) + :pe ,(bindat--toplevel 'pack type)))) + +(eval-and-compile + (defconst bindat--primitives '(byte uint uintr str strz bits fill align + struct type vec unit))) + +(eval-and-compile + (defvar bindat--macroenv + (mapcar (lambda (s) (cons s (lambda (&rest args) + (bindat--makefun (cons s args))))) + bindat--primitives))) + +(defmacro bindat-defmacro (name args &rest body) + "Define a new Bindat type as a macro." + (declare (indent 2) (doc-string 3) (debug (&define name sexp def-body))) + (let ((leaders ())) + (while (and (cdr body) + (or (stringp (car body)) + (memq (car-safe (car body)) '(:documentation declare)))) + (push (pop body) leaders)) + ;; FIXME: Add support for Edebug decls to those macros. + `(eval-and-compile ;; Yuck! But needed to define types where you use them! + (setf (alist-get ',name bindat--macroenv) + (lambda ,args ,@(nreverse leaders) + (bindat--fun ,(macroexp-progn body))))))) + +(put 'bindat-type 'function-documentation '(bindat--make-docstring)) +(defun bindat--make-docstring () + ;; Largely inspired from `pcase--make-docstring'. + (let* ((main (documentation (symbol-function 'bindat-type) 'raw)) + (ud (help-split-fundoc main 'bindat-type))) + (require 'help-fns) + (declare-function help-fns--signature "help-fns") + (with-temp-buffer + (insert (or (cdr ud) main)) + (pcase-dolist (`(,name . ,me) (reverse bindat--macroenv)) + (unless (memq name bindat--primitives) + (let ((doc (documentation me 'raw))) + (insert "\n\n-- ") + (setq doc (help-fns--signature name doc me + (indirect-function me) + nil)) + (insert "\n" (or doc "Not documented."))))) + (let ((combined-doc (buffer-string))) + (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc))))) + +(bindat-defmacro u8 () "Unsigned 8bit integer." '(byte)) +(bindat-defmacro sint (bitlen r) + "Signed integer of size BITLEN. +Bigendian if R is nil and little endian if not." + (let ((bl (make-symbol "bitlen")) + (max (make-symbol "max")) + (wrap (make-symbol "wrap"))) + `(let* ((,bl ,bitlen) + (,max (ash 1 (1- ,bl))) + (,wrap (+ ,max ,max))) + (struct :pack-var v + (n if ,r (uintr ,bl) (uint ,bl) + :pack-val (if (< v 0) (+ v ,wrap) v)) + :unpack-val (if (>= n ,max) (- n ,wrap) n))))) + +(bindat-defmacro repeat (count &rest type) + "Like `vec', but unpacks to a list rather than a vector." + `(:pack-var v + (v vec ,count ,@type :pack-val v) + :unpack-val (append v nil))) + +(defvar bindat--op nil + "The operation we're currently building. +This is a simple symbol and can be one of: `unpack', `pack', or `length'. +This is used during macroexpansion of `bindat-type' so that the +macros know which code to generate. +FIXME: this is closely related and very similar to the `op' argument passed +to `bindat--type', yet it's annoyingly different.") + +(defun bindat--fun (type) + (if (or (keywordp (car type)) (consp (car type))) (cons 'struct type) + type)) + +(defun bindat--makefun (type) + (let* ((v (make-symbol "v")) + (args (pcase bindat--op ('unpack ()) (_ (list v))))) + (pcase (apply #'bindat--type + (pcase bindat--op ('unpack 'unpack) (op `(,op . ,args))) + type) + (`(funcall ,f . ,(pred (equal args))) f) ;η-reduce. + (exp `(lambda ,args ,exp))))) + +(defun bindat--toplevel (op type) + (let* ((bindat--op op) + (env `(,@bindat--macroenv + ,@macroexpand-all-environment))) + (macroexpand-all (bindat--fun type) env))) + (provide 'bindat) ;;; bindat.el ends here diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 9f0ba232a4b..b3325816c5c 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -607,9 +607,12 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (setq args (cddr args))) (cons fn (nreverse var-expr-list)))) - (`(defvar ,(and (pred symbolp) name) . ,_) - (push name byte-optimize--dynamic-vars) - form) + (`(defvar ,(and (pred symbolp) name) . ,rest) + (let ((optimized-rest (and rest + (cons (byte-optimize-form (car rest) nil) + (cdr rest))))) + (push name byte-optimize--dynamic-vars) + `(defvar ,name . ,optimized-rest))) (`(,(pred byte-code-function-p) . ,exps) (cons fn (mapcar #'byte-optimize-form exps))) @@ -1413,7 +1416,8 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") copysign isnan ldexp float logb floor ceiling round truncate ffloor fceiling fround ftruncate - string= string-equal string< string-lessp + string= string-equal string< string-lessp string> string-greaterp + string-empty-p string-blank-p string-prefix-p string-suffix-p string-search consp atom listp nlistp proper-list-p sequencep arrayp vectorp stringp bool-vector-p hash-table-p diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 534e57e06d3..aca5dcba62c 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -253,7 +253,7 @@ The return value is undefined. #'(lambda (x) (let ((f (cdr (assq (car x) macro-declarations-alist)))) (if f (apply (car f) name arglist (cdr x)) - (macroexp--warn-and-return + (macroexp-warn-and-return (format-message "Unknown macro property %S in %S" (car x) name) @@ -326,7 +326,7 @@ The return value is undefined. body))) nil) (t - (macroexp--warn-and-return + (macroexp-warn-and-return (format-message "Unknown defun property `%S' in %S" (car x) name) nil))))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 3ee8113c4f4..94424fc38af 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2497,8 +2497,6 @@ list that represents a doc string reference. byte-compile-output nil byte-compile-jump-tables nil)))) -(defvar byte-compile-force-lexical-warnings nil) - (defun byte-compile-preprocess (form &optional _for-effect) (setq form (macroexpand-all form byte-compile-macro-environment)) ;; FIXME: We should run byte-optimize-form here, but it currently does not @@ -2509,7 +2507,6 @@ list that represents a doc string reference. ;; (setq form (byte-optimize-form form for-effect))) (cond (lexical-binding (cconv-closure-convert form)) - (byte-compile-force-lexical-warnings (cconv-warnings-only form)) (t form))) ;; byte-hunk-handlers cannot call this! @@ -2872,16 +2869,12 @@ FUN should be either a `lambda' value or a `closure' value." (dolist (binding env) (cond ((consp binding) - ;; We check shadowing by the args, so that the `let' can be moved - ;; within the lambda, which can then be unfolded. FIXME: Some of those - ;; bindings might be unused in `body'. - (unless (memq (car binding) args) ;Shadowed. - (push `(,(car binding) ',(cdr binding)) renv))) + (push `(,(car binding) ',(cdr binding)) renv)) ((eq binding t)) (t (push `(defvar ,binding) body)))) (if (null renv) `(lambda ,args ,@preamble ,@body) - `(lambda ,args ,@preamble (let ,(nreverse renv) ,@body))))) + `(let ,renv (lambda ,args ,@preamble ,@body))))) ;;;###autoload (defun byte-compile (form) @@ -2906,23 +2899,27 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if (symbolp form) form "provided")) fun) (t - (when (or (symbolp form) (eq (car-safe fun) 'closure)) - ;; `fun' is a function *value*, so try to recover its corresponding - ;; source code. - (setq lexical-binding (eq (car fun) 'closure)) - (setq fun (byte-compile--reify-function fun))) - ;; Expand macros. - (setq fun (byte-compile-preprocess fun)) - (setq fun (byte-compile-top-level fun nil 'eval)) - (if (symbolp form) - ;; byte-compile-top-level returns an *expression* equivalent to the - ;; `fun' expression, so we need to evaluate it, tho normally - ;; this is not needed because the expression is just a constant - ;; byte-code object, which is self-evaluating. - (setq fun (eval fun t))) - (if macro (push 'macro fun)) - (if (symbolp form) (fset form fun)) - fun)))))) + (let (final-eval) + (when (or (symbolp form) (eq (car-safe fun) 'closure)) + ;; `fun' is a function *value*, so try to recover its corresponding + ;; source code. + (setq lexical-binding (eq (car fun) 'closure)) + (setq fun (byte-compile--reify-function fun)) + (setq final-eval t)) + ;; Expand macros. + (setq fun (byte-compile-preprocess fun)) + (setq fun (byte-compile-top-level fun nil 'eval)) + (if (symbolp form) + ;; byte-compile-top-level returns an *expression* equivalent to the + ;; `fun' expression, so we need to evaluate it, tho normally + ;; this is not needed because the expression is just a constant + ;; byte-code object, which is self-evaluating. + (setq fun (eval fun t))) + (if final-eval + (setq fun (eval fun t))) + (if macro (push 'macro fun)) + (if (symbolp form) (fset form fun)) + fun))))))) (defun byte-compile-sexp (sexp) "Compile and return SEXP." @@ -5319,8 +5316,9 @@ already up-to-date." "Reload any Lisp file that was changed since Emacs was dumped. Use with caution." (let* ((argv0 (car command-line-args)) - (emacs-file (executable-find argv0))) - (if (not (and emacs-file (file-executable-p emacs-file))) + (emacs-file (or (cdr (nth 2 (pdumper-stats))) + (executable-find argv0)))) + (if (not (and emacs-file (file-exists-p emacs-file))) (message "Can't find %s to refresh preloaded Lisp files" argv0) (dolist (f (reverse load-history)) (setq f (car f)) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index e79583974a8..bd0a3e87e64 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -121,19 +121,22 @@ (defconst cconv-liftwhen 6 "Try to do lambda lifting if the number of arguments + free variables is less than this number.") -;; List of all the variables that are both captured by a closure -;; and mutated. Each entry in the list takes the form -;; (BINDER . PARENTFORM) where BINDER is the (VAR VAL) that introduces the -;; variable (or is just (VAR) for variables not introduced by let). -(defvar cconv-captured+mutated) - -;; List of candidates for lambda lifting. -;; Each candidate has the form (BINDER . PARENTFORM). A candidate -;; is a variable that is only passed to `funcall' or `apply'. -(defvar cconv-lambda-candidates) - -;; Alist associating to each function body the list of its free variables. -(defvar cconv-freevars-alist) +(defvar cconv-var-classification + ;; Alist mapping variables to a given class. + ;; The keys are of the form (BINDER . PARENTFORM) where BINDER + ;; is the (VAR VAL) that introduces it (or is just (VAR) for variables + ;; not introduced by let). + ;; The class can be one of: + ;; - :unused + ;; - :lambda-candidate + ;; - :captured+mutated + ;; - nil for "normal" variables, which would then just not appear + ;; in the alist at all. + ) + +(defvar cconv-freevars-alist + ;; Alist associating to each function body the list of its free variables. + ) ;;;###autoload (defun cconv-closure-convert (form) @@ -144,25 +147,13 @@ is less than this number.") Returns a form where all lambdas don't have any free variables." ;; (message "Entering cconv-closure-convert...") (let ((cconv-freevars-alist '()) - (cconv-lambda-candidates '()) - (cconv-captured+mutated '())) + (cconv-var-classification '())) ;; Analyze form - fill these variables with new information. (cconv-analyze-form form '()) (setq cconv-freevars-alist (nreverse cconv-freevars-alist)) (prog1 (cconv-convert form nil nil) ; Env initially empty. (cl-assert (null cconv-freevars-alist))))) -;;;###autoload -(defun cconv-warnings-only (form) - "Add the warnings that closure conversion would encounter." - (let ((cconv-freevars-alist '()) - (cconv-lambda-candidates '()) - (cconv-captured+mutated '())) - ;; Analyze form - fill these variables with new information. - (cconv-analyze-form form '()) - ;; But don't perform the closure conversion. - form)) - (defconst cconv--dummy-var (make-symbol "ignored")) (defun cconv--set-diff (s1 s2) @@ -261,28 +252,55 @@ Returns a form where all lambdas don't have any free variables." (nthcdr 3 mapping))))) new-env)) +(defun cconv--warn-unused-msg (var varkind) + (unless (or ;; Uninterned symbols typically come from macro-expansion, so + ;; it is often non-trivial for the programmer to avoid such + ;; unused vars. + (not (intern-soft var)) + (eq ?_ (aref (symbol-name var) 0)) + ;; As a special exception, ignore "ignore". + (eq var 'ignored)) + (let ((suggestions (help-uni-confusable-suggestions (symbol-name var)))) + (format "Unused lexical %s `%S'%s" + varkind var + (if suggestions (concat "\n " suggestions) ""))))) + +(define-inline cconv--var-classification (binder form) + (inline-quote + (alist-get (cons ,binder ,form) cconv-var-classification + nil nil #'equal))) + (defun cconv--convert-funcbody (funargs funcbody env parentform) "Run `cconv-convert' on FUNCBODY, the forms of a lambda expression. PARENTFORM is the form containing the lambda expression. ENV is a lexical environment (same format as for `cconv-convert'), not including FUNARGS, the function's argument list. Return a list of converted forms." - (let ((letbind ())) + (let ((wrappers ())) (dolist (arg funargs) - (if (not (member (cons (list arg) parentform) cconv-captured+mutated)) - (if (assq arg env) (push `(,arg . nil) env)) - (push `(,arg . (car-safe ,arg)) env) - (push `(,arg (list ,arg)) letbind))) + (pcase (cconv--var-classification (list arg) parentform) + (:captured+mutated + (push `(,arg . (car-safe ,arg)) env) + (push (lambda (body) `(let ((,arg (list ,arg))) ,body)) wrappers)) + ((and :unused + (let (and (pred stringp) msg) + (cconv--warn-unused-msg arg "argument"))) + (if (assq arg env) (push `(,arg . nil) env)) ;FIXME: Is it needed? + (push (lambda (body) (macroexp--warn-wrap msg body)) wrappers)) + (_ + (if (assq arg env) (push `(,arg . nil) env))))) (setq funcbody (mapcar (lambda (form) (cconv-convert form env nil)) funcbody)) - (if letbind + (if wrappers (let ((special-forms '())) ;; Keep special forms at the beginning of the body. (while (or (stringp (car funcbody)) ;docstring. (memq (car-safe (car funcbody)) '(interactive declare))) (push (pop funcbody) special-forms)) - `(,@(nreverse special-forms) (let ,letbind . ,funcbody))) + (let ((body (macroexp-progn funcbody))) + (dolist (wrapper wrappers) (setq body (funcall wrapper body))) + `(,@(nreverse special-forms) ,@(macroexp-unprogn body)))) funcbody))) (defun cconv-convert (form env extend) @@ -340,46 +358,58 @@ places where they originally did not directly appear." (setq value (cadr binder)) (car binder))) (new-val - (cond - ;; Check if var is a candidate for lambda lifting. - ((and (member (cons binder form) cconv-lambda-candidates) - (progn - (cl-assert (and (eq (car value) 'function) - (eq (car (cadr value)) 'lambda))) - (cl-assert (equal (cddr (cadr value)) - (caar cconv-freevars-alist))) - ;; Peek at the freevars to decide whether to λ-lift. - (let* ((fvs (cdr (car cconv-freevars-alist))) - (fun (cadr value)) - (funargs (cadr fun)) - (funcvars (append fvs funargs))) + (pcase (cconv--var-classification binder form) + ;; Check if var is a candidate for lambda lifting. + ((and :lambda-candidate + (guard + (progn + (cl-assert (and (eq (car value) 'function) + (eq (car (cadr value)) 'lambda))) + (cl-assert (equal (cddr (cadr value)) + (caar cconv-freevars-alist))) + ;; Peek at the freevars to decide whether to λ-lift. + (let* ((fvs (cdr (car cconv-freevars-alist))) + (fun (cadr value)) + (funargs (cadr fun)) + (funcvars (append fvs funargs))) ; lambda lifting condition - (and fvs (>= cconv-liftwhen (length funcvars)))))) + (and fvs (>= cconv-liftwhen + (length funcvars))))))) ; Lift. - (let* ((fvs (cdr (pop cconv-freevars-alist))) - (fun (cadr value)) - (funargs (cadr fun)) - (funcvars (append fvs funargs)) - (funcbody (cddr fun)) - (funcbody-env ())) - (push `(,var . (apply-partially ,var . ,fvs)) new-env) - (dolist (fv fvs) - (cl-pushnew fv new-extend) - (if (and (eq 'car-safe (car-safe (cdr (assq fv env)))) - (not (memq fv funargs))) - (push `(,fv . (car-safe ,fv)) funcbody-env))) - `(function (lambda ,funcvars . - ,(cconv--convert-funcbody - funargs funcbody funcbody-env value))))) + (let* ((fvs (cdr (pop cconv-freevars-alist))) + (fun (cadr value)) + (funargs (cadr fun)) + (funcvars (append fvs funargs)) + (funcbody (cddr fun)) + (funcbody-env ())) + (push `(,var . (apply-partially ,var . ,fvs)) new-env) + (dolist (fv fvs) + (cl-pushnew fv new-extend) + (if (and (eq 'car-safe (car-safe (cdr (assq fv env)))) + (not (memq fv funargs))) + (push `(,fv . (car-safe ,fv)) funcbody-env))) + `(function (lambda ,funcvars . + ,(cconv--convert-funcbody + funargs funcbody funcbody-env value))))) ;; Check if it needs to be turned into a "ref-cell". - ((member (cons binder form) cconv-captured+mutated) + (:captured+mutated ;; Declared variable is mutated and captured. (push `(,var . (car-safe ,var)) new-env) `(list ,(cconv-convert value env extend))) + ;; Check if it needs to be turned into a "ref-cell". + (:unused + ;; Declared variable is unused. + (if (assq var new-env) (push `(,var) new-env)) ;FIXME:Needed? + (let ((newval + `(ignore ,(cconv-convert value env extend))) + (msg (cconv--warn-unused-msg var "variable"))) + (if (null msg) newval + (macroexp--warn-wrap msg newval)))) + ;; Normal default case. - (t + (_ (if (assq var new-env) (push `(,var) new-env)) (cconv-convert value env extend))))) @@ -464,22 +494,28 @@ places where they originally did not directly appear." ; condition-case (`(condition-case ,var ,protected-form . ,handlers) - `(condition-case ,var - ,(cconv-convert protected-form env extend) - ,@(let* ((cm (and var (member (cons (list var) form) - cconv-captured+mutated))) - (newenv - (cond (cm (cons `(,var . (car-save ,var)) env)) - ((assq var env) (cons `(,var) env)) - (t env)))) - (mapcar + (let* ((class (and var (cconv--var-classification (list var) form))) + (newenv + (cond ((eq class :captured+mutated) + (cons `(,var . (car-save ,var)) env)) + ((assq var env) (cons `(,var) env)) + (t env))) + (msg (when (eq class :unused) + (cconv--warn-unused-msg var "variable"))) + (newprotform (cconv-convert protected-form env extend))) + `(condition-case ,var + ,(if msg + (macroexp--warn-wrap msg newprotform) + newprotform) + ,@(mapcar (lambda (handler) `(,(car handler) ,@(let ((body (mapcar (lambda (form) (cconv-convert form newenv extend)) (cdr handler)))) - (if (not cm) body + (if (not (eq class :captured+mutated)) + body `((let ((,var (list ,var))) ,@body)))))) handlers)))) @@ -563,29 +599,21 @@ FORM is the parent form that binds this var." (`(,_ nil nil nil nil) nil) (`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_) ,_ ,_ ,_ ,_) + ;; FIXME: Convert this warning to use `macroexp--warn-wrap' + ;; so as to give better position information. (byte-compile-warn "%s `%S' not left unused" varkind var))) (pcase vardata - (`((,var . ,_) nil ,_ ,_ nil) - ;; FIXME: This gives warnings in the wrong order, with imprecise line - ;; numbers and without function name info. - (unless (or ;; Uninterned symbols typically come from macro-expansion, so - ;; it is often non-trivial for the programmer to avoid such - ;; unused vars. - (not (intern-soft var)) - (eq ?_ (aref (symbol-name var) 0)) - ;; As a special exception, ignore "ignore". - (eq var 'ignored)) - (let ((suggestions (help-uni-confusable-suggestions (symbol-name var)))) - (byte-compile-warn "Unused lexical %s `%S'%s" - varkind var - (if suggestions (concat "\n " suggestions) ""))))) + (`(,binder nil ,_ ,_ nil) + (push (cons (cons binder form) :unused) cconv-var-classification)) ;; If it's unused, there's no point converting it into a cons-cell, even if ;; it's captured and mutated. (`(,binder ,_ t t ,_) - (push (cons binder form) cconv-captured+mutated)) + (push (cons (cons binder form) :captured+mutated) + cconv-var-classification)) (`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t) - (push (cons binder form) cconv-lambda-candidates)))) + (push (cons (cons binder form) :lambda-candidate) + cconv-var-classification)))) (defun cconv--analyze-function (args body env parentform) (let* ((newvars nil) @@ -638,8 +666,7 @@ Analyze lambdas if they are suitable for lambda lifting. - ENV is an alist mapping each enclosing lexical variable to its info. I.e. each element has the form (VAR . (READ MUTATED CAPTURED CALLED)). This function does not return anything but instead fills the -`cconv-captured+mutated' and `cconv-lambda-candidates' variables -and updates the data stored in ENV." +`cconv-var-classification' variable and updates the data stored in ENV." (pcase form ; let special form (`(,(and (or 'let* 'let) letsym) ,binders . ,body-forms) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 75aefdc7ba0..213ab43184f 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -932,7 +932,7 @@ don't move point." ;; definition ends prematurely. (end-of-file))) (`(,(or 'defun 'defvar 'defcustom 'defmacro 'defconst 'defsubst 'defadvice - 'cl-defun 'cl-defgeneric 'cl-defmethod 'cl-defmacro) + 'cl-defun 'cl-defgeneric 'cl-defmacro) ,(pred symbolp) ;; Require an initializer, i.e. ignore single-argument `defvar' ;; forms, which never have a doc string. @@ -942,6 +942,25 @@ don't move point." ;; initializer or argument list. (forward-sexp 3) (skip-chars-forward " \n\t") + t) + (`(,'cl-defmethod + ,(pred symbolp) + . ,rest) + (down-list) + (forward-sexp (pcase (car rest) + ;; No qualifier, so skip like we would have skipped in + ;; the first clause of the outer `pcase'. + ((pred listp) 3) + (':extra + ;; Skip the :extra qualifier together with its string too. + ;; Skip any additional qualifier. + (if (memq (nth 2 rest) '(:around :before :after)) + 6 + 5)) + ;; Skip :before, :after or :around qualifier too. + ((or ':around ':before ':after) + 4))) + (skip-chars-forward " \n\t") t))) ;;;###autoload diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 84199c16127..eabba27d229 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -94,7 +94,7 @@ strings case-insensitively." (defun cl--mapcar-many (cl-func cl-seqs &optional acc) (if (cdr (cdr cl-seqs)) (let* ((cl-res nil) - (cl-n (apply 'min (mapcar 'length cl-seqs))) + (cl-n (apply #'min (mapcar #'length cl-seqs))) (cl-i 0) (cl-args (copy-sequence cl-seqs)) cl-p1 cl-p2) @@ -131,7 +131,7 @@ strings case-insensitively." "Map a FUNCTION across one or more SEQUENCEs, returning a sequence. TYPE is the sequence type to return. \n(fn TYPE FUNCTION SEQUENCE...)" - (let ((cl-res (apply 'cl-mapcar cl-func cl-seq cl-rest))) + (let ((cl-res (apply #'cl-mapcar cl-func cl-seq cl-rest))) (and cl-type (cl-coerce cl-res cl-type)))) ;;;###autoload @@ -190,14 +190,14 @@ the elements themselves. "Like `cl-mapcar', but nconc's together the values returned by the function. \n(fn FUNCTION SEQUENCE...)" (if cl-rest - (apply 'nconc (apply 'cl-mapcar cl-func cl-seq cl-rest)) + (apply #'nconc (apply #'cl-mapcar cl-func cl-seq cl-rest)) (mapcan cl-func cl-seq))) ;;;###autoload (defun cl-mapcon (cl-func cl-list &rest cl-rest) "Like `cl-maplist', but nconc's together the values returned by the function. \n(fn FUNCTION LIST...)" - (apply 'nconc (apply 'cl-maplist cl-func cl-list cl-rest))) + (apply #'nconc (apply #'cl-maplist cl-func cl-list cl-rest))) ;;;###autoload (defun cl-some (cl-pred cl-seq &rest cl-rest) @@ -236,13 +236,13 @@ non-nil value. (defun cl-notany (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is false of every element of SEQ or SEQs. \n(fn PREDICATE SEQ...)" - (not (apply 'cl-some cl-pred cl-seq cl-rest))) + (not (apply #'cl-some cl-pred cl-seq cl-rest))) ;;;###autoload (defun cl-notevery (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is false of some element of SEQ or SEQs. \n(fn PREDICATE SEQ...)" - (not (apply 'cl-every cl-pred cl-seq cl-rest))) + (not (apply #'cl-every cl-pred cl-seq cl-rest))) ;;;###autoload (defun cl--map-keymap-recursively (cl-func-rec cl-map &optional cl-base) @@ -693,12 +693,11 @@ PROPLIST is a list of the sort returned by `symbol-plist'. "Expand macros in FORM and insert the pretty-printed result." (declare (advertised-calling-convention (form) "27.1")) (message "Expanding...") - (let ((byte-compile-macro-environment nil)) - (setq form (macroexpand-all form)) - (message "Formatting...") - (prog1 - (cl-prettyprint form) - (message "")))) + (setq form (macroexpand-all form)) + (message "Formatting...") + (prog1 + (cl-prettyprint form) + (message ""))) ;;; Integration into the online help system. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 279b9d137c9..f5b8c7b662f 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -425,6 +425,16 @@ the specializer used will be the one returned by BODY." (defun cl-generic--method-qualifier-p (x) (not (listp x))) +(defun cl--defmethod-doc-pos () + "Return the index of the docstring for a `cl-defmethod'. +Presumes point is at the end of the `cl-defmethod' symbol." + (save-excursion + (let ((n 2)) + (while (and (ignore-errors (forward-sexp 1) t) + (not (eq (char-before) ?\)))) + (cl-incf n)) + n))) + ;;;###autoload (defmacro cl-defmethod (name args &rest body) "Define a new method for generic function NAME. @@ -445,8 +455,12 @@ all methods of NAME have to use the same set of arguments for dispatch. Each dispatch argument and TYPE are specified in ARGS where the corresponding formal argument appears as (VAR TYPE) rather than just VAR. -The optional second argument QUALIFIER is a specifier that -modifies how the method is combined with other methods, including: +The optional EXTRA element, on the form `:extra STRING', allows +you to add more methods for the same specializers and qualifiers. +These are distinguished by STRING. + +The optional argument QUALIFIER is a specifier that modifies how +the method is combined with other methods, including: :before - Method will be called before the primary :after - Method will be called after the primary :around - Method will be called around everything else @@ -463,8 +477,8 @@ method to be applicable. The set of acceptable TYPEs (also called \"specializers\") is defined \(and can be extended) by the various methods of `cl-generic-generalizers'. -\(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" - (declare (doc-string 3) (indent defun) +\(fn NAME [EXTRA] [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" + (declare (doc-string cl--defmethod-doc-pos) (indent defun) (debug (&define ; this means we are defining something [&name [sexp ;Allow (setf ...) additionally to symbols. @@ -487,7 +501,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (or (not (fboundp 'byte-compile-warning-enabled-p)) (byte-compile-warning-enabled-p 'obsolete name)) (let* ((obsolete (get name 'byte-obsolete-info))) - (macroexp--warn-and-return + (macroexp-warn-and-return (macroexp--obsolete-warning name obsolete "generic function") nil))) ;; You could argue that `defmethod' modifies rather than defines the diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 0184fd57e25..b7ffd25d62c 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -565,7 +565,7 @@ its argument list allows full Common Lisp conventions." ,(length (cl-ldiff args p))) exactarg (not (eq args p))))) (while (and args (not (memq (car args) cl--lambda-list-keywords))) - (let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car) + (let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car-safe) restarg))) (cl--do-arglist (pop args) @@ -723,7 +723,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. (defun cl--compile-time-too (form) (or (and (symbolp (car-safe form)) (get (car-safe form) 'byte-hunk-handler)) (setq form (macroexpand - form (cons '(cl-eval-when) byte-compile-macro-environment)))) + form (cons '(cl-eval-when) macroexpand-all-environment)))) (cond ((eq (car-safe form) 'progn) (cons 'progn (mapcar #'cl--compile-time-too (cdr form)))) ((eq (car-safe form) 'cl-eval-when) @@ -2298,7 +2298,7 @@ of `cl-symbol-macrolet' to additionally expand symbol macros." ;; The behavior of CL made sense in a dynamically scoped ;; language, but nowadays, lexical scoping semantics is more often ;; expected. - (`(,(or 'let 'let*) . ,(or `(,bindings . ,body) dontcare)) + (`(,(or 'let 'let*) . ,(or `(,bindings . ,body) pcase--dontcare)) (let ((nbs ()) (found nil)) (dolist (binding bindings) (let* ((var (if (symbolp binding) binding (car binding))) @@ -2393,7 +2393,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). (append bindings venv)) macroexpand-all-environment)))) (if malformed-bindings - (macroexp--warn-and-return + (macroexp-warn-and-return (format-message "Malformed `cl-symbol-macrolet' binding(s): %S" (nreverse malformed-bindings)) expansion) @@ -2511,12 +2511,12 @@ Example: '(nil byte-compile-inline-expand)) (error "%s already has a byte-optimizer, can't make it inline" (car spec))) - (put (car spec) 'byte-optimizer 'byte-compile-inline-expand))) + (put (car spec) 'byte-optimizer #'byte-compile-inline-expand))) ((eq (car-safe spec) 'notinline) (while (setq spec (cdr spec)) (if (eq (get (car spec) 'byte-optimizer) - 'byte-compile-inline-expand) + #'byte-compile-inline-expand) (put (car spec) 'byte-optimizer nil)))) ((eq (car-safe spec) 'optimize) @@ -3062,7 +3062,7 @@ Supported keywords for slots are: forms) (when (cl-oddp (length desc)) (push - (macroexp--warn-and-return + (macroexp-warn-and-return (format "Missing value for option `%S' of slot `%s' in struct %s!" (car (last desc)) slot name) 'nil) @@ -3071,7 +3071,7 @@ Supported keywords for slots are: (not (keywordp (car desc)))) (let ((kw (car defaults))) (push - (macroexp--warn-and-return + (macroexp-warn-and-return (format " I'll take `%s' to be an option rather than a default value." kw) 'nil) @@ -3287,7 +3287,6 @@ does not contain SLOT-NAME." (signal 'cl-struct-unknown-slot (list struct-type slot-name)))) (defvar byte-compile-function-environment) -(defvar byte-compile-macro-environment) (defun cl--macroexp-fboundp (sym) "Return non-nil if SYM will be bound when we run the code. @@ -3295,7 +3294,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (or (fboundp sym) (and (macroexp-compiling-p) (or (cdr (assq sym byte-compile-function-environment)) - (cdr (assq sym byte-compile-macro-environment)))))) + (cdr (assq sym macroexpand-all-environment)))))) (pcase-dolist (`(,type . ,pred) ;; Mostly kept in alphabetical order. diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 8ddfb9e78ef..87b34e7cd57 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -35,7 +35,6 @@ (defsubst easy-menu-intern (s) (if (stringp s) (intern s) s)) -;;;###autoload (defmacro easy-menu-define (symbol maps doc menu) "Define a pop-up menu and/or menu bar menu specified by MENU. If SYMBOL is non-nil, define SYMBOL as a function to pop up the @@ -166,7 +165,6 @@ This is expected to be bound to a mouse event." "")) (cons menu props))))) -;;;###autoload (defun easy-menu-do-define (symbol maps doc menu) ;; We can't do anything that might differ between Emacs dialects in ;; `easy-menu-define' in order to make byte compiled files @@ -192,7 +190,11 @@ This is expected to be bound to a mouse event." (function-put symbol 'completion-predicate #'ignore)) (dolist (map (if (keymapp maps) (list maps) maps)) (define-key map - (vector 'menu-bar (easy-menu-intern (car menu))) + (vector 'menu-bar (if (symbolp (car menu)) + (car menu) + ;; If a string, then use the downcased + ;; version for greater backwards compatibility. + (intern (downcase (car menu))))) (easy-menu-binding keymap (car menu)))))) (defun easy-menu-filter-return (menu &optional name) @@ -218,7 +220,6 @@ If NAME is provided, it is used for the keymap." If it holds a list, this is expected to be a list of keys already seen in the menu we're processing. Else it means we're not processing a menu.") -;;;###autoload (defun easy-menu-create-menu (menu-name menu-items) "Create a menu called MENU-NAME with items described in MENU-ITEMS. MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items @@ -474,7 +475,6 @@ When non-nil, NOEXP indicates that CALLBACK cannot be an expression (eval `(lambda () (interactive) ,callback) t))) command)) -;;;###autoload (defun easy-menu-change (path name items &optional before map) "Change menu found at PATH as item NAME to contain ITEMS. PATH is a list of strings for locating the menu that diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index a8361c0d4b4..e7727fd3fc9 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -729,7 +729,7 @@ Argument FN is the function calling this verifier." (pcase slot ((and (or `',name (and name (pred keywordp))) (guard (not (memq name eieio--known-slot-names)))) - (macroexp--warn-and-return + (macroexp-warn-and-return (format-message "Unknown slot `%S'" name) exp 'compile-only)) (_ exp)))) (gv-setter eieio-oset)) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index d3e5d03edb5..910023b841b 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -269,7 +269,7 @@ This method is obsolete." (lambda (whole) (if (not (stringp (car slots))) whole - (macroexp--warn-and-return + (macroexp-warn-and-return (format "Obsolete name arg %S to constructor %S" (car slots) (car whole)) ;; Keep the name arg, for backward compatibility, diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index cc2927caf40..411ea2af69c 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -583,7 +583,7 @@ displayed." ;; continue standard unloading nil) -(cl-defmethod loadhist-unload-element :before :extra "elp" ((x (head defun))) +(cl-defmethod loadhist-unload-element :extra "elp" :before ((x (head defun))) "Un-instrument before unloading a function." (elp-restore-function (cdr x))) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index a5c877e53ad..155b6a9d4e6 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -277,14 +277,7 @@ It should only be stopped when ran from inside ert--run-test-internal." (let ((form ;; catch macroexpansion errors (condition-case err - (macroexpand-all form - (append (bound-and-true-p - byte-compile-macro-environment) - (cond - ((boundp 'macroexpand-all-environment) - macroexpand-all-environment) - ((boundp 'cl-macro-environment) - cl-macro-environment)))) + (macroexpand-all form macroexpand-all-environment) (error `(signal ',(car err) ',(cdr err)))))) (cond ((or (atom form) (ert--special-operator-p (car form))) @@ -1550,7 +1543,7 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ (message "------------------") (setq tests (sort tests (lambda (x y) (> (car x) (car y))))) (when (< high (length tests)) (setcdr (nthcdr (1- high) tests) nil)) - (message "%s" (mapconcat 'cdr tests "\n"))) + (message "%s" (mapconcat #'cdr tests "\n"))) ;; More details on hydra, where the logs are harder to get to. (when (and (getenv "EMACS_HYDRA_CI") (not (zerop (+ nunexpected nskipped)))) @@ -2077,7 +2070,7 @@ and how to display message." (ert-run-tests selector listener t))) ;;;###autoload -(defalias 'ert 'ert-run-tests-interactively) +(defalias 'ert #'ert-run-tests-interactively) ;;; Simple view mode for auxiliary information like stack traces or diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 2b213e2065f..3d8054950c1 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -593,7 +593,7 @@ binding mode." ;; dynamic binding mode as well. (eq (car-safe code) 'cons)) code - (macroexp--warn-and-return + (macroexp-warn-and-return "Use of gv-ref probably requires lexical-binding" code)))) diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el index d6106fe35d0..36d71a8c04d 100644 --- a/lisp/emacs-lisp/inline.el +++ b/lisp/emacs-lisp/inline.el @@ -262,7 +262,7 @@ See Info node `(elisp)Defining Functions' for more details." '(throw 'inline--just-use ;; FIXME: This would inf-loop by calling us right back when ;; macroexpand-all recurses to expand inline--form. - ;; (macroexp--warn-and-return (format ,@args) + ;; (macroexp-warn-and-return (format ,@args) ;; inline--form) inline--form)) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 54089c4bc69..4aa8ddcfa11 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -740,25 +740,24 @@ font-lock keywords will not be case sensitive." ;;; Generic Lisp mode. (defvar lisp-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap "Lisp"))) + (let ((map (make-sparse-keymap))) (set-keymap-parent map lisp-mode-shared-map) (define-key map "\e\C-x" 'lisp-eval-defun) (define-key map "\C-c\C-z" 'run-lisp) - (bindings--define-key map [menu-bar lisp] (cons "Lisp" menu-map)) - (bindings--define-key menu-map [run-lisp] - '(menu-item "Run inferior Lisp" run-lisp - :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'")) - (bindings--define-key menu-map [ev-def] - '(menu-item "Eval defun" lisp-eval-defun - :help "Send the current defun to the Lisp process made by M-x run-lisp")) - (bindings--define-key menu-map [ind-sexp] - '(menu-item "Indent sexp" indent-sexp - :help "Indent each line of the list starting just after point")) map) "Keymap for ordinary Lisp mode. All commands in `lisp-mode-shared-map' are inherited by this map.") +(easy-menu-define lisp-mode-menu lisp-mode-map + "Menu for ordinary Lisp mode." + '("Lisp" + ["Indent sexp" indent-sexp + :help "Indent each line of the list starting just after point"] + ["Eval defun" lisp-eval-defun + :help "Send the current defun to the Lisp process made by M-x run-lisp"] + ["Run inferior Lisp" run-lisp + :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'"])) + (define-derived-mode lisp-mode lisp-data-mode "Lisp" "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp. Commands: @@ -1372,7 +1371,8 @@ and initial semicolons." fill-column))) (save-restriction (save-excursion - (let ((ppss (syntax-ppss))) + (let ((ppss (syntax-ppss)) + (start (point))) ;; If we're in a string, then narrow (roughly) to that ;; string before filling. This avoids filling Lisp ;; statements that follow the string. @@ -1387,6 +1387,8 @@ and initial semicolons." t)) (narrow-to-region (ppss-comment-or-string-start ppss) (point)))) + ;; Move back to where we were. + (goto-char start) (fill-paragraph justify))))) ;; Never return nil. t)) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index d52aee5a4ad..59ada5ec35a 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -135,28 +135,33 @@ Other uses risk returning non-nil value that point to the wrong file." (defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key)) -(defun macroexp--warn-and-return (msg form &optional compile-only) +(defun macroexp--warn-wrap (msg form) (let ((when-compiled (lambda () (byte-compile-warn "%s" msg)))) - (cond - ((null msg) form) - ((macroexp-compiling-p) - (if (and (consp form) (gethash form macroexp--warned)) - ;; Already wrapped this exp with a warning: avoid inf-looping - ;; where we keep adding the same warning onto `form' because - ;; macroexpand-all gets right back to macroexpanding `form'. - form - (puthash form form macroexp--warned) - `(progn - (macroexp--funcall-if-compiled ',when-compiled) - ,form))) - (t - (unless compile-only - (message "%sWarning: %s" - (if (stringp load-file-name) - (concat (file-relative-name load-file-name) ": ") - "") - msg)) - form)))) + `(progn + (macroexp--funcall-if-compiled ',when-compiled) + ,form))) + +(define-obsolete-function-alias 'macroexp--warn-and-return + #'macroexp-warn-and-return "28.1") +(defun macroexp-warn-and-return (msg form &optional compile-only) + (cond + ((null msg) form) + ((macroexp-compiling-p) + (if (and (consp form) (gethash form macroexp--warned)) + ;; Already wrapped this exp with a warning: avoid inf-looping + ;; where we keep adding the same warning onto `form' because + ;; macroexpand-all gets right back to macroexpanding `form'. + form + (puthash form form macroexp--warned) + (macroexp--warn-wrap msg form))) + (t + (unless compile-only + (message "%sWarning: %s" + (if (stringp load-file-name) + (concat (file-relative-name load-file-name) ": ") + "") + msg)) + form))) (defun macroexp--obsolete-warning (fun obsolescence-data type) (let ((instead (car obsolescence-data)) @@ -205,7 +210,7 @@ Other uses risk returning non-nil value that point to the wrong file." (byte-compile-warning-enabled-p 'obsolete (car form)))) (let* ((fun (car form)) (obsolete (get fun 'byte-obsolete-info))) - (macroexp--warn-and-return + (macroexp-warn-and-return (macroexp--obsolete-warning fun obsolete (if (symbolp (symbol-function fun)) @@ -260,7 +265,7 @@ Other uses risk returning non-nil value that point to the wrong file." values (cdr values)))) (setq arglist (cdr arglist))) (if values - (macroexp--warn-and-return + (macroexp-warn-and-return (format (if (eq values 'too-few) "attempt to open-code `%s' with too few arguments" "attempt to open-code `%s' with too many arguments") @@ -289,10 +294,12 @@ Assumes the caller has bound `macroexpand-all-environment'." macroexpand-all-environment) ;; Normal form; get its expansion, and then expand arguments. (setq form (macroexp-macroexpand form macroexpand-all-environment)) + ;; FIXME: It'd be nice to use `byte-optimize--pcase' here, but when + ;; I tried it, it broke the bootstrap :-( (pcase form (`(cond . ,clauses) (macroexp--cons 'cond (macroexp--all-clauses clauses) form)) - (`(condition-case . ,(or `(,err ,body . ,handlers) dontcare)) + (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare)) (macroexp--cons 'condition-case (macroexp--cons err @@ -309,12 +316,13 @@ Assumes the caller has bound `macroexpand-all-environment'." (cdr form)) form)) (`(,(or 'function 'quote) . ,_) form) - (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) dontcare)) + (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) + pcase--dontcare)) (macroexp--cons fun (macroexp--cons (macroexp--all-clauses bindings 1) (if (null body) (macroexp-unprogn - (macroexp--warn-and-return + (macroexp-warn-and-return (format "Empty %s body" fun) nil t)) (macroexp--all-forms body)) @@ -334,27 +342,7 @@ Assumes the caller has bound `macroexpand-all-environment'." form) (macroexp--expand-all newform)))) - ;; The following few cases are for normal function calls that - ;; are known to funcall one of their arguments. The byte - ;; compiler has traditionally handled these functions specially - ;; by treating a lambda expression quoted by `quote' as if it - ;; were quoted by `function'. We make the same transformation - ;; here, so that any code that cares about the difference will - ;; see the same transformation. - ;; First arg is a function: - (`(,(and fun (or 'funcall 'apply 'mapcar 'mapatoms 'mapconcat 'mapc)) - ',(and f `(lambda . ,_)) . ,args) - (macroexp--warn-and-return - (format "%s quoted with ' rather than with #'" - (list 'lambda (nth 1 f) '...)) - (macroexp--expand-all `(,fun #',f . ,args)))) - ;; Second arg is a function: - (`(,(and fun (or 'sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args) - (macroexp--warn-and-return - (format "%s quoted with ' rather than with #'" - (list 'lambda (nth 1 f) '...)) - (macroexp--expand-all `(,fun ,arg1 #',f . ,args)))) - (`(funcall ,exp . ,args) + (`(funcall . ,(or `(,exp . ,args) pcase--dontcare)) (let ((eexp (macroexp--expand-all exp)) (eargs (macroexp--all-forms args))) ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo' @@ -363,10 +351,22 @@ Assumes the caller has bound `macroexpand-all-environment'." (`#',f (macroexp--expand-all `(,f . ,eargs))) (_ `(funcall ,eexp . ,eargs))))) (`(,func . ,_) - ;; Macro expand compiler macros. This cannot be delayed to - ;; byte-optimize-form because the output of the compiler-macro can - ;; use macros. - (let ((handler (function-get func 'compiler-macro))) + (let ((handler (function-get func 'compiler-macro)) + (funargs (function-get func 'funarg-positions))) + ;; Check functions quoted with ' rather than with #' + (dolist (funarg funargs) + (let ((arg (nth funarg form))) + (when (and (eq 'quote (car-safe arg)) + (eq 'lambda (car-safe (cadr arg)))) + (setcar (nthcdr funarg form) + (macroexp-warn-and-return + (format "%S quoted with ' rather than with #'" + (let ((f (cadr arg))) + (if (symbolp f) f `(lambda ,(nth 1 f) ...)))) + arg))))) + ;; Macro expand compiler macros. This cannot be delayed to + ;; byte-optimize-form because the output of the compiler-macro can + ;; use macros. (if (null handler) ;; No compiler macro. We just expand each argument (for ;; setq/setq-default this works alright because the variable names @@ -392,6 +392,18 @@ Assumes the caller has bound `macroexpand-all-environment'." (_ form)))) +;; Record which arguments expect functions, so we can warn when those +;; are accidentally quoted with ' rather than with #' +(dolist (f '(funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash)) + (put f 'funarg-positions '(1))) +(dolist (f '( add-hook remove-hook advice-remove advice--remove-function + defalias fset global-set-key run-after-idle-timeout + set-process-filter set-process-sentinel sort)) + (put f 'funarg-positions '(2))) +(dolist (f '( advice-add define-key + run-at-time run-with-idle-timer run-with-timer )) + (put f 'funarg-positions '(3))) + ;;;###autoload (defun macroexpand-all (form &optional environment) "Return result of expanding macros at all levels in FORM. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 46a1bd21a3d..c0cbc7b5a18 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -3,12 +3,10 @@ ;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; Author: Nicolas Petton <nicolas@petton.fr> -;; Keywords: convenience, map, hash-table, alist, array -;; Version: 2.1 -;; Package-Requires: ((emacs "25")) -;; Package: map - ;; Maintainer: emacs-devel@gnu.org +;; Keywords: extensions, lisp +;; Version: 3.0 +;; Package-Requires: ((emacs "26")) ;; This file is part of GNU Emacs. @@ -27,8 +25,9 @@ ;;; Commentary: -;; map.el provides map-manipulation functions that work on alists, -;; hash-table and arrays. All functions are prefixed with "map-". +;; map.el provides generic map-manipulation functions that work on +;; alists, plists, hash-tables, and arrays. All functions are +;; prefixed with "map-". ;; ;; Functions taking a predicate or iterating over a map using a ;; function take the function as their first argument. All other @@ -54,7 +53,7 @@ ARGS is a list of elements to be matched in the map. Each element of ARGS can be of the form (KEY PAT), in which case KEY is evaluated and searched for in the map. The match fails if for any KEY found in the map, the corresponding PAT doesn't match the value -associated to the KEY. +associated with the KEY. Each element can also be a SYMBOL, which is an abbreviation of a (KEY PAT) tuple of the form (\\='SYMBOL SYMBOL). When SYMBOL @@ -75,7 +74,7 @@ bound to the looked up value in MAP. KEYS can also be a list of (KEY VARNAME) pairs, in which case KEY is an unquoted form. -MAP can be a list, hash-table or array." +MAP can be an alist, plist, hash-table, or array." (declare (indent 2) (debug ((&rest &or symbolp ([form symbolp])) form body))) `(pcase-let ((,(map--make-pcase-patterns keys) ,map)) @@ -101,7 +100,7 @@ Returns the result of evaluating the form associated with MAP-VAR's type." (define-error 'map-not-inplace "Cannot modify map in-place") (defsubst map--plist-p (list) - (and (consp list) (not (listp (car list))))) + (and (consp list) (atom (car list)))) (cl-defgeneric map-elt (map key &optional default testfn) "Lookup KEY in MAP and return its associated value. @@ -109,7 +108,8 @@ If KEY is not found, return DEFAULT which defaults to nil. TESTFN is deprecated. Its default depends on the MAP argument. -In the base definition, MAP can be an alist, hash-table, or array." +In the base definition, MAP can be an alist, plist, hash-table, +or array." (declare (gv-expander (lambda (do) @@ -127,26 +127,25 @@ In the base definition, MAP can be an alist, hash-table, or array." `(map-insert ,mgetter ,key ,v)))))))))) ;; `testfn' is deprecated. (advertised-calling-convention (map key &optional default) "27.1")) + ;; Can't use `cl-defmethod' with `advertised-calling-convention'. (map--dispatch map :list (if (map--plist-p map) - (let ((res (plist-get map key))) - (if (and default (null res) (not (plist-member map key))) - default - res)) + (let ((res (plist-member map key))) + (if res (cadr res) default)) (alist-get key map default nil testfn)) :hash-table (gethash key map default) - :array (if (and (>= key 0) (< key (seq-length map))) - (seq-elt map key) + :array (if (map-contains-key map key) + (aref map key) default))) (defmacro map-put (map key value &optional testfn) "Associate KEY with VALUE in MAP and return VALUE. If KEY is already present in MAP, replace the associated value with VALUE. -When MAP is a list, test equality with TESTFN if non-nil, +When MAP is an alist, test equality with TESTFN if non-nil, otherwise use `eql'. -MAP can be a list, hash-table or array." +MAP can be an alist, plist, hash-table, or array." (declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead" "27.1")) `(setf (map-elt ,map ,key nil ,testfn) ,value)) @@ -168,23 +167,30 @@ MAP can be a list, hash-table or array." (cl-defgeneric map-delete (map key) "Delete KEY in-place from MAP and return MAP. -No error is signaled if KEY is not a key of MAP. -If MAP is an array, store nil at the index KEY." - (map--dispatch map - ;; FIXME: Signal map-not-inplace i.s.o returning a different list? - :list (if (map--plist-p map) - (setq map (map--plist-delete map key)) - (setf (alist-get key map nil t) nil)) - :hash-table (remhash key map) - :array (and (>= key 0) - (<= key (seq-length map)) - (aset map key nil))) +Keys not present in MAP are ignored.") + +(cl-defmethod map-delete ((map list) key) + ;; FIXME: Signal map-not-inplace i.s.o returning a different list? + (if (map--plist-p map) + (map--plist-delete map key) + (setf (alist-get key map nil t) nil) + map)) + +(cl-defmethod map-delete ((map hash-table) key) + (remhash key map) + map) + +(cl-defmethod map-delete ((map array) key) + "Store nil at index KEY." + (when (map-contains-key map key) + (aset map key nil)) map) (defun map-nested-elt (map keys &optional default) "Traverse MAP using KEYS and return the looked up value or DEFAULT if nil. -Map can be a nested map composed of alists, hash-tables and arrays." +MAP can be a nested map composed of alists, plists, hash-tables, +and arrays." (or (seq-reduce (lambda (acc key) (when (mapp acc) (map-elt acc key))) @@ -202,30 +208,49 @@ The default implementation delegates to `map-apply'." The default implementation delegates to `map-apply'." (map-apply (lambda (_ value) value) map)) +(cl-defmethod map-values ((map array)) + "Convert MAP into a list." + (append map ())) + (cl-defgeneric map-pairs (map) - "Return the elements of MAP as key/value association lists. + "Return the key/value pairs in MAP as an alist. The default implementation delegates to `map-apply'." (map-apply #'cons map)) (cl-defgeneric map-length (map) ;; FIXME: Should we rename this to `map-size'? - "Return the number of elements in the map. -The default implementation counts `map-keys'." - (cond - ((hash-table-p map) (hash-table-count map)) - ((listp map) - ;; FIXME: What about repeated/shadowed keys? - (if (map--plist-p map) (/ (length map) 2) (length map))) - ((arrayp map) (length map)) - (t (length (map-keys map))))) + "Return the number of key/value pairs in MAP. +Note that this does not always reflect the number of unique keys. +The default implementation delegates to `map-do'." + (let ((size 0)) + (map-do (lambda (_k _v) (setq size (1+ size))) map) + size)) + +(cl-defmethod map-length ((map hash-table)) + (hash-table-count map)) + +(cl-defmethod map-length ((map list)) + (if (map--plist-p map) + (/ (length map) 2) + (length map))) + +(cl-defmethod map-length ((map array)) + (length map)) (cl-defgeneric map-copy (map) - "Return a copy of MAP." - ;; FIXME: Clarify how deep is the copy! - (map--dispatch map - :list (seq-copy map) ;FIXME: Probably not deep enough for alists! - :hash-table (copy-hash-table map) - :array (seq-copy map))) + "Return a copy of MAP.") + +(cl-defmethod map-copy ((map list)) + "Use `copy-alist' on alists and `copy-sequence' on plists." + (if (map--plist-p map) + (copy-sequence map) + (copy-alist map))) + +(cl-defmethod map-copy ((map hash-table)) + (copy-hash-table map)) + +(cl-defmethod map-copy ((map array)) + (copy-sequence map)) (cl-defgeneric map-apply (function map) "Apply FUNCTION to each element of MAP and return the result as a list. @@ -243,26 +268,28 @@ FUNCTION is called with two arguments, the key and the value.") (cl-defmethod map-do (function (map hash-table)) (maphash function map)) (cl-defgeneric map-keys-apply (function map) - "Return the result of applying FUNCTION to each key of MAP. + "Return the result of applying FUNCTION to each key in MAP. The default implementation delegates to `map-apply'." (map-apply (lambda (key _) (funcall function key)) map)) (cl-defgeneric map-values-apply (function map) - "Return the result of applying FUNCTION to each value of MAP. + "Return the result of applying FUNCTION to each value in MAP. The default implementation delegates to `map-apply'." (map-apply (lambda (_ val) (funcall function val)) map)) +(cl-defmethod map-values-apply (function (map array)) + (mapcar function map)) + (cl-defgeneric map-filter (pred map) "Return an alist of key/val pairs for which (PRED key val) is non-nil in MAP. The default implementation delegates to `map-apply'." (delq nil (map-apply (lambda (key val) - (if (funcall pred key val) - (cons key val) - nil)) + (and (funcall pred key val) + (cons key val))) map))) (cl-defgeneric map-remove (pred map) @@ -272,7 +299,7 @@ The default implementation delegates to `map-filter'." map)) (cl-defgeneric mapp (map) - "Return non-nil if MAP is a map (alist, hash-table, array, ...)." + "Return non-nil if MAP is a map (alist/plist, hash-table, array, ...)." (or (listp map) (hash-table-p map) (arrayp map))) @@ -292,56 +319,58 @@ The default implementation delegates to `map-length'." ;; test function! "Return non-nil if and only if MAP contains KEY. TESTFN is deprecated. Its default depends on MAP. -The default implementation delegates to `map-do'." +The default implementation delegates to `map-some'." (unless testfn (setq testfn #'equal)) - (catch 'map--catch - (map-do (lambda (k _v) - (if (funcall testfn key k) (throw 'map--catch t))) - map) - nil)) + (map-some (lambda (k _v) (funcall testfn key k)) map)) (cl-defmethod map-contains-key ((map list) key &optional testfn) - (let ((v '(nil))) - (not (eq v (alist-get key map v nil (or testfn #'equal)))))) + "Return non-nil if MAP contains KEY. +If MAP is an alist, TESTFN defaults to `equal'. +If MAP is a plist, `plist-member' is used instead." + (if (map--plist-p map) + (plist-member map key) + (let ((v '(nil))) + (not (eq v (alist-get key map v nil (or testfn #'equal))))))) (cl-defmethod map-contains-key ((map array) key &optional _testfn) - (and (integerp key) - (>= key 0) - (< key (length map)))) + "Return non-nil if KEY is an index of MAP, ignoring TESTFN." + (and (natnump key) (< key (length map)))) (cl-defmethod map-contains-key ((map hash-table) key &optional _testfn) + "Return non-nil if MAP contains KEY, ignoring TESTFN." (let ((v '(nil))) (not (eq v (gethash key map v))))) (cl-defgeneric map-some (pred map) "Return the first non-nil (PRED key val) in MAP. -The default implementation delegates to `map-apply'." +Return nil if no such element is found. +The default implementation delegates to `map-do'." ;; FIXME: Not sure if there's much benefit to defining it as defgeneric, ;; since as defined, I can't think of a map-type where we could provide an ;; algorithmically more efficient algorithm than the default. (catch 'map--break - (map-apply (lambda (key value) - (let ((result (funcall pred key value))) - (when result - (throw 'map--break result)))) - map) + (map-do (lambda (key value) + (let ((result (funcall pred key value))) + (when result + (throw 'map--break result)))) + map) nil)) (cl-defgeneric map-every-p (pred map) "Return non-nil if (PRED key val) is non-nil for all elements of MAP. -The default implementation delegates to `map-apply'." +The default implementation delegates to `map-do'." ;; FIXME: Not sure if there's much benefit to defining it as defgeneric, ;; since as defined, I can't think of a map-type where we could provide an ;; algorithmically more efficient algorithm than the default. (catch 'map--break - (map-apply (lambda (key value) + (map-do (lambda (key value) (or (funcall pred key value) (throw 'map--break nil))) map) t)) (defun map-merge (type &rest maps) - "Merge into a map of type TYPE all the key/value pairs in MAPS. + "Merge into a map of TYPE all the key/value pairs in MAPS. See `map-into' for all supported values of TYPE." (let ((result (map-into (pop maps) type))) (while maps @@ -349,48 +378,57 @@ See `map-into' for all supported values of TYPE." ;; For small tables, this is fine, but for large tables, we ;; should probably use a hash-table internally which we convert ;; to an alist in the end. - (map-apply (lambda (key value) - (setf (map-elt result key) value)) - (pop maps))) + (map-do (lambda (key value) + (setf (map-elt result key) value)) + (pop maps))) result)) (defun map-merge-with (type function &rest maps) - "Merge into a map of type TYPE all the key/value pairs in MAPS. -When two maps contain the same key (`eql'), call FUNCTION on the two + "Merge into a map of TYPE all the key/value pairs in MAPS. +When two maps contain the same (`eql') key, call FUNCTION on the two values and use the value returned by it. -MAP can be a list, hash-table or array. +Each of MAPS can be an alist, plist, hash-table, or array. See `map-into' for all supported values of TYPE." (let ((result (map-into (pop maps) type)) - (not-found (cons nil nil))) + (not-found (list nil))) (while maps - (map-apply (lambda (key value) - (cl-callf (lambda (old) - (if (eql old not-found) - value - (funcall function old value))) - (map-elt result key not-found))) - (pop maps))) + (map-do (lambda (key value) + (cl-callf (lambda (old) + (if (eql old not-found) + value + (funcall function old value))) + (map-elt result key not-found))) + (pop maps))) result)) (cl-defgeneric map-into (map type) - "Convert the map MAP into a map of type TYPE.") + "Convert MAP into a map of TYPE.") + ;; FIXME: I wish there was a way to avoid this η-redex! -(cl-defmethod map-into (map (_type (eql list))) (map-pairs map)) -(cl-defmethod map-into (map (_type (eql alist))) (map-pairs map)) +(cl-defmethod map-into (map (_type (eql list))) + "Convert MAP into an alist." + (map-pairs map)) + +(cl-defmethod map-into (map (_type (eql alist))) + "Convert MAP into an alist." + (map-pairs map)) + (cl-defmethod map-into (map (_type (eql plist))) - (let ((plist '())) - (map-do (lambda (k v) (setq plist `(,k ,v ,@plist))) map) - plist)) + "Convert MAP into a plist." + (let (plist) + (map-do (lambda (k v) (setq plist `(,v ,k ,@plist))) map) + (nreverse plist))) (cl-defgeneric map-put! (map key value &optional testfn) "Associate KEY with VALUE in MAP. If KEY is already present in MAP, replace the associated value with VALUE. This operates by modifying MAP in place. -If it cannot do that, it signals the `map-not-inplace' error. -If you want to insert an element without modifying MAP, use `map-insert'." +If it cannot do that, it signals a `map-not-inplace' error. +To insert an element without modifying MAP, use `map-insert'." ;; `testfn' only exists for backward compatibility with `map-put'! (declare (advertised-calling-convention (map key value) "27.1")) + ;; Can't use `cl-defmethod' with `advertised-calling-convention'. (map--dispatch map :list (if (map--plist-p map) @@ -404,18 +442,20 @@ If you want to insert an element without modifying MAP, use `map-insert'." ;; and let `map-insert' grow the array? :array (aset map key value))) -(define-error 'map-inplace "Can only modify map in place") - (cl-defgeneric map-insert (map key value) "Return a new map like MAP except that it associates KEY with VALUE. This does not modify MAP. -If you want to insert an element in place, use `map-put!'." - (if (listp map) - (if (map--plist-p map) - `(,key ,value ,@map) - (cons (cons key value) map)) - ;; FIXME: Should we signal an error or use copy+put! ? - (signal 'map-inplace (list map)))) +If you want to insert an element in place, use `map-put!'. +The default implementation defaults to `map-copy' and `map-put!'." + (let ((copy (map-copy map))) + (map-put! copy key value) + copy)) + +(cl-defmethod map-insert ((map list) key value) + "Cons KEY and VALUE to the front of MAP." + (if (map--plist-p map) + (cons key (cons value map)) + (cons (cons key value) map))) ;; There shouldn't be old source code referring to `map--put', yet we do ;; need to keep it for backward compatibility with .elc files where the @@ -425,11 +465,9 @@ If you want to insert an element in place, use `map-put!'." (cl-defmethod map-apply (function (map list)) (if (map--plist-p map) (cl-call-next-method) - (seq-map (lambda (pair) - (funcall function - (car pair) - (cdr pair))) - map))) + (mapcar (lambda (pair) + (funcall function (car pair) (cdr pair))) + map))) (cl-defmethod map-apply (function (map hash-table)) (let (result) @@ -439,46 +477,40 @@ If you want to insert an element in place, use `map-put!'." (nreverse result))) (cl-defmethod map-apply (function (map array)) - (let ((index 0)) - (seq-map (lambda (elt) - (prog1 - (funcall function index elt) - (setq index (1+ index)))) - map))) + (seq-map-indexed (lambda (elt index) + (funcall function index elt)) + map)) (cl-defmethod map-do (function (map list)) - "Private function used to iterate over ALIST using FUNCTION." (if (map--plist-p map) (while map (funcall function (pop map) (pop map))) - (seq-do (lambda (pair) - (funcall function - (car pair) - (cdr pair))) - map))) + (mapc (lambda (pair) + (funcall function (car pair) (cdr pair))) + map) + nil)) -(cl-defmethod map-do (function (array array)) - "Private function used to iterate over ARRAY using FUNCTION." +(cl-defmethod map-do (function (map array)) (seq-do-indexed (lambda (elt index) - (funcall function index elt)) - array)) + (funcall function index elt)) + map)) (defun map--into-hash (map keyword-args) "Convert MAP into a hash-table. KEYWORD-ARGS are forwarded to `make-hash-table'." (let ((ht (apply #'make-hash-table keyword-args))) - (map-apply (lambda (key value) - (setf (gethash key ht) value)) - map) + (map-do (lambda (key value) + (puthash key value ht)) + map) ht)) (cl-defmethod map-into (map (_type (eql hash-table))) - "Convert MAP into a hash-table." - (map--into-hash map (list :size (map-length map) :test 'equal))) + "Convert MAP into a hash-table with keys compared with `equal'." + (map--into-hash map (list :size (map-length map) :test #'equal))) (cl-defmethod map-into (map (type (head hash-table))) "Convert MAP into a hash-table. -TYPE is a list where the car is `hash-table' and the cdr are the +TYPE is a list whose car is `hash-table' and cdr a list of keyword-args forwarded to `make-hash-table'. Example: @@ -487,23 +519,23 @@ Example: (defun map--make-pcase-bindings (args) "Return a list of pcase bindings from ARGS to the elements of a map." - (seq-map (lambda (elt) - (cond ((consp elt) - `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt))) - ((keywordp elt) - (let ((var (intern (substring (symbol-name elt) 1)))) - `(app (pcase--flip map-elt ,elt) ,var))) - (t `(app (pcase--flip map-elt ',elt) ,elt)))) - args)) + (mapcar (lambda (elt) + (cond ((consp elt) + `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt))) + ((keywordp elt) + (let ((var (intern (substring (symbol-name elt) 1)))) + `(app (pcase--flip map-elt ,elt) ,var))) + (t `(app (pcase--flip map-elt ',elt) ,elt)))) + args)) (defun map--make-pcase-patterns (args) "Return a list of `(map ...)' pcase patterns built from ARGS." (cons 'map - (seq-map (lambda (elt) - (if (and (consp elt) (eq 'map (car elt))) - (map--make-pcase-patterns elt) - elt)) - args))) + (mapcar (lambda (elt) + (if (eq (car-safe elt) 'map) + (map--make-pcase-patterns elt) + elt)) + args))) (provide 'map) ;;; map.el ends here diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index b7fa3120c10..059eda602c3 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2759,6 +2759,7 @@ either a full name or nil, and EMAIL is a valid email address." (define-key map "U" 'package-menu-mark-upgrades) (define-key map "r" 'revert-buffer) (define-key map "~" 'package-menu-mark-obsolete-for-deletion) + (define-key map "w" 'package-browse-url) (define-key map "x" 'package-menu-execute) (define-key map "h" 'package-menu-quick-help) (define-key map "H" #'package-menu-hide-package) @@ -2781,6 +2782,8 @@ either a full name or nil, and EMAIL is a valid email address." "Menu for `package-menu-mode'." '("Package" ["Describe Package" package-menu-describe-package :help "Display information about this package"] + ["Open Package Homepage" package-browse-url + :help "Open the homepage of this package"] ["Help" package-menu-quick-help :help "Show short key binding help for package-menu-mode"] "--" ["Refresh Package List" revert-buffer @@ -4189,6 +4192,22 @@ beginning of the line." (package-version-join (package-desc-version package-desc)) (package-desc-summary package-desc)))) +(defun package-browse-url (desc &optional secondary) + "Open the home page of the package under point in a browser. +`browse-url' is used to determine the browser to be used. +If SECONDARY (interactively, the prefix), use the secondary browser." + (interactive (list (tabulated-list-get-id) + current-prefix-arg) + package-menu-mode) + (unless desc + (user-error "No package here")) + (let ((url (cdr (assoc :url (package-desc-extras desc))))) + (unless url + (user-error "No home page for %s" (package-desc-name desc))) + (if secondary + (funcall browse-url-secondary-browser-function url) + (browse-url url)))) + ;;;; Introspection (defun package-get-descriptor (pkg-name) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index c7288b7fa2a..5342a0179d9 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -326,72 +326,76 @@ of the elements of LIST is performed as if by `pcase-let'. (macroexp-let2 macroexp-copyable-p val exp (let* ((defs ()) (seen '()) - (codegen - (lambda (code vars) - (let ((vars (macroexp--fgrep vars code)) - (prev (assq code seen))) - (if (not prev) - (let ((res (pcase-codegen code vars))) - (push (list code vars res) seen) - res) - ;; Since we use a tree-based pattern matching - ;; technique, the leaves (the places that contain the - ;; code to run once a pattern is matched) can get - ;; copied a very large number of times, so to avoid - ;; code explosion, we need to keep track of how many - ;; times we've used each leaf and move it - ;; to a separate function if that number is too high. - ;; - ;; We've already used this branch. So it is shared. - (let* ((code (car prev)) (cdrprev (cdr prev)) - (prevvars (car cdrprev)) (cddrprev (cdr cdrprev)) - (res (car cddrprev))) - (unless (symbolp res) - ;; This is the first repeat, so we have to move - ;; the branch to a separate function. - (let ((bsym - (make-symbol (format "pcase-%d" (length defs))))) - (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code)) - defs) - (setcar res 'funcall) - (setcdr res (cons bsym (mapcar #'cdr prevvars))) - (setcar (cddr prev) bsym) - (setq res bsym))) - (setq vars (copy-sequence vars)) - (let ((args (mapcar (lambda (pa) - (let ((v (assq (car pa) vars))) - (setq vars (delq v vars)) - (cdr v))) - prevvars))) - ;; If some of `vars' were not found in `prevvars', that's - ;; OK it just means those vars aren't present in all - ;; branches, so they can be used within the pattern - ;; (e.g. by a `guard/let/pred') but not in the branch. - ;; FIXME: But if some of `prevvars' are not in `vars' we - ;; should remove them from `prevvars'! - `(funcall ,res ,@args))))))) - (used-cases ()) (main (pcase--u - (mapcar (lambda (case) - `(,(pcase--match val (pcase--macroexpand (car case))) - ,(lambda (vars) - (unless (memq case used-cases) - ;; Keep track of the cases that are used. - (push case used-cases)) - (funcall - (if (pcase--small-branch-p (cdr case)) - ;; Don't bother sharing multiple - ;; occurrences of this leaf since it's small. - (lambda (code vars) - (pcase-codegen code - (macroexp--fgrep vars code))) - codegen) - (cdr case) - vars)))) - cases)))) + (mapcar + (lambda (case) + `(,(pcase--match val (pcase--macroexpand (car case))) + ,(lambda (vars) + (let ((prev (assq case seen)) + (code (cdr case))) + (unless prev + ;; Keep track of the cases that are used. + (push (setq prev (list case)) seen)) + (if (member code '(nil (nil))) nil + ;; Put `code' in the cdr just so that not all + ;; branches look identical (to avoid things like + ;; `macroexp--if' optimizing them too optimistically). + (let ((ph (list 'pcase--placeholder code))) + (setcdr prev (cons (cons vars ph) (cdr prev))) + ph)))))) + cases)))) + ;; Take care of the place holders now. + (dolist (branch seen) + (let ((code (cdar branch)) + (uses (cdr branch))) + ;; Find all the vars that are in scope (the union of the + ;; vars provided in each use case). + (let* ((allvarinfo '()) + (_ (dolist (use uses) + (dolist (v (car use)) + (let ((vi (assq (car v) allvarinfo))) + (if vi + (if (cddr v) (setcdr vi 'used)) + (push (cons (car v) (cddr v)) allvarinfo)))))) + (allvars (mapcar #'car allvarinfo)) + (ignores (mapcar (lambda (vi) (when (cdr vi) `(ignore ,(car vi)))) + allvarinfo))) + ;; Since we use a tree-based pattern matching + ;; technique, the leaves (the places that contain the + ;; code to run once a pattern is matched) can get + ;; copied a very large number of times, so to avoid + ;; code explosion, we need to keep track of how many + ;; times we've used each leaf and move it + ;; to a separate function if that number is too high. + (if (or (null (cdr uses)) (pcase--small-branch-p code)) + (dolist (use uses) + (let ((vars (car use)) + (placeholder (cdr use))) + ;; (cl-assert (eq (car placeholder) 'pcase--placeholder)) + (setcar placeholder 'let) + (setcdr placeholder + `(,(mapcar (lambda (v) (list v (cadr (assq v vars)))) + allvars) + ;; Try and silence some of the most common + ;; spurious "unused var" warnings. + ,@ignores + ,@code)))) + ;; Several occurrence of this non-small branch in the output. + (let ((bsym + (make-symbol (format "pcase-%d" (length defs))))) + (push `(,bsym (lambda ,allvars ,@ignores ,@code)) defs) + (dolist (use uses) + (let ((vars (car use)) + (placeholder (cdr use))) + ;; (cl-assert (eq (car placeholder) 'pcase--placeholder)) + (setcar placeholder 'funcall) + (setcdr placeholder + `(,bsym + ,@(mapcar (lambda (v) (cadr (assq v vars))) + allvars)))))))))) (dolist (case cases) - (unless (or (memq case used-cases) + (unless (or (assq case seen) (memq (car case) pcase--dontwarn-upats)) (message "pcase pattern %S shadowed by previous pcase pattern" (car case)))) @@ -432,7 +436,13 @@ for the result of evaluating EXP (first arg to `pcase'). (decl (assq 'declare body))) (when decl (setq body (remove decl body))) `(progn - (defun ,fsym ,args ,@body) + ;; FIXME: We use `eval-and-compile' here so that the pcase macro can be + ;; used in the same file where it's defined, but ideally, we should + ;; handle this using something similar to `overriding-plist-environment' + ;; but for `symbol-function' slots so compiling a file doesn't have the + ;; side-effect of defining the function. + (eval-and-compile + (defun ,fsym ,args ,@body)) (define-symbol-prop ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl))) (define-symbol-prop ',name 'pcase-macroexpander #',fsym)))) @@ -448,15 +458,6 @@ for the result of evaluating EXP (first arg to `pcase'). (t `(match ,val . ,upat)))) -(defun pcase-codegen (code vars) - ;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding - ;; let* which might prevent the setcar/setcdr in pcase--expand's fancy - ;; codegen from later metamorphosing this let into a funcall. - (if vars - `(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars) - ,@code) - `(progn ,@code))) - (defun pcase--small-branch-p (code) (and (= 1 (length code)) (or (not (consp (car code))) @@ -469,8 +470,10 @@ for the result of evaluating EXP (first arg to `pcase'). ;; the depth of the generated tree. (defun pcase--if (test then else) (cond - ((eq else :pcase--dontcare) then) - ((eq then :pcase--dontcare) (debug) else) ;Can/should this ever happen? + ((eq else :pcase--dontcare) `(progn (ignore ,test) ,then)) + ;; This happens very rarely. Known case: + ;; (pcase EXP ((and 1 pcase--dontcare) FOO)) + ((eq then :pcase--dontcare) `(progn (ignore ,test) ,else)) (t (macroexp-if test then else)))) ;; Note about MATCH: @@ -495,11 +498,14 @@ for the result of evaluating EXP (first arg to `pcase'). "Expand matcher for rules BRANCHES. Each BRANCH has the form (MATCH CODE . VARS) where CODE is the code generator for that branch. -VARS is the set of vars already bound by earlier matches. MATCH is the pattern that needs to be matched, of the form: (match VAR . PAT) (and MATCH ...) - (or MATCH ...)" + (or MATCH ...) +VARS is the set of vars already bound by earlier matches. +It is a list of (NAME VAL . USED) where NAME is the variable's symbol, +VAL is the expression to which it should be bound and USED is a boolean +recording whether the var has been referenced by earlier parts of the match." (when (setq branches (delq nil branches)) (let* ((carbranch (car branches)) (match (car carbranch)) (cdarbranch (cdr carbranch)) @@ -659,7 +665,7 @@ A and B can be one of: ;; run, but we don't have the environment in which `pat' will ;; run, so we can't do a reliable verification. But let's try ;; and catch at least the easy cases such as (bug#14773). - (not (macroexp--fgrep (mapcar #'car vars) (cadr upat))))) + (not (macroexp--fgrep vars (cadr upat))))) '(:pcase--succeed . :pcase--fail)) ;; In case PAT is of the form (pred (not PRED)) ((and (eq 'pred (car-safe pat)) (eq 'not (car-safe (cadr pat)))) @@ -746,8 +752,11 @@ A and B can be one of: ((symbolp fun) `(,fun ,arg)) ((eq 'not (car-safe fun)) `(not ,(pcase--funcall (cadr fun) arg vars))) (t - (let* (;; `env' is an upper bound on the bindings we need. - (env (mapcar (lambda (x) (list (car x) (cdr x))) + (let* (;; `env' is hopefully an upper bound on the bindings we need, + ;; FIXME: See bug#46786 for a counter example :-( + (env (mapcar (lambda (x) + (setcdr (cdr x) 'used) + (list (car x) (cadr x))) (macroexp--fgrep vars fun))) (call (progn (when (assq arg env) @@ -755,7 +764,7 @@ A and B can be one of: (let ((newsym (gensym "x"))) (push (list newsym arg) env) (setq arg newsym))) - (if (functionp fun) + (if (or (functionp fun) (not (consp fun))) `(funcall #',fun ,arg) `(,@fun ,arg))))) (if (null env) @@ -768,10 +777,12 @@ A and B can be one of: (defun pcase--eval (exp vars) "Build an expression that will evaluate EXP." (let* ((found (assq exp vars))) - (if found (cdr found) + (if found (progn (setcdr (cdr found) 'used) (cadr found)) (let* ((env (macroexp--fgrep vars exp))) (if env - (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x))) + (macroexp-let* (mapcar (lambda (x) + (setcdr (cdr x) 'used) + (list (car x) (cadr x))) env) exp) exp))))) @@ -845,7 +856,7 @@ Otherwise, it defers to REST which is a list of branches of the form ((memq upat '(t _)) (let ((code (pcase--u1 matches code vars rest))) (if (eq upat '_) code - (macroexp--warn-and-return + (macroexp-warn-and-return "Pattern t is deprecated. Use `_' instead" code)))) ((eq upat 'pcase--dontcare) :pcase--dontcare) @@ -863,12 +874,14 @@ Otherwise, it defers to REST which is a list of branches of the form (pcase--u else-rest)))) ((and (symbolp upat) upat) (pcase--mark-used sym) - (if (not (assq upat vars)) - (pcase--u1 matches code (cons (cons upat sym) vars) rest) - ;; Non-linear pattern. Turn it into an `eq' test. - (pcase--u1 (cons `(match ,sym . (pred (eql ,(cdr (assq upat vars))))) - matches) - code vars rest))) + (let ((v (assq upat vars))) + (if (not v) + (pcase--u1 matches code (cons (list upat sym) vars) rest) + ;; Non-linear pattern. Turn it into an `eq' test. + (setcdr (cdr v) 'used) + (pcase--u1 (cons `(match ,sym . (pred (eql ,(cadr v)))) + matches) + code vars rest)))) ((eq (car-safe upat) 'app) ;; A upat of the form (app FUN PAT) (pcase--mark-used sym) @@ -971,8 +984,8 @@ The predicate is the logical-AND of: (nreverse upats)))) ((consp qpat) `(and (pred consp) - (app car ,(list '\` (car qpat))) - (app cdr ,(list '\` (cdr qpat))))) + (app car-safe ,(list '\` (car qpat))) + (app cdr-safe ,(list '\` (cdr qpat))))) ((or (stringp qpat) (numberp qpat) (symbolp qpat)) `',qpat) ;; In all other cases just raise an error so we can't break ;; backward compatibility when adding \` support for other diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el index 0905ac608bb..fb659753501 100644 --- a/lisp/emacs-lisp/radix-tree.el +++ b/lisp/emacs-lisp/radix-tree.el @@ -194,14 +194,13 @@ If not found, return nil." "Return an alist of all bindings in TREE for prefixes of STRING." (radix-tree--prefixes tree string 0 nil)) -(eval-and-compile - (pcase-defmacro radix-tree-leaf (vpat) - "Pattern which matches a radix-tree leaf. +(pcase-defmacro radix-tree-leaf (vpat) + "Pattern which matches a radix-tree leaf. The pattern VPAT is matched against the leaf's carried value." - ;; We used to use `(pred atom)', but `pcase' doesn't understand that - ;; `atom' is equivalent to the negation of `consp' and hence generates - ;; suboptimal code. - `(or `(t . ,,vpat) (and (pred (not consp)) ,vpat)))) + ;; We used to use `(pred atom)', but `pcase' doesn't understand that + ;; `atom' is equivalent to the negation of `consp' and hence generates + ;; suboptimal code. + `(or `(t . ,,vpat) (and (pred (not consp)) ,vpat))) (defun radix-tree-iter-subtrees (tree fun) "Apply FUN to every immediate subtree of radix TREE. diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index ffc21951b64..56e588ee0d5 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1418,6 +1418,12 @@ into a plain rx-expression, collecting names into `rx--pcase-vars'." (cons head (mapcar #'rx--pcase-transform rest))) (_ rx))) +(defun rx--reduce-right (f l) + "Right-reduction on L by F. L must be non-empty." + (if (cdr l) + (funcall f (car l) (rx--reduce-right f (cdr l))) + (car l))) + ;;;###autoload (pcase-defmacro rx (&rest regexps) "A pattern that matches strings against `rx' REGEXPS in sexp form. @@ -1436,17 +1442,28 @@ following constructs: introduced by a previous (let REF ...) construct." (let* ((rx--pcase-vars nil) - (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps))))) + (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps)))) + (nvars (length rx--pcase-vars))) `(and (pred stringp) - ;; `pcase-let' takes a match for granted and discards all unnecessary - ;; conditions, which means that a `pred' clause cannot be used for - ;; the match condition. The following construct seems to survive. - (app (lambda (s) (string-match ,regexp s)) (pred identity)) - ,@(let ((i 0)) - (mapcar (lambda (name) - (setq i (1+ i)) - `(app (match-string ,i) ,name)) - (reverse rx--pcase-vars)))))) + ,(if (zerop nvars) + ;; No variables bound: a single predicate suffices. + `(pred (string-match ,regexp)) + ;; Pack the submatches into a dotted list which is then + ;; immediately destructured into individual variables again. + ;; This is of course slightly inefficient when NVARS > 1. + ;; A dotted list is used to reduce the number of conses + ;; to create and take apart. + `(app (lambda (s) + (and (string-match ,regexp s) + ,(rx--reduce-right + (lambda (a b) `(cons ,a ,b)) + (mapcar (lambda (i) `(match-string ,i s)) + (number-sequence 1 nvars))))) + ,(list '\` + (rx--reduce-right + #'cons + (mapcar (lambda (name) (list '\, name)) + (reverse rx--pcase-vars))))))))) ;; Obsolete internal symbol, used in old versions of the `flycheck' package. (define-obsolete-function-alias 'rx-submatch-n 'rx-to-string "27.1") diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index adfce950176..2b8807faad5 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -134,9 +134,10 @@ Unlike `seq-map', FUNCTION takes two arguments: the element of the sequence, and its index within the sequence." (let ((index 0)) (seq-do (lambda (elt) - (funcall function elt index) - (setq index (1+ index))) - sequence))) + (funcall function elt index) + (setq index (1+ index))) + sequence)) + nil) (cl-defgeneric seqp (object) "Return non-nil if OBJECT is a sequence, nil otherwise." diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index fa07d622484..9354687b081 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -161,7 +161,7 @@ "Helper function to get internal values. You can call this function to add internal values in the trace buffer." (unless inhibit-trace - (with-current-buffer trace-buffer + (with-current-buffer (get-buffer-create trace-buffer) (goto-char (point-max)) (insert (trace-entry-message @@ -174,7 +174,7 @@ and CONTEXT is a string describing the dynamic context (e.g. values of some global variables)." (let ((print-circle t)) (format "%s%s%d -> %S%s\n" - (mapconcat 'char-to-string (make-string (1- level) ?|) " ") + (mapconcat 'char-to-string (make-string (max 0 (1- level)) ?|) " ") (if (> level 1) " " "") level ;; FIXME: Make it so we can click the function name to jump to its diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index a64274bc0c1..54f881bde8a 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1,4 +1,4 @@ -;;; cua-base.el --- emulate CUA key bindings +;;; cua-base.el --- emulate CUA key bindings -*- lexical-binding: t; -*- ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. @@ -272,19 +272,16 @@ a shifted movement key. If the value is nil, these keys are never enabled." :type '(choice (const :tag "Disabled" nil) (const :tag "Shift region only" shift) - (other :tag "Enabled" t)) - :group 'cua) + (other :tag "Enabled" t))) (defcustom cua-remap-control-v t "If non-nil, C-v binding is used for paste (yank). Also, M-v is mapped to `delete-selection-repeat-replace-region'." - :type 'boolean - :group 'cua) + :type 'boolean) (defcustom cua-remap-control-z t "If non-nil, C-z binding is used for undo." - :type 'boolean - :group 'cua) + :type 'boolean) (defcustom cua-highlight-region-shift-only nil "If non-nil, only highlight region if marked with S-<move>. @@ -292,8 +289,7 @@ When this is non-nil, CUA toggles `transient-mark-mode' on when the region is marked using shifted movement keys, and off when the mark is cleared. But when the mark was set using \\[cua-set-mark], Transient Mark mode is not turned on." - :type 'boolean - :group 'cua) + :type 'boolean) (make-obsolete-variable 'cua-highlight-region-shift-only 'transient-mark-mode "24.4") @@ -307,33 +303,28 @@ first prefix key is discarded, so typing a prefix key twice in quick succession will also inhibit overriding the prefix key. If the value is nil, use a shifted prefix key to inhibit the override." :type '(choice (number :tag "Inhibit delay") - (const :tag "No delay" nil)) - :group 'cua) + (const :tag "No delay" nil))) (defcustom cua-delete-selection t "If non-nil, typed text replaces text in the active selection." :type '(choice (const :tag "Disabled" nil) - (other :tag "Enabled" t)) - :group 'cua) + (other :tag "Enabled" t))) (defcustom cua-keep-region-after-copy nil "If non-nil, don't deselect the region after copying." - :type 'boolean - :group 'cua) + :type 'boolean) (defcustom cua-toggle-set-mark t "If non-nil, the `cua-set-mark' command toggles the mark." :type '(choice (const :tag "Disabled" nil) - (other :tag "Enabled" t)) - :group 'cua) + (other :tag "Enabled" t))) (defcustom cua-auto-mark-last-change nil "If non-nil, set implicit mark at position of last buffer change. This means that \\[universal-argument] \\[cua-set-mark] will jump to the position of the last buffer change before jumping to the explicit marks on the mark ring. See `cua-set-mark' for details." - :type 'boolean - :group 'cua) + :type 'boolean) (defcustom cua-enable-register-prefix 'not-ctrl-u "If non-nil, registers are supported via numeric prefix arg. @@ -346,32 +337,27 @@ interpreted as a register number." :type '(choice (const :tag "Disabled" nil) (const :tag "Enabled, but C-u arg is not a register" not-ctrl-u) (const :tag "Enabled, but only for C-u arg" ctrl-u-only) - (other :tag "Enabled" t)) - :group 'cua) + (other :tag "Enabled" t))) (defcustom cua-delete-copy-to-register-0 t ;; FIXME: Obey delete-selection-save-to-register rather than hardcoding ;; register 0. "If non-nil, save last deleted region or rectangle to register 0." - :type 'boolean - :group 'cua) + :type 'boolean) (defcustom cua-enable-region-auto-help nil "If non-nil, automatically show help for active region." - :type 'boolean - :group 'cua) + :type 'boolean) (defcustom cua-enable-modeline-indications nil "If non-nil, use minor-mode hook to show status in mode line." - :type 'boolean - :group 'cua) + :type 'boolean) (defcustom cua-check-pending-input t "If non-nil, don't override prefix key if input pending. It is rumored that `input-pending-p' is unreliable under some window managers, so try setting this to nil, if prefix override doesn't work." - :type 'boolean - :group 'cua) + :type 'boolean) (defcustom cua-paste-pop-rotate-temporarily nil "If non-nil, \\[cua-paste-pop] only rotates the kill-ring temporarily. @@ -380,8 +366,7 @@ insert the most recently killed text. Each immediately following \\[cua-paste-p replaces the previous text with the next older element on the `kill-ring'. With prefix arg, \\[universal-argument] \\[yank-pop] inserts the same text as the most recent \\[yank-pop] (or \\[yank]) command." - :type 'boolean - :group 'cua) + :type 'boolean) ;;; Rectangle Customization @@ -390,8 +375,7 @@ most recent \\[yank-pop] (or \\[yank]) command." Note that although rectangles are always DISPLAYED with straight edges, the buffer is NOT modified, until you execute a command that actually modifies it. M-p toggles this feature when a rectangle is active." - :type 'boolean - :group 'cua) + :type 'boolean) (defcustom cua-auto-tabify-rectangles 1000 "If non-nil, automatically tabify after rectangle commands. @@ -403,11 +387,12 @@ present. The number specifies then number of characters before and after the region marked by the rectangle to search." :type '(choice (number :tag "Auto detect (limit)") (const :tag "Disabled" nil) - (other :tag "Enabled" t)) - :group 'cua) + (other :tag "Enabled" t))) (defvar cua-global-keymap) ; forward (defvar cua--region-keymap) ; forward +(declare-function cua-clear-rectangle-mark "cua-rect" ()) +(declare-function cua-mouse-set-rectangle-mark "cua-rect" (event)) (defcustom cua-rectangle-mark-key [(control return)] "Global key used to toggle the cua rectangle mark." @@ -416,14 +401,13 @@ and after the region marked by the rectangle to search." (when (and (boundp 'cua--keymaps-initialized) cua--keymaps-initialized) (define-key cua-global-keymap value - 'cua-set-rectangle-mark) + #'cua-set-rectangle-mark) (when (boundp 'cua--rectangle-keymap) (define-key cua--rectangle-keymap value - 'cua-clear-rectangle-mark) + #'cua-clear-rectangle-mark) (define-key cua--region-keymap value - 'cua-toggle-rectangle-mark)))) - :type 'key-sequence - :group 'cua) + #'cua-toggle-rectangle-mark)))) + :type 'key-sequence) (defcustom cua-rectangle-modifier-key 'meta "Modifier key used for rectangle commands bindings. @@ -432,8 +416,7 @@ Must be set prior to enabling CUA." :type '(choice (const :tag "Meta key" meta) (const :tag "Alt key" alt) (const :tag "Hyper key" hyper) - (const :tag "Super key" super)) - :group 'cua) + (const :tag "Super key" super))) (defcustom cua-rectangle-terminal-modifier-key 'meta "Modifier key used for rectangle commands bindings in terminals. @@ -442,54 +425,46 @@ Must be set prior to enabling CUA." (const :tag "Alt key" alt) (const :tag "Hyper key" hyper) (const :tag "Super key" super)) - :group 'cua :version "27.1") (defcustom cua-enable-rectangle-auto-help t "If non-nil, automatically show help for region, rectangle and global mark." - :type 'boolean - :group 'cua) + :type 'boolean) (defface cua-rectangle '((default :inherit region) (((class color)) :foreground "white" :background "maroon")) - "Font used by CUA for highlighting the rectangle." - :group 'cua) + "Font used by CUA for highlighting the rectangle.") (defface cua-rectangle-noselect '((default :inherit region) (((class color)) :foreground "white" :background "dimgray")) - "Font used by CUA for highlighting the non-selected rectangle lines." - :group 'cua) + "Font used by CUA for highlighting the non-selected rectangle lines.") ;;; Global Mark Customization (defcustom cua-global-mark-keep-visible t "If non-nil, always keep global mark visible in other window." - :type 'boolean - :group 'cua) + :type 'boolean) (defface cua-global-mark '((((min-colors 88)(class color)) :foreground "black" :background "yellow1") (((class color)) :foreground "black" :background "yellow") (t :weight bold)) - "Font used by CUA for highlighting the global mark." - :group 'cua) + "Font used by CUA for highlighting the global mark.") (defcustom cua-global-mark-blink-cursor-interval 0.20 "Blink cursor at this interval when global mark is active." :type '(choice (number :tag "Blink interval") - (const :tag "No blink" nil)) - :group 'cua) + (const :tag "No blink" nil))) ;;; Cursor Indication Customization (defcustom cua-enable-cursor-indications nil "If non-nil, use different cursor colors for indications." - :type 'boolean - :group 'cua) + :type 'boolean) (defcustom cua-normal-cursor-color (or (and (boundp 'initial-cursor-color) initial-cursor-color) (and (boundp 'initial-frame-alist) @@ -507,7 +482,7 @@ If the value is a COLOR name, then only the `cursor-color' attribute will be affected. If the value is a cursor TYPE (one of: box, hollow, bar, or hbar), then only the `cursor-type' property will be affected. If the value is a cons (TYPE . COLOR), then both properties are affected." - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :type '(choice (color :tag "Color") (choice :tag "Type" @@ -521,8 +496,7 @@ a cons (TYPE . COLOR), then both properties are affected." (const :tag "Vertical bar" bar) (const :tag "Horizontal bar" hbar) (const :tag "Hollow box" hollow)) - (color :tag "Color"))) - :group 'cua) + (color :tag "Color")))) (defcustom cua-read-only-cursor-color "darkgreen" "Cursor color used in read-only buffers, if non-nil. @@ -545,8 +519,7 @@ a cons (TYPE . COLOR), then both properties are affected." (const :tag "Vertical bar" bar) (const :tag "Horizontal bar" hbar) (const :tag "Hollow box" hollow)) - (color :tag "Color"))) - :group 'cua) + (color :tag "Color")))) (defcustom cua-overwrite-cursor-color "yellow" "Cursor color used when overwrite mode is set, if non-nil. @@ -569,8 +542,7 @@ a cons (TYPE . COLOR), then both properties are affected." (const :tag "Vertical bar" bar) (const :tag "Horizontal bar" hbar) (const :tag "Hollow box" hollow)) - (color :tag "Color"))) - :group 'cua) + (color :tag "Color")))) (defcustom cua-global-mark-cursor-color "cyan" "Indication for active global mark. @@ -594,8 +566,7 @@ a cons (TYPE . COLOR), then both properties are affected." (const :tag "Vertical bar" bar) (const :tag "Horizontal bar" hbar) (const :tag "Hollow box" hollow)) - (color :tag "Color"))) - :group 'cua) + (color :tag "Color")))) ;;; Rectangle support is in cua-rect.el @@ -710,7 +681,7 @@ a cons (TYPE . COLOR), then both properties are affected." (<= cua-prefix-override-inhibit-delay 0) ;; In state [1], start [T] and change to state [2] (run-with-timer cua-prefix-override-inhibit-delay nil - 'cua--prefix-override-timeout))) + #'cua--prefix-override-timeout))) ;; Don't record this command (setq this-command last-command) ;; Restore the prefix arg @@ -1243,6 +1214,8 @@ If ARG is the atom `-', scroll upward by nearly full screen." (interactive) (cua--shift-control-prefix ?\C-x)) +(declare-function delete-selection-repeat-replace-region "delsel" (arg)) + (defun cua--init-keymaps () ;; Cache actual rectangle modifier key. (setq cua--rectangle-modifier-key @@ -1250,68 +1223,84 @@ If ARG is the atom `-', scroll upward by nearly full screen." cua-rectangle-terminal-modifier-key cua-rectangle-modifier-key)) ;; C-return always toggles rectangle mark - (define-key cua-global-keymap cua-rectangle-mark-key 'cua-set-rectangle-mark) + (define-key cua-global-keymap cua-rectangle-mark-key #'cua-set-rectangle-mark) (unless (eq cua--rectangle-modifier-key 'meta) - (cua--M/H-key cua-global-keymap ?\s 'cua-set-rectangle-mark) + (cua--M/H-key cua-global-keymap ?\s #'cua-set-rectangle-mark) (define-key cua-global-keymap - (vector (list cua--rectangle-modifier-key 'mouse-1)) 'cua-mouse-set-rectangle-mark)) + (vector (list cua--rectangle-modifier-key 'mouse-1)) + #'cua-mouse-set-rectangle-mark)) - (define-key cua-global-keymap [(shift control ?\s)] 'cua-toggle-global-mark) + (define-key cua-global-keymap [(shift control ?\s)] #'cua-toggle-global-mark) ;; replace region with rectangle or element on kill ring - (define-key cua-global-keymap [remap yank] 'cua-paste) - (define-key cua-global-keymap [remap clipboard-yank] 'cua-paste) - (define-key cua-global-keymap [remap x-clipboard-yank] 'cua-paste) + (define-key cua-global-keymap [remap yank] #'cua-paste) + (define-key cua-global-keymap [remap clipboard-yank] #'cua-paste) + (define-key cua-global-keymap [remap x-clipboard-yank] #'cua-paste) ;; replace current yank with previous kill ring element - (define-key cua-global-keymap [remap yank-pop] 'cua-paste-pop) + (define-key cua-global-keymap [remap yank-pop] #'cua-paste-pop) ;; set mark - (define-key cua-global-keymap [remap set-mark-command] 'cua-set-mark) - (define-key cua-global-keymap [remap exchange-point-and-mark] 'cua-exchange-point-and-mark) + (define-key cua-global-keymap [remap set-mark-command] #'cua-set-mark) + (define-key cua-global-keymap [remap exchange-point-and-mark] + #'cua-exchange-point-and-mark) ;; scrolling - (define-key cua-global-keymap [remap scroll-up] 'cua-scroll-up) - (define-key cua-global-keymap [remap scroll-down] 'cua-scroll-down) - (define-key cua-global-keymap [remap scroll-up-command] 'cua-scroll-up) - (define-key cua-global-keymap [remap scroll-down-command] 'cua-scroll-down) + (define-key cua-global-keymap [remap scroll-up] #'cua-scroll-up) + (define-key cua-global-keymap [remap scroll-down] #'cua-scroll-down) + (define-key cua-global-keymap [remap scroll-up-command] #'cua-scroll-up) + (define-key cua-global-keymap [remap scroll-down-command] #'cua-scroll-down) - (define-key cua--cua-keys-keymap [(control x) timeout] 'kill-region) - (define-key cua--cua-keys-keymap [(control c) timeout] 'copy-region-as-kill) + (define-key cua--cua-keys-keymap [(control x) timeout] #'kill-region) + (define-key cua--cua-keys-keymap [(control c) timeout] #'copy-region-as-kill) (when cua-remap-control-z - (define-key cua--cua-keys-keymap [(control z)] 'undo)) + (define-key cua--cua-keys-keymap [(control z)] #'undo)) (when cua-remap-control-v - (define-key cua--cua-keys-keymap [(control v)] 'yank) + (define-key cua--cua-keys-keymap [(control v)] #'yank) (define-key cua--cua-keys-keymap [(meta v)] - 'delete-selection-repeat-replace-region)) + #'delete-selection-repeat-replace-region)) - (define-key cua--prefix-override-keymap [(control x)] 'cua--prefix-override-handler) - (define-key cua--prefix-override-keymap [(control c)] 'cua--prefix-override-handler) + (define-key cua--prefix-override-keymap [(control x)] + #'cua--prefix-override-handler) + (define-key cua--prefix-override-keymap [(control c)] + #'cua--prefix-override-handler) - (define-key cua--prefix-repeat-keymap [(control x) (control x)] 'cua--prefix-repeat-handler) - (define-key cua--prefix-repeat-keymap [(control c) (control c)] 'cua--prefix-repeat-handler) + (define-key cua--prefix-repeat-keymap [(control x) (control x)] + #'cua--prefix-repeat-handler) + (define-key cua--prefix-repeat-keymap [(control c) (control c)] + #'cua--prefix-repeat-handler) (dolist (key '(up down left right home end next prior)) - (define-key cua--prefix-repeat-keymap (vector '(control x) key) 'cua--prefix-cut-handler) - (define-key cua--prefix-repeat-keymap (vector '(control c) key) 'cua--prefix-copy-handler)) + (define-key cua--prefix-repeat-keymap (vector '(control x) key) + #'cua--prefix-cut-handler) + (define-key cua--prefix-repeat-keymap (vector '(control c) key) + #'cua--prefix-copy-handler)) ;; Enable shifted fallbacks for C-x and C-c when region is active - (define-key cua--region-keymap [(shift control x)] 'cua--shift-control-x-prefix) - (define-key cua--region-keymap [(shift control c)] 'cua--shift-control-c-prefix) + (define-key cua--region-keymap [(shift control x)] + #'cua--shift-control-x-prefix) + (define-key cua--region-keymap [(shift control c)] + #'cua--shift-control-c-prefix) ;; delete current region - (define-key cua--region-keymap [remap delete-backward-char] 'cua-delete-region) - (define-key cua--region-keymap [remap backward-delete-char] 'cua-delete-region) - (define-key cua--region-keymap [remap backward-delete-char-untabify] 'cua-delete-region) - (define-key cua--region-keymap [remap delete-char] 'cua-delete-region) - (define-key cua--region-keymap [remap delete-forward-char] 'cua-delete-region) + (define-key cua--region-keymap [remap delete-backward-char] + #'cua-delete-region) + (define-key cua--region-keymap [remap backward-delete-char] + #'cua-delete-region) + (define-key cua--region-keymap [remap backward-delete-char-untabify] + #'cua-delete-region) + (define-key cua--region-keymap [remap delete-char] + #'cua-delete-region) + (define-key cua--region-keymap [remap delete-forward-char] + #'cua-delete-region) ;; kill region - (define-key cua--region-keymap [remap kill-region] 'cua-cut-region) - (define-key cua--region-keymap [remap clipboard-kill-region] 'cua-cut-region) + (define-key cua--region-keymap [remap kill-region] #'cua-cut-region) + (define-key cua--region-keymap [remap clipboard-kill-region] #'cua-cut-region) ;; copy region - (define-key cua--region-keymap [remap copy-region-as-kill] 'cua-copy-region) - (define-key cua--region-keymap [remap kill-ring-save] 'cua-copy-region) - (define-key cua--region-keymap [remap clipboard-kill-ring-save] 'cua-copy-region) + (define-key cua--region-keymap [remap copy-region-as-kill] #'cua-copy-region) + (define-key cua--region-keymap [remap kill-ring-save] #'cua-copy-region) + (define-key cua--region-keymap [remap clipboard-kill-ring-save] + #'cua-copy-region) ;; cancel current region/rectangle - (define-key cua--region-keymap [remap keyboard-escape-quit] 'cua-cancel) - (define-key cua--region-keymap [remap keyboard-quit] 'cua-cancel) + (define-key cua--region-keymap [remap keyboard-escape-quit] #'cua-cancel) + (define-key cua--region-keymap [remap keyboard-quit] #'cua-cancel) ) @@ -1344,11 +1333,9 @@ You can customize `cua-enable-cua-keys' to completely disable the CUA bindings, or `cua-prefix-override-inhibit-delay' to change the prefix fallback behavior." :global t - :group 'cua :set-after '(cua-enable-modeline-indications cua-remap-control-v cua-remap-control-z cua-rectangle-mark-key cua-rectangle-modifier-key) - :require 'cua-base :link '(emacs-commentary-link "cua-base.el") (setq mark-even-if-inactive t) (setq highlight-nonselected-windows nil) @@ -1359,15 +1346,15 @@ the prefix fallback behavior." (if cua-mode (progn - (add-hook 'pre-command-hook 'cua--pre-command-handler) - (add-hook 'post-command-hook 'cua--post-command-handler) + (add-hook 'pre-command-hook #'cua--pre-command-handler) + (add-hook 'post-command-hook #'cua--post-command-handler) (if (and cua-enable-modeline-indications (not (assoc 'cua-mode minor-mode-alist))) (setq minor-mode-alist (cons '(cua-mode cua--status-string) minor-mode-alist))) (if cua-enable-cursor-indications (cua--update-indications))) - (remove-hook 'pre-command-hook 'cua--pre-command-handler) - (remove-hook 'post-command-hook 'cua--post-command-handler)) + (remove-hook 'pre-command-hook #'cua--pre-command-handler) + (remove-hook 'post-command-hook #'cua--post-command-handler)) (if (not cua-mode) (setq emulation-mode-map-alists diff --git a/lisp/emulation/cua-gmrk.el b/lisp/emulation/cua-gmrk.el index 6f6b9fce130..7014330b6ef 100644 --- a/lisp/emulation/cua-gmrk.el +++ b/lisp/emulation/cua-gmrk.el @@ -1,4 +1,4 @@ -;;; cua-gmrk.el --- CUA unified global mark support +;;; cua-gmrk.el --- CUA unified global mark support -*- lexical-binding: t; -*- ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. @@ -186,7 +186,7 @@ With prefix argument, don't jump to global mark when canceling it." (defun cua--copy-rectangle-to-global-mark (as-text) ;; Copy rectangle to global mark buffer/position. (if (cua--global-mark-active) - (let ((src-buf (current-buffer)) + (let (;; (src-buf (current-buffer)) (text (cua--extract-rectangle))) (with-current-buffer (marker-buffer cua--global-mark-marker) (goto-char (marker-position cua--global-mark-marker)) @@ -351,29 +351,44 @@ With prefix argument, don't jump to global mark when canceling it." ;;; Initialization (defun cua--init-global-mark () - (define-key cua--global-mark-keymap [remap copy-region-as-kill] 'cua-copy-to-global-mark) - (define-key cua--global-mark-keymap [remap kill-ring-save] 'cua-copy-to-global-mark) - (define-key cua--global-mark-keymap [remap kill-region] 'cua-cut-to-global-mark) - (define-key cua--global-mark-keymap [remap yank] 'cua-copy-next-to-global-mark) - - (define-key cua--global-mark-keymap [remap keyboard-escape-quit] 'cua-cancel-global-mark) - (define-key cua--global-mark-keymap [remap keyboard-quit] 'cua-cancel-global-mark) - - (define-key cua--global-mark-keymap [(control ?d)] 'cua-cut-next-to-global-mark) - (define-key cua--global-mark-keymap [remap delete-backward-char] 'cua-delete-backward-char-at-global-mark) - (define-key cua--global-mark-keymap [remap backward-delete-char] 'cua-delete-backward-char-at-global-mark) - (define-key cua--global-mark-keymap [remap backward-delete-char-untabify] 'cua-delete-backward-char-at-global-mark) - (define-key cua--global-mark-keymap [remap self-insert-command] 'cua-insert-char-at-global-mark) + (define-key cua--global-mark-keymap [remap copy-region-as-kill] + #'cua-copy-to-global-mark) + (define-key cua--global-mark-keymap [remap kill-ring-save] + #'cua-copy-to-global-mark) + (define-key cua--global-mark-keymap [remap kill-region] + #'cua-cut-to-global-mark) + (define-key cua--global-mark-keymap [remap yank] + #'cua-copy-next-to-global-mark) + + (define-key cua--global-mark-keymap [remap keyboard-escape-quit] + #'cua-cancel-global-mark) + (define-key cua--global-mark-keymap [remap keyboard-quit] + #'cua-cancel-global-mark) + + (define-key cua--global-mark-keymap [(control ?d)] + #'cua-cut-next-to-global-mark) + (define-key cua--global-mark-keymap [remap delete-backward-char] + #'cua-delete-backward-char-at-global-mark) + (define-key cua--global-mark-keymap [remap backward-delete-char] + #'cua-delete-backward-char-at-global-mark) + (define-key cua--global-mark-keymap [remap backward-delete-char-untabify] + #'cua-delete-backward-char-at-global-mark) + (define-key cua--global-mark-keymap [remap self-insert-command] + #'cua-insert-char-at-global-mark) ;; Catch self-inserting characters which are "stolen" by other modes (define-key cua--global-mark-keymap [t] '(menu-item "sic" cua-insert-char-at-global-mark :filter cua--self-insert-char-p)) - (define-key cua--global-mark-keymap [remap newline] 'cua-insert-newline-at-global-mark) - (define-key cua--global-mark-keymap [remap newline-and-indent] 'cua-insert-newline-at-global-mark) - (define-key cua--global-mark-keymap "\r" 'cua-insert-newline-at-global-mark) + (define-key cua--global-mark-keymap [remap newline] + #'cua-insert-newline-at-global-mark) + (define-key cua--global-mark-keymap [remap newline-and-indent] + #'cua-insert-newline-at-global-mark) + (define-key cua--global-mark-keymap "\r" + #'cua-insert-newline-at-global-mark) - (define-key cua--global-mark-keymap "\t" 'cua-indent-to-global-mark-column) + (define-key cua--global-mark-keymap "\t" + #'cua-indent-to-global-mark-column) (setq cua--global-mark-initialized t)) diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index b734fd15a24..e66050b7136 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -90,7 +90,7 @@ See `cua--rectangle'.") (defvar cua--overlay-keymap (let ((map (make-sparse-keymap))) - (define-key map "\r" 'cua-rotate-rectangle))) + (define-key map "\r" #'cua-rotate-rectangle))) (defvar cua--virtual-edges-debug nil) @@ -104,7 +104,7 @@ See `cua--rectangle'.") (e (cua--rect-end-position))) (undo-boundary) (push (list 'apply 0 s e - 'cua--rect-undo-handler + #'cua--rect-undo-handler (copy-sequence cua--rectangle) t s e) buffer-undo-list)))) @@ -114,7 +114,7 @@ See `cua--rectangle'.") (setq cua--restored-rectangle (copy-sequence rect)) (setq cua--buffer-and-point-before-command nil)) (push (list 'apply 0 s (if on e s) - 'cua--rect-undo-handler rect on s e) + #'cua--rect-undo-handler rect on s e) buffer-undo-list)) ;;;###autoload @@ -1483,79 +1483,79 @@ With prefix arg, indent to that column." (cua--M/H-key cua--rectangle-keymap key cmd)) (defun cua--init-rectangles () - (define-key cua--rectangle-keymap cua-rectangle-mark-key 'cua-clear-rectangle-mark) - (define-key cua--region-keymap cua-rectangle-mark-key 'cua-toggle-rectangle-mark) + (define-key cua--rectangle-keymap cua-rectangle-mark-key #'cua-clear-rectangle-mark) + (define-key cua--region-keymap cua-rectangle-mark-key #'cua-toggle-rectangle-mark) (unless (eq cua--rectangle-modifier-key 'meta) - (cua--rect-M/H-key ?\s 'cua-clear-rectangle-mark) - (cua--M/H-key cua--region-keymap ?\s 'cua-toggle-rectangle-mark)) - - (define-key cua--rectangle-keymap [remap set-mark-command] 'cua-toggle-rectangle-mark) - - (define-key cua--rectangle-keymap [remap forward-char] 'cua-resize-rectangle-right) - (define-key cua--rectangle-keymap [remap right-char] 'cua-resize-rectangle-right) - (define-key cua--rectangle-keymap [remap backward-char] 'cua-resize-rectangle-left) - (define-key cua--rectangle-keymap [remap left-char] 'cua-resize-rectangle-left) - (define-key cua--rectangle-keymap [remap next-line] 'cua-resize-rectangle-down) - (define-key cua--rectangle-keymap [remap previous-line] 'cua-resize-rectangle-up) - (define-key cua--rectangle-keymap [remap end-of-line] 'cua-resize-rectangle-eol) - (define-key cua--rectangle-keymap [remap beginning-of-line] 'cua-resize-rectangle-bol) - (define-key cua--rectangle-keymap [remap end-of-buffer] 'cua-resize-rectangle-bot) - (define-key cua--rectangle-keymap [remap beginning-of-buffer] 'cua-resize-rectangle-top) - (define-key cua--rectangle-keymap [remap scroll-down] 'cua-resize-rectangle-page-up) - (define-key cua--rectangle-keymap [remap scroll-up] 'cua-resize-rectangle-page-down) - (define-key cua--rectangle-keymap [remap scroll-down-command] 'cua-resize-rectangle-page-up) - (define-key cua--rectangle-keymap [remap scroll-up-command] 'cua-resize-rectangle-page-down) - - (define-key cua--rectangle-keymap [remap delete-backward-char] 'cua-delete-char-rectangle) - (define-key cua--rectangle-keymap [remap backward-delete-char] 'cua-delete-char-rectangle) - (define-key cua--rectangle-keymap [remap backward-delete-char-untabify] 'cua-delete-char-rectangle) - (define-key cua--rectangle-keymap [remap self-insert-command] 'cua-insert-char-rectangle) + (cua--rect-M/H-key ?\s #'cua-clear-rectangle-mark) + (cua--M/H-key cua--region-keymap ?\s #'cua-toggle-rectangle-mark)) + + (define-key cua--rectangle-keymap [remap set-mark-command] #'cua-toggle-rectangle-mark) + + (define-key cua--rectangle-keymap [remap forward-char] #'cua-resize-rectangle-right) + (define-key cua--rectangle-keymap [remap right-char] #'cua-resize-rectangle-right) + (define-key cua--rectangle-keymap [remap backward-char] #'cua-resize-rectangle-left) + (define-key cua--rectangle-keymap [remap left-char] #'cua-resize-rectangle-left) + (define-key cua--rectangle-keymap [remap next-line] #'cua-resize-rectangle-down) + (define-key cua--rectangle-keymap [remap previous-line] #'cua-resize-rectangle-up) + (define-key cua--rectangle-keymap [remap end-of-line] #'cua-resize-rectangle-eol) + (define-key cua--rectangle-keymap [remap beginning-of-line] #'cua-resize-rectangle-bol) + (define-key cua--rectangle-keymap [remap end-of-buffer] #'cua-resize-rectangle-bot) + (define-key cua--rectangle-keymap [remap beginning-of-buffer] #'cua-resize-rectangle-top) + (define-key cua--rectangle-keymap [remap scroll-down] #'cua-resize-rectangle-page-up) + (define-key cua--rectangle-keymap [remap scroll-up] #'cua-resize-rectangle-page-down) + (define-key cua--rectangle-keymap [remap scroll-down-command] #'cua-resize-rectangle-page-up) + (define-key cua--rectangle-keymap [remap scroll-up-command] #'cua-resize-rectangle-page-down) + + (define-key cua--rectangle-keymap [remap delete-backward-char] #'cua-delete-char-rectangle) + (define-key cua--rectangle-keymap [remap backward-delete-char] #'cua-delete-char-rectangle) + (define-key cua--rectangle-keymap [remap backward-delete-char-untabify] #'cua-delete-char-rectangle) + (define-key cua--rectangle-keymap [remap self-insert-command] #'cua-insert-char-rectangle) ;; Catch self-inserting characters which are "stolen" by other modes (define-key cua--rectangle-keymap [t] '(menu-item "sic" cua-insert-char-rectangle :filter cua--self-insert-char-p)) - (define-key cua--rectangle-keymap "\r" 'cua-rotate-rectangle) - (define-key cua--rectangle-keymap "\t" 'cua-indent-rectangle) - - (define-key cua--rectangle-keymap [(control ??)] 'cua-help-for-rectangle) - - (define-key cua--rectangle-keymap [mouse-1] 'cua-mouse-set-rectangle-mark) - (define-key cua--rectangle-keymap [down-mouse-1] 'cua--mouse-ignore) - (define-key cua--rectangle-keymap [drag-mouse-1] 'cua--mouse-ignore) - (define-key cua--rectangle-keymap [mouse-3] 'cua-mouse-save-then-kill-rectangle) - (define-key cua--rectangle-keymap [down-mouse-3] 'cua--mouse-ignore) - (define-key cua--rectangle-keymap [drag-mouse-3] 'cua--mouse-ignore) - - (cua--rect-M/H-key 'up 'cua-move-rectangle-up) - (cua--rect-M/H-key 'down 'cua-move-rectangle-down) - (cua--rect-M/H-key 'left 'cua-move-rectangle-left) - (cua--rect-M/H-key 'right 'cua-move-rectangle-right) - - (cua--rect-M/H-key '(control up) 'cua-scroll-rectangle-up) - (cua--rect-M/H-key '(control down) 'cua-scroll-rectangle-down) - - (cua--rect-M/H-key ?a 'cua-align-rectangle) - (cua--rect-M/H-key ?b 'cua-blank-rectangle) - (cua--rect-M/H-key ?c 'cua-close-rectangle) - (cua--rect-M/H-key ?f 'cua-fill-char-rectangle) - (cua--rect-M/H-key ?i 'cua-incr-rectangle) - (cua--rect-M/H-key ?k 'cua-cut-rectangle-as-text) - (cua--rect-M/H-key ?l 'cua-downcase-rectangle) - (cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text) - (cua--rect-M/H-key ?n 'cua-sequence-rectangle) - (cua--rect-M/H-key ?o 'cua-open-rectangle) - (cua--rect-M/H-key ?p 'cua-toggle-rectangle-virtual-edges) - (cua--rect-M/H-key ?P 'cua-do-rectangle-padding) - (cua--rect-M/H-key ?q 'cua-refill-rectangle) - (cua--rect-M/H-key ?r 'cua-replace-in-rectangle) - (cua--rect-M/H-key ?R 'cua-reverse-rectangle) - (cua--rect-M/H-key ?s 'cua-string-rectangle) - (cua--rect-M/H-key ?t 'cua-text-fill-rectangle) - (cua--rect-M/H-key ?u 'cua-upcase-rectangle) - (cua--rect-M/H-key ?| 'cua-shell-command-on-rectangle) - (cua--rect-M/H-key ?' 'cua-restrict-prefix-rectangle) - (cua--rect-M/H-key ?/ 'cua-restrict-regexp-rectangle) + (define-key cua--rectangle-keymap "\r" #'cua-rotate-rectangle) + (define-key cua--rectangle-keymap "\t" #'cua-indent-rectangle) + + (define-key cua--rectangle-keymap [(control ??)] #'cua-help-for-rectangle) + + (define-key cua--rectangle-keymap [mouse-1] #'cua-mouse-set-rectangle-mark) + (define-key cua--rectangle-keymap [down-mouse-1] #'cua--mouse-ignore) + (define-key cua--rectangle-keymap [drag-mouse-1] #'cua--mouse-ignore) + (define-key cua--rectangle-keymap [mouse-3] #'cua-mouse-save-then-kill-rectangle) + (define-key cua--rectangle-keymap [down-mouse-3] #'cua--mouse-ignore) + (define-key cua--rectangle-keymap [drag-mouse-3] #'cua--mouse-ignore) + + (cua--rect-M/H-key 'up #'cua-move-rectangle-up) + (cua--rect-M/H-key 'down #'cua-move-rectangle-down) + (cua--rect-M/H-key 'left #'cua-move-rectangle-left) + (cua--rect-M/H-key 'right #'cua-move-rectangle-right) + + (cua--rect-M/H-key '(control up) #'cua-scroll-rectangle-up) + (cua--rect-M/H-key '(control down) #'cua-scroll-rectangle-down) + + (cua--rect-M/H-key ?a #'cua-align-rectangle) + (cua--rect-M/H-key ?b #'cua-blank-rectangle) + (cua--rect-M/H-key ?c #'cua-close-rectangle) + (cua--rect-M/H-key ?f #'cua-fill-char-rectangle) + (cua--rect-M/H-key ?i #'cua-incr-rectangle) + (cua--rect-M/H-key ?k #'cua-cut-rectangle-as-text) + (cua--rect-M/H-key ?l #'cua-downcase-rectangle) + (cua--rect-M/H-key ?m #'cua-copy-rectangle-as-text) + (cua--rect-M/H-key ?n #'cua-sequence-rectangle) + (cua--rect-M/H-key ?o #'cua-open-rectangle) + (cua--rect-M/H-key ?p #'cua-toggle-rectangle-virtual-edges) + (cua--rect-M/H-key ?P #'cua-do-rectangle-padding) + (cua--rect-M/H-key ?q #'cua-refill-rectangle) + (cua--rect-M/H-key ?r #'cua-replace-in-rectangle) + (cua--rect-M/H-key ?R #'cua-reverse-rectangle) + (cua--rect-M/H-key ?s #'cua-string-rectangle) + (cua--rect-M/H-key ?t #'cua-text-fill-rectangle) + (cua--rect-M/H-key ?u #'cua-upcase-rectangle) + (cua--rect-M/H-key ?| #'cua-shell-command-on-rectangle) + (cua--rect-M/H-key ?' #'cua-restrict-prefix-rectangle) + (cua--rect-M/H-key ?/ #'cua-restrict-regexp-rectangle) (setq cua--rectangle-initialized t)) diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el index 98085c6214d..c1c17723a44 100644 --- a/lisp/emulation/edt-mapper.el +++ b/lisp/emulation/edt-mapper.el @@ -1,4 +1,4 @@ -;;; edt-mapper.el --- create an EDT LK-201 map file for X-Windows Emacs +;;; edt-mapper.el --- create an EDT LK-201 map file for X-Windows Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1994-1995, 2000-2021 Free Software Foundation, Inc. @@ -176,7 +176,7 @@ (mapc (lambda (function-key) (if (not (lookup-key (current-global-map) function-key)) - (define-key (current-global-map) function-key 'forward-char))) + (define-key (current-global-map) function-key #'forward-char))) '([kp-0] [kp-1] [kp-2] [kp-3] [kp-4] [kp-5] [kp-6] [kp-7] [kp-8] [kp-9] [kp-space] diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index 7760a7f2b46..b8dea2f2cc7 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el @@ -1,4 +1,4 @@ -;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs +;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1986, 1992-1995, 2000-2021 Free Software Foundation, ;; Inc. @@ -192,8 +192,7 @@ Emulation. If set to nil (the default), the `page-delimiter' variable is set to \"\\f\" when edt-emulation-on is first invoked. This setting replicates EDT's page delimiter behavior. The original value is restored when edt-emulation-off is called." - :type 'boolean - :group 'edt) + :type 'boolean) (defcustom edt-use-EDT-control-key-bindings nil "Emacs MUST be restarted for a change in value to take effect! @@ -201,8 +200,7 @@ Non-nil causes the control key bindings to be replaced with EDT bindings. If set to nil (the default), EDT control key bindings are not used and the current Emacs control key bindings are retained for use within the EDT emulation." - :type 'boolean - :group 'edt) + :type 'boolean) (defcustom edt-word-entities '(?\t) "Specifies the list of EDT word entity characters. @@ -226,22 +224,19 @@ representations, which you can also use: In EDT Emulation movement-by-word commands, each character in the list will be treated as if it were a separate word." - :type '(repeat integer) - :group 'edt) + :type '(repeat integer)) (defcustom edt-top-scroll-margin 10 "Scroll margin at the top of the screen. Interpreted as a percent of the current window size with a default setting of 10%. If set to 0, top scroll margin is disabled." - :type 'integer - :group 'edt) + :type 'integer) (defcustom edt-bottom-scroll-margin 15 "Scroll margin at the bottom of the screen. Interpreted as a percent of the current window size with a default setting of 15%. If set to 0, bottom scroll margin is disabled." - :type 'integer - :group 'edt) + :type 'integer) ;;; ;;; Internal Variables @@ -323,31 +318,31 @@ This means that an edt-user.el file was found in the user's `load-path'.") ;;;; EDT Emulation Commands ;;;; -;;; Almost all of EDT's keypad mode commands have equivalent Emacs -;;; function counterparts. But many of these counterparts behave -;;; somewhat differently in Emacs. -;;; -;;; So, the following Emacs functions emulate, where practical, the -;;; exact behavior of the corresponding EDT keypad mode commands. In -;;; a few cases, the emulation is not exact, but it should be close -;;; enough for most EDT die-hards. -;;; +;; Almost all of EDT's keypad mode commands have equivalent Emacs +;; function counterparts. But many of these counterparts behave +;; somewhat differently in Emacs. +;; +;; So, the following Emacs functions emulate, where practical, the +;; exact behavior of the corresponding EDT keypad mode commands. In +;; a few cases, the emulation is not exact, but it should be close +;; enough for most EDT die-hards. +;; ;;; ;;; PAGE ;;; -;;; Emacs uses the regexp assigned to page-delimiter to determine what -;;; marks a page break. This is normally "^\f", which causes the -;;; edt-page command to ignore form feeds not located at the beginning -;;; of a line. To emulate the EDT PAGE command exactly, -;;; page-delimiter is set to "\f" when EDT emulation is turned on, and -;;; restored to its original value when EDT emulation is turned off. -;;; But this can be overridden if the EDT definition is not desired by -;;; placing -;;; -;;; (setq edt-keep-current-page-delimiter t) -;;; -;;; in your init file. +;; Emacs uses the regexp assigned to page-delimiter to determine what +;; marks a page break. This is normally "^\f", which causes the +;; edt-page command to ignore form feeds not located at the beginning +;; of a line. To emulate the EDT PAGE command exactly, +;; page-delimiter is set to "\f" when EDT emulation is turned on, and +;; restored to its original value when EDT emulation is turned off. +;; But this can be overridden if the EDT definition is not desired by +;; placing +;; +;; (setq edt-keep-current-page-delimiter t) +;; +;; in your init file. (defun edt-page-forward (num) "Move forward to just after next page delimiter. @@ -384,12 +379,12 @@ Argument NUM is the number of page delimiters to move." ;;; ;;; SECT ;;; -;;; EDT defaults a section size to be 16 lines of its one and only -;;; 24-line window. That's two-thirds of the window at a time. The -;;; EDT SECT commands moves the cursor, not the window. -;;; -;;; This emulation of EDT's SECT moves the cursor approximately -;;; two-thirds of the current window at a time. +;; EDT defaults a section size to be 16 lines of its one and only +;; 24-line window. That's two-thirds of the window at a time. The +;; EDT SECT commands moves the cursor, not the window. +;; +;; This emulation of EDT's SECT moves the cursor approximately +;; two-thirds of the current window at a time. (defun edt-sect-forward (num) "Move cursor forward two-thirds of a window's number of lines. @@ -417,8 +412,8 @@ Argument NUM is the number of sections to move." ;;; ;;; BEGINNING OF LINE ;;; -;;; EDT's beginning-of-line command is not affected by current -;;; direction, for some unknown reason. +;; EDT's beginning-of-line command is not affected by current +;; direction, for some unknown reason. (defun edt-beginning-of-line (num) "Move backward to next beginning of line mark. @@ -470,13 +465,13 @@ Argument NUM is the number of EOL marks to move." ;;; ;;; WORD ;;; -;;; This one is a tad messy. To emulate EDT's behavior everywhere in -;;; the file (beginning of file, end of file, beginning of line, end -;;; of line, etc.) it takes a bit of special handling. -;;; -;;; The variable edt-word-entities contains a list of characters which -;;; are to be viewed as distinct words wherever they appear in the -;;; buffer. This emulates the EDT line mode command SET ENTITY WORD. +;; This one is a tad messy. To emulate EDT's behavior everywhere in +;; the file (beginning of file, end of file, beginning of line, end +;; of line, etc.) it takes a bit of special handling. +;; +;; The variable edt-word-entities contains a list of characters which +;; are to be viewed as distinct words wherever they appear in the +;; buffer. This emulates the EDT line mode command SET ENTITY WORD. (defun edt-one-word-forward () @@ -567,9 +562,9 @@ Argument NUM is the number of characters to move." ;;; ;;; LINE ;;; -;;; When direction is set to BACKUP, LINE behaves just like BEGINNING -;;; OF LINE in EDT. So edt-line-backward is not really needed as a -;;; separate function. +;; When direction is set to BACKUP, LINE behaves just like BEGINNING +;; OF LINE in EDT. So edt-line-backward is not really needed as a +;; separate function. (defun edt-line-backward (num) "Move backward to next beginning of line mark. @@ -655,6 +650,7 @@ Argument NUM is the number of lines to move." (far (save-excursion (goto-char bottom) (point-at-bol (1- height))))) + (ignore top left far) ,@body)) ;;; @@ -1203,9 +1199,9 @@ Argument BOTTOM is the bottom margin in number of lines or percent of window." ;;;; ;;; -;;; Several enhancements and additions to EDT keypad mode commands are -;;; provided here. Some of these have been motivated by similar -;;; TPU/EVE and EVE-Plus commands. Others are new. +;; Several enhancements and additions to EDT keypad mode commands are +;; provided here. Some of these have been motivated by similar +;; TPU/EVE and EVE-Plus commands. Others are new. ;;; ;;; CHANGE DIRECTION @@ -1378,8 +1374,8 @@ Definition is stored in `edt-last-replaced-key-definition'." ;;; ;;; SCROLL WINDOW ;;; -;;; Scroll a window (less one line) at a time. Leave cursor in center of -;;; window. +;; Scroll a window (less one line) at a time. Leave cursor in center of +;; window. (defun edt-scroll-window-forward (num) "Scroll forward one window in buffer, less one line. @@ -2051,7 +2047,7 @@ Optional argument USER-SETUP non-nil means called from function (fset 'edt-emulation-on (symbol-function 'edt-select-default-global-map)) (edt-select-default-global-map))) ;; Keep the menu bar Buffers menu up-to-date in edt-default-global-map. - (add-hook 'menu-bar-update-hook 'edt-default-menu-bar-update-buffers)) + (add-hook 'menu-bar-update-hook #'edt-default-menu-bar-update-buffers)) (defun edt-user-emulation-setup () "Setup user custom emulation of DEC's EDT editor." @@ -2072,7 +2068,7 @@ Optional argument USER-SETUP non-nil means called from function (edt-setup-user-bindings)) (edt-select-user-global-map) ;; Keep the menu bar Buffers menu up-to-date in edt-user-global-map. - (add-hook 'menu-bar-update-hook 'edt-user-menu-bar-update-buffers)) + (add-hook 'menu-bar-update-hook #'edt-user-menu-bar-update-buffers)) (defun edt-select-default-global-map() "Select default EDT emulation key bindings." @@ -2490,7 +2486,7 @@ G-C-\\: Split Window | FNDNXT | Yank | CUT | (and b (with-current-buffer b (set-buffer-modified-p t))) - (fset 'help-print-return-message 'ignore) + (fset 'help-print-return-message #'ignore) (call-interactively fun) (and (get-buffer name) (get-buffer-window (get-buffer name)) diff --git a/lisp/emulation/keypad.el b/lisp/emulation/keypad.el index e4f3c4d53ec..56202c7fff8 100644 --- a/lisp/emulation/keypad.el +++ b/lisp/emulation/keypad.el @@ -1,4 +1,4 @@ -;;; keypad.el --- simplified keypad bindings +;;; keypad.el --- simplified keypad bindings -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. @@ -101,10 +101,10 @@ "Specifies the keypad setup for unshifted keypad keys when NumLock is off. When selecting the plain numeric keypad setup, the character returned by the decimal key must be specified." - :set (lambda (symbol value) + :set (lambda (_symbol value) (if value (keypad-setup value nil nil value))) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :link '(emacs-commentary-link "keypad.el") :version "22.1" :type '(choice (const :tag "Plain numeric keypad" numeric) @@ -124,10 +124,10 @@ decimal key must be specified." "Specifies the keypad setup for unshifted keypad keys when NumLock is on. When selecting the plain numeric keypad setup, the character returned by the decimal key must be specified." - :set (lambda (symbol value) + :set (lambda (_symbol value) (if value (keypad-setup value t nil value))) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :link '(emacs-commentary-link "keypad.el") :version "22.1" :type '(choice (const :tag "Plain numeric keypad" numeric) @@ -147,10 +147,10 @@ decimal key must be specified." "Specifies the keypad setup for shifted keypad keys when NumLock is off. When selecting the plain numeric keypad setup, the character returned by the decimal key must be specified." - :set (lambda (symbol value) + :set (lambda (_symbol value) (if value (keypad-setup value nil t value))) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :link '(emacs-commentary-link "keypad.el") :version "22.1" :type '(choice (const :tag "Plain numeric keypad" numeric) @@ -170,10 +170,10 @@ decimal key must be specified." "Specifies the keypad setup for shifted keypad keys when NumLock is off. When selecting the plain numeric keypad setup, the character returned by the decimal key must be specified." - :set (lambda (symbol value) + :set (lambda (_symbol value) (if value (keypad-setup value t t value))) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :link '(emacs-commentary-link "keypad.el") :version "22.1" :type '(choice (const :tag "Plain numeric keypad" numeric) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index f38be908897..42d6c1eb198 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -24,8 +24,6 @@ ;;; Code: -(provide 'viper-cmd) - ;; Compiler pacifier (defvar viper-minibuffer-current-face) (defvar viper-minibuffer-insert-face) @@ -293,15 +291,15 @@ ;; desirable that viper-pre-command-sentinel is the last hook and ;; viper-post-command-sentinel is the first hook. - (remove-hook 'post-command-hook 'viper-post-command-sentinel) - (add-hook 'post-command-hook 'viper-post-command-sentinel) - (remove-hook 'pre-command-hook 'viper-pre-command-sentinel) - (add-hook 'pre-command-hook 'viper-pre-command-sentinel t) + (remove-hook 'post-command-hook #'viper-post-command-sentinel) + (add-hook 'post-command-hook #'viper-post-command-sentinel) + (remove-hook 'pre-command-hook #'viper-pre-command-sentinel) + (add-hook 'pre-command-hook #'viper-pre-command-sentinel t) ;; These hooks will be added back if switching to insert/replace mode (remove-hook 'viper-post-command-hooks - 'viper-insert-state-post-command-sentinel 'local) + #'viper-insert-state-post-command-sentinel 'local) (remove-hook 'viper-pre-command-hooks - 'viper-insert-state-pre-command-sentinel 'local) + #'viper-insert-state-pre-command-sentinel 'local) (setq viper-intermediate-command nil) (cond ((eq new-state 'vi-state) (cond ((member viper-current-state '(insert-state replace-state)) @@ -344,9 +342,9 @@ (viper-move-marker-locally 'viper-last-posn-while-in-insert-state (point)) (add-hook 'viper-post-command-hooks - 'viper-insert-state-post-command-sentinel t 'local) + #'viper-insert-state-post-command-sentinel t 'local) (add-hook 'viper-pre-command-hooks - 'viper-insert-state-pre-command-sentinel t 'local)) + #'viper-insert-state-pre-command-sentinel t 'local)) ) ; outermost cond ;; Nothing needs to be done to switch to emacs mode! Just set some @@ -378,12 +376,12 @@ (cond ((memq state '(insert-state replace-state)) (if viper-auto-indent (progn - (define-key viper-insert-basic-map "\C-m" 'viper-autoindent) + (define-key viper-insert-basic-map "\C-m" #'viper-autoindent) (if viper-want-emacs-keys-in-insert ;; expert (define-key viper-insert-basic-map "\C-j" nil) ;; novice - (define-key viper-insert-basic-map "\C-j" 'viper-autoindent))) + (define-key viper-insert-basic-map "\C-j" #'viper-autoindent))) (define-key viper-insert-basic-map "\C-m" nil) (define-key viper-insert-basic-map "\C-j" nil)) @@ -392,25 +390,24 @@ (if viper-want-ctl-h-help (progn - (define-key viper-insert-basic-map "\C-h" 'help-command) - (define-key viper-replace-map "\C-h" 'help-command)) + (define-key viper-insert-basic-map "\C-h" #'help-command) + (define-key viper-replace-map "\C-h" #'help-command)) (define-key viper-insert-basic-map - "\C-h" 'viper-del-backward-char-in-insert) + "\C-h" #'viper-del-backward-char-in-insert) (define-key viper-replace-map - "\C-h" 'viper-del-backward-char-in-replace)) + "\C-h" #'viper-del-backward-char-in-replace)) ;; In XEmacs, C-h overrides backspace, so we make sure it doesn't. (define-key viper-insert-basic-map - [backspace] 'viper-del-backward-char-in-insert) + [backspace] #'viper-del-backward-char-in-insert) (define-key viper-replace-map - [backspace] 'viper-del-backward-char-in-replace) + [backspace] #'viper-del-backward-char-in-replace) ) ; end insert/replace case (t ; Vi state (setq viper-vi-diehard-minor-mode (not viper-want-emacs-keys-in-vi)) - (if viper-want-ctl-h-help - (define-key viper-vi-basic-map "\C-h" 'help-command) - (define-key viper-vi-basic-map "\C-h" 'viper-backward-char)) + (define-key viper-vi-basic-map "\C-h" + (if viper-want-ctl-h-help #'help-command #'viper-backward-char)) ;; In XEmacs, C-h overrides backspace, so we make sure it doesn't. - (define-key viper-vi-basic-map [backspace] 'viper-backward-char)) + (define-key viper-vi-basic-map [backspace] #'viper-backward-char)) )) @@ -831,7 +828,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to (condition-case nil (let (viper-vi-kbd-minor-mode) ; execute without kbd macros - (setq result (eval form))) + (setq result (eval form t))) (error (signal 'quit nil))) @@ -847,7 +844,7 @@ Similar to `viper-escape-to-emacs', but accepts forms rather than keystrokes." (let ((buff (current-buffer)) result) (viper-set-mode-vars-for 'emacs-state) - (setq result (eval form)) + (setq result (eval form t)) (if (not (equal buff (current-buffer))) ; cmd switched buffer (with-current-buffer buff (viper-set-mode-vars-for viper-current-state))) @@ -1411,17 +1408,17 @@ as a Meta key and any number of multiple escapes are allowed." ;; without affecting other functions. Buffer search can now be bound ;; to any character. -(aset viper-exec-array ?c 'viper-exec-change) -(aset viper-exec-array ?C 'viper-exec-Change) -(aset viper-exec-array ?d 'viper-exec-delete) -(aset viper-exec-array ?D 'viper-exec-Delete) -(aset viper-exec-array ?y 'viper-exec-yank) -(aset viper-exec-array ?Y 'viper-exec-Yank) -(aset viper-exec-array ?r 'viper-exec-dummy) -(aset viper-exec-array ?! 'viper-exec-bang) -(aset viper-exec-array ?< 'viper-exec-shift) -(aset viper-exec-array ?> 'viper-exec-shift) -(aset viper-exec-array ?= 'viper-exec-equals) +(aset viper-exec-array ?c #'viper-exec-change) +(aset viper-exec-array ?C #'viper-exec-Change) +(aset viper-exec-array ?d #'viper-exec-delete) +(aset viper-exec-array ?D #'viper-exec-Delete) +(aset viper-exec-array ?y #'viper-exec-yank) +(aset viper-exec-array ?Y #'viper-exec-Yank) +(aset viper-exec-array ?r #'viper-exec-dummy) +(aset viper-exec-array ?! #'viper-exec-bang) +(aset viper-exec-array ?< #'viper-exec-shift) +(aset viper-exec-array ?> #'viper-exec-shift) +(aset viper-exec-array ?= #'viper-exec-equals) @@ -1560,7 +1557,7 @@ invokes the command before that, etc." (defun viper-undo-sentinel (beg end length) (run-hook-with-args 'viper-undo-functions beg end length)) -(add-hook 'after-change-functions 'viper-undo-sentinel) +(add-hook 'after-change-functions #'viper-undo-sentinel) ;; Hook used in viper-undo (defun viper-after-change-undo-hook (beg end _len) @@ -1570,7 +1567,7 @@ invokes the command before that, etc." ;; some other hooks may be changing various text properties in ;; the buffer in response to 'undo'; so remove this hook to avoid ;; its repeated invocation - (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local) + (remove-hook 'viper-undo-functions #'viper-after-change-undo-hook 'local) )) (defun viper-undo () @@ -1581,7 +1578,7 @@ invokes the command before that, etc." undo-beg-posn undo-end-posn) ;; the viper-after-change-undo-hook removes itself after the 1st invocation - (add-hook 'viper-undo-functions 'viper-after-change-undo-hook nil 'local) + (add-hook 'viper-undo-functions #'viper-after-change-undo-hook nil 'local) (undo-start) (undo-more 2) @@ -1853,8 +1850,8 @@ Undo previous insertion and inserts new." ;;; Minibuffer business (defsubst viper-set-minibuffer-style () - (add-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel) - (add-hook 'post-command-hook 'viper-minibuffer-post-command-hook)) + (add-hook 'minibuffer-setup-hook #'viper-minibuffer-setup-sentinel) + (add-hook 'post-command-hook #'viper-minibuffer-post-command-hook)) (defun viper-minibuffer-setup-sentinel () @@ -2017,11 +2014,12 @@ problems." padding (viper-array-to-string (this-command-keys)) temp-msg "") ;; the following tries to be smart about what to put in history - (if (not (string= val (car (eval history-var)))) - (set history-var (cons val (eval history-var)))) - (if (or (string= (nth 0 (eval history-var)) (nth 1 (eval history-var))) - (string= (nth 0 (eval history-var)) "")) - (set history-var (cdr (eval history-var)))) + (if (not (string= val (car (symbol-value history-var)))) + (push val (symbol-value history-var))) + (if (or (string= (nth 0 (symbol-value history-var)) + (nth 1 (symbol-value history-var))) + (string= (nth 0 (symbol-value history-var)) "")) + (pop (symbol-value history-var))) ;; If the user enters nothing but the prev cmd wasn't viper-ex, ;; viper-command-argument, or `! shell-command', this probably means ;; that the user typed something then erased. Return "" in this case, not @@ -2192,22 +2190,22 @@ problems." viper-sitting-in-replace t viper-replace-chars-to-delete 0) (add-hook - 'viper-after-change-functions 'viper-replace-mode-spy-after t 'local) + 'viper-after-change-functions #'viper-replace-mode-spy-after t 'local) (add-hook - 'viper-before-change-functions 'viper-replace-mode-spy-before t 'local) + 'viper-before-change-functions #'viper-replace-mode-spy-before t 'local) ;; this will get added repeatedly, but no harm - (add-hook 'after-change-functions 'viper-after-change-sentinel t) - (add-hook 'before-change-functions 'viper-before-change-sentinel t) + (add-hook 'after-change-functions #'viper-after-change-sentinel t) + (add-hook 'before-change-functions #'viper-before-change-sentinel t) (viper-move-marker-locally 'viper-last-posn-in-replace-region (viper-replace-start)) (add-hook - 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel + 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel t 'local) (add-hook - 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local) + 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t 'local) ;; guard against a smarty who switched from R-replace to normal replace (remove-hook - 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local) + 'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local) (if overwrite-mode (overwrite-mode -1)) ) @@ -2281,13 +2279,13 @@ problems." ;; Don't delete anything if current point is past the end of the overlay. (defun viper-finish-change () (remove-hook - 'viper-after-change-functions 'viper-replace-mode-spy-after 'local) + 'viper-after-change-functions #'viper-replace-mode-spy-after 'local) (remove-hook - 'viper-before-change-functions 'viper-replace-mode-spy-before 'local) + 'viper-before-change-functions #'viper-replace-mode-spy-before 'local) (remove-hook - 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local) + 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel 'local) (remove-hook - 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local) + 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local) (viper-restore-cursor-color 'after-replace-mode) (setq viper-sitting-in-replace nil) ; just in case we'll need to know it (save-excursion @@ -2317,21 +2315,21 @@ problems." (defun viper-finish-R-mode () (remove-hook - 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local) + 'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local) (remove-hook - 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local) + 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local) (viper-downgrade-to-insert)) (defun viper-start-R-mode () ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number (overwrite-mode 1) (add-hook - 'viper-post-command-hooks 'viper-R-state-post-command-sentinel t 'local) + 'viper-post-command-hooks #'viper-R-state-post-command-sentinel t 'local) (add-hook - 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local) + 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t 'local) ;; guard against a smarty who switched from R-replace to normal replace (remove-hook - 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local) + 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel 'local) ) @@ -3467,7 +3465,8 @@ controlled by the sign of prefix numeric value." '(viper-command-argument viper-digit-argument viper-repeat)) (setq viper-this-command-keys (this-command-keys))) (let* ((keymap (let ((keymap (copy-keymap minibuffer-local-map))) - (define-key keymap [(control ?s)] 'viper-insert-isearch-string) + (define-key keymap [(control ?s)] + #'viper-insert-isearch-string) keymap)) (s (viper-read-string-with-history prompt @@ -3776,8 +3775,8 @@ Null string will repeat previous search." (char-to-string viper-buffer-search-char)) (t (error "viper-buffer-search-char: wrong value type, %S" viper-buffer-search-char))) - 'viper-command-argument) - (aset viper-exec-array viper-buffer-search-char 'viper-exec-buffer-search) + #'viper-command-argument) + (aset viper-exec-array viper-buffer-search-char #'viper-exec-buffer-search) (setq viper-prefix-commands (cons viper-buffer-search-char viper-prefix-commands))) @@ -4368,7 +4367,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back." ;; Input Mode Indentation -(define-obsolete-function-alias 'viper-looking-back 'looking-back "24.4") +(define-obsolete-function-alias 'viper-looking-back #'looking-back "24.4") (defun viper-forward-indent () @@ -4511,8 +4510,8 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back." ;; standard value. Otherwise, get the value saved in the alist STORAGE. If ;; STORAGE is nil, use viper-saved-user-settings. (defun viper-standard-value (symbol &optional storage) - (or (eval (car (get symbol 'customized-value))) - (eval (car (get symbol 'saved-value))) + (or (eval (car (get symbol 'customized-value)) t) + (eval (car (get symbol 'saved-value)) t) (nth 1 (assoc symbol (or storage viper-saved-user-settings))))) @@ -4849,7 +4848,5 @@ Mail anyway (y or n)? ") nil 'delete-other-windows salutation))) - - - +(provide 'viper-cmd) ;;; viper-cmd.el ends here diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index 238faed069f..5b2fa048a09 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -1,4 +1,4 @@ -;;; viper-ex.el --- functions implementing the Ex commands for Viper +;;; viper-ex.el --- functions implementing the Ex commands for Viper -*- lexical-binding: t; -*- ;; Copyright (C) 1994-1998, 2000-2021 Free Software Foundation, Inc. @@ -24,8 +24,6 @@ ;;; Code: -(provide 'viper-ex) - ;; Compiler pacifier (defvar read-file-name-map) (defvar viper-use-register) @@ -190,7 +188,7 @@ ;; Executes the function associated with the command (defun ex-cmd-execute (cmd) - (eval (cadr cmd))) + (eval (cadr cmd) t)) ;; If this is a one-letter magic command, splice in args. (defun ex-splice-args-in-1-letr-cmd (key list) @@ -299,8 +297,7 @@ "\\)") shell-file-name))) "Is the user using a unix-type shell under a non-OS?" - :type 'boolean - :group 'viper-ex) + :type 'boolean) (defcustom ex-unix-type-shell-options (let ((case-fold-search t)) @@ -312,13 +309,11 @@ ))) "Options to pass to the Unix-style shell. Don't put `-c' here, as it is added automatically." - :type '(choice (const nil) string) - :group 'viper-ex) + :type '(choice (const nil) string)) (defcustom ex-compile-command "make" "The command to run when the user types :make." - :type 'string - :group 'viper-ex) + :type 'string) (defcustom viper-glob-function (cond (ex-unix-type-shell 'viper-glob-unix-files) @@ -331,8 +326,7 @@ The default tries to set this variable to work with Unix or MS Windows. However, if it doesn't work right for some types of Unix shells or some OS, the user should supply the appropriate function and set this variable to the corresponding function symbol." - :type 'symbol - :group 'viper-ex) + :type 'symbol) ;; Remembers the previous Ex tag. @@ -363,13 +357,11 @@ corresponding function symbol." "If t, :n and :b cycles through files and buffers in other window. Then :N and :B cycles in the current window. If nil, this behavior is reversed." - :type 'boolean - :group 'viper-ex) + :type 'boolean) (defcustom ex-cycle-through-non-files nil "Cycle through *scratch* and other buffers that don't visit any file." - :type 'boolean - :group 'viper-ex) + :type 'boolean) ;; Last shell command executed with :! command. (defvar viper-ex-last-shell-com nil) @@ -1314,7 +1306,7 @@ reversed." (let ((nonstandard-filename-chars "[^-a-zA-Z0-9_./,~$\\]")) (cond ((file-exists-p filespec) (find-file filespec)) ((string-match nonstandard-filename-chars filespec) - (mapcar 'find-file (funcall viper-glob-function filespec))) + (mapcar #'find-file (funcall viper-glob-function filespec))) (t (find-file filespec))) )) @@ -1639,7 +1631,7 @@ reversed." ;; this function fixes ex-history for some commands like ex-read, ex-edit (defun ex-fixup-history (&rest args) (setq viper-ex-history - (cons (mapconcat 'identity args " ") (cdr viper-ex-history)))) + (cons (mapconcat #'identity args " ") (cdr viper-ex-history)))) ;; Ex recover from emacs \#file\# @@ -1672,8 +1664,8 @@ reversed." (cursor-in-echo-area t) str batch) (define-key - minibuffer-local-completion-map " " 'minibuffer-complete-and-exit) - (define-key minibuffer-local-completion-map "=" 'exit-minibuffer) + minibuffer-local-completion-map " " #'minibuffer-complete-and-exit) + (define-key minibuffer-local-completion-map "=" #'exit-minibuffer) (if (viper-set-unread-command-events (ex-get-inline-cmd-args "[ \t]*[a-zA-Z]*[ \t]*" nil "\C-m")) (progn @@ -1837,7 +1829,7 @@ reversed." (format "%S" val) val))) (if actual-lisp-cmd - (eval (car (read-from-string actual-lisp-cmd)))) + (eval (car (read-from-string actual-lisp-cmd)) t)) (if (string= var "fill-column") (if (> val2 0) (auto-fill-mode 1) @@ -2319,4 +2311,5 @@ Type `mak ' (including the space) to run make with no args." (with-output-to-temp-buffer " *viper-info*" (princ lines)))))) +(provide 'viper-ex) ;;; viper-ex.el ends here diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index c05cf6a48b4..8188971c0d0 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -1,4 +1,4 @@ -;;; viper-init.el --- some common definitions for Viper +;;; viper-init.el --- some common definitions for Viper -*- lexical-binding: t; -*- ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. @@ -46,7 +46,7 @@ ;; Tell whether we are running as a window application or on a TTY -(define-obsolete-function-alias 'viper-device-type 'window-system "27.1") +(define-obsolete-function-alias 'viper-device-type #'window-system "27.1") (defun viper-color-display-p () (condition-case nil @@ -141,7 +141,7 @@ docstring. The variable becomes buffer-local whenever set." (append (vconcat string) nil)) (defsubst viper-charlist-to-string (list) - (mapconcat 'char-to-string list "")) + (mapconcat #'char-to-string list "")) ;; like char-after/before, but saves typing (defun viper-char-at-pos (direction &optional offset) diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 1d80c9cd026..4a9070e84be 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -155,29 +155,26 @@ In insert mode, this key also functions as Meta." (let ((old-value (if (boundp 'viper-toggle-key) viper-toggle-key [(control ?z)]))) - (mapc - (lambda (buf) - (with-current-buffer buf - (when (and (boundp 'viper-insert-basic-map) - (keymapp viper-insert-basic-map)) - (when old-value - (define-key viper-insert-basic-map old-value nil)) - (define-key viper-insert-basic-map value 'viper-escape-to-vi)) - (when (and (boundp 'viper-vi-intercept-map) - (keymapp viper-vi-intercept-map)) - (when old-value - (define-key viper-vi-intercept-map old-value nil)) - (define-key - viper-vi-intercept-map value 'viper-toggle-key-action)) - (when (and (boundp 'viper-emacs-intercept-map) - (keymapp viper-emacs-intercept-map)) - (define-key viper-emacs-intercept-map old-value nil) - (define-key - viper-emacs-intercept-map value 'viper-change-state-to-vi)) - )) - (buffer-list)) - (set-default symbol value) - ))) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (and (boundp 'viper-insert-basic-map) + (keymapp viper-insert-basic-map)) + (when old-value + (define-key viper-insert-basic-map old-value nil)) + (define-key viper-insert-basic-map value 'viper-escape-to-vi)) + (when (and (boundp 'viper-vi-intercept-map) + (keymapp viper-vi-intercept-map)) + (when old-value + (define-key viper-vi-intercept-map old-value nil)) + (define-key + viper-vi-intercept-map value 'viper-toggle-key-action)) + (when (and (boundp 'viper-emacs-intercept-map) + (keymapp viper-emacs-intercept-map)) + (define-key viper-emacs-intercept-map old-value nil) + (define-key + viper-emacs-intercept-map value 'viper-change-state-to-vi)) + )) + (set-default symbol value)))) (defcustom viper-quoted-insert-key "\C-v" "The key used to quote special characters when inserting them in Insert state." @@ -257,7 +254,7 @@ In insert mode, this key also functions as Meta." (let ((i ?\ )) (while (<= i ?~) - (define-key viper-insert-diehard-map (make-string 1 i) 'self-insert-command) + (define-key viper-insert-diehard-map (string i) #'self-insert-command) (setq i (1+ i)))) ;; Insert mode map when user wants emacs style @@ -490,7 +487,7 @@ Useful in some modes, such as Gnus, MH, etc.") The effect is seen in the current buffer only. Useful for customizing mailer buffers, gnus, etc. STATE is `vi-state', `insert-state', or `emacs-state'. -ALIST is of the form ((key . func) (key . func) ...) +ALIST is of the form ((KEY . FUNC) (KEY . FUNC) ...) Normally, this would be called from a hook to a major mode or on a per buffer basis. Usage: @@ -548,14 +545,11 @@ The above needs not to be done for major modes that come up in Vi or Insert state by default. Arguments: (major-mode viper-state keymap)" - (let ((alist - (cond ((eq state 'vi-state) 'viper-vi-state-modifier-alist) - ((eq state 'insert-state) 'viper-insert-state-modifier-alist) - ((eq state 'emacs-state) 'viper-emacs-state-modifier-alist))) - elt) - (if (setq elt (assoc mode (eval alist))) - (set alist (delq elt (eval alist)))) - (set alist (cons (cons mode keymap) (eval alist))) + (let* ((alist + (cond ((eq state 'vi-state) 'viper-vi-state-modifier-alist) + ((eq state 'insert-state) 'viper-insert-state-modifier-alist) + ((eq state 'emacs-state) 'viper-emacs-state-modifier-alist)))) + (setf (alist-get mode (symbol-value alist)) keymap) ;; Normalization usually doesn't help here, since one needs to ;; normalize in the actual buffer where changes to the keymap are @@ -646,9 +640,9 @@ Arguments: (major-mode viper-state keymap)" (cdr mapsrc))) (defun viper-modify-keymap (map alist) - "Modifies MAP with bindings specified in the ALIST. The alist has the -form ((key . function) (key . function) ... )." - (mapcar (lambda (p) (define-key map (eval (car p)) (cdr p))) + "Modifies MAP with bindings specified in the ALIST. +The ALIST has the form ((KEY . FUNCTION) (KEY . FUNCTION) ... )." + (mapcar (lambda (p) (define-key map (eval (car p) t) (cdr p))) alist)) diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el index 039ddabcdc3..94ab8178925 100644 --- a/lisp/emulation/viper-macs.el +++ b/lisp/emulation/viper-macs.el @@ -24,8 +24,6 @@ ;;; Code: -(provide 'viper-macs) - ;; compiler pacifier (defvar viper-ex-work-buf) (defvar viper-custom-file-name) @@ -37,7 +35,7 @@ (require 'viper-util) (require 'viper-keym) - +(require 'seq) ;;; Variables @@ -102,9 +100,11 @@ a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g., ;; if defining macro for insert, switch there for authentic WYSIWYG (if ins (viper-change-state-to-insert)) (start-kbd-macro nil) - (define-key viper-vi-intercept-map "\C-x)" 'viper-end-mapping-kbd-macro) - (define-key viper-insert-intercept-map "\C-x)" 'viper-end-mapping-kbd-macro) - (define-key viper-emacs-intercept-map "\C-x)" 'viper-end-mapping-kbd-macro) + (define-key viper-vi-intercept-map "\C-x)" #'viper-end-mapping-kbd-macro) + (define-key viper-insert-intercept-map "\C-x)" + #'viper-end-mapping-kbd-macro) + (define-key viper-emacs-intercept-map "\C-x)" + #'viper-end-mapping-kbd-macro) (message "Mapping %S in %s state. Type macro definition followed by `C-x )'" (viper-display-macro macro-name) (if ins "Insert" "Vi"))) @@ -442,7 +442,7 @@ If SCOPE is nil, the user is asked to specify the scope." (list nil (list (cons scope nil)) (cons t nil))) ((stringp scope) (list (list (cons scope nil)) nil (cons t nil)))))) - (setq old-elt (assoc macro-name (eval macro-alist-var))) + (setq old-elt (assoc macro-name (symbol-value macro-alist-var))) (if (null old-elt) (progn @@ -450,8 +450,8 @@ If SCOPE is nil, the user is asked to specify the scope." (define-key keymap (vector (viper-key-to-emacs-key (aref macro-name 0))) - 'viper-exec-mapped-kbd-macro) - (setq lis (eval macro-alist-var)) + #'viper-exec-mapped-kbd-macro) + (setq lis (symbol-value macro-alist-var)) (while (and lis (string< (viper-array-to-string (car (car lis))) (viper-array-to-string macro-name))) (setq lis2 (cons (car lis) lis2)) @@ -514,7 +514,7 @@ mistakes in macro names to be passed to this function is to use (if (viper-char-array-p macro-name) (setq macro-name (viper-char-array-to-macro macro-name))) - (setq macro-entry (assoc macro-name (eval macro-alist-var))) + (setq macro-entry (assoc macro-name (symbol-value macro-alist-var))) (if (= (length macro-name) 0) (error "Can't unmap an empty macro name")) (if (null macro-entry) @@ -557,9 +557,10 @@ mistakes in macro names to be passed to this function is to use (cdr mode-mapping) (cdr global-mapping) (progn - (set macro-alist-var (delq macro-entry (eval macro-alist-var))) + (set macro-alist-var (delq macro-entry + (symbol-value macro-alist-var))) (if (viper-can-release-key (aref macro-name 0) - (eval macro-alist-var)) + (symbol-value macro-alist-var)) (define-key keymap (vector (viper-key-to-emacs-key (aref macro-name 0))) @@ -649,11 +650,11 @@ mistakes in macro names to be passed to this function is to use (interactive) (with-output-to-temp-buffer " *viper-info*" (princ "Macros in Vi state:\n===================\n") - (mapc 'viper-describe-one-macro viper-vi-kbd-macro-alist) + (mapc #'viper-describe-one-macro viper-vi-kbd-macro-alist) (princ "\n\nMacros in Insert and Replace states:\n====================================\n") - (mapc 'viper-describe-one-macro viper-insert-kbd-macro-alist) + (mapc #'viper-describe-one-macro viper-insert-kbd-macro-alist) (princ "\n\nMacros in Emacs state:\n======================\n") - (mapcar 'viper-describe-one-macro viper-emacs-kbd-macro-alist) + (mapc #'viper-describe-one-macro viper-emacs-kbd-macro-alist) )) (defun viper-describe-one-macro (macro) @@ -661,11 +662,11 @@ mistakes in macro names to be passed to this function is to use (viper-display-macro (car macro)))) (princ " ** Buffer-specific:") (if (viper-kbd-buf-alist macro) - (mapc 'viper-describe-one-macro-elt (viper-kbd-buf-alist macro)) + (mapc #'viper-describe-one-macro-elt (viper-kbd-buf-alist macro)) (princ " none\n")) (princ "\n ** Mode-specific:") (if (viper-kbd-mode-alist macro) - (mapc 'viper-describe-one-macro-elt (viper-kbd-mode-alist macro)) + (mapc #'viper-describe-one-macro-elt (viper-kbd-mode-alist macro)) (princ " none\n")) (princ "\n ** Global:") (if (viper-kbd-global-definition macro) @@ -683,10 +684,9 @@ mistakes in macro names to be passed to this function is to use ;; check if SEQ is a prefix of some car of an element in ALIST (defun viper-keyseq-is-a-possible-macro (seq alist) (let ((converted-seq (viper-events-to-macro seq))) - (eval (cons 'or - (mapcar - (lambda (elt) (viper-prefix-subseq-p converted-seq elt)) - (viper-this-buffer-macros alist)))))) + (seq-some + (lambda (elt) (viper-prefix-subseq-p converted-seq elt)) + (viper-this-buffer-macros alist)))) ;; whether SEQ1 is a prefix of SEQ2 (defun viper-prefix-subseq-p (seq1 seq2) @@ -704,11 +704,10 @@ mistakes in macro names to be passed to this function is to use len) (if (= (length seqs) 0) (setq len 0) - (setq len (apply 'min (mapcar 'length seqs)))) + (setq len (apply #'min (mapcar #'length seqs)))) (while (< idx len) - (if (eval (cons 'and - (mapcar (lambda (s) (equal (elt first idx) (elt s idx))) - rest))) + (if (seq-every-p (lambda (s) (equal (elt first idx) (elt s idx))) + rest) (setq pref (vconcat pref (vector (elt first idx))))) (setq idx (1+ idx))) pref)) @@ -720,7 +719,7 @@ mistakes in macro names to be passed to this function is to use (defun viper-do-sequence-completion (seq alist compl-message) (let* ((matches (viper-extract-matching-alist-members seq alist)) - (new-seq (apply 'viper-common-seq-prefix matches)) + (new-seq (apply #'viper-common-seq-prefix matches)) ) (cond ((and (equal seq new-seq) (= (length matches) 1)) (message "%s (Sole completion)" compl-message) @@ -741,8 +740,8 @@ mistakes in macro names to be passed to this function is to use (defun viper-display-vector-completions (list) (with-output-to-temp-buffer "*Completions*" (display-completion-list - (mapcar 'prin1-to-string - (mapcar 'viper-display-macro list))))) + (mapcar #'prin1-to-string + (mapcar #'viper-display-macro list))))) @@ -793,9 +792,9 @@ mistakes in macro names to be passed to this function is to use ;; string--do so. Otherwise, do nothing. (defun viper-display-macro (macro-name-or-body) (cond ((viper-char-symbol-sequence-p macro-name-or-body) - (mapconcat 'symbol-name macro-name-or-body "")) + (mapconcat #'symbol-name macro-name-or-body "")) ((viper-char-array-p macro-name-or-body) - (mapconcat 'char-to-string macro-name-or-body "")) + (mapconcat #'char-to-string macro-name-or-body "")) (t macro-name-or-body))) ;; convert sequence of events (that came presumably from emacs kbd macro) into @@ -815,7 +814,7 @@ mistakes in macro names to be passed to this function is to use ;; convert strings or arrays of characters to Viper macro form (defun viper-char-array-to-macro (array) - (vconcat (mapcar 'viper-event-key (vconcat array)))) + (vconcat (mapcar #'viper-event-key (vconcat array)))) ;; For macros bodies and names, goes over MACRO and checks if all members are ;; names of keys (actually, it only checks if they are symbols or lists @@ -850,7 +849,7 @@ mistakes in macro names to be passed to this function is to use macro))) (defun viper-macro-to-events (macro-body) - (vconcat (mapcar 'viper-key-to-emacs-key macro-body))) + (vconcat (mapcar #'viper-key-to-emacs-key macro-body))) @@ -929,5 +928,5 @@ mistakes in macro names to be passed to this function is to use (beginning-of-line) (call-last-kbd-macro))) - +(provide 'viper-macs) ;;; viper-macs.el ends here diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index 71e40ee023e..83fc5afafa5 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -1,4 +1,4 @@ -;;; viper-mous.el --- mouse support for Viper +;;; viper-mous.el --- mouse support for Viper -*- lexical-binding: t; -*- ;; Copyright (C) 1994-1997, 2001-2021 Free Software Foundation, Inc. @@ -24,8 +24,6 @@ ;;; Code: -(provide 'viper-mous) - ;; compiler pacifier (defvar double-click-time) (defvar mouse-track-multi-click-time) @@ -60,8 +58,7 @@ Takes two parameters: a COUNT, indicating how many words to return, and CLICK-COUNT, telling whether this is the first click, a double-click, or a triple-click." - :type 'symbol - :group 'viper-mouse) + :type 'symbol) ;; time interval in millisecond within which successive clicks are ;; considered related @@ -70,8 +67,7 @@ or a triple-click." 500) "Time interval in millisecond within which successive mouse clicks are considered related." - :type 'integer - :group 'viper-mouse) + :type 'integer) ;; Local variable used to toggle wraparound search on click. (defvar-local viper-mouse-click-search-noerror t) @@ -292,7 +288,7 @@ See `viper-surrounding-word' for the definition of a word in this case." (prin1-to-string (viper-event-key event))))) (define-obsolete-function-alias 'viper-event-click-count - 'event-click-count "28.1") + #'event-click-count "28.1") (declare-function viper-forward-word "viper-cmd" (arg)) (declare-function viper-adjust-window "viper-cmd" ()) @@ -407,7 +403,7 @@ this command. (setq arg (1- arg))) )))) -(defun viper-mouse-catch-frame-switch (event arg) +(defun viper-mouse-catch-frame-switch (_event arg) "Catch the event of switching frame. Usually is bound to a `down-mouse' event to work properly. See sample bindings in the Viper manual." @@ -436,8 +432,9 @@ bindings in the Viper manual." ;; until you do something other than viper-mouse-click-* command. ;; In XEmacs, you have to manually select frame B (with the mouse click) in ;; order to shift focus to frame B. -(defsubst viper-remember-current-frame (frame) - (setq last-command 'handle-switch-frame +(defun viper-remember-current-frame (&rest _) + "Remember the selected frame before the switch-frame event." + (setq last-command #'handle-switch-frame viper-current-frame-saved (selected-frame))) @@ -446,8 +443,8 @@ bindings in the Viper manual." ;; Emacs. EVENT-TYPE is either `up' or `down'. Up returns button-up key; down ;; returns button-down key. (defun viper-parse-mouse-key (key-var event-type) - (let ((key (eval key-var)) - button-spec meta-spec shift-spec control-spec key-spec) + (let ((key (symbol-value key-var)) + button-spec meta-spec shift-spec control-spec) (if (null key) ;; just return nil () @@ -470,10 +467,9 @@ bindings in the Viper manual." control-spec (if (memq 'control key) "C-" "")) - (setq key-spec - (vector - (intern (concat control-spec meta-spec - shift-spec button-spec))))))) + (vector + (intern (concat control-spec meta-spec + shift-spec button-spec)))))) (defun viper-unbind-mouse-search-key () (if viper-mouse-up-search-key-parsed @@ -497,8 +493,8 @@ bindings in the Viper manual." (viper-parse-mouse-key 'viper-mouse-search-key 'up) viper-mouse-down-search-key-parsed (viper-parse-mouse-key 'viper-mouse-search-key 'down)) - (cond ((or (null viper-mouse-up-search-key-parsed) - (null viper-mouse-down-search-key-parsed)) + (cond ((not (and viper-mouse-up-search-key-parsed + viper-mouse-down-search-key-parsed)) nil) ; just quit ((and (null force) (key-binding viper-mouse-up-search-key-parsed) @@ -516,9 +512,9 @@ bindings in the Viper manual." viper-mouse-down-search-key-parsed)) (t (global-set-key viper-mouse-up-search-key-parsed - 'viper-mouse-click-search-word) + #'viper-mouse-click-search-word) (global-set-key viper-mouse-down-search-key-parsed - 'viper-mouse-catch-frame-switch)))) + #'viper-mouse-catch-frame-switch)))) ;; If FORCE, bind even if this mouse action is already bound to something else (defun viper-bind-mouse-insert-key (&optional force) @@ -526,8 +522,8 @@ bindings in the Viper manual." (viper-parse-mouse-key 'viper-mouse-insert-key 'up) viper-mouse-down-insert-key-parsed (viper-parse-mouse-key 'viper-mouse-insert-key 'down)) - (cond ((or (null viper-mouse-up-insert-key-parsed) - (null viper-mouse-down-insert-key-parsed)) + (cond ((not (and viper-mouse-up-insert-key-parsed + viper-mouse-down-insert-key-parsed)) nil) ; just quit ((and (null force) (key-binding viper-mouse-up-insert-key-parsed) @@ -545,9 +541,9 @@ bindings in the Viper manual." viper-mouse-down-insert-key-parsed)) (t (global-set-key viper-mouse-up-insert-key-parsed - 'viper-mouse-click-insert-word) + #'viper-mouse-click-insert-word) (global-set-key viper-mouse-down-insert-key-parsed - 'viper-mouse-catch-frame-switch)))) + #'viper-mouse-catch-frame-switch)))) (defun viper-reset-mouse-search-key (symb val) (viper-unbind-mouse-search-key) @@ -573,8 +569,7 @@ This buffer may be different from the one where the click occurred." (const :format "%v " shift) (const control)) (integer :tag "Button")) - :set 'viper-reset-mouse-search-key - :group 'viper-mouse) + :set #'viper-reset-mouse-search-key) (defcustom viper-mouse-insert-key '(meta shift 2) "Key used to click-insert in Viper. @@ -589,7 +584,7 @@ This buffer may be different from the one where the click occurred." (const :format "%v " shift) (const control)) (integer :tag "Button")) - :set 'viper-reset-mouse-insert-key - :group 'viper-mouse) + :set #'viper-reset-mouse-insert-key) +(provide 'viper-mous) ;;; viper-mous.el ends here diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 1bdb155538a..51f7406ad26 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -24,8 +24,7 @@ ;;; Code: -(provide 'viper-util) - +(require 'seq) ;; Compiler pacifier (defvar viper-minibuffer-current-face) @@ -47,22 +46,22 @@ -(define-obsolete-function-alias 'viper-overlay-p 'overlayp "27.1") -(define-obsolete-function-alias 'viper-make-overlay 'make-overlay "27.1") -(define-obsolete-function-alias 'viper-overlay-live-p 'overlayp "27.1") -(define-obsolete-function-alias 'viper-move-overlay 'move-overlay "27.1") -(define-obsolete-function-alias 'viper-overlay-start 'overlay-start "27.1") -(define-obsolete-function-alias 'viper-overlay-end 'overlay-end "27.1") -(define-obsolete-function-alias 'viper-overlay-get 'overlay-get "27.1") -(define-obsolete-function-alias 'viper-overlay-put 'overlay-put "27.1") -(define-obsolete-function-alias 'viper-read-event 'read-event "27.1") -(define-obsolete-function-alias 'viper-characterp 'integerp "27.1") -(define-obsolete-function-alias 'viper-int-to-char 'identity "27.1") -(define-obsolete-function-alias 'viper-get-face 'facep "27.1") +(define-obsolete-function-alias 'viper-overlay-p #'overlayp "27.1") +(define-obsolete-function-alias 'viper-make-overlay #'make-overlay "27.1") +(define-obsolete-function-alias 'viper-overlay-live-p #'overlayp "27.1") +(define-obsolete-function-alias 'viper-move-overlay #'move-overlay "27.1") +(define-obsolete-function-alias 'viper-overlay-start #'overlay-start "27.1") +(define-obsolete-function-alias 'viper-overlay-end #'overlay-end "27.1") +(define-obsolete-function-alias 'viper-overlay-get #'overlay-get "27.1") +(define-obsolete-function-alias 'viper-overlay-put #'overlay-put "27.1") +(define-obsolete-function-alias 'viper-read-event #'read-event "27.1") +(define-obsolete-function-alias 'viper-characterp #'integerp "27.1") +(define-obsolete-function-alias 'viper-int-to-char #'identity "27.1") +(define-obsolete-function-alias 'viper-get-face #'facep "27.1") (define-obsolete-function-alias 'viper-color-defined-p - 'x-color-defined-p "27.1") + #'x-color-defined-p "27.1") (define-obsolete-function-alias 'viper-iconify - 'iconify-or-deiconify-frame "27.1") + #'iconify-or-deiconify-frame "27.1") ;; CHAR is supposed to be a char or an integer (positive or negative) @@ -269,10 +268,10 @@ Otherwise return the normal value." ;; Then, each time this var is used in `viper-move-marker-locally' in a new ;; buffer, a new marker will be created. (defun viper-move-marker-locally (var pos &optional buffer) - (if (markerp (eval var)) + (if (markerp (symbol-value var)) () (set var (make-marker))) - (move-marker (eval var) pos buffer)) + (move-marker (symbol-value var) pos buffer)) ;; Print CONDITIONS as a message. @@ -280,7 +279,7 @@ Otherwise return the normal value." (let ((case (car conditions)) (msg (cdr conditions))) (if (null msg) (message "%s" case) - (message "%s: %s" case (mapconcat 'prin1-to-string msg " "))) + (message "%s: %s" case (mapconcat #'prin1-to-string msg " "))) (beep 1))) @@ -453,7 +452,7 @@ Otherwise return the normal value." "$")) tmp2)) (setq tmp (cdr tmp))) - (reverse (apply 'append tmp2))))) + (reverse (apply #'append tmp2))))) ;;; Insertion ring @@ -488,11 +487,11 @@ Otherwise return the normal value." ;; Push item onto ring. The second argument is a ring-variable, not value. (defun viper-push-onto-ring (item ring-var) - (or (ring-p (eval ring-var)) - (set ring-var (make-ring (eval (intern (format "%S-size" ring-var)))))) + (or (ring-p (symbol-value ring-var)) + (set ring-var (make-ring (symbol-value (intern (format "%S-size" ring-var)))))) (or (null item) ; don't push nil (and (stringp item) (string= item "")) ; or empty strings - (equal item (viper-current-ring-item (eval ring-var))) ; or old stuff + (equal item (viper-current-ring-item (symbol-value ring-var))) ; or old stuff ;; Since viper-set-destructive-command checks if we are inside ;; viper-repeat, we don't check whether this-command-keys is a `.'. The ;; cmd viper-repeat makes a call to the current function only if `.' is @@ -505,7 +504,7 @@ Otherwise return the normal value." (and (eq ring-var 'viper-command-ring) (string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)" (viper-array-to-string (this-command-keys)))) - (viper-ring-insert (eval ring-var) item)) + (viper-ring-insert (symbol-value ring-var) item)) ) @@ -595,7 +594,7 @@ Otherwise return the normal value." ;; Arguments: var message file &optional erase-message (defun viper-save-setting (var message file &optional erase-msg) (let* ((var-name (symbol-name var)) - (var-val (if (boundp var) (eval var))) + (var-val (if (boundp var) (symbol-value var))) (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z0-9---_']*[ \t\n)]" var-name)) (buf (find-file-noselect (substitute-in-file-name file))) ) @@ -795,7 +794,7 @@ Otherwise return the normal value." ;;; XEmacs compatibility (define-obsolete-function-alias 'viper-abbreviate-file-name - 'abbreviate-file-name "27.1") + #'abbreviate-file-name "27.1") (defsubst viper-sit-for-short (val &optional nodisp) (declare (obsolete nil "28.1")) @@ -815,7 +814,7 @@ Otherwise return the normal value." (with-current-buffer buf (and (<= pos (point-max)) (<= (point-min) pos)))))) -(define-obsolete-function-alias 'viper-mark-marker 'mark-marker "27.1") +(define-obsolete-function-alias 'viper-mark-marker #'mark-marker "27.1") (defvar viper-saved-mark nil "Where viper saves mark. This mark is resurrected by m^.") @@ -831,9 +830,9 @@ Otherwise return the normal value." ;; highlighted due to Viper's pushing marks. So, we deactivate marks, ;; unless the user explicitly wants highlighting, e.g., by hitting '' ;; or `` -(define-obsolete-function-alias 'viper-deactivate-mark 'deactivate-mark "27.1") +(define-obsolete-function-alias 'viper-deactivate-mark #'deactivate-mark "27.1") -(define-obsolete-function-alias 'viper-leave-region-active 'ignore "27.1") +(define-obsolete-function-alias 'viper-leave-region-active #'ignore "27.1") ;; Check if arg is a valid character for register ;; TYPE is a list that can contain `letter', `Letter', and `digit'. @@ -852,7 +851,7 @@ Otherwise return the normal value." -(define-obsolete-function-alias 'viper-copy-event 'identity "27.1") +(define-obsolete-function-alias 'viper-copy-event #'identity "27.1") ;; Uses different timeouts for ESC-sequences and others (defun viper-fast-keysequence-p () @@ -862,7 +861,7 @@ Otherwise return the normal value." t))) (define-obsolete-function-alias 'viper-read-event-convert-to-char - 'read-event "27.1") + #'read-event "27.1") ;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil) @@ -941,20 +940,20 @@ Otherwise return the normal value." (car (read-from-string (concat "?\\" - (mapconcat 'identity mod-char-list "-\\") + (mapconcat #'identity mod-char-list "-\\") "-" base-key-name)))) (setq key-name (intern (concat - (mapconcat 'identity mod-char-list "-") + (mapconcat #'identity mod-char-list "-") "-" base-key-name)))))) )) ;; LIS is assumed to be a list of events of characters -(define-obsolete-function-alias 'viper-eventify-list-xemacs 'ignore "27.1") +(define-obsolete-function-alias 'viper-eventify-list-xemacs #'ignore "27.1") ;; Arg is a character, an event, a list of events or a sequence of @@ -985,22 +984,20 @@ Otherwise return the normal value." ;; XEmacs only (defun viper-event-vector-p (vec) (and (vectorp vec) - (eval (cons 'and (mapcar (lambda (elt) (if (eventp elt) t)) vec))))) + (seq-every-p (lambda (elt) (if (eventp elt) t)) vec))) ;; check if vec is a vector of character symbols (defun viper-char-symbol-sequence-p (vec) (and (sequencep vec) - (eval - (cons 'and - (mapcar (lambda (elt) - (and (symbolp elt) (= (length (symbol-name elt)) 1))) - vec))))) + (seq-every-p (lambda (elt) + (and (symbolp elt) (= (length (symbol-name elt)) 1))) + vec))) (defun viper-char-array-p (array) - (eval (cons 'and (mapcar 'characterp array)))) + (seq-every-p #'characterp array)) ;; Args can be a sequence of events, a string, or a Viper macro. Will try to @@ -1012,19 +1009,19 @@ Otherwise return the normal value." (let (temp temp2) (cond ((stringp event-seq) event-seq) ((viper-event-vector-p event-seq) - (setq temp (mapcar 'viper-event-key event-seq)) + (setq temp (mapcar #'viper-event-key event-seq)) (cond ((viper-char-symbol-sequence-p temp) - (mapconcat 'symbol-name temp "")) + (mapconcat #'symbol-name temp "")) ((and (viper-char-array-p - (setq temp2 (mapcar 'viper-key-to-character temp)))) - (mapconcat 'char-to-string temp2 "")) + (setq temp2 (mapcar #'viper-key-to-character temp)))) + (mapconcat #'char-to-string temp2 "")) (t (prin1-to-string (vconcat temp))))) ((viper-char-symbol-sequence-p event-seq) - (mapconcat 'symbol-name event-seq "")) + (mapconcat #'symbol-name event-seq "")) ((and (vectorp event-seq) (viper-char-array-p - (setq temp (mapcar 'viper-key-to-character event-seq)))) - (mapconcat 'char-to-string temp "")) + (setq temp (mapcar #'viper-key-to-character event-seq)))) + (mapconcat #'char-to-string temp "")) (t (prin1-to-string event-seq))))) (defun viper-key-press-events-to-chars (events) @@ -1172,7 +1169,7 @@ syntax tables. This option is appropriate if you like Emacs-style words." :type '(radio (const strict-vi) (const reformed-vi) (const extended) (const emacs)) - :set 'viper-set-syntax-preference + :set #'viper-set-syntax-preference :group 'viper) (make-variable-buffer-local 'viper-syntax-preference) @@ -1375,4 +1372,5 @@ This option is appropriate if you like Emacs-style words." (setq i (1+ i) start (1+ start))) res)))))) +(provide 'viper-util) ;;; viper-util.el ends here diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index df5a083a08a..cce51174336 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -1061,9 +1061,7 @@ This may be needed if the previous `:map' command terminated abnormally." (if (viper-window-display-p) (viper--advice-add 'handle-switch-frame :before - (lambda (&rest _) - "Remember the selected frame before the switch-frame event." - (viper-remember-current-frame (selected-frame))))) + #'viper-remember-current-frame)) ) ; end viper-non-hook-settings @@ -1191,7 +1189,7 @@ These two lines must come in the order given.")) ;; The default viper-toggle-key is \C-z; for the novice, it suspends or ;; iconifies Emacs -(define-key viper-vi-intercept-map viper-toggle-key 'viper-toggle-key-action) +(define-key viper-vi-intercept-map viper-toggle-key #'viper-toggle-key-action) (define-key viper-emacs-intercept-map viper-toggle-key #'viper-change-state-to-vi) diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el index 71a9f8ef3da..028ab1eead8 100644 --- a/lisp/erc/erc-ring.el +++ b/lisp/erc/erc-ring.el @@ -69,10 +69,13 @@ Call this function when setting up the mode." (setq erc-input-ring (make-ring comint-input-ring-size))) (setq erc-input-ring-index nil)) -(defun erc-add-to-input-ring (state) - "Add string S to the input ring and reset history position." +(defun erc-add-to-input-ring (state-or-string) + "Add STATE-OR-STRING to input ring and reset history position. +STATE-OR-STRING should be a string or an erc-input object." (unless erc-input-ring (erc-input-ring-setup)) - (ring-insert erc-input-ring (erc-input-string state)) + (ring-insert erc-input-ring (if (erc-input-p state-or-string) + (erc-input-string state-or-string) + state-or-string)) ; string (setq erc-input-ring-index nil)) (defun erc-clear-input-ring () @@ -101,11 +104,10 @@ containing a password." ;; area, push it on the history ring before moving back through ;; the input history, so it will be there when we return to the ;; front. - (if (null erc-input-ring-index) - (when (> (point-max) erc-input-marker) - (erc-add-to-input-ring (buffer-substring erc-input-marker - (point-max))) - (setq erc-input-ring-index 0))) + (when (and (null erc-input-ring-index) + (> (point-max) erc-input-marker)) + (erc-add-to-input-ring (erc-user-input)) + (setq erc-input-ring-index 0)) (setq erc-input-ring-index (if erc-input-ring-index (ring-plus1 erc-input-ring-index diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index dd7f50fb381..7ee409b7351 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2136,19 +2136,20 @@ If no buffer matches, return nil." (erc-current-nick-p nick))))) (defcustom erc-before-connect nil - "Hook called before connecting to a server. -This hook gets executed before `erc' actually invokes `erc-mode' -with your input data. The functions in here get called with three -parameters, SERVER, PORT and NICK." + "Functions called before connecting to a server. +The functions in this variable gets executed before `erc' +actually invokes `erc-mode' with your input data. The functions +in here get called with three parameters, SERVER, PORT and NICK." :group 'erc-hooks - :type 'hook) + :type '(repeat function)) (defcustom erc-after-connect nil - "Hook called after connecting to a server. -This hook gets executed when an end of MOTD has been received. All -functions in here get called with the parameters SERVER and NICK." + "Functions called after connecting to a server. +This functions in this variable gets executed when an end of MOTD +has been received. All functions in here get called with the +parameters SERVER and NICK." :group 'erc-hooks - :type 'hook) + :type '(repeat function)) ;;;###autoload (defun erc-select-read-args () diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 78571776a39..07871bb0b64 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -100,6 +100,7 @@ If it is registered in `file-notify-descriptors', a `stopped' event is sent." "Handle a file system monitoring event, coming from backends. If OBJECT is a filewatch event, call its callback. Otherwise, signal a `file-notify-error'." + (declare (completion ignore)) (interactive "e") (when file-notify-debug (message "file-notify-handle-event %S" object)) diff --git a/lisp/files.el b/lisp/files.el index 4fa1e56f794..6815354cf55 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6240,11 +6240,6 @@ an auto-save file." "Cannot revert unreadable file %s") file-name)) (t - ;; Bind buffer-file-name to nil - ;; so that we don't try to lock the file. - (let ((buffer-file-name nil)) - (or auto-save-p - (unlock-buffer))) (widen) (let ((coding-system-for-read ;; Auto-saved file should be read by Emacs's diff --git a/lisp/filesets.el b/lisp/filesets.el index 2ef13ae8320..a51b6f81358 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -90,7 +90,6 @@ (require 'cl-lib) (require 'seq) -(require 'easymenu) ;;; Some variables diff --git a/lisp/follow.el b/lisp/follow.el index 069758747c1..42e3b60ec42 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -201,7 +201,6 @@ ;;; Code: -(require 'easymenu) (eval-when-compile (require 'cl-lib)) ;;; Variables diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 9a22256113c..e3b9c196186 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -88,7 +88,6 @@ (require 'gnus-art) (require 'gnus-util) (require 'nnmail) -(require 'easymenu) (require 'registry) (defvar gnus-adaptive-word-syntax-table) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 91b9c512584..057f18f85bf 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -668,7 +668,7 @@ FILE is the file where FUNCTION was probably defined." ;; Almost all entries are of the form "* ... in Emacs NN.MM." ;; but there are also a few in the form "* Emacs NN.MM is a bug ;; fix release ...". - (if (not (re-search-backward "^\\*.* Emacs \\([0-9.]+[0-9]\\)" + (if (not (re-search-backward "^\\* .* Emacs \\([0-9.]+[0-9]\\)" nil t)) (message "Ref found in non-versioned section in %S" (file-name-nondirectory f)) diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 0ad499b4dbf..68f8cc50549 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -254,39 +254,25 @@ that older functionality. This variable avoids multiple reminders.") Assumption is made if `hi-lock-mode' used in the *scratch* buffer while a library is being loaded.") -(defvar hi-lock-menu - (let ((map (make-sparse-keymap "Hi Lock"))) - (define-key-after map [highlight-regexp] - '(menu-item "Highlight Regexp..." highlight-regexp - :help "Highlight text matching PATTERN (a regexp).")) - - (define-key-after map [highlight-phrase] - '(menu-item "Highlight Phrase..." highlight-phrase - :help "Highlight text matching PATTERN (a regexp processed to match phrases).")) - - (define-key-after map [highlight-lines-matching-regexp] - '(menu-item "Highlight Lines..." highlight-lines-matching-regexp - :help "Highlight lines containing match of PATTERN (a regexp).")) - - (define-key-after map [highlight-symbol-at-point] - '(menu-item "Highlight Symbol at Point" highlight-symbol-at-point - :help "Highlight symbol found near point without prompting.")) - - (define-key-after map [unhighlight-regexp] - '(menu-item "Remove Highlighting..." unhighlight-regexp - :help "Remove previously entered highlighting pattern." - :enable hi-lock-interactive-patterns)) - - (define-key-after map [hi-lock-write-interactive-patterns] - '(menu-item "Patterns to Buffer" hi-lock-write-interactive-patterns - :help "Insert interactively added REGEXPs into buffer at point." - :enable hi-lock-interactive-patterns)) - - (define-key-after map [hi-lock-find-patterns] - '(menu-item "Patterns from Buffer" hi-lock-find-patterns - :help "Use patterns (if any) near top of buffer.")) - map) - "Menu for hi-lock mode.") +(easy-menu-define hi-lock-menu nil + "Menu for hi-lock mode." + '("Hi Lock" + ["Highlight Regexp..." highlight-regexp + :help "Highlight text matching PATTERN (a regexp)."] + ["Highlight Phrase..." highlight-phrase + :help "Highlight text matching PATTERN (a regexp processed to match phrases)."] + ["Highlight Lines..." highlight-lines-matching-regexp + :help "Highlight lines containing match of PATTERN (a regexp)."] + ["Highlight Symbol at Point" highlight-symbol-at-point + :help "Highlight symbol found near point without prompting."] + ["Remove Highlighting..." unhighlight-regexp + :help "Remove previously entered highlighting pattern." + :enable hi-lock-interactive-patterns] + ["Patterns to Buffer" hi-lock-write-interactive-patterns + :help "Insert interactively added REGEXPs into buffer at point." + :enable hi-lock-interactive-patterns] + ["Patterns from Buffer" hi-lock-find-patterns + :help "Use patterns (if any) near top of buffer."])) (defvar hi-lock-map (let ((map (make-sparse-keymap "Hi Lock"))) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 6dc1c7ebc2b..7939bbb7739 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -364,64 +364,6 @@ directory, like `default-directory'." (regexp :tag "From") (regexp :tag "To")))) -(defvar ibuffer-mode-groups-popup - (let ((groups-map (make-sparse-keymap "Filter Groups"))) - ;; Filter groups - - (define-key-after groups-map [filters-to-filter-group] - '(menu-item "Create filter group from current filters..." - ibuffer-filters-to-filter-group - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) - (define-key-after groups-map [forward-filter-group] - '(menu-item "Move point to the next filter group" - ibuffer-forward-filter-group)) - (define-key-after groups-map [backward-filter-group] - '(menu-item "Move point to the previous filter group" - ibuffer-backward-filter-group)) - (define-key-after groups-map [jump-to-filter-group] - '(menu-item "Move point to a specific filter group..." - ibuffer-jump-to-filter-group)) - (define-key-after groups-map [kill-filter-group] - '(menu-item "Kill filter group named..." - ibuffer-kill-filter-group - :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups))) - (define-key-after groups-map [yank-filter-group] - '(menu-item "Yank last killed filter group before..." - ibuffer-yank-filter-group - :enable (and (featurep 'ibuf-ext) ibuffer-filter-group-kill-ring))) - (define-key-after groups-map [pop-filter-group] - '(menu-item "Remove top filter group" - ibuffer-pop-filter-group - :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups))) - (define-key-after groups-map [clear-filter-groups] - '(menu-item "Remove all filter groups" - ibuffer-clear-filter-groups - :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups))) - (define-key-after groups-map [pop-filter-group] - '(menu-item "Decompose filter group..." - ibuffer-pop-filter-group - :help "\"Unmake\" a filter group" - :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups))) - (define-key-after groups-map [save-filter-groups] - '(menu-item "Save current filter groups permanently..." - ibuffer-save-filter-groups - :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups) - :help "Use a mnemonic name to store current filter groups")) - (define-key-after groups-map [switch-to-saved-filter-groups] - '(menu-item "Restore permanently saved filters..." - ibuffer-switch-to-saved-filter-groups - :enable (and (featurep 'ibuf-ext) ibuffer-saved-filter-groups) - :help "Replace current filters with a saved stack")) - (define-key-after groups-map [delete-saved-filter-groups] - '(menu-item "Delete permanently saved filter groups..." - ibuffer-delete-saved-filter-groups - :enable (and (featurep 'ibuf-ext) ibuffer-saved-filter-groups))) - (define-key-after groups-map [set-filter-groups-by-mode] - '(menu-item "Set current filter groups to filter by mode" - ibuffer-set-filter-groups-by-mode)) - - groups-map)) - (defvar ibuffer--filter-map (let ((map (make-sparse-keymap))) (define-key map (kbd "RET") 'ibuffer-filter-by-mode) @@ -588,303 +530,233 @@ directory, like `default-directory'." (define-key map (kbd "C-x 5 RET") 'ibuffer-visit-buffer-other-frame) (define-key map (kbd "/") ibuffer--filter-map) - - (define-key map [menu-bar view] - (cons "View" (make-sparse-keymap "View"))) - - (define-key-after map [menu-bar view visit-buffer] - '(menu-item "View this buffer" ibuffer-visit-buffer)) - (define-key-after map [menu-bar view visit-buffer-other-window] - '(menu-item "View (other window)" ibuffer-visit-buffer-other-window)) - (define-key-after map [menu-bar view visit-buffer-other-frame] - '(menu-item "View (other frame)" ibuffer-visit-buffer-other-frame)) - (define-key-after map [menu-bar view ibuffer-update] - '(menu-item "Update" ibuffer-update - :help "Regenerate the list of buffers")) - (define-key-after map [menu-bar view switch-format] - '(menu-item "Switch display format" ibuffer-switch-format - :help "Toggle between available values of `ibuffer-formats'")) - - (define-key-after map [menu-bar view dashes] - '("--")) - - (define-key-after map [menu-bar view sort] - (cons "Sort" (make-sparse-keymap "Sort"))) - - (define-key-after map [menu-bar view sort do-sort-by-major-mode] - '(menu-item "Sort by major mode" ibuffer-do-sort-by-major-mode)) - (define-key-after map [menu-bar view sort do-sort-by-size] - '(menu-item "Sort by buffer size" ibuffer-do-sort-by-size)) - (define-key-after map [menu-bar view sort do-sort-by-alphabetic] - '(menu-item "Sort lexicographically" ibuffer-do-sort-by-alphabetic - :help "Sort by the alphabetic order of buffer name")) - (define-key-after map [menu-bar view sort do-sort-by-recency] - '(menu-item "Sort by view time" ibuffer-do-sort-by-recency - :help "Sort by the last time the buffer was displayed")) - (define-key-after map [menu-bar view sort dashes] - '("--")) - (define-key-after map [menu-bar view sort invert-sorting] - '(menu-item "Reverse sorting order" ibuffer-invert-sorting)) - (define-key-after map [menu-bar view sort toggle-sorting-mode] - '(menu-item "Switch sorting mode" ibuffer-toggle-sorting-mode - :help "Switch between the various sorting criteria")) - - (define-key-after map [menu-bar view filter] - (cons "Filter" (make-sparse-keymap "Filter"))) - - (define-key-after map [menu-bar view filter filter-disable] - '(menu-item "Disable all filtering" ibuffer-filter-disable - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) - (define-key-after map [menu-bar view filter filter-by-mode] - '(menu-item "Add filter by any major mode..." ibuffer-filter-by-mode)) - (define-key-after map [menu-bar view filter filter-by-used-mode] - '(menu-item "Add filter by a major mode in use..." - ibuffer-filter-by-used-mode)) - (define-key-after map [menu-bar view filter filter-by-derived-mode] - '(menu-item "Add filter by derived mode..." - ibuffer-filter-by-derived-mode)) - (define-key-after map [menu-bar view filter filter-by-name] - '(menu-item "Add filter by buffer name..." ibuffer-filter-by-name)) - (define-key-after map [menu-bar view filter filter-by-starred-name] - '(menu-item "Add filter by starred buffer name..." - ibuffer-filter-by-starred-name - :help "List buffers whose names begin with a star")) - (define-key-after map [menu-bar view filter filter-by-filename] - '(menu-item "Add filter by full filename..." ibuffer-filter-by-filename - :help - (concat "For a buffer associated with file `/a/b/c.d', " - "list buffer if a given pattern matches `/a/b/c.d'"))) - (define-key-after map [menu-bar view filter filter-by-basename] - '(menu-item "Add filter by file basename..." - ibuffer-filter-by-basename - :help (concat "For a buffer associated with file `/a/b/c.d', " - "list buffer if a given pattern matches `c.d'"))) - (define-key-after map [menu-bar view filter filter-by-file-extension] - '(menu-item "Add filter by file name extension..." - ibuffer-filter-by-file-extension - :help (concat "For a buffer associated with file `/a/b/c.d', " - "list buffer if a given pattern matches `d'"))) - (define-key-after map [menu-bar view filter filter-by-directory] - '(menu-item "Add filter by filename's directory..." - ibuffer-filter-by-directory - :help - (concat "For a buffer associated with file `/a/b/c.d', " - "list buffer if a given pattern matches `/a/b'"))) - (define-key-after map [menu-bar view filter filter-by-size-lt] - '(menu-item "Add filter by size less than..." ibuffer-filter-by-size-lt)) - (define-key-after map [menu-bar view filter filter-by-size-gt] - '(menu-item "Add filter by size greater than..." - ibuffer-filter-by-size-gt)) - (define-key-after map [menu-bar view filter filter-by-modified] - '(menu-item "Add filter by modified buffer" ibuffer-filter-by-modified - :help "List buffers that are marked as modified")) - (define-key-after map [menu-bar view filter filter-by-visiting-file] - '(menu-item "Add filter by buffer visiting a file" - ibuffer-filter-by-visiting-file - :help "List buffers that are visiting files")) - (define-key-after map [menu-bar view filter filter-by-content] - '(menu-item "Add filter by content (regexp)..." - ibuffer-filter-by-content)) - (define-key-after map [menu-bar view filter filter-by-predicate] - '(menu-item "Add filter by Lisp predicate..." - ibuffer-filter-by-predicate)) - (define-key-after map [menu-bar view filter pop-filter] - '(menu-item "Remove top filter" ibuffer-pop-filter - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) - (define-key-after map [menu-bar view filter and-filter] - '(menu-item "AND top two filters" ibuffer-and-filter - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers - (cdr ibuffer-filtering-qualifiers)) - :help - "Create a new filter which is the logical AND of the top two filters")) - (define-key-after map [menu-bar view filter or-filter] - '(menu-item "OR top two filters" ibuffer-or-filter - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers - (cdr ibuffer-filtering-qualifiers)) - :help - "Create a new filter which is the logical OR of the top two filters")) - (define-key-after map [menu-bar view filter negate-filter] - '(menu-item "Negate top filter" ibuffer-negate-filter - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) - (define-key-after map [menu-bar view filter decompose-filter] - '(menu-item "Decompose top filter" ibuffer-decompose-filter - :enable (and (featurep 'ibuf-ext) - (memq (car ibuffer-filtering-qualifiers) '(or saved not))) - :help "Break down a complex filter like OR or NOT")) - (define-key-after map [menu-bar view filter exchange-filters] - '(menu-item "Swap top two filters" ibuffer-exchange-filters - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers - (cdr ibuffer-filtering-qualifiers)))) - (define-key-after map [menu-bar view filter save-filters] - '(menu-item "Save current filters permanently..." ibuffer-save-filters - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers) - :help "Use a mnemonic name to store current filter stack")) - (define-key-after map [menu-bar view filter switch-to-saved-filters] - '(menu-item "Restore permanently saved filters..." - ibuffer-switch-to-saved-filters - :enable (and (featurep 'ibuf-ext) ibuffer-saved-filters) - :help "Replace current filters with a saved stack")) - (define-key-after map [menu-bar view filter add-saved-filters] - '(menu-item "Add to permanently saved filters..." - ibuffer-add-saved-filters - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers) - :help "Include already saved stack with current filters")) - (define-key-after map [menu-bar view filter delete-saved-filters] - '(menu-item "Delete permanently saved filters..." - ibuffer-delete-saved-filters - :enable (and (featurep 'ibuf-ext) ibuffer-saved-filters))) - - (define-key-after map [menu-bar view filter-groups] - (cons "Filter Groups" ibuffer-mode-groups-popup)) - - (define-key-after map [menu-bar view dashes2] - '("--")) - (define-key-after map [menu-bar view auto-mode] - '(menu-item "Auto Mode" ibuffer-auto-mode - :button (:toggle . ibuffer-auto-mode) - :help "Attempt to automatically update the Ibuffer buffer")) - - (define-key-after map [menu-bar mark] - (cons "Mark" (make-sparse-keymap "Mark"))) - - (define-key-after map [menu-bar mark toggle-marks] - '(menu-item "Toggle marks" ibuffer-toggle-marks - :help "Unmark marked buffers, and mark unmarked buffers")) - (define-key-after map [menu-bar mark change-marks] - '(menu-item "Change marks" ibuffer-change-marks - :help "Change OLD mark for marked buffers with NEW")) - (define-key-after map [menu-bar mark mark-forward] - '(menu-item "Mark" ibuffer-mark-forward - :help "Mark the buffer at point")) - (define-key-after map [menu-bar mark unmark-forward] - '(menu-item "Unmark" ibuffer-unmark-forward - :help "Unmark the buffer at point")) - (define-key-after map [menu-bar mark mark-by-mode] - '(menu-item "Mark by mode..." ibuffer-mark-by-mode - :help "Mark all buffers in a particular major mode")) - (define-key-after map [menu-bar mark mark-modified-buffers] - '(menu-item "Mark modified buffers" ibuffer-mark-modified-buffers - :help "Mark all buffers which have been modified")) - (define-key-after map [menu-bar mark mark-unsaved-buffers] - '(menu-item "Mark unsaved buffers" ibuffer-mark-unsaved-buffers - :help "Mark all buffers which have a file and are modified")) - (define-key-after map [menu-bar mark mark-read-only-buffers] - '(menu-item "Mark read-only buffers" ibuffer-mark-read-only-buffers - :help "Mark all buffers which are read-only")) - (define-key-after map [menu-bar mark mark-special-buffers] - '(menu-item "Mark special buffers" ibuffer-mark-special-buffers - :help "Mark all buffers whose name begins with a *")) - (define-key-after map [menu-bar mark mark-dired-buffers] - '(menu-item "Mark dired buffers" ibuffer-mark-dired-buffers - :help "Mark buffers in dired-mode")) - (define-key-after map [menu-bar mark mark-dissociated-buffers] - '(menu-item "Mark dissociated buffers" ibuffer-mark-dissociated-buffers - :help "Mark buffers with a non-existent associated file")) - (define-key-after map [menu-bar mark mark-help-buffers] - '(menu-item "Mark help buffers" ibuffer-mark-help-buffers - :help "Mark buffers in help-mode")) - (define-key-after map [menu-bar mark mark-compressed-file-buffers] - '(menu-item "Mark compressed file buffers" - ibuffer-mark-compressed-file-buffers - :help "Mark buffers which have a file that is compressed")) - (define-key-after map [menu-bar mark mark-old-buffers] - '(menu-item "Mark old buffers" ibuffer-mark-old-buffers - :help "Mark buffers which have not been viewed recently")) - (define-key-after map [menu-bar mark unmark-all] - '(menu-item "Unmark All" ibuffer-unmark-all)) - (define-key-after map [menu-bar mark unmark-all-marks] - '(menu-item "Unmark All buffers" ibuffer-unmark-all-marks)) - - (define-key-after map [menu-bar mark dashes] - '("--")) - - (define-key-after map [menu-bar mark mark-by-name-regexp] - '(menu-item "Mark by buffer name (regexp)..." ibuffer-mark-by-name-regexp - :help "Mark buffers whose name matches a regexp")) - (define-key-after map [menu-bar mark mark-by-mode-regexp] - '(menu-item "Mark by major mode (regexp)..." ibuffer-mark-by-mode-regexp - :help "Mark buffers whose major mode name matches a regexp")) - (define-key-after map [menu-bar mark mark-by-file-name-regexp] - '(menu-item "Mark by file name (regexp)..." - ibuffer-mark-by-file-name-regexp - :help "Mark buffers whose file name matches a regexp")) - (define-key-after map [menu-bar mark ibuffer-mark-by-content-regexp] - '(menu-item "Mark by content (regexp)..." - ibuffer-mark-by-content-regexp - :help "Mark buffers whose content matches a regexp")) - (define-key-after map [menu-bar mark mark-by-locked] - '(menu-item "Mark by locked buffers..." ibuffer-mark-by-locked - :help "Mark all locked buffers")) - map)) -(defvar ibuffer-mode-operate-map - (let ((operate-map (make-sparse-keymap "Operate"))) - (define-key-after operate-map [do-view] - '(menu-item "View" ibuffer-do-view)) - (define-key-after operate-map [do-view-other-frame] - '(menu-item "View (separate frame)" ibuffer-do-view-other-frame)) - (define-key-after operate-map [do-save] - '(menu-item "Save" ibuffer-do-save)) - (define-key-after operate-map [do-replace-regexp] - '(menu-item "Replace (regexp)..." ibuffer-do-replace-regexp - :help "Replace text inside marked buffers")) - (define-key-after operate-map [do-query-replace] - '(menu-item "Query Replace..." ibuffer-do-query-replace - :help "Replace text in marked buffers, asking each time")) - (define-key-after operate-map [do-query-replace-regexp] - '(menu-item "Query Replace (regexp)..." ibuffer-do-query-replace-regexp - :help "Replace text in marked buffers by regexp, asking each time")) - (define-key-after operate-map [do-print] - '(menu-item "Print" ibuffer-do-print)) - (define-key-after operate-map [do-toggle-modified] - '(menu-item "Toggle modification flag" ibuffer-do-toggle-modified)) - (define-key-after operate-map [do-toggle-read-only] - '(menu-item "Toggle read-only flag" ibuffer-do-toggle-read-only)) - (define-key-after operate-map [do-toggle-lock] - '(menu-item "Toggle lock flag" ibuffer-do-toggle-lock)) - (define-key-after operate-map [do-revert] - '(menu-item "Revert" ibuffer-do-revert - :help "Revert marked buffers to their associated file")) - (define-key-after operate-map [do-rename-uniquely] - '(menu-item "Rename Uniquely" ibuffer-do-rename-uniquely - :help "Rename marked buffers to a new, unique name")) - (define-key-after operate-map [do-delete] - '(menu-item "Kill" ibuffer-do-delete)) - (define-key-after operate-map [do-occur] - '(menu-item "List lines matching..." ibuffer-do-occur - :help "View all lines in marked buffers matching a regexp")) - (define-key-after operate-map [do-shell-command-pipe] - '(menu-item "Pipe to shell command..." ibuffer-do-shell-command-pipe - :help "For each marked buffer, send its contents to a shell command")) - (define-key-after operate-map [do-shell-command-pipe-replace] - '(menu-item "Pipe to shell command (replace)..." ibuffer-do-shell-command-pipe-replace - :help "For each marked buffer, replace its contents with output of shell command")) - (define-key-after operate-map [do-shell-command-file] - '(menu-item "Shell command on buffer's file..." ibuffer-do-shell-command-file - :help "For each marked buffer, run a shell command with its file as argument")) - (define-key-after operate-map [do-eval] - '(menu-item "Eval..." ibuffer-do-eval - :help "Evaluate a Lisp form in each marked buffer")) - (define-key-after operate-map [do-view-and-eval] - '(menu-item "Eval (viewing buffer)..." ibuffer-do-view-and-eval - :help "Evaluate a Lisp form in each marked buffer while viewing it")) - (define-key-after operate-map [diff-with-file] - '(menu-item "Diff with file" ibuffer-diff-with-file - :help "View the differences between this buffer and its file")) - - operate-map)) - -(define-key ibuffer-mode-groups-popup [kill-filter-group] - '(menu-item "Kill filter group" - ibuffer-kill-line - :enable (and (featurep 'ibuf-ext) - ibuffer-filter-groups))) -(define-key ibuffer-mode-groups-popup [yank-filter-group] - '(menu-item "Yank last killed filter group" - ibuffer-yank - :enable (and (featurep 'ibuf-ext) - ibuffer-filter-group-kill-ring))) +(defun ibuffer-mode--groups-menu-definition (&optional is-popup) + "Build the `ibuffer' \"Filter\" menu. Internal." + `("Filter Groups" + ["Create filter group from current filters..." + ibuffer-filters-to-filter-group + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)] + ["Move point to the next filter group" + ibuffer-forward-filter-group] + ["Move point to the previous filter group" + ibuffer-backward-filter-group] + ["Move point to a specific filter group..." + ibuffer-jump-to-filter-group] + ,@(if is-popup + '(["Kill filter group" + ibuffer-kill-line + :enable (and (featurep 'ibuf-ext) + ibuffer-filter-groups)] + ["Yank last killed filter group" + ibuffer-yank + :enable (and (featurep 'ibuf-ext) + ibuffer-filter-group-kill-ring)]) + '(["Kill filter group named..." + ibuffer-kill-filter-group + :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)] + ["Yank last killed filter group before..." + ibuffer-yank-filter-group + :enable (and (featurep 'ibuf-ext) ibuffer-filter-group-kill-ring)])) + ["Remove top filter group" + ibuffer-pop-filter-group + :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)] + ["Remove all filter groups" + ibuffer-clear-filter-groups + :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)] + ["Decompose filter group..." + ibuffer-pop-filter-group + :help "\"Unmake\" a filter group" + :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)] + ["Save current filter groups permanently..." + ibuffer-save-filter-groups + :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups) + :help "Use a mnemonic name to store current filter groups"] + ["Restore permanently saved filters..." + ibuffer-switch-to-saved-filter-groups + :enable (and (featurep 'ibuf-ext) ibuffer-saved-filter-groups) + :help "Replace current filters with a saved stack"] + ["Delete permanently saved filter groups..." + ibuffer-delete-saved-filter-groups + :enable (and (featurep 'ibuf-ext) ibuffer-saved-filter-groups)] + ["Set current filter groups to filter by mode" + ibuffer-set-filter-groups-by-mode])) + +(easy-menu-define ibuffer-mode-groups-popup nil + "Menu for `ibuffer'." + (ibuffer-mode--groups-menu-definition 'is-popup)) + +(easy-menu-define ibuffer-mode-mark-menu ibuffer-mode-map + "Mark menu for `ibuffer'." + '("Mark" + ["Toggle marks" ibuffer-toggle-marks + :help "Unmark marked buffers, and mark unmarked buffers"] + ["Change marks" ibuffer-change-marks + :help "Change OLD mark for marked buffers with NEW"] + ["Mark" ibuffer-mark-forward + :help "Mark the buffer at point"] + ["Unmark" ibuffer-unmark-forward + :help "Unmark the buffer at point"] + ["Mark by mode..." ibuffer-mark-by-mode + :help "Mark all buffers in a particular major mode"] + ["Mark modified buffers" ibuffer-mark-modified-buffers + :help "Mark all buffers which have been modified"] + ["Mark unsaved buffers" ibuffer-mark-unsaved-buffers + :help "Mark all buffers which have a file and are modified"] + ["Mark read-only buffers" ibuffer-mark-read-only-buffers + :help "Mark all buffers which are read-only"] + ["Mark special buffers" ibuffer-mark-special-buffers + :help "Mark all buffers whose name begins with a *"] + ["Mark dired buffers" ibuffer-mark-dired-buffers + :help "Mark buffers in dired-mode"] + ["Mark dissociated buffers" ibuffer-mark-dissociated-buffers + :help "Mark buffers with a non-existent associated file"] + ["Mark help buffers" ibuffer-mark-help-buffers + :help "Mark buffers in help-mode"] + ["Mark compressed file buffers" ibuffer-mark-compressed-file-buffers + :help "Mark buffers which have a file that is compressed"] + ["Mark old buffers" ibuffer-mark-old-buffers + :help "Mark buffers which have not been viewed recently"] + ["Unmark All" ibuffer-unmark-all] + ["Unmark All buffers" ibuffer-unmark-all-marks] + "---" + ["Mark by buffer name (regexp)..." ibuffer-mark-by-name-regexp + :help "Mark buffers whose name matches a regexp"] + ["Mark by major mode (regexp)..." ibuffer-mark-by-mode-regexp + :help "Mark buffers whose major mode name matches a regexp"] + ["Mark by file name (regexp)..." ibuffer-mark-by-file-name-regexp + :help "Mark buffers whose file name matches a regexp"] + ["Mark by content (regexp)..." ibuffer-mark-by-content-regexp + :help "Mark buffers whose content matches a regexp"] + ["Mark by locked buffers..." ibuffer-mark-by-locked + :help "Mark all locked buffers"])) + +(easy-menu-define ibuffer-mode-view-menu ibuffer-mode-map + "View menu for `ibuffer'." + `("View" + ["View this buffer" ibuffer-visit-buffer] + ["View (other window)" ibuffer-visit-buffer-other-window] + ["View (other frame)" ibuffer-visit-buffer-other-frame] + ["Update" ibuffer-update + :help "Regenerate the list of buffers"] + ["Switch display format" ibuffer-switch-format + :help "Toggle between available values of `ibuffer-formats'"] + "---" + ("Sort" + ["Sort by major mode" ibuffer-do-sort-by-major-mode] + ["Sort by buffer size" ibuffer-do-sort-by-size] + ["Sort lexicographically" ibuffer-do-sort-by-alphabetic + :help "Sort by the alphabetic order of buffer name"] + ["Sort by view time" ibuffer-do-sort-by-recency + :help "Sort by the last time the buffer was displayed"] + "---" + ["Reverse sorting order" ibuffer-invert-sorting] + ["Switch sorting mode" ibuffer-toggle-sorting-mode + :help "Switch between the various sorting criteria"]) + ("Filter" + ["Disable all filtering" ibuffer-filter-disable + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)] + ["Add filter by any major mode..." ibuffer-filter-by-mode] + ["Add filter by a major mode in use..." ibuffer-filter-by-used-mode] + ["Add filter by derived mode..." ibuffer-filter-by-derived-mode] + ["Add filter by buffer name..." ibuffer-filter-by-name] + ["Add filter by starred buffer name..." ibuffer-filter-by-starred-name + :help "List buffers whose names begin with a star"] + ["Add filter by full filename..." ibuffer-filter-by-filename + :help (concat "For a buffer associated with file `/a/b/c.d', " + "list buffer if a given pattern matches `/a/b/c.d'")] + ["Add filter by file basename..." ibuffer-filter-by-basename + :help (concat "For a buffer associated with file `/a/b/c.d', " + "list buffer if a given pattern matches `c.d'")] + ["Add filter by file name extension..." ibuffer-filter-by-file-extension + :help (concat "For a buffer associated with file `/a/b/c.d', " + "list buffer if a given pattern matches `d'")] + ["Add filter by filename's directory..." ibuffer-filter-by-directory + :help (concat "For a buffer associated with file `/a/b/c.d', " + "list buffer if a given pattern matches `/a/b'")] + ["Add filter by size less than..." ibuffer-filter-by-size-lt] + ["Add filter by size greater than..." ibuffer-filter-by-size-gt] + ["Add filter by modified buffer" ibuffer-filter-by-modified + :help "List buffers that are marked as modified"] + ["Add filter by buffer visiting a file" ibuffer-filter-by-visiting-file + :help "List buffers that are visiting files"] + ["Add filter by content (regexp)..." ibuffer-filter-by-content] + ["Add filter by Lisp predicate..." ibuffer-filter-by-predicate] + ["Remove top filter" ibuffer-pop-filter + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)] + ["AND top two filters" ibuffer-and-filter + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers + (cdr ibuffer-filtering-qualifiers)) + :help "Create a new filter which is the logical AND of the top two filters"] + ["OR top two filters" ibuffer-or-filter + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers + (cdr ibuffer-filtering-qualifiers)) + :help "Create a new filter which is the logical OR of the top two filters"] + ["Negate top filter" ibuffer-negate-filter + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)] + ["Decompose top filter" ibuffer-decompose-filter + :enable (and (featurep 'ibuf-ext) + (memq (car ibuffer-filtering-qualifiers) '(or saved not))) + :help "Break down a complex filter like OR or NOT"] + ["Swap top two filters" ibuffer-exchange-filters + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers + (cdr ibuffer-filtering-qualifiers))] + ["Save current filters permanently..." ibuffer-save-filters + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers) + :help "Use a mnemonic name to store current filter stack"] + ["Restore permanently saved filters..." ibuffer-switch-to-saved-filters + :enable (and (featurep 'ibuf-ext) ibuffer-saved-filters) + :help "Replace current filters with a saved stack"] + ["Add to permanently saved filters..." ibuffer-add-saved-filters + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers) + :help "Include already saved stack with current filters"] + ["Delete permanently saved filters..." ibuffer-delete-saved-filters + :enable (and (featurep 'ibuf-ext) ibuffer-saved-filters)]) + ;; The "Filter Groups" menu: + ,(ibuffer-mode--groups-menu-definition) + "---" + ["Auto Mode" ibuffer-auto-mode + :style toggle + :selected ibuffer-auto-mode + :help "Attempt to automatically update the Ibuffer buffer"])) + +(define-obsolete-variable-alias 'ibuffer-mode-operate-map 'ibuffer-mode-operate-menu "28.1") +(easy-menu-define ibuffer-mode-operate-menu ibuffer-mode-map + "Operate menu for `ibuffer'." + '("Operate" + ["View" ibuffer-do-view] + ["View (separate frame)" ibuffer-do-view-other-frame] + ["Save" ibuffer-do-save] + ["Replace (regexp)..." ibuffer-do-replace-regexp + :help "Replace text inside marked buffers"] + ["Query Replace..." ibuffer-do-query-replace + :help "Replace text in marked buffers, asking each time"] + ["Query Replace (regexp)..." ibuffer-do-query-replace-regexp + :help "Replace text in marked buffers by regexp, asking each time"] + ["Print" ibuffer-do-print] + ["Toggle modification flag" ibuffer-do-toggle-modified] + ["Toggle read-only flag" ibuffer-do-toggle-read-only] + ["Toggle lock flag" ibuffer-do-toggle-lock] + ["Revert" ibuffer-do-revert + :help "Revert marked buffers to their associated file"] + ["Rename Uniquely" ibuffer-do-rename-uniquely + :help "Rename marked buffers to a new, unique name"] + ["Kill" ibuffer-do-delete] + ["List lines matching..." ibuffer-do-occur + :help "View all lines in marked buffers matching a regexp"] + ["Pipe to shell command..." ibuffer-do-shell-command-pipe + :help "For each marked buffer, send its contents to a shell command"] + ["Pipe to shell command (replace)..." ibuffer-do-shell-command-pipe-replace + :help "For each marked buffer, replace its contents with output of shell command"] + ["Shell command on buffer's file..." ibuffer-do-shell-command-file + :help "For each marked buffer, run a shell command with its file as argument"] + ["Eval..." ibuffer-do-eval + :help "Evaluate a Lisp form in each marked buffer"] + ["Eval (viewing buffer)..." ibuffer-do-view-and-eval + :help "Evaluate a Lisp form in each marked buffer while viewing it"] + ["Diff with file" ibuffer-diff-with-file + :help "View the differences between this buffer and its file"])) (defvar ibuffer-name-map (let ((map (make-sparse-keymap))) @@ -1025,7 +897,7 @@ width and the longest string in LIST." (goto-char eventpt) (ibuffer-set-mark ibuffer-marked-char)) (save-excursion - (popup-menu ibuffer-mode-operate-map))))) + (popup-menu ibuffer-mode-operate-menu))))) (setq buffer-read-only t) (if (= eventpt (point)) (goto-char origpt))))) @@ -2734,7 +2606,6 @@ will be inserted before the group at point." (setq-local ibuffer-tmp-hide-regexps nil) (setq-local ibuffer-tmp-show-regexps nil) (define-key ibuffer-mode-map [menu-bar edit] 'undefined) - (define-key ibuffer-mode-map [menu-bar operate] (cons "Operate" ibuffer-mode-operate-map)) (ibuffer-update-format) (when ibuffer-default-directory (setq default-directory ibuffer-default-directory)) diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 48f9cd0767c..e4b53bd2751 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -2553,7 +2553,6 @@ easy-to-use form." (let ((files (dired-get-marked-files))) (pop-to-buffer-same-window "*Image-Dired Edit Meta Data*") (kill-all-local-variables) - (make-local-variable 'widget-example-repeat) (let ((inhibit-read-only t)) (erase-buffer)) (remove-overlays) diff --git a/lisp/isearch.el b/lisp/isearch.el index 8266c4b7a01..e7926ac08ce 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -26,7 +26,7 @@ ;; Instructions -;; For programmed use of isearch-mode, e.g. calling (isearch-forward), +;; For programmed use of isearch-mode, e.g. calling `isearch-forward', ;; isearch-mode behaves modally and does not return until the search ;; is completed. It uses a recursive-edit to behave this way. @@ -46,7 +46,7 @@ ;; exits and searches in the last search direction. ;; Exiting immediately from isearch uses isearch-edit-string instead -;; of nonincremental-search, if search-nonincremental-instead is non-nil. +;; of nonincremental-search, if `search-nonincremental-instead' is non-nil. ;; The name of this option should probably be changed if we decide to ;; keep the behavior. No point in forcing nonincremental search until ;; the last possible moment. @@ -527,159 +527,6 @@ This is like `describe-bindings', but displays only Isearch keys." '(isearch-tmm-menubar tmm-menubar menu-bar-open mouse-minor-mode-menu) "List of commands that can open a menu during Isearch.") -(defvar isearch-menu-bar-yank-map - (let ((map (make-sparse-keymap))) - (define-key map [isearch-yank-pop] - '(menu-item "Previous kill" isearch-yank-pop-only - :help "Replace previous yanked kill on search string")) - (define-key map [isearch-yank-kill] - '(menu-item "Current kill" isearch-yank-kill - :help "Append current kill to search string")) - (define-key map [isearch-yank-until-char] - '(menu-item "Until char..." isearch-yank-until-char - :help "Yank from point to specified character into search string")) - (define-key map [isearch-yank-line] - '(menu-item "Rest of line" isearch-yank-line - :help "Yank the rest of the current line on search string")) - (define-key map [isearch-yank-symbol-or-char] - '(menu-item "Symbol/char" - isearch-yank-symbol-or-char - :help "Yank next symbol or char on search string")) - (define-key map [isearch-yank-word-or-char] - '(menu-item "Word/char" - isearch-yank-word-or-char - :help "Yank next word or char on search string")) - (define-key map [isearch-yank-char] - '(menu-item "Char" isearch-yank-char - :help "Yank char at point on search string")) - map)) - -(defvar isearch-menu-bar-map - (let ((map (make-sparse-keymap "Isearch"))) - (define-key map [isearch-complete] - '(menu-item "Complete current search string" isearch-complete - :help "Complete current search string over search history")) - (define-key map [isearch-complete-separator] - '(menu-item "--")) - (define-key map [isearch-query-replace-regexp] - '(menu-item "Replace search string as regexp" isearch-query-replace-regexp - :help "Replace matches for current search string as regexp")) - (define-key map [isearch-query-replace] - '(menu-item "Replace search string" isearch-query-replace - :help "Replace matches for current search string")) - (define-key map [isearch-occur] - '(menu-item "Show all matches for search string" isearch-occur - :help "Show all matches for current search string")) - (define-key map [isearch-highlight-regexp] - '(menu-item "Highlight all matches for search string" - isearch-highlight-regexp - :help "Highlight all matches for current search string")) - (define-key map [isearch-search-replace-separator] - '(menu-item "--")) - (define-key map [isearch-transient-input-method] - '(menu-item "Turn on transient input method" - isearch-transient-input-method - :help "Turn on transient input method for search")) - (define-key map [isearch-toggle-specified-input-method] - '(menu-item "Turn on specific input method" - isearch-toggle-specified-input-method - :help "Turn on specific input method for search")) - (define-key map [isearch-toggle-input-method] - '(menu-item "Toggle input method" isearch-toggle-input-method - :help "Toggle input method for search")) - (define-key map [isearch-input-method-separator] - '(menu-item "--")) - (define-key map [isearch-char-by-name] - '(menu-item "Search for char by name" isearch-char-by-name - :help "Search for character by name")) - (define-key map [isearch-quote-char] - '(menu-item "Search for literal char" isearch-quote-char - :help "Search for literal char")) - (define-key map [isearch-special-char-separator] - '(menu-item "--")) - (define-key map [isearch-toggle-word] - '(menu-item "Word matching" isearch-toggle-word - :help "Word matching" - :button (:toggle - . (eq isearch-regexp-function 'word-search-regexp)))) - (define-key map [isearch-toggle-symbol] - '(menu-item "Symbol matching" isearch-toggle-symbol - :help "Symbol matching" - :button (:toggle - . (eq isearch-regexp-function - 'isearch-symbol-regexp)))) - (define-key map [isearch-toggle-regexp] - '(menu-item "Regexp matching" isearch-toggle-regexp - :help "Regexp matching" - :button (:toggle . isearch-regexp))) - (define-key map [isearch-toggle-invisible] - '(menu-item "Invisible text matching" isearch-toggle-invisible - :help "Invisible text matching" - :button (:toggle . isearch-invisible))) - (define-key map [isearch-toggle-char-fold] - '(menu-item "Character folding matching" isearch-toggle-char-fold - :help "Character folding matching" - :button (:toggle - . (eq isearch-regexp-function - 'char-fold-to-regexp)))) - (define-key map [isearch-toggle-case-fold] - '(menu-item "Case folding matching" isearch-toggle-case-fold - :help "Case folding matching" - :button (:toggle . isearch-case-fold-search))) - (define-key map [isearch-toggle-lax-whitespace] - '(menu-item "Lax whitespace matching" isearch-toggle-lax-whitespace - :help "Lax whitespace matching" - :button (:toggle . isearch-lax-whitespace))) - (define-key map [isearch-toggle-separator] - '(menu-item "--")) - (define-key map [isearch-yank-menu] - `(menu-item "Yank on search string" ,isearch-menu-bar-yank-map)) - (define-key map [isearch-edit-string] - '(menu-item "Edit current search string" isearch-edit-string - :help "Edit current search string")) - (define-key map [isearch-ring-retreat] - '(menu-item "Edit previous search string" isearch-ring-retreat - :help "Edit previous search string in Isearch history")) - (define-key map [isearch-ring-advance] - '(menu-item "Edit next search string" isearch-ring-advance - :help "Edit next search string in Isearch history")) - (define-key map [isearch-del-char] - '(menu-item "Delete last char from search string" isearch-del-char - :help "Delete last character from search string")) - (define-key map [isearch-delete-char] - '(menu-item "Undo last input item" isearch-delete-char - :help "Undo the effect of the last Isearch command")) - (define-key map [isearch-end-of-buffer] - '(menu-item "Go to last match" isearch-end-of-buffer - :help "Go to last occurrence of current search string")) - (define-key map [isearch-beginning-of-buffer] - '(menu-item "Go to first match" isearch-beginning-of-buffer - :help "Go to first occurrence of current search string")) - (define-key map [isearch-repeat-backward] - '(menu-item "Repeat search backward" isearch-repeat-backward - :help "Repeat current search backward")) - (define-key map [isearch-repeat-forward] - '(menu-item "Repeat search forward" isearch-repeat-forward - :help "Repeat current search forward")) - (define-key map [isearch-nonincremental] - '(menu-item "Nonincremental search" isearch-exit - :help "Start nonincremental search" - :visible (string-equal isearch-string ""))) - (define-key map [isearch-exit] - '(menu-item "Finish search" isearch-exit - :help "Finish search leaving point where it is" - :visible (not (string-equal isearch-string "")))) - (define-key map [isearch-abort] - '(menu-item "Remove characters not found" isearch-abort - :help "Quit current search" - :visible (not isearch-success))) - (define-key map [isearch-cancel] - `(menu-item "Cancel search" isearch-cancel - :help "Cancel current search and return to starting point" - :filter ,(lambda (binding) - (if isearch-success 'isearch-abort binding)))) - map)) - ;; Note: Before adding more key bindings to this map, please keep in ;; mind that any unbound key exits Isearch and runs the command bound ;; to it in the local or global map. So in effect every key unbound @@ -795,13 +642,116 @@ This is like `describe-bindings', but displays only Isearch keys." ;; The key translations defined in the C-x 8 prefix should add ;; characters to the search string. See iso-transl.el. (define-key map "\C-x8\r" 'isearch-char-by-name) - - (define-key map [menu-bar search-menu] - (list 'menu-item "Isearch" isearch-menu-bar-map)) - map) "Keymap for `isearch-mode'.") +(easy-menu-define isearch-menu-bar-map isearch-mode-map + "Menu for `isearch-mode'." + '("Isearch" + ["Cancel search" isearch-cancel + :help "Cancel current search and return to starting point" + :filter (lambda (binding) + (if isearch-success 'isearch-abort binding))] + ["Remove characters not found" isearch-abort + :help "Quit current search" + :visible (not isearch-success)] + ["Finish search" isearch-exit + :help "Finish search leaving point where it is" + :visible (not (string-equal isearch-string ""))] + ["Nonincremental search" isearch-exit + :help "Start nonincremental search" + :visible (string-equal isearch-string "")] + ["Repeat search forward" isearch-repeat-forward + :help "Repeat current search forward"] + ["Repeat search backward" isearch-repeat-backward + :help "Repeat current search backward"] + ["Go to first match" isearch-beginning-of-buffer + :help "Go to first occurrence of current search string"] + ["Go to last match" isearch-end-of-buffer + :help "Go to last occurrence of current search string"] + ["Undo last input item" isearch-delete-char + :help "Undo the effect of the last Isearch command"] + ["Delete last char from search string" isearch-del-char + :help "Delete last character from search string"] + ["Edit next search string" isearch-ring-advance + :help "Edit next search string in Isearch history"] + ["Edit previous search string" isearch-ring-retreat + :help "Edit previous search string in Isearch history"] + ["Edit current search string" isearch-edit-string + :help "Edit current search string"] + ("Yank on search string" + ["Char" isearch-yank-char + :help "Yank char at point on search string"] + ["Word/char" + isearch-yank-word-or-char + :help "Yank next word or char on search string"] + ["Symbol/char" + isearch-yank-symbol-or-char + :help "Yank next symbol or char on search string"] + ["Rest of line" isearch-yank-line + :help "Yank the rest of the current line on search string"] + ["Until char..." isearch-yank-until-char + :help "Yank from point to specified character into search string"] + ["Current kill" isearch-yank-kill + :help "Append current kill to search string"] + ["Previous kill" isearch-yank-pop-only + :help "Replace previous yanked kill on search string"]) + "---" + ["Lax whitespace matching" isearch-toggle-lax-whitespace + :help "Lax whitespace matching" + :style toggle + :selected isearch-lax-whitespace] + ["Case folding matching" isearch-toggle-case-fold + :help "Case folding matching" + :style toggle + :selected isearch-case-fold-search] + ["Character folding matching" isearch-toggle-char-fold + :help "Character folding matching" + :style toggle + :selected (eq isearch-regexp-function + 'char-fold-to-regexp)] + ["Invisible text matching" isearch-toggle-invisible + :help "Invisible text matching" + :style toggle + :selected isearch-invisible] + ["Regexp matching" isearch-toggle-regexp + :help "Regexp matching" + :style toggle + :selected isearch-regexp] + ["Symbol matching" isearch-toggle-symbol + :help "Symbol matching" + :style toggle + :selected (eq isearch-regexp-function + 'isearch-symbol-regexp)] + ["Word matching" isearch-toggle-word + :help "Word matching" + :style toggle + :selected (eq isearch-regexp-function 'word-search-regexp)] + "---" + ["Search for literal char" isearch-quote-char + :help "Search for literal char"] + ["Search for char by name" isearch-char-by-name + :help "Search for character by name"] + "---" + ["Toggle input method" isearch-toggle-input-method + :help "Toggle input method for search"] + ["Turn on specific input method" isearch-toggle-specified-input-method + :help "Turn on specific input method for search"] + ["Turn on transient input method" isearch-transient-input-method + :help "Turn on transient input method for search"] + "---" + ["Highlight all matches for search string" isearch-highlight-regexp + :help "Highlight all matches for current search string"] + ["Show all matches for search string" isearch-occur + :help "Show all matches for current search string"] + ["Replace search string" isearch-query-replace + :help "Replace matches for current search string"] + ["Replace search string as regexp" isearch-query-replace-regexp + :help "Replace matches for current search string as regexp"] + "---" + ["Complete current search string" isearch-complete + :help "Complete current search string over search history"])) + (defvar isearch-tool-bar-old-map nil "Variable holding the old local value of `tool-bar-map', if any.") @@ -1499,7 +1449,7 @@ REGEXP if non-nil says use the regexp search ring." (apply 'propertize string properties)) (defun isearch-update-from-string-properties (string) - "Update isearch properties from the isearch string" + "Update isearch properties from the isearch STRING." (when (plist-member (text-properties-at 0 string) 'isearch-case-fold-search) (setq isearch-case-fold-search (get-text-property 0 'isearch-case-fold-search string))) @@ -2536,7 +2486,7 @@ minibuffer to read a string from the `kill-ring' as `yank-pop' does." Unlike `isearch-yank-pop', when this command is called not immediately after a `isearch-yank-kill' or a `isearch-yank-pop-only', it only pops the last killed string instead of activating the minibuffer to read -a string from the `kill-ring' as `yank-pop' does. The prefix arg C-u +a string from the `kill-ring' as `yank-pop' does. The prefix arg \\[universal-argument] always reads a string from the `kill-ring' using the minibuffer." (interactive "P") (cond @@ -2695,7 +2645,7 @@ With argument, add COUNT copies of the character." string "")))))))) (defun isearch-search-and-update () - ;; Do the search and update the display. + "Do the search and update the display." (when (or isearch-success ;; Unsuccessful regexp search may become successful by ;; addition of characters which make isearch-string valid @@ -3227,7 +3177,7 @@ If there is no completion possible, say so and continue searching." ;; Message string (defun isearch-message (&optional c-q-hack ellipsis) - ;; Generate and print the message string. + "Generate and print the message string." ;; N.B.: This function should always be called with point at the ;; search point, because in certain (rare) circumstances, undesired @@ -3481,7 +3431,7 @@ Optional third argument, if t, means if fail just return nil (no error). pos1))) (defun isearch-search () - ;; Do the search with the current search string. + "Do the search with the current search string." (if (and (eq isearch-case-fold-search t) search-upper-case) (setq isearch-case-fold-search (isearch-no-upper-case-p isearch-string isearch-regexp))) diff --git a/lisp/json.el b/lisp/json.el index f20123fcfbc..6677c3b1b37 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -40,6 +40,17 @@ ;; Similarly, since `false' and `null' are distinct in JSON, you can ;; distinguish them by binding `json-false' and `json-null' as desired. +;;; Organization: + +;; Historically json.el used the prefix `json-read-' for decoding and +;; the prefix `json-encode-' for encoding. Many of these definitions +;; are used by external packages since few were marked as internal. +;; Optimizing the encoder to manipulate a buffer rather than strings +;; while minimizing code duplication therefore necessitated a new +;; namespace `json--print-'. This rendered many encoding functions +;; obsolete and unused, but those considered externally useful are +;; kept for backward compatibility and as a public API. + ;;; History: ;; 2006-03-11 - Initial version. @@ -57,7 +68,7 @@ (require 'map) (require 'subr-x) -;; Parameters +;;;; Parameters (defvar json-object-type 'alist "Type to convert JSON objects to. @@ -102,13 +113,22 @@ this around your call to `json-read' instead of `setq'ing it.") "Value to use as an element separator when encoding.") (defvar json-encoding-default-indentation " " - "The default indentation level for encoding. + "String used for a single indentation level during encoding. +This value is repeated for each further nested element. +Used only when `json-encoding-pretty-print' is non-nil.") + +(defvar json--print-indentation-prefix "\n" + "String used to start indentation during encoding. Used only when `json-encoding-pretty-print' is non-nil.") -(defvar json--encoding-current-indentation "\n" - "Internally used to keep track of the current indentation level of encoding. +(defvar json--print-indentation-depth 0 + "Current indentation level during encoding. +Dictates repetitions of `json-encoding-default-indentation'. Used only when `json-encoding-pretty-print' is non-nil.") +(defvar json--print-keyval-separator ":" + "String used to separate key-value pairs during encoding.") + (defvar json-encoding-pretty-print nil "If non-nil, then the output of `json-encode' will be pretty-printed.") @@ -137,7 +157,7 @@ respectively, with no arguments.") -;;; Utilities +;;;; Utilities (define-obsolete-function-alias 'json-join #'string-join "28.1") @@ -169,18 +189,38 @@ destructively modify PLIST to produce the result." (setcdr (cdr plist) prev))) plist) +;; Encoder utilities + +(defmacro json--with-output-to-string (&rest body) + "Eval BODY in a temporary buffer bound to `standard-output'. +Return the resulting buffer contents as a string." + (declare (indent 0) (debug t)) + `(with-output-to-string + (with-current-buffer standard-output + ;; This affords decent performance gains. + (setq-local inhibit-modification-hooks t) + ,@body))) + (defmacro json--with-indentation (&rest body) - "Evaluate BODY with the correct indentation for JSON encoding. -This macro binds `json--encoding-current-indentation' according -to `json-encoding-pretty-print' around BODY." + "Eval BODY with the JSON encoding nesting incremented by one step. +This macro sets up appropriate variable bindings for +`json--print-indentation' to produce the correct indentation when +`json-encoding-pretty-print' is non-nil." (declare (debug t) (indent 0)) - `(let ((json--encoding-current-indentation - (if json-encoding-pretty-print - (concat json--encoding-current-indentation - json-encoding-default-indentation) - ""))) + `(let ((json--print-indentation-prefix + (if json-encoding-pretty-print json--print-indentation-prefix "")) + (json--print-keyval-separator (if json-encoding-pretty-print ": " ":")) + (json--print-indentation-depth (1+ json--print-indentation-depth))) ,@body)) +(defun json--print-indentation () + "Insert the current indentation for JSON encoding at point. +Has no effect if `json-encoding-pretty-print' is nil." + (when json-encoding-pretty-print + (insert json--print-indentation-prefix) + (dotimes (_ json--print-indentation-depth) + (insert json-encoding-default-indentation)))) + ;; Reader utilities (define-inline json-advance (&optional n) @@ -210,8 +250,6 @@ Signal `json-end-of-file' if called at the end of the buffer." ;; definition of whitespace in JSON. (inline-quote (skip-chars-forward "\t\n\r "))) - - ;; Error conditions (define-error 'json-error "Unknown JSON error") @@ -228,7 +266,7 @@ Signal `json-end-of-file' if called at the end of the buffer." -;;; Paths +;;;; Paths (defvar json--path '() "Keeps track of the path during recursive calls to `json-read'. @@ -283,7 +321,9 @@ element in a deeply nested structure." (when (plist-get path :path) path)))) -;;; Keywords + + +;;;; Keywords (defconst json-keywords '("true" "false" "null") "List of JSON keywords.") @@ -316,7 +356,13 @@ element in a deeply nested structure." ((eq keyword json-false) "false") ((eq keyword json-null) "null"))) -;;; Numbers +(defun json--print-keyword (keyword) + "Insert KEYWORD as a JSON value at point. +Return nil if KEYWORD is not recognized as a JSON keyword." + (prog1 (setq keyword (json-encode-keyword keyword)) + (and keyword (insert keyword)))) + +;;;; Numbers ;; Number parsing @@ -339,10 +385,9 @@ element in a deeply nested structure." ;; Number encoding -(defalias 'json-encode-number #'number-to-string - "Return a JSON representation of NUMBER.") +(define-obsolete-function-alias 'json-encode-number #'json-encode "28.1") -;;; Strings +;;;; Strings (defconst json-special-chars '((?\" . ?\") @@ -410,65 +455,52 @@ element in a deeply nested structure." ;; String encoding -;; Escape only quotation mark, backslash, and the control -;; characters U+0000 to U+001F (RFC 4627, ECMA-404). -(rx-define json--escape (in ?\" ?\\ cntrl)) - -(defvar json--long-string-threshold 200 - "Length above which strings are considered long for JSON encoding. -It is generally faster to manipulate such strings in a buffer -rather than directly.") - -(defvar json--string-buffer nil - "Buffer used for encoding Lisp strings as JSON. -Initialized lazily by `json-encode-string'.") +(defun json--print-string (string &optional from) + "Insert a JSON representation of STRING at point. +FROM is the index of STRING to start from and defaults to 0." + (insert ?\") + (goto-char (prog1 (point) (princ string))) + (and from (delete-char from)) + ;; Escape only quotation mark, backslash, and the control + ;; characters U+0000 to U+001F (RFC 4627, ECMA-404). + (while (re-search-forward (rx (in ?\" ?\\ cntrl)) nil 'move) + (let ((char (preceding-char))) + (delete-char -1) + (insert ?\\ (or + ;; Special JSON character (\n, \r, etc.). + (car (rassq char json-special-chars)) + ;; Fallback: UCS code point in \uNNNN form. + (format "u%04x" char))))) + (insert ?\") + string) (defun json-encode-string (string) "Return a JSON representation of STRING." - ;; Try to avoid buffer overhead in trivial cases, while also - ;; avoiding searching pathological strings for escape characters. - ;; Since `string-match-p' doesn't take a LIMIT argument, we use - ;; string length as our heuristic. See also bug#20154. - (if (and (< (length string) json--long-string-threshold) - (not (string-match-p (rx json--escape) string))) - (concat "\"" (substring-no-properties string) "\"") - (with-current-buffer - (or json--string-buffer - (with-current-buffer (generate-new-buffer " *json-string*" t) - ;; This seems to afford decent performance gains. - (setq-local inhibit-modification-hooks t) - (setq json--string-buffer (current-buffer)))) - ;; Strip `read-only' property (bug#43549). - (insert ?\" (substring-no-properties string)) - (goto-char (1+ (point-min))) - (while (re-search-forward (rx json--escape) nil 'move) - (let ((char (preceding-char))) - (delete-char -1) - (insert ?\\ (or - ;; Special JSON character (\n, \r, etc.). - (car (rassq char json-special-chars)) - ;; Fallback: UCS code point in \uNNNN form. - (format "u%04x" char))))) - (insert ?\") - ;; Empty buffer for next invocation. - (delete-and-extract-region (point-min) (point-max))))) - -(defun json--encode-stringlike (object) - "Return OBJECT encoded as a JSON string, or nil if not possible." - (cond ((stringp object) (json-encode-string object)) - ((keywordp object) (json-encode-string - (substring (symbol-name object) 1))) - ((symbolp object) (json-encode-string (symbol-name object))))) + (json--with-output-to-string (json--print-string string))) + +(defun json--print-stringlike (object) + "Insert OBJECT encoded as a JSON string at point. +Return nil if OBJECT cannot be encoded as a JSON string." + (cond ((stringp object) (json--print-string object)) + ((keywordp object) (json--print-string (symbol-name object) 1)) + ((symbolp object) (json--print-string (symbol-name object))))) + +(defun json--print-key (object) + "Insert a JSON key representation of OBJECT at point. +Signal `json-key-format' if it cannot be encoded as a string." + (or (json--print-stringlike object) + (signal 'json-key-format (list object)))) (defun json-encode-key (object) "Return a JSON representation of OBJECT. If the resulting JSON object isn't a valid JSON object key, this signals `json-key-format'." - ;; Encoding must be a JSON string. - (or (json--encode-stringlike object) - (signal 'json-key-format (list object)))) + (declare (obsolete json-encode "28.1")) + (json--with-output-to-string (json--print-key object))) -;;; Objects +;;;; Objects + +;; JSON object parsing (defun json-new-object () "Create a new Elisp object corresponding to an empty JSON object. @@ -501,8 +533,6 @@ Please see the documentation of `json-object-type' and `json-key-type'." ((eq json-object-type 'plist) (cons key (cons value object)))))) -;; JSON object parsing - (defun json-read-object () "Read the JSON object at point." ;; Skip over the '{'. @@ -537,95 +567,81 @@ Please see the documentation of `json-object-type' and `json-key-type'." ('plist (json--plist-nreverse elements)) (_ elements)))) +;; JSON object encoding + +(defun json--print-pair (key val) + "Insert JSON representation of KEY-VAL pair at point. +This always inserts a trailing `json-encoding-separator'." + (json--print-indentation) + (json--print-key key) + (insert json--print-keyval-separator) + (json--print val) + (insert json-encoding-separator)) + +(defun json--print-map (map) + "Insert JSON object representation of MAP at point. +This works for any MAP satisfying `mapp'." + (insert ?\{) + (unless (map-empty-p map) + (json--with-indentation + (map-do #'json--print-pair map) + (delete-char (- (length json-encoding-separator)))) + (or json-encoding-lisp-style-closings + (json--print-indentation))) + (insert ?\})) + +(defun json--print-unordered-map (map) + "Like `json--print-map', but optionally sort MAP first. +If `json-encoding-object-sort-predicate' is non-nil, this first +transforms an unsortable MAP into a sortable alist." + (if (and json-encoding-object-sort-predicate + (not (map-empty-p map))) + (json--print-alist (map-pairs map) t) + (json--print-map map))) + ;; Hash table encoding -(defun json-encode-hash-table (hash-table) - "Return a JSON representation of HASH-TABLE." - (cond ((hash-table-empty-p hash-table) "{}") - (json-encoding-object-sort-predicate - (json--encode-alist (map-pairs hash-table) t)) - (t - (let ((kv-sep (if json-encoding-pretty-print ": " ":")) - result) - (json--with-indentation - (maphash - (lambda (k v) - (push (concat json--encoding-current-indentation - (json-encode-key k) - kv-sep - (json-encode v)) - result)) - hash-table)) - (concat "{" - (string-join (nreverse result) json-encoding-separator) - (and json-encoding-pretty-print - (not json-encoding-lisp-style-closings) - json--encoding-current-indentation) - "}"))))) +(define-obsolete-function-alias 'json-encode-hash-table #'json-encode "28.1") ;; List encoding (including alists and plists) -(defun json--encode-alist (alist &optional destructive) - "Return a JSON representation of ALIST. -DESTRUCTIVE non-nil means it is safe to modify ALIST by -side-effects." - (when json-encoding-object-sort-predicate - (setq alist (sort (if destructive alist (copy-sequence alist)) - (lambda (a b) - (funcall json-encoding-object-sort-predicate - (car a) (car b)))))) - (concat "{" - (let ((kv-sep (if json-encoding-pretty-print ": " ":"))) - (json--with-indentation - (mapconcat (lambda (cons) - (concat json--encoding-current-indentation - (json-encode-key (car cons)) - kv-sep - (json-encode (cdr cons)))) - alist - json-encoding-separator))) - (and json-encoding-pretty-print - (not json-encoding-lisp-style-closings) - json--encoding-current-indentation) - "}")) +(defun json--print-alist (alist &optional destructive) + "Insert a JSON representation of ALIST at point. +Sort ALIST first if `json-encoding-object-sort-predicate' is +non-nil. Sorting can optionally be DESTRUCTIVE for speed." + (json--print-map (if (and json-encoding-object-sort-predicate alist) + (sort (if destructive alist (copy-sequence alist)) + (lambda (a b) + (funcall json-encoding-object-sort-predicate + (car a) (car b)))) + alist))) + +;; The following two are unused but useful to keep around due to the +;; inherent ambiguity of lists. (defun json-encode-alist (alist) "Return a JSON representation of ALIST." - (if alist (json--encode-alist alist) "{}")) + (json--with-output-to-string (json--print-alist alist))) (defun json-encode-plist (plist) "Return a JSON representation of PLIST." - (cond ((null plist) "{}") - (json-encoding-object-sort-predicate - (json--encode-alist (map-pairs plist) t)) - (t - (let ((kv-sep (if json-encoding-pretty-print ": " ":")) - result) - (json--with-indentation - (while plist - (push (concat json--encoding-current-indentation - (json-encode-key (pop plist)) - kv-sep - (json-encode (pop plist))) - result))) - (concat "{" - (string-join (nreverse result) json-encoding-separator) - (and json-encoding-pretty-print - (not json-encoding-lisp-style-closings) - json--encoding-current-indentation) - "}"))))) + (json--with-output-to-string (json--print-unordered-map plist))) + +(defun json--print-list (list) + "Like `json-encode-list', but insert the JSON at point." + (cond ((json-alist-p list) (json--print-alist list)) + ((json-plist-p list) (json--print-unordered-map list)) + ((listp list) (json--print-array list)) + ((signal 'json-error (list list))))) (defun json-encode-list (list) "Return a JSON representation of LIST. -Tries to DWIM: simple lists become JSON arrays, while alists and plists -become JSON objects." - (cond ((json-alist-p list) (json-encode-alist list)) - ((json-plist-p list) (json-encode-plist list)) - ((listp list) (json-encode-array list)) - (t - (signal 'json-error (list list))))) +Tries to DWIM: alists and plists become JSON objects, while +simple lists become JSON arrays." + (declare (obsolete json-encode "28.1")) + (json--with-output-to-string (json--print-list list))) -;;; Arrays +;;;; Arrays ;; Array parsing @@ -658,28 +674,32 @@ become JSON objects." ;; Array encoding +(defun json--print-array (array) + "Like `json-encode-array', but insert the JSON at point." + (insert ?\[) + (unless (length= array 0) + (json--with-indentation + (json--print-indentation) + (let ((first t)) + (mapc (lambda (elt) + (if first + (setq first nil) + (insert json-encoding-separator) + (json--print-indentation)) + (json--print elt)) + array))) + (or json-encoding-lisp-style-closings + (json--print-indentation))) + (insert ?\])) + (defun json-encode-array (array) "Return a JSON representation of ARRAY. ARRAY can also be a list." - (if (and json-encoding-pretty-print - (not (length= array 0))) - (concat - "[" - (json--with-indentation - (concat json--encoding-current-indentation - (mapconcat #'json-encode array - (concat json-encoding-separator - json--encoding-current-indentation)))) - (unless json-encoding-lisp-style-closings - json--encoding-current-indentation) - "]") - (concat "[" - (mapconcat #'json-encode array json-encoding-separator) - "]"))) + (json--with-output-to-string (json--print-array array))) -;;; Reader +;;;; Reader (defmacro json-readtable-dispatch (char) "Dispatch reader function for CHAR at point. @@ -735,7 +755,17 @@ you will get the following structure returned: -;;; Encoder +;;;; Encoder + +(defun json--print (object) + "Like `json-encode', but insert or print the JSON at point." + (cond ((json--print-keyword object)) + ((listp object) (json--print-list object)) + ((json--print-stringlike object)) + ((numberp object) (prin1 object)) + ((arrayp object) (json--print-array object)) + ((hash-table-p object) (json--print-unordered-map object)) + ((signal 'json-error (list object))))) (defun json-encode (object) "Return a JSON representation of OBJECT as a string. @@ -743,15 +773,9 @@ you will get the following structure returned: OBJECT should have a structure like one returned by `json-read'. If an error is detected during encoding, an error based on `json-error' is signaled." - (cond ((json-encode-keyword object)) - ((listp object) (json-encode-list object)) - ((json--encode-stringlike object)) - ((numberp object) (json-encode-number object)) - ((arrayp object) (json-encode-array object)) - ((hash-table-p object) (json-encode-hash-table object)) - (t (signal 'json-error (list object))))) + (json--with-output-to-string (json--print object))) -;;; Pretty printing & minimizing +;;;; Pretty printing & minimizing (defun json-pretty-print-buffer (&optional minimize) "Pretty-print current buffer. @@ -762,7 +786,7 @@ With prefix argument MINIMIZE, minimize it instead." (defvar json-pretty-print-max-secs 2.0 "Maximum time for `json-pretty-print's comparison. The function `json-pretty-print' uses `replace-region-contents' -(which see) passing the value of this variable as argument +\(which see) passing the value of this variable as argument MAX-SECS.") (defun json-pretty-print (begin end &optional minimize) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 9924d62774e..fa971b33c7b 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -62,7 +62,7 @@ should return a grid vector array that is the new solution. ;;;### (autoloads nil "add-log" "vc/add-log.el" (0 0 0 0)) ;;; Generated autoloads from vc/add-log.el -(put 'change-log-default-name 'safe-local-variable 'string-or-null-p) +(put 'change-log-default-name 'safe-local-variable #'string-or-null-p) (defvar add-log-current-defun-function nil "\ If non-nil, function to guess name of surrounding function. @@ -1881,7 +1881,7 @@ specifies in the mode line. Activate Mouse Avoidance mode. See function `mouse-avoidance-mode' for possible values. Setting this variable directly does not take effect; -use either \\[customize] or the function `mouse-avoidance-mode'.") +use either \\[customize] or \\[mouse-avoidance-mode].") (custom-autoload 'mouse-avoidance-mode "avoid" nil) @@ -2529,7 +2529,7 @@ deletion, or > if it is flagged for displaying." t nil) (defalias 'edit-bookmarks 'bookmark-bmenu-list) (autoload 'bookmark-bmenu-search "bookmark" "\ -Incremental search of bookmarks, hiding the non-matches as we go." t nil) +Incremental search of bookmarks, hiding the non-matches as we go." '(bookmark-bmenu-mode) nil) (defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) (bindings--define-key map [load] '(menu-item "Load a Bookmark File..." bookmark-load :help "Load bookmarks from a bookmark file)")) (bindings--define-key map [write] '(menu-item "Save Bookmarks As..." bookmark-write :help "Write bookmarks to a file (reading the file name with the minibuffer)")) (bindings--define-key map [save] '(menu-item "Save Bookmarks" bookmark-save :help "Save currently defined bookmarks")) (bindings--define-key map [edit] '(menu-item "Edit Bookmark List" bookmark-bmenu-list :help "Display a list of existing bookmarks")) (bindings--define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) (bindings--define-key map [delete-all] '(menu-item "Delete all Bookmarks..." bookmark-delete-all :help "Delete all bookmarks from the bookmark list")) (bindings--define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) (bindings--define-key map [locate] '(menu-item "Insert Location..." bookmark-locate :help "Insert the name of the file associated with a bookmark")) (bindings--define-key map [insert] '(menu-item "Insert Contents..." bookmark-insert :help "Insert the text of the file pointed to by a bookmark")) (bindings--define-key map [set] '(menu-item "Set Bookmark..." bookmark-set :help "Set a bookmark named inside a file.")) (bindings--define-key map [jump] '(menu-item "Jump to Bookmark..." bookmark-jump :help "Jump to a bookmark (a point in some file)")) map)) @@ -4410,11 +4410,6 @@ Returns a form where all lambdas don't have any free variables. \(fn FORM)" nil nil) -(autoload 'cconv-warnings-only "cconv" "\ -Add the warnings that closure conversion would encounter. - -\(fn FORM)" nil nil) - (register-definition-prefixes "cconv" '("cconv-")) ;;;*** @@ -5940,8 +5935,7 @@ span the needed amount of lines. Variables `cperl-pod-here-scan', `cperl-pod-here-fontify', `cperl-pod-face', `cperl-pod-head-face' control processing of POD and -here-docs sections. With capable Emaxen results of scan are used -for indentation too, otherwise they are used for highlighting only. +here-docs sections. Results of scan are used for indentation too. Variables controlling indentation style: `cperl-tab-always-indent' @@ -6405,9 +6399,9 @@ PACKAGE value appearing in the :package-version keyword. Since the user might see the value in an error message, a good choice is the official name of the package, such as MH-E or Gnus.") -(defalias 'customize-changed 'customize-changed-options) +(define-obsolete-function-alias 'customize-changed-options #'customize-changed "28.1") -(autoload 'customize-changed-options "cus-edit" "\ +(autoload 'customize-changed "cus-edit" "\ Customize all settings whose meanings have changed in Emacs itself. This includes new user options and faces, and new customization groups, as well as older options and faces whose meanings or @@ -6775,6 +6769,13 @@ If the HANDLER returns a `dbus-error', it is propagated as return message. \(fn EVENT)" t nil) +(autoload 'dbus-monitor "dbus" "\ +Invoke `dbus-register-monitor' interactively, and switch to the buffer. +BUS is either a Lisp keyword, `:system' or `:session', or a +string denoting the bus address. The value nil defaults to `:session'. + +\(fn &optional BUS)" t nil) + (register-definition-prefixes "dbus" '("dbus-")) ;;;*** @@ -7006,7 +7007,9 @@ The most useful commands are: \\[decipher-frequency-count] Display the frequency of each ciphertext letter \\[decipher-adjacency-list] Show adjacency list for current letter (lists letters appearing next to it) \\[decipher-make-checkpoint] Save the current cipher alphabet (checkpoint) -\\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)" t nil) +\\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint) + +\(fn)" t nil) (register-definition-prefixes "decipher" '("decipher-")) @@ -7130,6 +7133,9 @@ KEYWORD-ARGS: :after-hook FORM A single lisp form which is evaluated after the mode hooks have been run. It should not be quoted. + :interactive BOOLEAN + Whether the derived mode should be `interactive' or not. + The default is t. BODY: forms to execute just before running the hooks for the new mode. Do not use `interactive' here. @@ -7475,13 +7481,13 @@ You can control what lines will be unwrapped by frobbing indicating the minimum and maximum length of an unwrapped citation line. If NODISPLAY is non-nil, don't redisplay the article buffer. -\(fn &optional NODISPLAY)" t nil) +\(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil) (autoload 'gnus-article-outlook-repair-attribution "deuglify" "\ Repair a broken attribution line. If NODISPLAY is non-nil, don't redisplay the article buffer. -\(fn &optional NODISPLAY)" t nil) +\(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil) (autoload 'gnus-outlook-deuglify-article "deuglify" "\ Full deuglify of broken Outlook (Express) articles. @@ -7489,10 +7495,10 @@ Treat \"smartquotes\", unwrap lines, repair attribution and rearrange citation. If NODISPLAY is non-nil, don't redisplay the article buffer. -\(fn &optional NODISPLAY)" t nil) +\(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil) (autoload 'gnus-article-outlook-deuglify-article "deuglify" "\ -Deuglify broken Outlook (Express) articles and redisplay." t nil) +Deuglify broken Outlook (Express) articles and redisplay." '(gnus-article-mode gnus-summary-mode) nil) (register-definition-prefixes "deuglify" '("gnus-")) @@ -7559,23 +7565,22 @@ This is a mode for searching a dictionary server implementing the protocol defined in RFC 2229. This is a quick reference to this mode describing the default key bindings: +\\<dictionary-mode-map> +* \\[dictionary-close] close the dictionary buffer +* \\[dictionary-help] display this help information +* \\[dictionary-search] ask for a new word to search +* \\[dictionary-lookup-definition] search the word at point +* \\[forward-button] or TAB place point to the next link +* \\[backward-button] or S-TAB place point to the prev link -* q close the dictionary buffer -* h display this help information -* s ask for a new word to search -* d search the word at point -* n or Tab place point to the next link -* p or S-Tab place point to the prev link +* \\[dictionary-match-words] ask for a pattern and list all matching words. +* \\[dictionary-select-dictionary] select the default dictionary +* \\[dictionary-select-strategy] select the default search strategy -* m ask for a pattern and list all matching words. -* D select the default dictionary -* M select the default search strategy - -* Return or Button2 visit that link -" nil nil) +* RET or <mouse-2> visit that link" nil nil) (autoload 'dictionary "dictionary" "\ -Create a new dictonary buffer and install dictionary-mode." t nil) +Create a new dictionary buffer and install `dictionary-mode'." t nil) (autoload 'dictionary-search "dictionary" "\ Search the WORD in DICTIONARY if given or in all if nil. @@ -7606,7 +7611,7 @@ Display entries matching WORD or the current word if not given. Display tooltips for the current word. This function can be used to enable or disable the tooltip mode -for the current buffer (based on ARG). If global-tooltip-mode is +for the current buffer (based on ARG). If global-tooltip-mode is active it will overwrite that mode for the current buffer. \(fn &optional ARG)" t nil) @@ -7772,10 +7777,15 @@ Switches passed to `ls' for Dired. MUST contain the `l' option. May contain all other options that don't contradict `-l'; may contain even `F', `b', `i' and `s'. See also the variable `dired-ls-F-marks-symlinks' concerning the `F' switch. + +If you have files with names with embedded newline characters, adding +`b' to the switches will allow Dired to handle those files better. + Options that include embedded whitespace must be quoted like this: \"--option=value with spaces\"; you can use `combine-and-quote-strings' to produce the correct quoting of each option. + On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp, some of the `ls' switches are not supported; see the doc string of `insert-directory' in `ls-lisp.el' for more details.") @@ -7873,19 +7883,9 @@ directories again, type \\[dired-do-redisplay] to relist the file at point or th subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer again for the directory tree. -Customization variables (rename this buffer and type \\[describe-variable] on each line -for more info): +See the `dired' customization group for a list of user options. - `dired-listing-switches' - `dired-trivial-filenames' - `dired-marker-char' - `dired-del-marker' - `dired-keep-marker-rename' - `dired-keep-marker-copy' - `dired-keep-marker-hardlink' - `dired-keep-marker-symlink' - -Hooks (use \\[describe-variable] to see their documentation): +This mode runs the following hooks: `dired-before-readin-hook' `dired-after-readin-hook' @@ -8266,6 +8266,13 @@ if some action was made, or nil if the URL is ignored.") ;;;### (autoloads nil "dns" "net/dns.el" (0 0 0 0)) ;;; Generated autoloads from net/dns.el +(autoload 'dns-query "dns" "\ +Query a DNS server for NAME of TYPE. +If FULL, return the entire record returned. +If REVERSE, look up an IP address. + +\(fn NAME &optional TYPE FULL REVERSE)" nil nil) + (register-definition-prefixes "dns" '("dns-")) ;;;*** @@ -8487,6 +8494,10 @@ BODY contains code to execute each time the mode is enabled or disabled. :lighter SPEC Same as the LIGHTER argument. :keymap MAP Same as the KEYMAP argument. :require SYM Same as in `defcustom'. +:interactive VAL Whether this mode should be a command or not. The default + is to make it one; use nil to avoid that. If VAL is a list, + it's interpreted as a list of major modes this minor mode + is useful in. :variable PLACE The location to use instead of the variable MODE to store the state of the mode. This can be simply a different named variable, or a generalized variable. @@ -8586,158 +8597,6 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX). ;;;*** -;;;### (autoloads nil "easymenu" "emacs-lisp/easymenu.el" (0 0 0 -;;;;;; 0)) -;;; Generated autoloads from emacs-lisp/easymenu.el - -(autoload 'easy-menu-define "easymenu" "\ -Define a pop-up menu and/or menu bar menu specified by MENU. -If SYMBOL is non-nil, define SYMBOL as a function to pop up the -submenu defined by MENU, with DOC as its doc string. - -MAPS, if non-nil, should be a keymap or a list of keymaps; add -the submenu defined by MENU to the keymap or each of the keymaps, -as a top-level menu bar item. - -The first element of MENU must be a string. It is the menu bar -item name. It may be followed by the following keyword argument -pairs: - - :filter FUNCTION - FUNCTION must be a function which, if called with one - argument---the list of the other menu items---returns the - items to actually display. - - :visible INCLUDE - INCLUDE is an expression. The menu is visible if the - expression evaluates to a non-nil value. `:included' is an - alias for `:visible'. - - :active ENABLE - ENABLE is an expression. The menu is enabled for selection - if the expression evaluates to a non-nil value. `:enable' is - an alias for `:active'. - - :label FORM - FORM is an expression that is dynamically evaluated and whose - value serves as the menu's label (the default is the first - element of MENU). - - :help HELP - HELP is a string, the help to display for the menu. - In a GUI this is a \"tooltip\" on the menu button. (Though - in Lucid :help is not shown for the top-level menu bar, only - for sub-menus.) - -The rest of the elements in MENU are menu items. -A menu item can be a vector of three elements: - - [NAME CALLBACK ENABLE] - -NAME is a string--the menu item name. - -CALLBACK is a command to run when the item is chosen, or an -expression to evaluate when the item is chosen. - -ENABLE is an expression; the item is enabled for selection if the -expression evaluates to a non-nil value. - -Alternatively, a menu item may have the form: - - [ NAME CALLBACK [ KEYWORD ARG ]... ] - -where NAME and CALLBACK have the same meanings as above, and each -optional KEYWORD and ARG pair should be one of the following: - - :keys KEYS - KEYS is a string; a keyboard equivalent to the menu item. - This is normally not needed because keyboard equivalents are - usually computed automatically. KEYS is expanded with - `substitute-command-keys' before it is used. - - :key-sequence KEYS - KEYS is a hint for speeding up Emacs's first display of the - menu. It should be nil if you know that the menu item has no - keyboard equivalent; otherwise it should be a string or - vector specifying a keyboard equivalent for the menu item. - - :active ENABLE - ENABLE is an expression; the item is enabled for selection - whenever this expression's value is non-nil. `:enable' is an - alias for `:active'. - - :visible INCLUDE - INCLUDE is an expression; this item is only visible if this - expression has a non-nil value. `:included' is an alias for - `:visible'. - - :label FORM - FORM is an expression that is dynamically evaluated and whose - value serves as the menu item's label (the default is NAME). - - :suffix FORM - FORM is an expression that is dynamically evaluated and whose - value is concatenated with the menu entry's label. - - :style STYLE - STYLE is a symbol describing the type of menu item; it should - be `toggle' (a checkbox), or `radio' (a radio button), or any - other value (meaning an ordinary menu item). - - :selected SELECTED - SELECTED is an expression; the checkbox or radio button is - selected whenever the expression's value is non-nil. - - :help HELP - HELP is a string, the help to display for the menu item. - -Alternatively, a menu item can be a string. Then that string -appears in the menu as unselectable text. A string consisting -solely of dashes is displayed as a menu separator. - -Alternatively, a menu item can be a list with the same format as -MENU. This is a submenu. - -\(fn SYMBOL MAPS DOC MENU)" nil t) - -(function-put 'easy-menu-define 'lisp-indent-function 'defun) - -(autoload 'easy-menu-do-define "easymenu" "\ - - -\(fn SYMBOL MAPS DOC MENU)" nil nil) - -(autoload 'easy-menu-create-menu "easymenu" "\ -Create a menu called MENU-NAME with items described in MENU-ITEMS. -MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items -possibly preceded by keyword pairs as described in `easy-menu-define'. - -\(fn MENU-NAME MENU-ITEMS)" nil nil) - -(autoload 'easy-menu-change "easymenu" "\ -Change menu found at PATH as item NAME to contain ITEMS. -PATH is a list of strings for locating the menu that -should contain a submenu named NAME. -ITEMS is a list of menu items, as in `easy-menu-define'. -These items entirely replace the previous items in that submenu. - -If MAP is specified, it should normally be a keymap; nil stands for the local -menu-bar keymap. It can also be a symbol, which has earlier been used as the -first argument in a call to `easy-menu-define', or the value of such a symbol. - -If the menu located by PATH has no submenu named NAME, add one. -If the optional argument BEFORE is present, add it just before -the submenu named BEFORE, otherwise add it at the end of the menu. - -To implement dynamic menus, either call this from -`menu-bar-update-hook' or use a menu filter. - -\(fn PATH NAME ITEMS &optional BEFORE MAP)" nil nil) - -(register-definition-prefixes "easymenu" '("add-submenu" "easy-menu-")) - -;;;*** - ;;;### (autoloads nil "ebnf-abn" "progmodes/ebnf-abn.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/ebnf-abn.el @@ -9423,26 +9282,6 @@ an EDE controlled project. ;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/edebug.el -(defvar edebug-all-defs nil "\ -If non-nil, evaluating defining forms instruments for Edebug. -This applies to `eval-defun', `eval-region', `eval-buffer', and -`eval-current-buffer'. `eval-region' is also called by -`eval-last-sexp', and `eval-print-last-sexp'. - -You can use the command `edebug-all-defs' to toggle the value of this -variable. You may wish to make it local to each buffer with -\(make-local-variable \\='edebug-all-defs) in your -`emacs-lisp-mode-hook'.") - -(custom-autoload 'edebug-all-defs "edebug" t) - -(defvar edebug-all-forms nil "\ -Non-nil means evaluation of all forms will instrument for Edebug. -This doesn't apply to loading or evaluations in the minibuffer. -Use the command `edebug-all-forms' to toggle the value of this option.") - -(custom-autoload 'edebug-all-forms "edebug" t) - (autoload 'edebug-basic-spec "edebug" "\ Return t if SPEC uses only extant spec symbols. An extant spec symbol is a symbol that is not a function and has a @@ -9476,7 +9315,7 @@ Toggle edebugging of all definitions." t nil) (autoload 'edebug-all-forms "edebug" "\ Toggle edebugging of all forms." t nil) -(register-definition-prefixes "edebug" '("cancel-edebug-on-entry" "edebug" "get-edebug-spec" "global-edebug-")) +(register-definition-prefixes "edebug" '("arglist" "backquote-form" "def-declarations" "edebug" "function-form" "interactive" "lambda-" "name" "nested-backquote-form")) ;;;*** @@ -9498,9 +9337,9 @@ arguments after setting up the Ediff buffers. \(fn FILE-A FILE-B FILE-C &optional STARTUP-HOOKS)" t nil) -(defalias 'ediff3 'ediff-files3) +(defalias 'ediff3 #'ediff-files3) -(defalias 'ediff 'ediff-files) +(defalias 'ediff #'ediff-files) (autoload 'ediff-current-file "ediff" "\ Start ediff between current buffer and its file on disk. @@ -9526,7 +9365,7 @@ symbol describing the Ediff job type; it defaults to \(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS JOB-NAME)" t nil) -(defalias 'ebuffers 'ediff-buffers) +(defalias 'ebuffers #'ediff-buffers) (autoload 'ediff-buffers3 "ediff" "\ Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C. @@ -9540,7 +9379,7 @@ symbol describing the Ediff job type; it defaults to \(fn BUFFER-A BUFFER-B BUFFER-C &optional STARTUP-HOOKS JOB-NAME)" t nil) -(defalias 'ebuffers3 'ediff-buffers3) +(defalias 'ebuffers3 #'ediff-buffers3) (autoload 'ediff-directories "ediff" "\ Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have @@ -9549,7 +9388,7 @@ expression; only file names that match the regexp are considered. \(fn DIR1 DIR2 REGEXP)" t nil) -(defalias 'edirs 'ediff-directories) +(defalias 'edirs #'ediff-directories) (autoload 'ediff-directory-revisions "ediff" "\ Run Ediff on a directory, DIR1, comparing its files with their revisions. @@ -9558,7 +9397,7 @@ names. Only the files that are under revision control are taken into account. \(fn DIR1 REGEXP)" t nil) -(defalias 'edir-revisions 'ediff-directory-revisions) +(defalias 'edir-revisions #'ediff-directory-revisions) (autoload 'ediff-directories3 "ediff" "\ Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that @@ -9567,7 +9406,7 @@ regular expression; only file names that match the regexp are considered. \(fn DIR1 DIR2 DIR3 REGEXP)" t nil) -(defalias 'edirs3 'ediff-directories3) +(defalias 'edirs3 #'ediff-directories3) (autoload 'ediff-merge-directories "ediff" "\ Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have @@ -9577,7 +9416,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files. \(fn DIR1 DIR2 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil) -(defalias 'edirs-merge 'ediff-merge-directories) +(defalias 'edirs-merge #'ediff-merge-directories) (autoload 'ediff-merge-directories-with-ancestor "ediff" "\ Merge files in directories DIR1 and DIR2 using files in ANCESTOR-DIR as ancestors. @@ -9597,7 +9436,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files. \(fn DIR1 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil) -(defalias 'edir-merge-revisions 'ediff-merge-directory-revisions) +(defalias 'edir-merge-revisions #'ediff-merge-directory-revisions) (autoload 'ediff-merge-directory-revisions-with-ancestor "ediff" "\ Run Ediff on a directory, DIR1, merging its files with their revisions and ancestors. @@ -9839,7 +9678,7 @@ Call `ediff-merge-directories-with-ancestor' with the next four command line arg (autoload 'ediff-show-registry "ediff-mult" "\ Display Ediff's registry." t nil) -(defalias 'eregistry 'ediff-show-registry) +(defalias 'eregistry #'ediff-show-registry) (register-definition-prefixes "ediff-mult" '("ediff-")) @@ -10866,10 +10705,6 @@ it has to be wrapped in `(eval (quote ...))'. (function-put 'ert-deftest 'lisp-indent-function '2) -(put 'ert-deftest 'lisp-indent-function 2) - -(put 'ert-info 'lisp-indent-function 1) - (autoload 'ert-run-tests-batch "ert" "\ Run the tests specified by SELECTOR, printing results to the terminal. @@ -10916,8 +10751,6 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test). ;;;### (autoloads nil "ert-x" "emacs-lisp/ert-x.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/ert-x.el -(put 'ert-with-test-buffer 'lisp-indent-function 1) - (autoload 'ert-kill-all-test-buffers "ert-x" "\ Kill all test buffers that are still live." t nil) @@ -12034,9 +11867,9 @@ INC may be passed as a numeric prefix argument. The actual adjustment made depends on the final component of the key-binding used to invoke the command, with all modifiers removed: - +, = Increase the default face height by one step - - Decrease the default face height by one step - 0 Reset the default face height to the global default + +, = Increase the height of the default face by one step + - Decrease the height of the default face by one step + 0 Reset the height of the default face to the global default After adjusting, continue to read input events and further adjust the face height as long as the input event read @@ -13931,7 +13764,7 @@ regular expression that can be used as an element of ;;;### (autoloads nil "generic-x" "generic-x.el" (0 0 0 0)) ;;; Generated autoloads from generic-x.el -(register-definition-prefixes "generic-x" '("default-generic-mode" "generic-")) +(register-definition-prefixes "generic-x" '("alias-generic-mode" "ansible-inventory-generic-mode" "apache-" "astap-generic-mode" "default-generic-mode" "etc-" "fvwm-generic-mode" "generic-" "hosts-generic-mode" "ibis-generic-mode" "java-" "mail" "named-" "pkginfo-generic-mode" "prototype-generic-mode" "rc-generic-mode" "rul-" "samba-generic-mode" "show-tabs-generic-mode" "spice-generic-mode" "vrml-generic-mode" "x-resource-generic-mode" "xmodmap-generic-mode")) ;;;*** @@ -14190,7 +14023,7 @@ Make the current buffer look like a nice article." nil nil) ;;; Generated autoloads from gnus/gnus-bookmark.el (autoload 'gnus-bookmark-set "gnus-bookmark" "\ -Set a bookmark for this article." t nil) +Set a bookmark for this article." '(gnus-article-mode gnus-summary-mode) nil) (autoload 'gnus-bookmark-jump "gnus-bookmark" "\ Jump to a Gnus bookmark (BMK-NAME). @@ -14296,7 +14129,7 @@ The value of `message-draft-headers' determines which headers are generated when the article is delayed. Remaining headers are generated when the article is sent. -\(fn DELAY)" t nil) +\(fn DELAY)" '(message-mode) nil) (autoload 'gnus-delay-send-queue "gnus-delay" "\ Send all the delayed messages that are due now." t nil) @@ -14440,13 +14273,13 @@ Insert a random Face header from `gnus-face-directory'." nil nil) Display gravatar in the From header. If gravatar is already displayed, remove it. -\(fn &optional FORCE)" t nil) +\(fn &optional FORCE)" '(gnus-article-mode gnus-summary-mode) nil) (autoload 'gnus-treat-mail-gravatar "gnus-gravatar" "\ Display gravatars in the Cc and To headers. If gravatars are already displayed, remove them. -\(fn &optional FORCE)" t nil) +\(fn &optional FORCE)" '(gnus-article-mode gnus-summary-mode) nil) (register-definition-prefixes "gnus-gravatar" '("gnus-gravatar-")) @@ -14724,15 +14557,15 @@ This is typically a function to add in (autoload 'gnus-treat-from-picon "gnus-picon" "\ Display picons in the From header. -If picons are already displayed, remove them." t nil) +If picons are already displayed, remove them." '(gnus-article-mode gnus-summary-mode) nil) (autoload 'gnus-treat-mail-picon "gnus-picon" "\ Display picons in the Cc and To headers. -If picons are already displayed, remove them." t nil) +If picons are already displayed, remove them." '(gnus-article-mode gnus-summary-mode) nil) (autoload 'gnus-treat-newsgroups-picon "gnus-picon" "\ Display picons in the Newsgroups and Followup-To headers. -If picons are already displayed, remove them." t nil) +If picons are already displayed, remove them." '(gnus-article-mode gnus-summary-mode) nil) (register-definition-prefixes "gnus-picon" '("gnus-picon-")) @@ -14864,7 +14697,7 @@ between gnus-sieve-region-start and gnus-sieve-region-end with \(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost). See the documentation for these variables and functions for details." t nil) -(autoload 'gnus-sieve-article-add-rule "gnus-sieve" nil t nil) +(autoload 'gnus-sieve-article-add-rule "gnus-sieve" nil '(gnus-article-mode gnus-summary-mode) nil) (register-definition-prefixes "gnus-sieve" '("gnus-sieve-")) @@ -15472,6 +15305,8 @@ arguments as NAME. DO is a function as defined in `gv-get'. (or (assq 'gv-setter defun-declarations-alist) (push (list 'gv-setter #'gv--setter-defun-declaration) defun-declarations-alist)) +(let ((spec (get 'compiler-macro 'edebug-declaration-spec))) (put 'gv-expander 'edebug-declaration-spec spec) (put 'gv-setter 'edebug-declaration-spec spec)) + (autoload 'gv-define-setter "gv" "\ Define a setter method for generalized variable NAME. This macro is an easy-to-use substitute for `gv-define-expander' that works @@ -15512,7 +15347,7 @@ The return value is the last VAL in the list. \(fn PLACE VAL PLACE VAL ...)" nil t) -(put 'gv-place 'edebug-form-spec 'edebug-match-form) +(def-edebug-elem-spec 'gv-place '(form)) (autoload 'gv-ref "gv" "\ Return a reference to PLACE. @@ -15993,7 +15828,7 @@ Add xrefs for symbols in `pp's output between FROM and TO. (define-obsolete-function-alias 'help-xref-interned 'describe-symbol "25.1") (autoload 'help-bookmark-jump "help-mode" "\ -Jump to help-mode bookmark BOOKMARK. +Jump to `help-mode' bookmark BOOKMARK. Handler function for record returned by `help-bookmark-make-record'. BOOKMARK is a bookmark name or a bookmark record. @@ -17029,7 +16864,7 @@ If optional arg OTHER-WINDOW is non-nil, then use another window. \(fn &optional OTHER-WINDOW)" t nil) -(register-definition-prefixes "ibuffer" '("filename" "ibuffer-" "locked" "mark" "mod" "name" "process" "read-only" "size")) +(register-definition-prefixes "ibuffer" '("filename" "ibuffer-" "locked" "mark" "mod" "name" "process" "read-only" "recency" "size")) ;;;*** @@ -18192,7 +18027,7 @@ element should come before the second. The arguments are cons cells; (custom-autoload 'imenu-sort-function "imenu" t) -(defvar imenu-generic-expression nil "\ +(defvar-local imenu-generic-expression nil "\ List of definition matchers for creating an Imenu index. Each element of this list should have the form @@ -18228,9 +18063,7 @@ characters which normally have \"symbol\" syntax are considered to have \"word\" syntax during matching.") (put 'imenu-generic-expression 'risky-local-variable t) -(make-variable-buffer-local 'imenu-generic-expression) - -(defvar imenu-create-index-function 'imenu-default-create-index-function "\ +(defvar-local imenu-create-index-function 'imenu-default-create-index-function "\ The function to use for creating an index alist of the current buffer. It should be a function that takes no arguments and returns @@ -18239,9 +18072,7 @@ called within a `save-excursion'. See `imenu--index-alist' for the format of the buffer index alist.") -(make-variable-buffer-local 'imenu-create-index-function) - -(defvar imenu-prev-index-position-function 'beginning-of-defun "\ +(defvar-local imenu-prev-index-position-function 'beginning-of-defun "\ Function for finding the next index position. If `imenu-create-index-function' is set to @@ -18252,18 +18083,14 @@ file. The function should leave point at the place to be connected to the index and it should return nil when it doesn't find another index.") -(make-variable-buffer-local 'imenu-prev-index-position-function) - -(defvar imenu-extract-index-name-function nil "\ +(defvar-local imenu-extract-index-name-function nil "\ Function for extracting the index item name, given a position. This function is called after `imenu-prev-index-position-function' finds a position for an index item, with point at that position. It should return the name for that index item.") -(make-variable-buffer-local 'imenu-extract-index-name-function) - -(defvar imenu-name-lookup-function nil "\ +(defvar-local imenu-name-lookup-function nil "\ Function to compare string with index item. This function will be called with two strings, and should return @@ -18274,18 +18101,28 @@ Set this to some other function for more advanced comparisons, such as \"begins with\" or \"name matches and number of arguments match\".") -(make-variable-buffer-local 'imenu-name-lookup-function) - -(defvar imenu-default-goto-function 'imenu-default-goto-function "\ +(defvar-local imenu-default-goto-function 'imenu-default-goto-function "\ The default function called when selecting an Imenu item. The function in this variable is called when selecting a normal index-item.") - -(make-variable-buffer-local 'imenu-default-goto-function) (put 'imenu--index-alist 'risky-local-variable t) -(make-variable-buffer-local 'imenu-syntax-alist) +(defvar-local imenu-syntax-alist nil "\ +Alist of syntax table modifiers to use while in `imenu--generic-function'. + +The car of the assocs may be either a character or a string and the +cdr is a syntax description appropriate for `modify-syntax-entry'. For +a string, all the characters in the string get the specified syntax. -(make-variable-buffer-local 'imenu-case-fold-search) +This is typically used to give word syntax to characters which +normally have symbol syntax to simplify `imenu-expression' +and speed-up matching.") + +(defvar-local imenu-case-fold-search t "\ +Defines whether `imenu--generic-function' should fold case when matching. + +This variable should be set (only) by initialization code +for modes which use `imenu--generic-function'. If it is not set, but +`font-lock-defaults' is set, then font-lock's setting is used.") (autoload 'imenu-add-to-menubar "imenu" "\ Add an `imenu' entry to the menu bar for the current buffer. @@ -20685,7 +20522,7 @@ to auto-complete your input based on the installed manual pages. (autoload 'man-follow "man" "\ Get a Un*x manual page of the item under point and put it in a buffer. -\(fn MAN-ARGS)" t nil) +\(fn MAN-ARGS)" '(man-common) nil) (autoload 'Man-bookmark-jump "man" "\ Default bookmark handler for Man buffers. @@ -20922,9 +20759,12 @@ which specify the range to operate on. Command to parse command line mailto: links. This is meant to be used for MIME handlers: Setting the handler for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\" -will then start up Emacs ready to compose mail." t nil) +will then start up Emacs ready to compose mail. For emacsclient use + emacsclient -e '(message-mailto \"%u\")' -(register-definition-prefixes "message" '("message-" "nil")) +\(fn &optional URL)" t nil) + +(register-definition-prefixes "message" '("message-")) ;;;*** @@ -22202,7 +22042,8 @@ This affects the implicit sorting of lists of coding systems returned by operations such as `find-coding-systems-region'. \(fn CODING-SYSTEMS &rest BODY)" nil t) -(put 'with-coding-priority 'lisp-indent-function 1) + +(function-put 'with-coding-priority 'lisp-indent-function '1) (autoload 'detect-coding-with-language-environment "mule-util" "\ Detect a coding system for the text between FROM and TO with LANG-ENV. @@ -24585,7 +24426,6 @@ PATTERN matches. PATTERN can take one of the forms: (pred (not FUN)) matches if FUN called on EXPVAL returns nil. (app FUN PAT) matches if FUN called on EXPVAL matches PAT. (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. - (let PAT EXPR) matches if EXPR matches PAT. (and PAT...) matches if all the patterns match. (or PAT...) matches if any of the patterns matches. @@ -24595,7 +24435,7 @@ FUN in `pred' and `app' can take one of the forms: (F ARG1 .. ARGn) call F with ARG1..ARGn and EXPVAL as n+1'th argument -FUN, BOOLEXP, EXPR, and subsequent PAT can refer to variables +FUN, BOOLEXP, and subsequent PAT can refer to variables bound earlier in the pattern by a SYMBOL pattern. Additional patterns can be defined using `pcase-defmacro'. @@ -27428,6 +27268,34 @@ recently executed command not bound to an input event\". \(fn REPEAT-ARG)" t nil) +(defvar repeat-mode nil "\ +Non-nil if Repeat mode is enabled. +See the `repeat-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `repeat-mode'.") + +(custom-autoload 'repeat-mode "repeat" nil) + +(autoload 'repeat-mode "repeat" "\ +Toggle Repeat mode. +When Repeat mode is enabled, and the command symbol has the property named +`repeat-map', this map is activated temporarily for the next command. + +If called interactively, toggle `Repeat mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the +mode if ARG is a negative number. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +\(fn &optional ARG)" t nil) + (register-definition-prefixes "repeat" '("repeat-")) ;;;*** @@ -28269,7 +28137,7 @@ Major mode for editing Ruby code. ;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (0 0 0 0)) ;;; Generated autoloads from ruler-mode.el -(defvar ruler-mode nil "\ +(defvar-local ruler-mode nil "\ Non-nil if Ruler mode is enabled. Use the command `ruler-mode' to change this variable.") @@ -29433,6 +29301,12 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil. \(fn SEQUENCE ELT &optional TESTFN)" nil nil) +(autoload 'seq-intersection "seq" "\ +Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2. +Equality is defined by TESTFN if non-nil or by `equal' if nil. + +\(fn SEQUENCE1 SEQUENCE2 &optional TESTFN)" nil nil) + (autoload 'seq-group-by "seq" "\ Apply FUNCTION to each element of SEQUENCE. Separate the elements of SEQUENCE into an alist using the results as @@ -31785,9 +31659,7 @@ disabled. \(fn &optional ARG)" t nil) -(defvar tab-line-exclude nil) - -(make-variable-buffer-local 'tab-line-exclude) +(defvar-local tab-line-exclude nil) (put 'global-tab-line-mode 'globalized-minor-mode t) @@ -35515,6 +35387,22 @@ first backend that could register the file is used. \(fn &optional VC-FILESET COMMENT)" t nil) +(autoload 'vc-ignore "vc" "\ +Ignore FILE under the VCS of DIRECTORY. + +Normally, FILE is a wildcard specification that matches the files +to be ignored. When REMOVE is non-nil, remove FILE from the list +of ignored files. + +DIRECTORY defaults to `default-directory' and is used to +determine the responsible VC backend. + +When called interactively, prompt for a FILE to ignore, unless a +prefix argument is given, in which case prompt for a file FILE to +remove from the list of ignored files. + +\(fn FILE &optional DIRECTORY REMOVE)" t nil) + (autoload 'vc-version-diff "vc" "\ Report diffs between revisions REV1 and REV2 in the repository history. This compares two revisions of the current fileset. @@ -36139,7 +36027,7 @@ Key bindings: ;;;### (autoloads nil "verilog-mode" "progmodes/verilog-mode.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from progmodes/verilog-mode.el -(push (purecopy '(verilog-mode 2020 6 27 14326051)) package--builtin-versions) +(push (purecopy '(verilog-mode 2021 2 2 263931197)) package--builtin-versions) (autoload 'verilog-mode "verilog-mode" "\ Major mode for editing Verilog code. @@ -36888,13 +36776,11 @@ If nil, make an icon of the frame. If non-nil, delete the frame.") (custom-autoload 'view-remove-frame-by-deleting "view" t) -(defvar view-mode nil "\ +(defvar-local view-mode nil "\ Non-nil if View mode is enabled. Don't change this variable directly, you must change it by one of the functions that enable or disable view mode.") -(make-variable-buffer-local 'view-mode) - (autoload 'kill-buffer-if-not-modified "view" "\ Like `kill-buffer', but does nothing if the buffer is modified. @@ -38476,12 +38362,12 @@ Zone out, completely." t nil) ;;;;;; "cus-face.el" "cus-start.el" "custom.el" "dired-aux.el" "dired-x.el" ;;;;;; "electric.el" "emacs-lisp/backquote.el" "emacs-lisp/byte-run.el" ;;;;;; "emacs-lisp/cl-extra.el" "emacs-lisp/cl-macs.el" "emacs-lisp/cl-preloaded.el" -;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/eieio-compat.el" "emacs-lisp/eieio-custom.el" -;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/float-sup.el" "emacs-lisp/lisp-mode.el" -;;;;;; "emacs-lisp/lisp.el" "emacs-lisp/macroexp.el" "emacs-lisp/map-ynp.el" -;;;;;; "emacs-lisp/nadvice.el" "emacs-lisp/syntax.el" "emacs-lisp/timer.el" -;;;;;; "env.el" "epa-hook.el" "erc/erc-autoaway.el" "erc/erc-button.el" -;;;;;; "erc/erc-capab.el" "erc/erc-dcc.el" "erc/erc-desktop-notifications.el" +;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/easymenu.el" "emacs-lisp/eieio-compat.el" +;;;;;; "emacs-lisp/eieio-custom.el" "emacs-lisp/eieio-opt.el" "emacs-lisp/float-sup.el" +;;;;;; "emacs-lisp/lisp-mode.el" "emacs-lisp/lisp.el" "emacs-lisp/macroexp.el" +;;;;;; "emacs-lisp/map-ynp.el" "emacs-lisp/nadvice.el" "emacs-lisp/syntax.el" +;;;;;; "emacs-lisp/timer.el" "env.el" "epa-hook.el" "erc/erc-autoaway.el" +;;;;;; "erc/erc-button.el" "erc/erc-capab.el" "erc/erc-dcc.el" "erc/erc-desktop-notifications.el" ;;;;;; "erc/erc-ezbounce.el" "erc/erc-fill.el" "erc/erc-identd.el" ;;;;;; "erc/erc-imenu.el" "erc/erc-join.el" "erc/erc-list.el" "erc/erc-log.el" ;;;;;; "erc/erc-match.el" "erc/erc-menu.el" "erc/erc-netsplit.el" diff --git a/lisp/loadup.el b/lisp/loadup.el index 98d4e4fe673..5b39152482e 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -263,6 +263,7 @@ (load "scroll-bar")) (load "select") (load "emacs-lisp/timer") +(load "emacs-lisp/easymenu") (load "isearch") (load "rfn-eshadow") diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index aacb8ab00bb..55825e32fcd 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3162,7 +3162,7 @@ or a symbol, see `completion-pcm--merge-completions'." (let ((n '())) (while p (pcase p - (`(,(or 'any 'any-delim) ,(or 'any 'point) . ,rest) + (`(,(or 'any 'any-delim) ,(or 'any 'point) . ,_) (setq p (cdr p))) ;; This is not just a performance improvement: it turns a ;; terminating `point' into an implicit `any', which affects diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index a9de35c814f..1e7f836d820 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -1144,6 +1144,7 @@ compound type arguments (TYPE VALUE) will be kept as is." EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being part of the event, is called with arguments ARGS (without type information). If the HANDLER returns a `dbus-error', it is propagated as return message." + (declare (completion ignore)) (interactive "e") (condition-case err (let (monitor args result) diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index f61929c9ef8..4f048045d52 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -49,10 +49,6 @@ (require 'cl-lib) -(eval-and-compile - (if (not (fboundp 'make-overlay)) - (require 'overlay))) - (unless (fboundp 'custom-menu-create) (autoload 'custom-menu-create "cus-edit")) @@ -1056,8 +1052,6 @@ queries the server for the existing fields and displays a corresponding form." ;;{{{ Menus and keymaps -(require 'easymenu) - (defconst eudc-custom-generated-menu (cdr (custom-menu-create 'eudc))) (defconst eudc-tail-menu diff --git a/lisp/net/eww.el b/lisp/net/eww.el index c94fa03a071..32fe857e65c 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1595,9 +1595,9 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (goto-char (car elem)) (if (not (eq (cdr elem) input)) (progn - (plist-put input :checked nil) + (plist-put (cdr elem) :checked nil) (eww-update-field eww-form-checkbox-symbol)) - (plist-put input :checked t) + (plist-put (cdr elem) :checked t) (eww-update-field eww-form-checkbox-selected-symbol))))) (forward-char 1))))) diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index f5b47610787..418c1e2e966 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -39,10 +39,10 @@ (require 'iso8601) ;; Silence warnings +(defvar newsticker-groups) (defvar w3-mode-map) (defvar w3m-minor-mode-map) - (defvar newsticker--retrieval-timer-list nil "List of timers for news retrieval. This is an alist, each element consisting of (feed-name . timer).") @@ -66,35 +66,34 @@ considered to be running if the newsticker timer list is not empty." ;; Hard-coding URLs like this is a recipe for propagating obsolete info. (defconst newsticker--raw-url-list-defaults - '( - ("Debian Security Advisories" - "http://www.debian.org/security/dsa.en.rdf") + '(("Debian Security Advisories" + "http://www.debian.org/security/dsa.en.rdf") ("Debian Security Advisories - Long format" - "http://www.debian.org/security/dsa-long.en.rdf") + "http://www.debian.org/security/dsa-long.en.rdf") ("Emacs Wiki" - "https://www.emacswiki.org/emacs?action=rss" - nil - 3600) + "https://www.emacswiki.org/emacs?action=rss" + nil + 3600) ("LWN (Linux Weekly News)" - "https://lwn.net/headlines/rss") + "https://lwn.net/headlines/rss") ("Quote of the day" - "http://feeds.feedburner.com/quotationspage/qotd" - "07:00" - 86400) + "http://feeds.feedburner.com/quotationspage/qotd" + "07:00" + 86400) ("The Register" - "https://www.theregister.co.uk/headlines.rss") + "https://www.theregister.co.uk/headlines.rss") ("slashdot" - "http://rss.slashdot.org/Slashdot/slashdot" - nil - 3600) ;/. will ban you if under 3600 seconds! + "http://rss.slashdot.org/Slashdot/slashdot" + nil + 3600) ;/. will ban you if under 3600 seconds! ("Wired News" - "https://www.wired.com/feed/rss") + "https://www.wired.com/feed/rss") ("Heise News (german)" - "http://www.heise.de/newsticker/heise.rdf") + "http://www.heise.de/newsticker/heise.rdf") ("Tagesschau (german)" - "http://www.tagesschau.de/newsticker.rdf" - nil - 1800)) + "http://www.tagesschau.de/newsticker.rdf" + nil + 1800)) "Default URL list in raw form. This list is fed into defcustom via `newsticker--splicer'.") @@ -153,10 +152,10 @@ value effective." :group 'newsticker) (defcustom newsticker-url-list-defaults - '(("Emacs Wiki" - "https://www.emacswiki.org/emacs?action=rss" - nil - 3600)) + '(("Emacs Wiki" + "https://www.emacswiki.org/emacs?action=rss" + nil + 3600)) "A customizable list of news feeds to select from. These were mostly extracted from the Radio Community Server <http://rcs.userland.com/>. @@ -680,8 +679,8 @@ See `newsticker-get-news'." (condition-case error-data (url-retrieve url 'newsticker--get-news-by-url-callback (list feed-name)) - (error (message "Error retrieving news from %s: %s" feed-name - error-data)))) + (error (message "Error retrieving news from %s: %s" feed-name + error-data)))) (force-mode-line-update)) (defun newsticker--get-news-by-url-callback (status feed-name) @@ -825,7 +824,7 @@ Argument BUFFER is the buffer of the retrieval process." (setq coding-system (intern (downcase (match-string 1)))) (setq coding-system (condition-case nil - (check-coding-system coding-system) + (check-coding-system coding-system) (coding-system-error (message "newsticker.el: ignoring coding system %s for %s" @@ -936,8 +935,8 @@ Argument BUFFER is the buffer of the retrieval process." ;; setup scrollable text (when (= 0 (length newsticker--process-ids)) (when (fboundp 'newsticker--ticker-text-setup) ;silence - ;compiler - ;warnings + ;compiler + ;warnings (newsticker--ticker-text-setup))) (setq newsticker--latest-update-time (current-time)) (when something-was-added @@ -945,8 +944,8 @@ Argument BUFFER is the buffer of the retrieval process." (newsticker--cache-save-feed (newsticker--cache-get-feed name-symbol)) (when (fboundp 'newsticker--buffer-set-uptodate) ;silence - ;compiler - ;warnings + ;compiler + ;warnings (newsticker--buffer-set-uptodate nil))) ;; kill the process buffer if wanted (unless newsticker-debug @@ -1107,8 +1106,8 @@ same as in `newsticker--parse-atom-1.0'." ;; time-fn (lambda (node) (newsticker--decode-rfc822-date - (car (xml-node-children - (car (xml-get-children node 'modified)))))) + (car (xml-node-children + (car (xml-get-children node 'modified)))))) ;; guid-fn (lambda (node) (newsticker--guid-to-string @@ -1679,7 +1678,7 @@ Sat, 07 Sep 2002 00:00:01 GMT (message "Cannot decode \"%s\": %s %s" rfc822-string (car error-data) (cdr error-data)) nil)))) - nil)) + nil)) (defun newsticker--lists-intersect-p (list1 list2) "Return t if LIST1 and LIST2 share elements." @@ -1738,27 +1737,27 @@ Save image as FILENAME in DIRECTORY, download it from URL." (let* ((proc-name (concat feed-name "-" filename)) (buffername (concat " *newsticker-wget-image-" proc-name "*")) (item (or (assoc feed-name newsticker-url-list) - (assoc feed-name newsticker-url-list-defaults) - (error - "Cannot get image for %s: Check newsticker-url-list" - feed-name))) + (assoc feed-name newsticker-url-list-defaults) + (error + "Cannot get image for %s: Check newsticker-url-list" + feed-name))) (wget-arguments (or (car (cdr (cdr (cdr (cdr item))))) newsticker-wget-arguments))) - (with-current-buffer (get-buffer-create buffername) - (erase-buffer) - ;; throw an error if there is an old wget-process around - (if (get-process feed-name) - (error "Another wget-process is running for image %s" - feed-name)) - ;; start wget - (let* ((args (append wget-arguments (list url))) - (proc (apply 'start-process proc-name buffername - newsticker-wget-name args))) - (set-process-coding-system proc 'no-conversion 'no-conversion) - (set-process-sentinel proc 'newsticker--image-sentinel) - (process-put proc 'nt-directory directory) - (process-put proc 'nt-feed-name feed-name) - (process-put proc 'nt-filename filename))))) + (with-current-buffer (get-buffer-create buffername) + (erase-buffer) + ;; throw an error if there is an old wget-process around + (if (get-process feed-name) + (error "Another wget-process is running for image %s" + feed-name)) + ;; start wget + (let* ((args (append wget-arguments (list url))) + (proc (apply 'start-process proc-name buffername + newsticker-wget-name args))) + (set-process-coding-system proc 'no-conversion 'no-conversion) + (set-process-sentinel proc 'newsticker--image-sentinel) + (process-put proc 'nt-directory directory) + (process-put proc 'nt-feed-name feed-name) + (process-put proc 'nt-filename filename))))) (defun newsticker--image-sentinel (process _event) "Sentinel for image-retrieving PROCESS caused by EVENT." @@ -1783,18 +1782,18 @@ Save image as FILENAME in DIRECTORY, download it from URL." "Save contents of BUFFER in DIRECTORY as FILE-NAME. Finally kill buffer." (with-current-buffer buffer - (let ((image-name (concat directory file-name))) - (set-buffer-file-coding-system 'no-conversion) - ;; make sure the cache dir exists - (unless (file-directory-p directory) - (make-directory directory)) - ;; write and close buffer - (let ((require-final-newline nil) - (backup-inhibited t) - (coding-system-for-write 'no-conversion)) - (write-region nil nil image-name nil 'quiet)) - (set-buffer-modified-p nil) - (kill-buffer buffer)))) + (let ((image-name (concat directory file-name))) + (set-buffer-file-coding-system 'no-conversion) + ;; make sure the cache dir exists + (unless (file-directory-p directory) + (make-directory directory)) + ;; write and close buffer + (let ((require-final-newline nil) + (backup-inhibited t) + (coding-system-for-write 'no-conversion)) + (write-region nil nil image-name nil 'quiet)) + (set-buffer-modified-p nil) + (kill-buffer buffer)))) (defun newsticker--image-remove (directory file-name) "In DIRECTORY remove FILE-NAME." @@ -1809,8 +1808,8 @@ Save image as FILENAME in DIRECTORY, download it from URL." (condition-case error-data (url-retrieve url 'newsticker--image-download-by-url-callback (list feed-name directory filename)) - (error (message "Error retrieving image from %s: %s" feed-name - error-data)))) + (error (message "Error retrieving image from %s: %s" feed-name + error-data)))) (force-mode-line-update)) (defun newsticker--image-download-by-url-callback (status feed-name directory filename) @@ -2147,11 +2146,11 @@ FEED is a symbol!" (concat newsticker-dir "/feeds")) (defun newsticker--cache-save () - "Save cache data for all feeds." - (unless (file-directory-p newsticker-dir) - (make-directory newsticker-dir t)) - (mapc 'newsticker--cache-save-feed newsticker--cache) - nil) + "Save cache data for all feeds." + (unless (file-directory-p newsticker-dir) + (make-directory newsticker-dir t)) + (mapc 'newsticker--cache-save-feed newsticker--cache) + nil) (defun newsticker--cache-save-feed (feed) "Save cache data for FEED." @@ -2217,7 +2216,7 @@ If AGES is nil, the total number of items is returned." (if (memq (newsticker--age (car items)) ages) (setq num (1+ num))) (if (memq (newsticker--age (car items)) '(new old immortal obsolete)) - (setq num (1+ num)))) + (setq num (1+ num)))) (setq items (cdr items))) num)) @@ -2237,39 +2236,66 @@ If AGE is nil, the total number of items is returned." (defun newsticker-opml-export () "OPML subscription export. Export subscriptions to a buffer in OPML Format." - ;; FIXME: use newsticker-groups (interactive) (with-current-buffer (get-buffer-create "*OPML Export*") + (erase-buffer) (set-buffer-file-coding-system 'utf-8) (insert (concat "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n" "<!-- OPML generated by Emacs newsticker.el -->\n" "<opml version=\"1.0\">\n" " <head>\n" - " <title>mySubscriptions</title>\n" + " <title>Emacs newsticker subscriptions</title>\n" " <dateCreated>" (format-time-string "%a, %d %b %Y %T %z") "</dateCreated>\n" " <ownerEmail>" user-mail-address "</ownerEmail>\n" " <ownerName>" (user-full-name) "</ownerName>\n" " </head>\n" " <body>\n")) - (dolist (sub (append newsticker-url-list newsticker-url-list-defaults)) - (insert " <outline text=\"") - (insert (newsticker--title sub)) - (insert "\" xmlUrl=\"") - (insert (xml-escape-string (let ((url (cadr sub))) - (if (stringp url) url (prin1-to-string url))))) - (insert "\"/>\n")) - (insert " </body>\n</opml>\n")) + (let ((feeds (append newsticker-url-list newsticker-url-list-defaults)) + ;; insert the feed groups and all feeds that are contained + (saved-feed-names (newsticker--opml-insert-elt newsticker-groups 2))) + ;; to be safe: insert all feeds that are not contained in any group + (dolist (f feeds) + (unless (seq-find (lambda (sfn) (string= (car f) sfn)) saved-feed-names) + (newsticker--opml-insert-feed (car f) 4))) + (insert " </body>\n</opml>\n"))) (pop-to-buffer "*OPML Export*") (when (fboundp 'sgml-mode) (sgml-mode))) +(defun newsticker--opml-insert-elt (elt depth) + "Insert an OPML ELT with indentation level DEPTH." + (if (listp elt) + (newsticker--opml-insert-group elt (+ 2 depth)) + (newsticker--opml-insert-feed elt (+ 2 depth)))) + +(defun newsticker--opml-insert-group (group depth) + "Insert an OPML GROUP with indentation level DEPTH." + (let (saved-feeds) + (insert (make-string depth ? ) "<outline type=\"folder\" text=\"" (car group) "\">\n") + (setq saved-feeds (mapcar (lambda (e) + (newsticker--opml-insert-elt e depth)) + (cdr group))) + (insert (make-string depth ? ) "</outline>\n") + (flatten-tree saved-feeds))) + +(defun newsticker--opml-insert-feed (feed-name depth) + "Insert an OPML FEED-NAME with indentation level DEPTH." + (let* ((feed-definition (seq-find (lambda (f) + (string= feed-name (car f))) + (append newsticker-url-list newsticker-url-list-defaults))) + (url (nth 1 feed-definition)) + (url-string (if (functionp url) (prin1-to-string url) + (xml-escape-string url)))) + (insert (make-string depth ? ) "<outline text=\"" feed-name + "\" xmlUrl=\"" url-string + "\"/>\n")) + feed-name) + (defun newsticker--opml-import-outlines (outlines) - "Recursively import OUTLINES from OPML data. -Note that nested outlines are currently flattened -- i.e. grouping is -removed." - (mapc (lambda (outline) + "Recursively import OUTLINES from OPML data." + (mapcar (lambda (outline) (let ((name (xml-get-attribute outline 'text)) (url (xml-get-attribute outline 'xmlUrl)) (children (xml-get-children outline 'outline))) @@ -2277,18 +2303,27 @@ removed." (add-to-list 'newsticker-url-list (list name url nil nil nil) t)) (if children - (newsticker--opml-import-outlines children)))) - outlines)) + (append (list name) + (newsticker--opml-import-outlines children)) + name))) + outlines)) (defun newsticker-opml-import (filename) - "Import OPML data from FILENAME." + "Import OPML data from FILENAME. +Feeds are added to `newsticker-url-list' and `newsticker-groups' +preserving the outline structure." (interactive "fOPML file: ") (set-buffer (find-file-noselect filename)) (goto-char (point-min)) (let* ((node-list (xml-parse-region (point-min) (point-max))) + (title (car (xml-node-children + (car (xml-get-children + (car (xml-get-children (car node-list) 'head)) + 'title))))) (body (car (xml-get-children (car node-list) 'body))) - (outlines (xml-get-children body 'outline))) - (newsticker--opml-import-outlines outlines)) + (outlines (xml-get-children body 'outline)) + (imported-groups-data (newsticker--opml-import-outlines outlines))) + (add-to-list 'newsticker-groups (cons title imported-groups-data) t)) (customize-variable 'newsticker-url-list)) ;; ====================================================================== diff --git a/lisp/net/puny.el b/lisp/net/puny.el index 6b3663a5fb2..1cdefc08f02 100644 --- a/lisp/net/puny.el +++ b/lisp/net/puny.el @@ -75,7 +75,7 @@ For instance \"xn--bcher-kva\" => \"bücher\"." (defconst puny-damp 700) (defconst puny-tmin 1) (defconst puny-tmax 26) -(defconst puny-skew 28) +(defconst puny-skew 38) ;; 0-25 a-z ;; 26-36 0-9 diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 58cc8b1be55..c80cd49c006 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -329,7 +329,8 @@ Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT." :type 'hook) (defvar rcirc-authenticated-hook nil - "Hook run after successfully authenticated.") + "Hook run after successfully authenticated. +Functions in this hook are called with a single argument PROCESS.") (defcustom rcirc-always-use-server-buffer-flag nil "Non-nil means messages without a channel target will go to the server buffer." diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index f0bbe31cea0..2aacf266f2b 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -144,11 +144,18 @@ When called interactively, a Tramp connection has to be selected." ;;;###tramp-autoload (defun tramp-cleanup-this-connection () "Flush all connection related objects of the current buffer's connection." + ;; (declare (completion tramp-command-completion-p))) (interactive) (and (tramp-tramp-file-p default-directory) (tramp-cleanup-connection (tramp-dissect-file-name default-directory 'noexpand)))) +;; Starting with Emacs 28.1, this can be replaced by the "(declare ...)" form. +;;;###tramp-autoload +(function-put + #'tramp-cleanup-this-connection 'completion-predicate + #'tramp-command-completion-p) + ;;;###tramp-autoload (defvar tramp-cleanup-all-connections-hook nil "List of functions to be called after all Tramp connections are cleaned up.") @@ -431,6 +438,7 @@ Interactively, TARGET is selected from `tramp-default-rename-alist' without confirmation if the prefix argument is non-nil. For details, see `tramp-rename-files'." + ;; (declare (completion tramp-command-completion-p)) (interactive (let ((source default-directory) target @@ -461,6 +469,11 @@ For details, see `tramp-rename-files'." (tramp-rename-files default-directory target)) +;; Starting with Emacs 28.1, this can be replaced by the "(declare ...)" form. +;;;###tramp-autoload +(function-put + #'tramp-rename-these-files 'completion-predicate #'tramp-command-completion-p) + ;; Tramp version is useful in a number of situations. ;;;###tramp-autoload diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e99e43938f2..14d5f8c3b6b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2591,6 +2591,14 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'." ;;; File name handler functions for completion mode: +;; This function takes action since Emacs 28.1, when +;; `read-extended-command-predicate' is set to +;; `command-completion-default-include-p'. +(defun tramp-command-completion-p (_symbol buffer) + "A predicate for Tramp interactive commands. +They are completed by \"M-x TAB\" only if the current buffer is remote." + (with-current-buffer buffer (tramp-tramp-file-p default-directory))) + (defun tramp-connectable-p (vec-or-filename) "Check, whether it is possible to connect the remote host w/o side-effects. This is true, if either the remote host is already connected, or if we are diff --git a/lisp/cedet/inversion.el b/lisp/obsolete/inversion.el index 2ef7e0df961..f192d888681 100644 --- a/lisp/cedet/inversion.el +++ b/lisp/obsolete/inversion.el @@ -5,6 +5,7 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 1.3 ;; Keywords: OO, lisp +;; Obsolete-since: 28.1 ;; This file is part of GNU Emacs. @@ -524,31 +525,6 @@ The package should have VERSION available for download." (copy-file (cdr (car files)) dest)))))) -;;; How we upgrade packages in Emacs has yet to be ironed out. - -;; (defun inversion-upgrade-package (package &optional directory) -;; "Try to upgrade PACKAGE in DIRECTORY is available." -;; (interactive "sPackage to upgrade: ") -;; (if (stringp package) (setq package (intern package))) -;; (if (not directory) -;; ;; Hope that the package maintainer specified. -;; (setq directory (symbol-value (or (intern-soft -;; (concat (symbol-name package) -;; "-url")) -;; (intern-soft -;; (concat (symbol-name package) -;; "-directory")))))) -;; (let ((files (inversion-locate-package-files-and-split -;; package directory)) -;; (cver (inversion-package-version package)) -;; (newer nil)) -;; (mapc (lambda (f) -;; (if (inversion-< cver (inversion-decode-version (car f))) -;; (setq newer (cons f newer)))) -;; files) -;; newer -;; )) - (provide 'inversion) ;;; inversion.el ends here diff --git a/lisp/org/org.el b/lisp/org/org.el index e6a5cca9391..41898dc2028 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -4757,8 +4757,8 @@ This is for getting out of special buffers like capture.") ;; Other stuff we need. (require 'time-date) (unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) -(require 'easymenu) -(require 'overlay) +(when (< emacs-major-version 28) ; preloaded in Emacs 28 + (require 'easymenu)) (require 'org-entities) (require 'org-faces) diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el index cf080549a6a..6e8d0d62141 100644 --- a/lisp/org/ox-texinfo.el +++ b/lisp/org/ox-texinfo.el @@ -1627,6 +1627,22 @@ Return output file's name." (org-export-to-file 'texinfo outfile async subtreep visible-only body-only ext-plist))) +(defun org-texinfo-export-to-texinfo-batch () + "Export Org file INFILE to Texinfo file OUTFILE, in batch mode. +Overwrites existing output file. +Usage: emacs -batch -f org-texinfo-export-to-texinfo-batch INFILE OUTFILE" + (or noninteractive (user-error "Batch mode use only")) + (let ((infile (pop command-line-args-left)) + (outfile (pop command-line-args-left)) + (org-export-coding-system org-texinfo-coding-system) + (make-backup-files nil)) + (unless (file-readable-p infile) + (message "File `%s' not readable" infile) + (kill-emacs 1)) + (with-temp-buffer + (insert-file-contents infile) + (org-export-to-file 'texinfo outfile)))) + ;;;###autoload (defun org-texinfo-export-to-info (&optional async subtreep visible-only body-only ext-plist) diff --git a/lisp/outline.el b/lisp/outline.el index 57909b307b8..640c0e06b9e 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -175,23 +175,42 @@ in the file it applies to.") outline-mode-menu-bar-map)))))) map)) +(defvar outline-mode-cycle-map + (let ((map (make-sparse-keymap))) + (let ((tab-binding `(menu-item + "" outline-cycle + ;; Only takes effect if point is on a heading. + :filter ,(lambda (cmd) + (when (outline-on-heading-p) cmd))))) + (define-key map [tab] tab-binding) + (define-key map (kbd "TAB") tab-binding) + (define-key map (kbd "<backtab>") #'outline-cycle-buffer)) + map) + "Keymap used by `outline-mode-map' and `outline-cycle-minor-mode'.") + (defvar outline-mode-map (let ((map (make-sparse-keymap))) + (set-keymap-parent map outline-mode-cycle-map) (define-key map "\C-c" outline-mode-prefix-map) (define-key map [menu-bar] outline-mode-menu-bar-map) - ;; Only takes effect if point is on a heading. - (define-key map (kbd "TAB") - `(menu-item "" outline-cycle - :filter ,(lambda (cmd) - (when (outline-on-heading-p) cmd)))) - (define-key map (kbd "<backtab>") #'outline-cycle-buffer) map)) (defvar outline-font-lock-keywords '( ;; Highlight headings according to the level. (eval . (list (concat "^\\(?:" outline-regexp "\\).+") - 0 '(outline-font-lock-face) nil t))) + 0 '(if outline-minor-mode-cycle + (if outline-minor-mode-highlight + (list 'face (outline-font-lock-face) + 'keymap outline-mode-cycle-map) + (list 'face nil + 'keymap outline-mode-cycle-map)) + (outline-font-lock-face)) + nil + (if (or outline-minor-mode-cycle + outline-minor-mode-highlight) + 'append + t)))) "Additional expressions to highlight in Outline mode.") (defface outline-1 @@ -305,6 +324,35 @@ After that, changing the prefix key requires manipulating keymaps." (define-key outline-minor-mode-map val outline-mode-prefix-map) (set-default sym val))) +(defvar outline-minor-mode-cycle nil + "Enable cycling of headings in `outline-minor-mode'. +When point is on a heading line, then typing `TAB' cycles between `hide all', +`headings only' and `show all' (`outline-cycle'). Typing `S-TAB' on +a heading line cycles the whole buffer (`outline-cycle-buffer'). +Typing these keys anywhere outside heading lines uses their default bindings.") +;;;###autoload(put 'outline-minor-mode-cycle 'safe-local-variable 'booleanp) + +(defvar outline-minor-mode-highlight nil + "Highlight headings in `outline-minor-mode' using font-lock keywords. +Non-nil value works well only when outline font-lock keywords +don't conflict with the major mode's font-lock keywords.") +;;;###autoload(put 'outline-minor-mode-highlight 'safe-local-variable 'booleanp) + +(defun outline-minor-mode-highlight-buffer () + ;; Fallback to overlays when font-lock is unsupported. + (save-excursion + (goto-char (point-min)) + (let ((regexp (concat "^\\(?:" outline-regexp "\\).*$"))) + (while (re-search-forward regexp nil t) + (let ((overlay (make-overlay (match-beginning 0) + (match-end 0)))) + (overlay-put overlay 'outline-overlay t) + (when outline-minor-mode-highlight + (overlay-put overlay 'face (outline-font-lock-face))) + (when outline-minor-mode-cycle + (overlay-put overlay 'keymap outline-mode-cycle-map))) + (goto-char (match-end 0)))))) + ;;;###autoload (define-minor-mode outline-minor-mode "Toggle Outline minor mode. @@ -314,6 +362,12 @@ See the command `outline-mode' for more information on this mode." (cons outline-minor-mode-prefix outline-mode-prefix-map)) (if outline-minor-mode (progn + (when (or outline-minor-mode-cycle outline-minor-mode-highlight) + (if (and global-font-lock-mode (font-lock-specified-p major-mode)) + (progn + (font-lock-add-keywords nil outline-font-lock-keywords t) + (font-lock-flush)) + (outline-minor-mode-highlight-buffer))) ;; Turn off this mode if we change major modes. (add-hook 'change-major-mode-hook (lambda () (outline-minor-mode -1)) @@ -321,12 +375,43 @@ See the command `outline-mode' for more information on this mode." (setq-local line-move-ignore-invisible t) ;; Cause use of ellipses for invisible text. (add-to-invisibility-spec '(outline . t))) + (when (or outline-minor-mode-cycle outline-minor-mode-highlight) + (if font-lock-fontified + (font-lock-remove-keywords nil outline-font-lock-keywords)) + (remove-overlays nil nil 'outline-overlay t) + (font-lock-flush)) (setq line-move-ignore-invisible nil) ;; Cause use of ellipses for invisible text. (remove-from-invisibility-spec '(outline . t)) ;; When turning off outline mode, get rid of any outline hiding. (outline-show-all))) +;;;###autoload +(define-minor-mode outline-cycle-minor-mode + "Toggle Outline-Cycle minor mode. +Set the buffer-local variable `outline-minor-mode-cycle' to t +and enable `outline-minor-mode'." + nil nil nil + (if outline-cycle-minor-mode + (progn + (setq-local outline-minor-mode-cycle t) + (outline-minor-mode +1)) + (outline-minor-mode -1) + (kill-local-variable 'outline-minor-mode-cycle))) + +;;;###autoload +(define-minor-mode outline-cycle-highlight-minor-mode + "Toggle Outline-Cycle-Highlight minor mode. +Set the buffer-local variable `outline-minor-mode-highlight' to t +and enable `outline-cycle-minor-mode'." + nil nil nil + (if outline-cycle-highlight-minor-mode + (progn + (setq-local outline-minor-mode-highlight t) + (outline-cycle-minor-mode +1)) + (outline-cycle-minor-mode -1) + (kill-local-variable 'outline-minor-mode-highlight))) + (defvar-local outline-heading-alist () "Alist associating a heading for every possible level. Each entry is of the form (HEADING . LEVEL). diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index 3cc5d9c8dce..cc058230751 100644 --- a/lisp/play/handwrite.el +++ b/lisp/play/handwrite.el @@ -90,6 +90,7 @@ (define-key map [handwrite] '("Write by hand" . handwrite)) map)) (fset 'menu-bar-handwrite-map menu-bar-handwrite-map) +(make-obsolete 'menu-bar-handwrite-map nil "28.1") (make-obsolete-variable 'menu-bar-handwrite-map nil "28.1") ;; User definable variables diff --git a/lisp/printing.el b/lisp/printing.el index 2f234b7b052..f6b9494e177 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1014,7 +1014,6 @@ Please send all bug fixes and enhancements to (require 'lpr) (require 'ps-print) -(require 'easymenu) (and (string< ps-print-version "6.6.4") (error "`printing' requires `ps-print' package version 6.6.4 or later")) diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index d569bf898c9..8a1d441773a 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -84,7 +84,8 @@ (eval-when-compile (require 'cl-lib)) -(require 'easymenu) +(when (< emacs-major-version 28) ; preloaded in Emacs 28 + (require 'easymenu)) (require 'cc-mode) ;; More compile-time-macros diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index d14ef1744af..51d51deef71 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -274,8 +274,10 @@ statement-block-intro, statement-case-intro, arglist-intro." (save-excursion (beginning-of-line) (backward-up-list 1) + (forward-char) (skip-chars-forward " \t" (c-point 'eol)) - (vector (1+ (current-column))))) + (if (eolp) (skip-chars-backward " \t")) + (vector (current-column)))) (defun c-lineup-arglist-close-under-paren (langelem) "Line up a line under the enclosing open paren. @@ -1145,7 +1147,8 @@ Works with brace-list-intro." ; the line. (save-excursion ; "{" earlier on the line (goto-char (c-langelem-pos - (assq 'brace-list-intro c-syntactic-context))) + (assq 'brace-list-entry + c-syntactic-context))) (and (eq (c-backward-token-2 1 nil diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 33a03602070..1754436d132 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1639,7 +1639,7 @@ No indentation or other \"electric\" behavior is performed." ;; ;; This function might do hidden buffer changes. (save-excursion - (let* (kluge-start + (let* (knr-start knr-res decl-result brace-decl-p (start (point)) (paren-state (c-parse-state)) @@ -1670,63 +1670,39 @@ No indentation or other \"electric\" behavior is performed." (not (looking-at c-defun-type-name-decl-key)))))) 'at-function-end) (t - ;; Find the start of the current declaration. NOTE: If we're in the - ;; variables after a "struct/eval" type block, we don't get to the - ;; real declaration here - we detect and correct for this later. - - ;;If we're in the parameters' parens, move back out of them. - (if least-enclosing (goto-char least-enclosing)) - ;; Kluge so that c-beginning-of-decl-1 won't go back if we're already - ;; at a declaration. - (if (or (and (eolp) (not (eobp))) ; EOL is matched by "\\s>" - (not (looking-at -"\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\|\\s!\\)"))) - (forward-char)) - (setq kluge-start (point)) - ;; First approximation as to whether the current "header" we're in is - ;; one followed by braces. - (setq brace-decl-p - (save-excursion - (and (c-syntactic-re-search-forward "[;{]" nil t t) - (or (eq (char-before) ?\{) - (and c-recognize-knr-p - ;; Might have stopped on the - ;; ';' in a K&R argdecl. In - ;; that case the declaration - ;; should contain a block. - (c-in-knr-argdecl)))))) - (setq decl-result - (car (c-beginning-of-decl-1 - ;; NOTE: If we're in a K&R region, this might be the start - ;; of a parameter declaration, not the actual function. - ;; It might also leave us at a label or "label" like - ;; "private:". - (and least-enclosing ; LIMIT for c-b-of-decl-1 - (c-safe-position least-enclosing paren-state))))) - - ;; Has the declaration we've gone back to got braces? - (if (or (eq decl-result 'label) - (looking-at c-protection-key)) - (setq brace-decl-p nil)) - - (cond - ((or (eq decl-result 'label) ; e.g. "private:" or invalid syntax. - (= (point) kluge-start)) ; might be BOB or unbalanced parens. - 'outwith-function) - ((eq decl-result 'same) - (if brace-decl-p - (if (eq (point) start) - 'at-header + (if (and least-enclosing + (eq (char-after least-enclosing) ?\()) + (c-go-list-forward least-enclosing)) + (c-forward-syntactic-ws) + (setq knr-start (point)) + (if (c-syntactic-re-search-forward "{" nil t t) + (progn + (backward-char) + (cond + ((or (progn + (c-backward-syntactic-ws) + (<= (point) start)) + (and c-recognize-knr-p + (and (setq knr-res (c-in-knr-argdecl)) + (<= knr-res knr-start)))) 'in-header) - 'outwith-function)) - ((eq decl-result 'previous) - (if (and (not brace-decl-p) - (c-in-function-trailer-p)) - 'at-function-end - 'outwith-function)) - (t (error - "c-where-wrt-brace-construct: c-beginning-of-decl-1 returned %s" - decl-result)))))))) + ((and knr-res + (goto-char knr-res) + (c-backward-syntactic-ws))) ; Always returns nil. + ((and (eq (char-before) ?\)) + (c-go-list-backward)) + (c-syntactic-skip-backward "^;" start t) + (if (eq (point) start) + (if (progn (c-backward-syntactic-ws) + (memq (char-before) '(?\; ?} nil))) + (if (progn (c-forward-syntactic-ws) + (eq (point) start)) + 'at-header + 'outwith-function) + 'in-header) + 'outwith-function)) + (t 'outwith-function))) + 'outwith-function)))))) (defun c-backward-to-nth-BOF-{ (n where) ;; Skip to the opening brace of the Nth function before point. If @@ -1749,9 +1725,11 @@ No indentation or other \"electric\" behavior is performed." (goto-char (c-least-enclosing-brace (c-parse-state))) (setq n (1- n))) ((eq where 'in-header) - (c-syntactic-re-search-forward "{") - (backward-char) - (setq n (1- n))) + (let ((encl-paren (c-least-enclosing-brace (c-parse-state)))) + (if encl-paren (goto-char encl-paren)) + (c-syntactic-re-search-forward "{" nil t t) + (backward-char) + (setq n (1- n)))) ((memq where '(at-header outwith-function at-function-end in-trailer)) (c-syntactic-skip-backward "^}") (when (eq (char-before) ?\}) @@ -1965,21 +1943,24 @@ defun." ;; The actual movement is done below. (setq n (1- n))) ((memq where '(at-function-end outwith-function at-header in-header)) - (when (c-syntactic-re-search-forward "{" nil 'eob) + (if (eq where 'in-header) + (let ((pos (c-least-enclosing-brace (c-parse-state)))) + (if pos (c-go-list-forward pos)))) + (when (c-syntactic-re-search-forward "{" nil 'eob t) (backward-char) (forward-sexp) (setq n (1- n)))) (t (error "c-forward-to-nth-EOF-\\;-or-}: `where' is %s" where))) - (when (c-in-function-trailer-p) - (c-syntactic-re-search-forward ";" nil 'eob t)) - ;; Each time round the loop, go forward to a "}" at the outermost level. (while (and (> n 0) (not (eobp))) (when (c-syntactic-re-search-forward "{" nil 'eob) (backward-char) (forward-sexp) (setq n (1- n)))) + + (when (c-in-function-trailer-p) + (c-syntactic-re-search-forward ";" nil 'eob t)) n) (defun c-end-of-defun (&optional arg) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 4cf7af843b7..b7ad02cf0cd 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1184,6 +1184,15 @@ comment at the start of cc-engine.el for more info." ;; suitable error. (setq pre-stmt-found t) (throw 'loop nil)) + ;; Handle C++'s `constexpr', etc. + (if (save-excursion + (and (looking-at c-block-stmt-hangon-key) + (progn + (c-backward-syntactic-ws lim) + (c-safe (c-backward-sexp) t)) + (looking-at c-block-stmt-2-key) + (setq pos (point)))) + (goto-char pos)) (cond ;; Have we moved into a macro? ((and (not macro-start) @@ -3784,12 +3793,14 @@ mhtml-mode." (point))) (bra ; Position of "{". ;; Don't start scanning in the middle of a CPP construct unless - ;; it contains HERE - these constructs, in Emacs, are "commented - ;; out" with category properties. - (if (eq (c-get-char-property macro-start-or-from 'category) - 'c-cpp-delimiter) - macro-start-or-from - from)) + ;; it contains HERE. + (if (and (not (eq macro-start-or-from from)) + (< macro-start-or-from here) ; Might not be needed. + (progn (goto-char macro-start-or-from) + (c-end-of-macro) + (>= (point) here))) + from + macro-start-or-from)) ce) ; Position of "}" (or upper-lim (setq upper-lim from)) @@ -11410,7 +11421,9 @@ comment at the start of cc-engine.el for more info." ;; also might be part of a declarator expression. Currently ;; there's no such language. (not (or (looking-at c-symbol-start) - (looking-at c-type-decl-prefix-key)))))) + (looking-at c-type-decl-prefix-key) + (and (eq (char-after) ?{) + (not (c-looking-at-statement-block)))))))) ;; In Pike a list of modifiers may be followed by a brace ;; to make them apply to many identifiers. Note that the @@ -11817,15 +11830,17 @@ comment at the start of cc-engine.el for more info." ;; POINT, or nil if there is no such position, or we do not know it. LIM is ;; a backward search limit. ;; - ;; The determination of whether the brace starts a brace list is solely by - ;; the context of the brace, not by its contents. + ;; The determination of whether the brace starts a brace list is mainly by + ;; the context of the brace, not by its contents. In exceptional + ;; circumstances (e.g. "struct A {" in C++ Mode), the contents are examined, + ;; too. ;; ;; Here, "brace list" does not include the body of an enum. (save-excursion (let ((start (point)) (braceassignp 'dontknow) inexpr-brace-list bufpos macro-start res pos after-type-id-pos - in-paren parens-before-brace + pos2 in-paren parens-before-brace paren-state paren-pos) (setq res (c-backward-token-2 1 t lim)) @@ -11841,12 +11856,16 @@ comment at the start of cc-engine.el for more info." (goto-char paren-pos) (setq braceassignp 'c++-noassign in-paren 'in-paren)) - ((looking-at c-pre-id-bracelist-key) + ((looking-at c-pre-brace-non-bracelist-key) (setq braceassignp nil)) ((looking-at c-return-key)) ((and (looking-at c-symbol-start) (not (looking-at c-keywords-regexp))) - (setq after-type-id-pos (point))) + (if (save-excursion + (and (zerop (c-backward-token-2 1 t lim)) + (looking-at c-pre-id-bracelist-key))) + (setq braceassignp 'c++-noassign) + (setq after-type-id-pos (point)))) ((eq (char-after) ?\() (setq parens-before-brace t) nil) @@ -11860,8 +11879,13 @@ comment at the start of cc-engine.el for more info." (eq (char-after paren-pos) ?\() (setq in-paren 'in-paren) (goto-char paren-pos))) - ((looking-at c-pre-id-bracelist-key)) + ((looking-at c-pre-brace-non-bracelist-key)) ((looking-at c-return-key)) + ((and (looking-at c-symbol-start) + (not (looking-at c-keywords-regexp)) + (save-excursion + (and (zerop (c-backward-token-2 1 t lim)) + (looking-at c-pre-id-bracelist-key))))) (t (setq after-type-id-pos (point)) nil)))) (setq braceassignp 'c++-noassign)) @@ -11946,8 +11970,12 @@ comment at the start of cc-engine.el for more info." (cond (braceassignp ;; We've hit the beginning of the aggregate list. - (c-beginning-of-statement-1 containing-sexp) - (cons (point) (or in-paren inexpr-brace-list))) + (setq pos2 (point)) + (cons + (if (eq (c-beginning-of-statement-1 containing-sexp) 'same) + (point) + pos2) + (or in-paren inexpr-brace-list))) ((and after-type-id-pos (save-excursion (when (eq (char-after) ?\;) @@ -11959,34 +11987,36 @@ comment at the start of cc-engine.el for more info." (c-get-char-property (point) 'syntax-table)) (c-go-list-forward nil after-type-id-pos) (c-forward-syntactic-ws))) - (and - (or (not (looking-at c-class-key)) - (save-excursion - (goto-char (match-end 1)) - (c-forward-syntactic-ws) - (not (eq (point) after-type-id-pos)))) - (progn - (setq res - (c-forward-decl-or-cast-1 - (save-excursion (c-backward-syntactic-ws) (point)) - nil nil)) - (and (consp res) - (cond - ((eq (car res) after-type-id-pos)) - ((> (car res) after-type-id-pos) nil) - (t - (catch 'find-decl - (save-excursion - (goto-char (car res)) - (c-do-declarators - (point-max) t nil nil - (lambda (id-start _id-end _tok _not-top _func _init) - (cond - ((> id-start after-type-id-pos) - (throw 'find-decl nil)) - ((eq id-start after-type-id-pos) - (throw 'find-decl t))))) - nil))))))))) + (if (and (not (eq (point) after-type-id-pos)) + (or (not (looking-at c-class-key)) + (save-excursion + (goto-char (match-end 1)) + (c-forward-syntactic-ws) + (not (eq (point) after-type-id-pos))))) + (progn + (setq res + (c-forward-decl-or-cast-1 (c-point 'bosws) + nil nil)) + (and (consp res) + (cond + ((eq (car res) after-type-id-pos)) + ((> (car res) after-type-id-pos) nil) + (t + (catch 'find-decl + (save-excursion + (goto-char (car res)) + (c-do-declarators + (point-max) t nil nil + (lambda (id-start _id-end _tok _not-top _func _init) + (cond + ((> id-start after-type-id-pos) + (throw 'find-decl nil)) + ((eq id-start after-type-id-pos) + (throw 'find-decl t))))) + nil)))))) + (save-excursion + (goto-char start) + (not (c-looking-at-statement-block)))))) (cons bufpos (or in-paren inexpr-brace-list))) ((or (eq (char-after) ?\;) ;; Brace lists can't contain a semicolon, so we're done. @@ -12136,33 +12166,31 @@ comment at the start of cc-engine.el for more info." (defun c-looking-at-statement-block () ;; Point is at an opening brace. If this is a statement block (i.e. the ;; elements in the block are terminated by semicolons, or the block is - ;; empty, or the block contains a keyword) return non-nil. Otherwise, - ;; return nil. + ;; empty, or the block contains a characteristic keyword, or there is a + ;; nested statement block) return non-nil. Otherwise, return nil. (let ((here (point))) (prog1 (if (c-go-list-forward) (let ((there (point))) (backward-char) - (c-syntactic-skip-backward "^;," here t) + (c-syntactic-skip-backward "^;" here t) (cond - ((eq (char-before) ?\;) t) - ((eq (char-before) ?,) nil) - (t ; We're at (1+ here). - (cond - ((progn (c-forward-syntactic-ws) - (eq (point) (1- there)))) - ((c-syntactic-re-search-forward c-keywords-regexp there t)) - ((c-syntactic-re-search-forward "{" there t t) - (backward-char) - (c-looking-at-statement-block)) - (t nil))))) + ((eq (char-before) ?\;)) + ((progn (c-forward-syntactic-ws) + (eq (point) (1- there)))) + ((c-syntactic-re-search-forward + c-stmt-block-only-keywords-regexp there t)) + ((c-syntactic-re-search-forward "{" there t t) + (backward-char) + (c-looking-at-statement-block)) + (t nil))) (forward-char) (cond - ((c-syntactic-re-search-forward "[;,]" nil t t) - (eq (char-before) ?\;)) + ((c-syntactic-re-search-forward ";" nil t t)) ((progn (c-forward-syntactic-ws) (eobp))) - ((c-syntactic-re-search-forward c-keywords-regexp nil t t)) + ((c-syntactic-re-search-forward c-stmt-block-only-keywords-regexp + nil t t)) ((c-syntactic-re-search-forward "{" nil t t) (backward-char) (c-looking-at-statement-block)) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 1938cc8ff1e..7819617bcf6 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -3099,6 +3099,36 @@ Note that Java specific rules are currently applied to tell this from t (c-make-keywords-re t (c-lang-const c-keywords))) (c-lang-defvar c-keywords-regexp (c-lang-const c-keywords-regexp)) +(c-lang-defconst c-stmt-block-only-keywords + "All keywords which unambiguously signify a statement block (as opposed to + a brace list) when occurring inside braces." + t (c--set-difference + (c-lang-const c-keywords) + (append (c-lang-const c-primary-expr-kwds) + (c-lang-const c-constant-kwds) + `(,@(when (c-major-mode-is 'c++-mode) + '("typeid" "dynamic_cast" "static_cast" "const_cast" + "reinterpret_cast" "alignof"))) + (c-lang-const c-type-modifier-prefix-kwds) + (c-lang-const c-overloadable-operators) + (c-lang-const c-template-typename-kwds) + `(,@(when (c-major-mode-is 'c++-mode) + '("reflexpr"))) + `(,@(when (c-major-mode-is '(c-mode c++-mode)) + '("sizeof"))) + (c-lang-const c-pre-lambda-tokens) + (c-lang-const c-block-decls-with-vars) + (c-lang-const c-primitive-type-kwds)) + :test 'string-equal)) + +(c-lang-defconst c-stmt-block-only-keywords-regexp + ;; A regexp matching a keyword in `c-stmt-block-only-keywords'. Such a + ;; match can start and end only at token boundaries. + t (concat "\\(^\\|\\=\\|[^" (c-lang-const c-symbol-chars) "]\\)" + (c-make-keywords-re t (c-lang-const c-stmt-block-only-keywords)))) +(c-lang-defvar c-stmt-block-only-keywords-regexp + (c-lang-const c-stmt-block-only-keywords-regexp)) + (c-lang-defconst c-keyword-member-alist ;; An alist with all the keywords in the cars. The cdr for each ;; keyword is a list of the symbols for the `*-kwds' lists that @@ -3651,13 +3681,25 @@ list." c t) (c-lang-defvar c-recognize-knr-p (c-lang-const c-recognize-knr-p)) +(c-lang-defconst c-pre-id-bracelist-kwds + "Keywords which, preceding an identifier and brace, signify a bracelist. +This is only used in c++-mode." + t nil + c++ '("new" "throw")) + (c-lang-defconst c-pre-id-bracelist-key - "A regexp matching tokens which, preceding an identifier, signify a bracelist. -" - t regexp-unmatchable - c++ "new\\([^[:alnum:]_$]\\|$\\)\\|&&?\\(\\S.\\|$\\)") + ;; A regexp matching keywords which, preceding an identifier and brace, + ;; signify a bracelist. Only used in c++-mode. + t (c-make-keywords-re t (c-lang-const c-pre-id-bracelist-kwds))) (c-lang-defvar c-pre-id-bracelist-key (c-lang-const c-pre-id-bracelist-key)) +(c-lang-defconst c-pre-brace-non-bracelist-key + "A regexp matching tokens which, preceding a brace, make it a non-bracelist." + t regexp-unmatchable + c++ "&&?\\(\\S.\\|$\\)") +(c-lang-defvar c-pre-brace-non-bracelist-key + (c-lang-const c-pre-brace-non-bracelist-key)) + (c-lang-defconst c-recognize-typeless-decls "Non-nil means function declarations without return type should be recognized. That can introduce an ambiguity with parenthesized macro diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index d040fdda28c..02288ac4071 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -46,140 +46,113 @@ It has `lisp-mode-abbrev-table' as its parent." "Syntax table used in `emacs-lisp-mode'.") (defvar emacs-lisp-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap "Emacs-Lisp")) - (lint-map (make-sparse-keymap)) - (prof-map (make-sparse-keymap)) - (tracing-map (make-sparse-keymap))) + (let ((map (make-sparse-keymap))) (set-keymap-parent map lisp-mode-shared-map) (define-key map "\e\t" 'completion-at-point) (define-key map "\e\C-x" 'eval-defun) (define-key map "\e\C-q" 'indent-pp-sexp) - (bindings--define-key map [menu-bar emacs-lisp] - (cons "Emacs-Lisp" menu-map)) - (bindings--define-key menu-map [eldoc] - '(menu-item "Auto-Display Documentation Strings" eldoc-mode - :button (:toggle . (bound-and-true-p eldoc-mode)) - :help "Display the documentation string for the item under cursor")) - (bindings--define-key menu-map [checkdoc] - '(menu-item "Check Documentation Strings" checkdoc - :help "Check documentation strings for style requirements")) - (bindings--define-key menu-map [re-builder] - '(menu-item "Construct Regexp" re-builder - :help "Construct a regexp interactively")) - (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map)) - (bindings--define-key tracing-map [tr-a] - '(menu-item "Untrace All" untrace-all - :help "Untrace all currently traced functions")) - (bindings--define-key tracing-map [tr-uf] - '(menu-item "Untrace Function..." untrace-function - :help "Untrace function, and possibly activate all remaining advice")) - (bindings--define-key tracing-map [tr-sep] menu-bar-separator) - (bindings--define-key tracing-map [tr-q] - '(menu-item "Trace Function Quietly..." trace-function-background - :help "Trace the function with trace output going quietly to a buffer")) - (bindings--define-key tracing-map [tr-f] - '(menu-item "Trace Function..." trace-function - :help "Trace the function given as an argument")) - (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map)) - (bindings--define-key prof-map [prof-restall] - '(menu-item "Remove Instrumentation for All Functions" elp-restore-all - :help "Restore the original definitions of all functions being profiled")) - (bindings--define-key prof-map [prof-restfunc] - '(menu-item "Remove Instrumentation for Function..." elp-restore-function - :help "Restore an instrumented function to its original definition")) - - (bindings--define-key prof-map [sep-rem] menu-bar-separator) - (bindings--define-key prof-map [prof-resall] - '(menu-item "Reset Counters for All Functions" elp-reset-all - :help "Reset the profiling information for all functions being profiled")) - (bindings--define-key prof-map [prof-resfunc] - '(menu-item "Reset Counters for Function..." elp-reset-function - :help "Reset the profiling information for a function")) - (bindings--define-key prof-map [prof-res] - '(menu-item "Show Profiling Results" elp-results - :help "Display current profiling results")) - (bindings--define-key prof-map [prof-pack] - '(menu-item "Instrument Package..." elp-instrument-package - :help "Instrument for profiling all function that start with a prefix")) - (bindings--define-key prof-map [prof-func] - '(menu-item "Instrument Function..." elp-instrument-function - :help "Instrument a function for profiling")) - ;; Maybe this should be in a separate submenu from the ELP stuff? - (bindings--define-key prof-map [sep-natprof] menu-bar-separator) - (bindings--define-key prof-map [prof-natprof-stop] - '(menu-item "Stop Native Profiler" profiler-stop - :help "Stop recording profiling information" - :enable (and (featurep 'profiler) - (profiler-running-p)))) - (bindings--define-key prof-map [prof-natprof-report] - '(menu-item "Show Profiler Report" profiler-report - :help "Show the current profiler report" - :enable (and (featurep 'profiler) - (profiler-running-p)))) - (bindings--define-key prof-map [prof-natprof-start] - '(menu-item "Start Native Profiler..." profiler-start - :help "Start recording profiling information")) - - (bindings--define-key menu-map [lint] (cons "Linting" lint-map)) - (bindings--define-key lint-map [lint-di] - '(menu-item "Lint Directory..." elint-directory - :help "Lint a directory")) - (bindings--define-key lint-map [lint-f] - '(menu-item "Lint File..." elint-file - :help "Lint a file")) - (bindings--define-key lint-map [lint-b] - '(menu-item "Lint Buffer" elint-current-buffer - :help "Lint the current buffer")) - (bindings--define-key lint-map [lint-d] - '(menu-item "Lint Defun" elint-defun - :help "Lint the function at point")) - (bindings--define-key menu-map [edebug-defun] - '(menu-item "Instrument Function for Debugging" edebug-defun - :help "Evaluate the top level form point is in, stepping through with Edebug" - :keys "C-u C-M-x")) - (bindings--define-key menu-map [separator-byte] menu-bar-separator) - (bindings--define-key menu-map [disas] - '(menu-item "Disassemble Byte Compiled Object..." disassemble - :help "Print disassembled code for OBJECT in a buffer")) - (bindings--define-key menu-map [byte-recompile] - '(menu-item "Byte-recompile Directory..." byte-recompile-directory - :help "Recompile every `.el' file in DIRECTORY that needs recompilation")) - (bindings--define-key menu-map [emacs-byte-compile-and-load] - '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load - :help "Byte-compile the current file (if it has changed), then load compiled code")) - (bindings--define-key menu-map [byte-compile] - '(menu-item "Byte-compile This File" emacs-lisp-byte-compile - :help "Byte compile the file containing the current buffer")) - (bindings--define-key menu-map [separator-eval] menu-bar-separator) - (bindings--define-key menu-map [ielm] - '(menu-item "Interactive Expression Evaluation" ielm - :help "Interactively evaluate Emacs Lisp expressions")) - (bindings--define-key menu-map [eval-buffer] - '(menu-item "Evaluate Buffer" eval-buffer - :help "Execute the current buffer as Lisp code")) - (bindings--define-key menu-map [eval-region] - '(menu-item "Evaluate Region" eval-region - :help "Execute the region as Lisp code" - :enable mark-active)) - (bindings--define-key menu-map [eval-sexp] - '(menu-item "Evaluate Last S-expression" eval-last-sexp - :help "Evaluate sexp before point; print value in echo area")) - (bindings--define-key menu-map [separator-format] menu-bar-separator) - (bindings--define-key menu-map [comment-region] - '(menu-item "Comment Out Region" comment-region - :help "Comment or uncomment each line in the region" - :enable mark-active)) - (bindings--define-key menu-map [indent-region] - '(menu-item "Indent Region" indent-region - :help "Indent each nonblank line in the region" - :enable mark-active)) - (bindings--define-key menu-map [indent-line] - '(menu-item "Indent Line" lisp-indent-line)) map) "Keymap for Emacs Lisp mode. All commands in `lisp-mode-shared-map' are inherited by this map.") +(easy-menu-define emacs-lisp-mode-menu emacs-lisp-mode-map + "Menu for Emacs Lisp mode." + '("Emacs-Lisp" + ["Indent Line" lisp-indent-line] + ["Indent Region" indent-region + :help "Indent each nonblank line in the region" + :active mark-active] + ["Comment Out Region" comment-region + :help "Comment or uncomment each line in the region" + :active mark-active] + "---" + ["Evaluate Last S-expression" eval-last-sexp + :help "Evaluate sexp before point; print value in echo area"] + ["Evaluate Region" eval-region + :help "Execute the region as Lisp code" + :active mark-active] + ["Evaluate Buffer" eval-buffer + :help "Execute the current buffer as Lisp code"] + ["Interactive Expression Evaluation" ielm + :help "Interactively evaluate Emacs Lisp expressions"] + "---" + ["Byte-compile This File" emacs-lisp-byte-compile + :help "Byte compile the file containing the current buffer"] + ["Byte-compile and Load" emacs-lisp-byte-compile-and-load + :help "Byte-compile the current file (if it has changed), then load compiled code"] + ["Byte-recompile Directory..." byte-recompile-directory + :help "Recompile every `.el' file in DIRECTORY that needs recompilation"] + ["Disassemble Byte Compiled Object..." disassemble + :help "Print disassembled code for OBJECT in a buffer"] + "---" + ["Instrument Function for Debugging" edebug-defun + :help "Evaluate the top level form point is in, stepping through with Edebug" + :keys "C-u C-M-x"] + ("Navigation" + ["Forward Sexp" forward-sexp + :help "Go to the next s-expression"] + ["Backward Sexp" backward-sexp + :help "Go to the previous s-expression"] + ["Beginning Of Defun" beginning-of-defun + :help "Go to the start of the current function definition"] + ["Up List" up-list + :help "Go one level up and forward"]) + ("Linting" + ["Lint Defun" elint-defun + :help "Lint the function at point"] + ["Lint Buffer" elint-current-buffer + :help "Lint the current buffer"] + ["Lint File..." elint-file + :help "Lint a file"] + ["Lint Directory..." elint-directory + :help "Lint a directory"]) + ("Profiling" + ;; Maybe this should be in a separate submenu from the ELP stuff? + ["Start Native Profiler..." profiler-start + :help "Start recording profiling information"] + ["Show Profiler Report" profiler-report + :help "Show the current profiler report" + :active (and (featurep 'profiler) + (profiler-running-p))] + ["Stop Native Profiler" profiler-stop + :help "Stop recording profiling information" + :active (and (featurep 'profiler) + (profiler-running-p))] + "---" + ["Instrument Function..." elp-instrument-function + :help "Instrument a function for profiling"] + ["Instrument Package..." elp-instrument-package + :help "Instrument for profiling all function that start with a prefix"] + ["Show Profiling Results" elp-results + :help "Display current profiling results"] + ["Reset Counters for Function..." elp-reset-function + :help "Reset the profiling information for a function"] + ["Reset Counters for All Functions" elp-reset-all + :help "Reset the profiling information for all functions being profiled"] + "---" + ["Remove Instrumentation for All Functions" elp-restore-all + :help "Restore the original definitions of all functions being profiled"] + ["Remove Instrumentation for Function..." elp-restore-function + :help "Restore an instrumented function to its original definition"]) + ("Tracing" + ["Trace Function..." trace-function + :help "Trace the function given as an argument"] + ["Trace Function Quietly..." trace-function-background + :help "Trace the function with trace output going quietly to a buffer"] + "---" + ["Untrace All" untrace-all + :help "Untrace all currently traced functions"] + ["Untrace Function..." untrace-function + :help "Untrace function, and possibly activate all remaining advice"]) + ["Construct Regexp" re-builder + :help "Construct a regexp interactively"] + ["Check Documentation Strings" checkdoc + :help "Check documentation strings for style requirements"] + ["Auto-Display Documentation Strings" eldoc-mode + :help "Display the documentation string for the item under cursor" + :style toggle + :selected (bound-and-true-p eldoc-mode)])) + (defun emacs-lisp-byte-compile () "Byte compile the file containing the current buffer." (interactive nil emacs-lisp-mode) @@ -936,35 +909,31 @@ non-nil result supersedes the xrefs produced by ;;; Elisp Interaction mode (defvar lisp-interaction-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap "Lisp-Interaction"))) + (let ((map (make-sparse-keymap))) (set-keymap-parent map lisp-mode-shared-map) (define-key map "\e\C-x" 'eval-defun) (define-key map "\e\C-q" 'indent-pp-sexp) (define-key map "\e\t" 'completion-at-point) (define-key map "\n" 'eval-print-last-sexp) - (bindings--define-key map [menu-bar lisp-interaction] - (cons "Lisp-Interaction" menu-map)) - (bindings--define-key menu-map [eval-defun] - '(menu-item "Evaluate Defun" eval-defun - :help "Evaluate the top-level form containing point, or after point")) - (bindings--define-key menu-map [eval-print-last-sexp] - '(menu-item "Evaluate and Print" eval-print-last-sexp - :help "Evaluate sexp before point; print value into current buffer")) - (bindings--define-key menu-map [edebug-defun-lisp-interaction] - '(menu-item "Instrument Function for Debugging" edebug-defun - :help "Evaluate the top level form point is in, stepping through with Edebug" - :keys "C-u C-M-x")) - (bindings--define-key menu-map [indent-pp-sexp] - '(menu-item "Indent or Pretty-Print" indent-pp-sexp - :help "Indent each line of the list starting just after point, or prettyprint it")) - (bindings--define-key menu-map [complete-symbol] - '(menu-item "Complete Lisp Symbol" completion-at-point - :help "Perform completion on Lisp symbol preceding point")) map) "Keymap for Lisp Interaction mode. All commands in `lisp-mode-shared-map' are inherited by this map.") +(easy-menu-define lisp-interaction-mode-menu lisp-interaction-mode-map + "Menu for Lisp Interaction mode." + '("Lisp-Interaction" + ["Complete Lisp Symbol" completion-at-point + :help "Perform completion on Lisp symbol preceding point"] + ["Indent or Pretty-Print" indent-pp-sexp + :help "Indent each line of the list starting just after point, or prettyprint it"] + ["Instrument Function for Debugging" edebug-defun + :help "Evaluate the top level form point is in, stepping through with Edebug" + :keys "C-u C-M-x"] + ["Evaluate and Print" eval-print-last-sexp + :help "Evaluate sexp before point; print value into current buffer"] + ["Evaluate Defun" eval-defun + :help "Evaluate the top-level form containing point, or after point"])) + (define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction" "Major mode for typing and evaluating Lisp forms. Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression @@ -1422,6 +1391,7 @@ which see." (interactive "P") (cond (edebug-it (require 'edebug) + (defvar edebug-all-defs) (eval-defun (not edebug-all-defs))) (t (if (null eval-expression-debug-on-error) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index bd308e02203..8481a27775f 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -284,16 +284,17 @@ If set to nil, don't suppress any zero counters." (defmacro flymake-log (level msg &rest args) "Log, at level LEVEL, the message MSG formatted with ARGS. LEVEL is passed to `display-warning', which is used to display -the warning. If this form is included in a byte-compiled file, +the warning. If this form is included in a file, the generated warning contains an indication of the file that generated it." - (let* ((compile-file (macroexp-file-name)) - (sublog (if (and - compile-file - (not load-file-name)) + (let* ((file (if (fboundp 'macroexp-file-name) + (macroexp-file-name) + (and (not load-file-name) + (bound-and-true-p byte-compile-current-file)))) + (sublog (if file (intern (file-name-nondirectory - (file-name-sans-extension compile-file)))))) + (file-name-sans-extension file)))))) `(flymake--log-1 ,level ',sublog ,msg ,@args))) (defun flymake-error (text &rest args) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 3e92c699132..8c9a1b53b1b 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -88,9 +88,9 @@ To make grep highlight matches even into a pipe, you need the option `always' that forces grep to use `--color=always' to unconditionally output escape sequences. -In interactive usage, the actual value of this variable is set up -by `grep-compute-defaults' when the default value is `auto-detect'. -To change the default value, use \\[customize] or call the function +If the value is `auto-detect' (the default), `grep' will call +`grep-compute-defaults' to compute the value. To change the +default value, use \\[customize] or call the function `grep-apply-setting'." :type '(choice (const :tag "Do not highlight matches with grep markers" nil) (const :tag "Highlight matches with grep markers" t) @@ -915,7 +915,10 @@ list is empty)." (if current-prefix-arg default grep-command) 'grep-history (if current-prefix-arg nil default)))))) - + ;; If called non-interactively, also compute the defaults if we + ;; haven't already. + (when (eq grep-highlight-matches 'auto-detect) + (grep-compute-defaults)) (grep--save-buffers) ;; Setting process-setup-function makes exit-message-function work ;; even when async processes aren't supported. diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el index d81fe1c753b..e9a21d4a0cf 100644 --- a/lisp/progmodes/icon.el +++ b/lisp/progmodes/icon.el @@ -1,4 +1,4 @@ -;;; icon.el --- mode for editing Icon code +;;; icon.el --- mode for editing Icon code -*- lexical-binding: t -*- ;; Copyright (C) 1989, 2001-2021 Free Software Foundation, Inc. @@ -197,12 +197,11 @@ with no args, if that value is non-nil." (progn (insert last-command-event) (icon-indent-line) - (if icon-auto-newline - (progn - (newline) - ;; (newline) may have done auto-fill - (setq insertpos (- (point) 2)) - (icon-indent-line))) + (when icon-auto-newline + (newline) + ;; (newline) may have done auto-fill + (setq insertpos (- (point) 2)) + (icon-indent-line)) (save-excursion (if insertpos (goto-char (1+ insertpos))) (delete-char -1)))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 21bda086801..eb690a72f6e 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -282,7 +282,7 @@ Match group 1 is the name of the macro.") "continue" "debugger" "default" "delete" "do" "else" "enum" "export" "extends" "final" "finally" "for" "function" "goto" "if" "implements" "import" "in" - "instanceof" "interface" "native" "new" "package" + "instanceof" "interface" "native" "new" "of" "package" "private" "protected" "public" "return" "static" "super" "switch" "synchronized" "throw" "throws" "transient" "try" "typeof" "var" "void" "let" @@ -3699,8 +3699,7 @@ Otherwise, use the current value of `process-mark'." Strings and numbers are JSON-encoded. Lists (including nil) are made into JavaScript array literals and their contents encoded with `js--js-encode-value'." - (cond ((stringp x) (json-encode-string x)) - ((numberp x) (json-encode-number x)) + (cond ((or (stringp x) (numberp x)) (json-encode x)) ((symbolp x) (format "{objid:%S}" (symbol-name x))) ((js--js-handle-p x) @@ -4390,7 +4389,8 @@ If one hasn't been set, or if it's stale, prompt for a new one." (with-temp-buffer (insert js--js-inserter) (insert "(") - (insert (json-encode-list defun-info)) + (let ((standard-output (current-buffer))) + (json--print-list defun-info)) (insert ",\n") (insert defun-body) (insert "\n)") diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index e7f407b6367..3f8afd97050 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1802,12 +1802,12 @@ FEATURE-NAME is a relative file name, file extension is optional. This commands delegates to `gem which', which searches both installed gems and the standard library. When called interactively, defaults to the feature name in the `require' -statement around point." +or `gem' statement around point." (interactive) (unless feature-name (let ((init (save-excursion (forward-line 0) - (when (looking-at "require [\"']\\(.*\\)[\"']") + (when (looking-at "\\(?:require\\| *gem\\) [\"']\\(.*?\\)[\"']") (match-string 1))))) (setq feature-name (read-string "Feature name: " init)))) (let ((out diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index c4de800e332..c8e55da642f 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -2159,7 +2159,8 @@ your style, only those that are different from the default.") ;; mandatory (require 'compile) ; XEmacs -(require 'easymenu) +(when (< emacs-major-version 28) ; preloaded in Emacs 28 + (require 'easymenu)) (require 'hippie-exp) ;; optional (minimize warning messages during compile) diff --git a/lisp/recentf.el b/lisp/recentf.el index d39a523289f..48b8e2b6719 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -37,7 +37,6 @@ ;; ;;; Code: -(require 'easymenu) (require 'tree-widget) (require 'timer) diff --git a/lisp/replace.el b/lisp/replace.el index eb7a439b54a..f131d263ec6 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1104,51 +1104,39 @@ a previously found match." count))) -(defvar occur-menu-map - (let ((map (make-sparse-keymap))) - (bindings--define-key map [next-error-follow-minor-mode] - '(menu-item "Auto Occurrence Display" - next-error-follow-minor-mode - :help "Display another occurrence when moving the cursor" - :button (:toggle . (and (boundp 'next-error-follow-minor-mode) - next-error-follow-minor-mode)))) - (bindings--define-key map [separator-1] menu-bar-separator) - (bindings--define-key map [kill-this-buffer] - '(menu-item "Kill Occur Buffer" kill-this-buffer - :help "Kill the current *Occur* buffer")) - (bindings--define-key map [quit-window] - '(menu-item "Quit Occur Window" quit-window - :help "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame")) - (bindings--define-key map [revert-buffer] - '(menu-item "Revert Occur Buffer" revert-buffer - :help "Replace the text in the *Occur* buffer with the results of rerunning occur")) - (bindings--define-key map [clone-buffer] - '(menu-item "Clone Occur Buffer" clone-buffer - :help "Create and return a twin copy of the current *Occur* buffer")) - (bindings--define-key map [occur-rename-buffer] - '(menu-item "Rename Occur Buffer" occur-rename-buffer - :help "Rename the current *Occur* buffer to *Occur: original-buffer-name*.")) - (bindings--define-key map [occur-edit-buffer] - '(menu-item "Edit Occur Buffer" occur-edit-mode - :help "Edit the *Occur* buffer and apply changes to the original buffers.")) - (bindings--define-key map [separator-2] menu-bar-separator) - (bindings--define-key map [occur-mode-goto-occurrence-other-window] - '(menu-item "Go To Occurrence Other Window" occur-mode-goto-occurrence-other-window - :help "Go to the occurrence the current line describes, in another window")) - (bindings--define-key map [occur-mode-goto-occurrence] - '(menu-item "Go To Occurrence" occur-mode-goto-occurrence - :help "Go to the occurrence the current line describes")) - (bindings--define-key map [occur-mode-display-occurrence] - '(menu-item "Display Occurrence" occur-mode-display-occurrence - :help "Display in another window the occurrence the current line describes")) - (bindings--define-key map [occur-next] - '(menu-item "Move to Next Match" occur-next - :help "Move to the Nth (default 1) next match in an Occur mode buffer")) - (bindings--define-key map [occur-prev] - '(menu-item "Move to Previous Match" occur-prev - :help "Move to the Nth (default 1) previous match in an Occur mode buffer")) - map) - "Menu keymap for `occur-mode'.") +(easy-menu-define occur-menu-map nil + "Menu for `occur-mode'." + '("Occur" + ["Move to Previous Match" occur-prev + :help "Move to the Nth (default 1) previous match in an Occur mode buffer"] + ["Move to Next Match" occur-next + :help "Move to the Nth (default 1) next match in an Occur mode buffer"] + ["Display Occurrence" occur-mode-display-occurrence + :help "Display in another window the occurrence the current line describes"] + ["Go To Occurrence" occur-mode-goto-occurrence + :help "Go to the occurrence the current line describes"] + ["Go To Occurrence Other Window" occur-mode-goto-occurrence-other-window + :help "Go to the occurrence the current line describes, in another window"] + "---" + ["Edit Occur Buffer" occur-edit-mode + :help "Edit the *Occur* buffer and apply changes to the original buffers."] + ["Rename Occur Buffer" occur-rename-buffer + :help "Rename the current *Occur* buffer to *Occur: original-buffer-name*."] + ["Clone Occur Buffer" clone-buffer + :help "Create and return a twin copy of the current *Occur* buffer"] + ["Revert Occur Buffer" revert-buffer + :help "Replace the text in the *Occur* buffer with the results of rerunning occur"] + ["Quit Occur Window" quit-window + :help "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame"] + ["Kill Occur Buffer" kill-this-buffer + :help "Kill the current *Occur* buffer"] + "---" + ["Auto Occurrence Display" + next-error-follow-minor-mode + :help "Display another occurrence when moving the cursor" + :style toggle + :selected (and (boundp 'next-error-follow-minor-mode) + next-error-follow-minor-mode)])) (defvar occur-mode-map (let ((map (make-sparse-keymap))) diff --git a/lisp/simple.el b/lisp/simple.el index 403861351c9..f8050091d58 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3043,8 +3043,7 @@ Return what remains of the list." (and (consp time) (equal (list (car time) (cdr time)) (visited-file-modtime)))) - (when (fboundp 'unlock-buffer) - (unlock-buffer)) + (unlock-buffer) (set-buffer-modified-p nil))) ;; Element (nil PROP VAL BEG . END) is property change. (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare)) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index d64c72184ea..4a785623805 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -106,7 +106,6 @@ ;;; TODO: ;; - Timeout directories we haven't visited in a while. -(require 'easymenu) (require 'dframe) (require 'ezimage) @@ -142,25 +141,6 @@ ;;; Code: -;; Note: `inversion-test' requires parts of the CEDET package that are -;; not included with Emacs. -;; -;; (defun speedbar-require-version (major minor &optional beta) -;; "Non-nil if this version of SPEEDBAR does not satisfy a specific version. -;; Arguments can be: -;; -;; (MAJOR MINOR &optional BETA) -;; -;; Values MAJOR and MINOR must be integers. BETA can be an integer, or -;; excluded if a released version is required. -;; -;; It is assumed that if the current version is newer than that specified, -;; everything passes. Exceptions occur when known incompatibilities are -;; introduced." -;; (inversion-test 'speedbar -;; (concat major "." minor -;; (when beta (concat "beta" beta))))) - (defvar speedbar-initial-expansion-mode-alist '(("buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map speedbar-buffer-buttons) diff --git a/lisp/subr.el b/lisp/subr.el index 9579c9a395e..f1c25627bee 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2538,10 +2538,10 @@ use `start-file-process'." (defun process-lines-handling-status (program status-handler &rest args) "Execute PROGRAM with ARGS, returning its output as a list of lines. -If STATUS-HANDLER is non-NIL, it must be a function with one +If STATUS-HANDLER is non-nil, it must be a function with one argument, which will be called with the exit status of the program before the output is collected. If STATUS-HANDLER is -NIL, an error is signalled if the program returns with a non-zero +nil, an error is signaled if the program returns with a non-zero exit status." (with-temp-buffer (let ((status (apply #'call-process program nil (current-buffer) nil args))) @@ -2569,7 +2569,7 @@ Also see `process-lines-ignore-status'." "Execute PROGRAM with ARGS, returning its output as a list of lines. The exit status of the program is ignored. Also see `process-lines'." - (apply #'process-lines-handling-status program #'identity args)) + (apply #'process-lines-handling-status program #'ignore args)) (defun process-live-p (process) "Return non-nil if PROCESS is alive. @@ -2837,6 +2837,11 @@ This function is used by the `interactive' code letter `n'." Otherwise, use the minibuffer.") (defun read-char-choice (prompt chars &optional inhibit-keyboard-quit) + (if (not read-char-choice-use-read-key) + (read-char-from-minibuffer prompt chars) + (read-char-choice-with-read-key prompt chars inhibit-keyboard-quit))) + +(defun read-char-choice-with-read-key (prompt chars &optional inhibit-keyboard-quit) "Read and return one of CHARS, prompting for PROMPT. Any input that is not one of CHARS is ignored. @@ -2846,46 +2851,44 @@ keyboard-quit events while waiting for a valid input. If you bind the variable `help-form' to a non-nil value while calling this function, then pressing `help-char' causes it to evaluate `help-form' and display the result." - (if (not read-char-choice-use-read-key) - (read-char-from-minibuffer prompt chars) - (unless (consp chars) - (error "Called `read-char-choice' without valid char choices")) - (let (char done show-help (helpbuf " *Char Help*")) - (let ((cursor-in-echo-area t) - (executing-kbd-macro executing-kbd-macro) - (esc-flag nil)) - (save-window-excursion ; in case we call help-form-show - (while (not done) - (unless (get-text-property 0 'face prompt) - (setq prompt (propertize prompt 'face 'minibuffer-prompt))) - (setq char (let ((inhibit-quit inhibit-keyboard-quit)) - (read-key prompt))) - (and show-help (buffer-live-p (get-buffer helpbuf)) - (kill-buffer helpbuf)) - (cond - ((not (numberp char))) - ;; If caller has set help-form, that's enough. - ;; They don't explicitly have to add help-char to chars. - ((and help-form - (eq char help-char) - (setq show-help t) - (help-form-show))) - ((memq char chars) - (setq done t)) - ((and executing-kbd-macro (= char -1)) - ;; read-event returns -1 if we are in a kbd macro and - ;; there are no more events in the macro. Attempt to - ;; get an event interactively. - (setq executing-kbd-macro nil)) - ((not inhibit-keyboard-quit) - (cond - ((and (null esc-flag) (eq char ?\e)) - (setq esc-flag t)) - ((memq char '(?\C-g ?\e)) - (keyboard-quit)))))))) - ;; Display the question with the answer. But without cursor-in-echo-area. - (message "%s%s" prompt (char-to-string char)) - char))) + (unless (consp chars) + (error "Called `read-char-choice' without valid char choices")) + (let (char done show-help (helpbuf " *Char Help*")) + (let ((cursor-in-echo-area t) + (executing-kbd-macro executing-kbd-macro) + (esc-flag nil)) + (save-window-excursion ; in case we call help-form-show + (while (not done) + (unless (get-text-property 0 'face prompt) + (setq prompt (propertize prompt 'face 'minibuffer-prompt))) + (setq char (let ((inhibit-quit inhibit-keyboard-quit)) + (read-key prompt))) + (and show-help (buffer-live-p (get-buffer helpbuf)) + (kill-buffer helpbuf)) + (cond + ((not (numberp char))) + ;; If caller has set help-form, that's enough. + ;; They don't explicitly have to add help-char to chars. + ((and help-form + (eq char help-char) + (setq show-help t) + (help-form-show))) + ((memq char chars) + (setq done t)) + ((and executing-kbd-macro (= char -1)) + ;; read-event returns -1 if we are in a kbd macro and + ;; there are no more events in the macro. Attempt to + ;; get an event interactively. + (setq executing-kbd-macro nil)) + ((not inhibit-keyboard-quit) + (cond + ((and (null esc-flag) (eq char ?\e)) + (setq esc-flag t)) + ((memq char '(?\C-g ?\e)) + (keyboard-quit)))))))) + ;; Display the question with the answer. But without cursor-in-echo-area. + (message "%s%s" prompt (char-to-string char)) + char)) (defun sit-for (seconds &optional nodisp obsolete) "Redisplay, then wait for SECONDS seconds. Stop when input is available. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index c95559a1b7d..917b5e496b8 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -90,8 +90,8 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and (set-default sym val) ;; Reenable the tab-bar with new keybindings (when tab-bar-mode - (tab-bar-mode -1) - (tab-bar-mode 1))) + (tab-bar--undefine-keys) + (tab-bar--define-keys))) :group 'tab-bar :version "27.1") @@ -113,7 +113,22 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and (unless (global-key-binding [(control shift tab)]) (global-set-key [(control shift tab)] 'tab-previous)) (unless (global-key-binding [(control shift iso-lefttab)]) - (global-set-key [(control shift iso-lefttab)] 'tab-previous))) + (global-set-key [(control shift iso-lefttab)] 'tab-previous)) + + ;; Replace default value with a condition that supports displaying + ;; global-mode-string in the tab bar instead of the mode line. + (when (and (memq 'tab-bar-format-global tab-bar-format) + (member '(global-mode-string ("" global-mode-string " ")) + mode-line-misc-info)) + (setq mode-line-misc-info + (append '(global-mode-string + ("" (:eval (if (and tab-bar-mode + (memq 'tab-bar-format-global + tab-bar-format)) + "" global-mode-string)) + " ")) + (remove '(global-mode-string ("" global-mode-string " ")) + mode-line-misc-info))))) (defun tab-bar--undefine-keys () "Uninstall key bindings previously bound by `tab-bar--define-keys'." @@ -159,21 +174,22 @@ either 1 or 0 depending on the value of the customizable variable (if (> (length (funcall tab-bar-tabs-function frame)) tab-bar-show) 1 0)))) (defun tab-bar--update-tab-bar-lines (&optional frames) - "Update the `tab-bar-lines' parameter in frames. -Update the tab-bar-lines frame parameter. If the optional -parameter FRAMES is omitted, update only the currently selected -frame. If it is `t', update all frames as well as the default -for new frames. Otherwise FRAMES should be a list of frames to -update." + "Update the `tab-bar-lines' frame parameter in FRAMES. +If the optional parameter FRAMES is omitted, update only +the currently selected frame. If it is `t', update all frames +as well as the default for new frames. Otherwise FRAMES should be +a list of frames to update." (let ((frame-lst (cond ((null frames) (list (selected-frame))) ((eq frames t) (frame-list)) (t frames)))) - ;; Loop over all frames and update default-frame-alist + ;; Loop over all frames and update `tab-bar-lines' (dolist (frame frame-lst) (unless (frame-parameter frame 'tab-bar-lines-keep-state) - (set-frame-parameter frame 'tab-bar-lines (tab-bar--tab-bar-lines-for-frame frame))))) + (set-frame-parameter frame 'tab-bar-lines + (tab-bar--tab-bar-lines-for-frame frame))))) + ;; Update `default-frame-alist' (when (eq frames t) (setq default-frame-alist (cons (cons 'tab-bar-lines (if (and tab-bar-mode (eq tab-bar-show t)) 1 0)) @@ -185,7 +201,7 @@ update." ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. :variable tab-bar-mode - ;; Recalculate tab-bar-lines for all frames + ;; Recalculate `tab-bar-lines' for all frames (tab-bar--update-tab-bar-lines t) (when tab-bar-mode @@ -503,56 +519,111 @@ the formatted tab name to display in the tab bar." "")) 'face (if current-p 'tab-bar-tab 'tab-bar-tab-inactive)))) -(defun tab-bar-make-keymap-1 () - "Generate an actual keymap from `tab-bar-map', without caching." +(defvar tab-bar-format '(tab-bar-format-history + tab-bar-format-tabs + tab-bar-separator + tab-bar-format-add-tab) + "Template for displaying tab bar items. +Every item in the list is a function that returns +a string, or a list of menu-item elements, or nil. +When you add more items `tab-bar-format-align-right' and +`tab-bar-format-global' to the end, then after enabling +`display-time-mode' (or any other mode that uses `global-mode-string') +it will display time aligned to the right on the tab bar instead of +the mode line.") + +(defun tab-bar-format-history () + (when (and tab-bar-history-mode tab-bar-history-buttons-show) + `((sep-history-back menu-item ,(tab-bar-separator) ignore) + (history-back + menu-item ,tab-bar-back-button tab-bar-history-back + :help "Click to go back in tab history") + (sep-history-forward menu-item ,(tab-bar-separator) ignore) + (history-forward + menu-item ,tab-bar-forward-button tab-bar-history-forward + :help "Click to go forward in tab history")))) + +(defun tab-bar-format-tabs () (let ((separator (tab-bar-separator)) (tabs (funcall tab-bar-tabs-function)) (i 0)) - (append - '(keymap (mouse-1 . tab-bar-handle-mouse)) - (when (and tab-bar-history-mode tab-bar-history-buttons-show) - `((sep-history-back menu-item ,separator ignore) - (history-back - menu-item ,tab-bar-back-button tab-bar-history-back - :help "Click to go back in tab history") - (sep-history-forward menu-item ,separator ignore) - (history-forward - menu-item ,tab-bar-forward-button tab-bar-history-forward - :help "Click to go forward in tab history"))) - (mapcan - (lambda (tab) - (setq i (1+ i)) - (append - `((,(intern (format "sep-%i" i)) menu-item ,separator ignore)) - (cond - ((eq (car tab) 'current-tab) - `((current-tab - menu-item - ,(funcall tab-bar-tab-name-format-function tab i) - ignore - :help "Current tab"))) - (t - `((,(intern (format "tab-%i" i)) - menu-item - ,(funcall tab-bar-tab-name-format-function tab i) - ,(or - (alist-get 'binding tab) - `(lambda () - (interactive) - (tab-bar-select-tab ,i))) - :help "Click to visit tab")))) - `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i))) - menu-item "" - ,(or - (alist-get 'close-binding tab) - `(lambda () - (interactive) - (tab-bar-close-tab ,i))))))) - tabs) - `((sep-add-tab menu-item ,separator ignore)) - (when (and tab-bar-new-button-show tab-bar-new-button) - `((add-tab menu-item ,tab-bar-new-button tab-bar-new-tab - :help "New tab")))))) + (mapcan + (lambda (tab) + (setq i (1+ i)) + (append + `((,(intern (format "sep-%i" i)) menu-item ,separator ignore)) + (cond + ((eq (car tab) 'current-tab) + `((current-tab + menu-item + ,(funcall tab-bar-tab-name-format-function tab i) + ignore + :help "Current tab"))) + (t + `((,(intern (format "tab-%i" i)) + menu-item + ,(funcall tab-bar-tab-name-format-function tab i) + ,(or + (alist-get 'binding tab) + `(lambda () + (interactive) + (tab-bar-select-tab ,i))) + :help "Click to visit tab")))) + `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i))) + menu-item "" + ,(or + (alist-get 'close-binding tab) + `(lambda () + (interactive) + (tab-bar-close-tab ,i))))))) + tabs))) + +(defun tab-bar-format-add-tab () + (when (and tab-bar-new-button-show tab-bar-new-button) + `((add-tab menu-item ,tab-bar-new-button tab-bar-new-tab + :help "New tab")))) + +(defun tab-bar-format-align-right () + "Align the rest of tab bar items to the right." + (let* ((rest (cdr (memq 'tab-bar-format-align-right tab-bar-format))) + (rest (tab-bar-format-list rest)) + (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) + (hpos (length rest)) + (str (propertize " " 'display `(space :align-to (- right ,hpos))))) + `((tab-bar-format-align-right menu-item ,str ignore)))) + +(defun tab-bar-format-global () + "Format `global-mode-string' to display it in the tab bar. +When `tab-bar-format-global' is added to `tab-bar-format' +(possibly appended after `tab-bar-format-align-right'), +then modes that display information on the mode line +using `global-mode-string' will display the same text +on the tab bar instead." + `((tab-bar-format-global + menu-item + ,(format-mode-line global-mode-string) + ignore))) + +(defun tab-bar-format-list (format-list) + (let ((i 0)) + (apply #'append + (mapcar + (lambda (format) + (setq i (1+ i)) + (cond + ((functionp format) + (let ((ret (funcall format))) + (when (stringp ret) + (setq ret `((,(intern (format "str-%i" i)) + menu-item ,ret ignore)))) + ret)))) + format-list)))) + +(defun tab-bar-make-keymap-1 () + "Generate an actual keymap from `tab-bar-map', without caching." + (append + '(keymap (mouse-1 . tab-bar-handle-mouse)) + (tab-bar-format-list tab-bar-format))) ;; Some window-configuration parameters don't need to be persistent. @@ -595,9 +666,9 @@ the formatted tab name to display in the tab bar." (wc-history-forward . ,(gethash (or frame (selected-frame)) tab-bar-history-forward))))) (defun tab-bar--current-tab (&optional tab frame) - ;; `tab` here is an argument meaning 'use tab as template'. This is + ;; `tab' here is an argument meaning "use tab as template". This is ;; necessary when switching tabs, otherwise the destination tab - ;; inherit the current tab's `explicit-name` parameter. + ;; inherits the current tab's `explicit-name' parameter. (let* ((tab (or tab (assq 'current-tab (frame-parameter frame 'tabs)))) (tab-explicit-name (alist-get 'explicit-name tab))) `(current-tab @@ -839,9 +910,8 @@ on the tab bar specifying where to insert a new tab." (defcustom tab-bar-tab-post-open-functions nil "List of functions to call after creating a new tab. -The current tab is supplied as an argument. Any modifications -made to the tab argument will be applied after all functions are -called." +The current tab is supplied as an argument. Any modifications made +to the tab argument will be applied after all functions are called." :type '(repeat function) :group 'tab-bar :version "27.1") @@ -896,7 +966,7 @@ After the tab is created, the hooks in (cl-pushnew to-tab (nthcdr to-index tabs)) (when (eq to-index 0) - ;; pushnew handles the head of tabs but not frame-parameter + ;; `pushnew' handles the head of tabs but not frame-parameter (set-frame-parameter nil 'tabs tabs)) (run-hook-with-args 'tab-bar-tab-post-open-functions @@ -904,8 +974,8 @@ After the tab is created, the hooks in (when tab-bar-show (if (not tab-bar-mode) - ;; Switch on tab-bar-mode, since a tab was created - ;; Note: This also updates tab-bar-lines + ;; Turn on `tab-bar-mode' since a tab was created. + ;; Note: this also updates `tab-bar-lines'. (tab-bar-mode 1) (tab-bar--update-tab-bar-lines))) @@ -956,10 +1026,10 @@ If `recent', select the most recently visited tab." "Defines what to do when the last tab is closed. If nil, do nothing and show a message, like closing the last window or frame. If `delete-frame', delete the containing frame, as a web browser would do. -If `tab-bar-mode-disable', disable tab-bar-mode so that tabs no longer show in -the frame. -If the value is a function, call that function with the tab to be closed as an - argument." +If `tab-bar-mode-disable', disable tab-bar-mode so that tabs no longer show +in the frame. +If the value is a function, call that function with the tab to be closed +as an argument." :type '(choice (const :tag "Do nothing and show message" nil) (const :tag "Close the containing frame" delete-frame) (const :tag "Disable tab-bar-mode" tab-bar-mode-disable) @@ -970,7 +1040,7 @@ If the value is a function, call that function with the tab to be closed as an (defcustom tab-bar-tab-prevent-close-functions nil "List of functions to call to determine whether to close a tab. The tab to be closed and a boolean indicating whether or not it -is the only tab in the frame are supplied as arguments. If any +is the only tab in the frame are supplied as arguments. If any function returns a non-nil value, the tab will not be closed." :type '(repeat function) :group 'tab-bar @@ -1054,7 +1124,7 @@ for the last tab on a frame is determined by tab-bar-closed-tabs) (set-frame-parameter nil 'tabs (delq close-tab tabs))) - ;; Recalculate tab-bar-lines and update frames + ;; Recalculate `tab-bar-lines' and update frames (tab-bar--update-tab-bar-lines) (force-mode-line-update) @@ -1081,8 +1151,8 @@ for the last tab on a frame is determined by (run-hook-with-args-until-success 'tab-bar-tab-prevent-close-functions (nth index tabs) - ; last-tab-p logically can't ever be true if we - ; make it this far + ;; `last-tab-p' logically can't ever be true + ;; if we make it this far nil)) (push `((frame . ,(selected-frame)) (index . ,index) @@ -1653,7 +1723,6 @@ Like \\[find-file-other-frame] (which see), but creates a new tab." (defun find-file-read-only-other-tab (filename &optional wildcards) "Edit file FILENAME, in another tab, but don't allow changes. Like \\[find-file-other-frame] (which see), but creates a new tab. - Like \\[find-file-other-tab], but marks buffer as read-only. Use \\[read-only-mode] to permit editing." (interactive diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el index 32542d0400f..25905385685 100644 --- a/lisp/textmodes/mhtml-mode.el +++ b/lisp/textmodes/mhtml-mode.el @@ -313,7 +313,7 @@ Prefix arg specifies how many times to move (default 1)." (interactive "P") (pcase (get-text-property (point) 'mhtml-submode) ('nil (sgml-skip-tag-forward arg)) - (submode (forward-sexp arg)))) + (_submode (forward-sexp arg)))) ;;;###autoload (define-derived-mode mhtml-mode html-mode diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index be9b23677cb..269d676c2bc 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -51,7 +51,8 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -(require 'easymenu) +(when (< emacs-major-version 28) ; preloaded in Emacs 28 + (require 'easymenu)) (defvar reftex-tables-dirty t "Flag showing if tables need to be re-computed.") diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index ab9f7b9c7c0..7836bd46bc5 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -70,32 +70,31 @@ (defvar text-mode-map (let ((map (make-sparse-keymap))) (define-key map "\e\t" 'ispell-complete-word) - (define-key map [menu-bar text] - (cons "Text" (make-sparse-keymap "Text"))) - (bindings--define-key map [menu-bar text toggle-text-mode-auto-fill] - '(menu-item "Auto Fill" toggle-text-mode-auto-fill - :button (:toggle . (memq 'turn-on-auto-fill text-mode-hook)) - :help "Automatically fill text while typing in text modes (Auto Fill mode)")) - (bindings--define-key map [menu-bar text paragraph-indent-minor-mode] - '(menu-item "Paragraph Indent" paragraph-indent-minor-mode - :button (:toggle . (bound-and-true-p paragraph-indent-minor-mode)) - :help "Toggle paragraph indent minor mode")) - (bindings--define-key map [menu-bar text sep] menu-bar-separator) - (bindings--define-key map [menu-bar text center-region] - '(menu-item "Center Region" center-region - :help "Center the marked region" - :enable (region-active-p))) - (bindings--define-key map [menu-bar text center-paragraph] - '(menu-item "Center Paragraph" center-paragraph - :help "Center the current paragraph")) - (bindings--define-key map [menu-bar text center-line] - '(menu-item "Center Line" center-line - :help "Center the current line")) map) "Keymap for `text-mode'. Many other modes, such as `mail-mode', `outline-mode' and `indented-text-mode', inherit all the commands defined in this map.") +(easy-menu-define text-mode-menu text-mode-map + "Menu for `text-mode'." + '("Text" + ["Center Line" center-line + :help "Center the current line"] + ["Center Paragraph" center-paragraph + :help "Center the current paragraph"] + ["Center Region" center-region + :help "Center the marked region" + :enable (region-active-p)] + "---" + ["Paragraph Indent" paragraph-indent-minor-mode + :help "Toggle paragraph indent minor mode" + :style toggle + :selected (bound-and-true-p paragraph-indent-minor-mode)] + ["Auto Fill" toggle-text-mode-auto-fill + :help "Automatically fill text while typing in text modes (Auto Fill mode)" + :style toggle + :selected (memq 'turn-on-auto-fill text-mode-hook)])) + (define-derived-mode text-mode nil "Text" "Major mode for editing text written for humans to read. diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index 19765e0da34..6b388066515 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -1,4 +1,4 @@ -;;; add-log.el --- change log maintenance commands for Emacs +;;; add-log.el --- change log maintenance commands for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1985-1986, 1988, 1993-1994, 1997-1998, 2000-2021 Free ;; Software Foundation, Inc. @@ -49,15 +49,13 @@ (defcustom change-log-default-name nil "Name of a change log file for \\[add-change-log-entry]." :type '(choice (const :tag "default" nil) - string) - :group 'change-log) + string)) ;;;###autoload -(put 'change-log-default-name 'safe-local-variable 'string-or-null-p) +(put 'change-log-default-name 'safe-local-variable #'string-or-null-p) (defcustom change-log-mode-hook nil "Normal hook run by `change-log-mode'." - :type 'hook - :group 'change-log) + :type 'hook) ;; Many modes set this variable, so avoid warnings. ;;;###autoload @@ -66,16 +64,14 @@ It is called by `add-log-current-defun' with no argument, and should return the function's name as a string, or nil if point is outside a function." - :type '(choice (const nil) function) - :group 'change-log) + :type '(choice (const nil) function)) ;;;###autoload (defcustom add-log-full-name nil "Full name of user, for inclusion in ChangeLog daily headers. This defaults to the value returned by the function `user-full-name'." :type '(choice (const :tag "Default" nil) - string) - :group 'change-log) + string)) ;;;###autoload (defcustom add-log-mailing-address nil @@ -86,8 +82,7 @@ will be recognized as referring to the same user; when creating a new ChangeLog entry, one element will be chosen at random." :type '(choice (const :tag "Default" nil) (string :tag "String") - (repeat :tag "List of Strings" string)) - :group 'change-log) + (repeat :tag "List of Strings" string))) (defcustom add-log-time-format 'add-log-iso8601-time-string "Function that defines the time format. @@ -98,8 +93,7 @@ and `current-time-string' are two valid values." add-log-iso8601-time-string) (const :tag "Old format, as returned by `current-time-string'" current-time-string) - (function :tag "Other")) - :group 'change-log) + (function :tag "Other"))) (defcustom add-log-keep-changes-together nil "If non-nil, normally keep day's log entries for one file together. @@ -130,14 +124,12 @@ and in the former: The NEW-ENTRY arg to `add-change-log-entry' can override the effect of this variable." :version "20.3" - :type 'boolean - :group 'change-log) + :type 'boolean) (defcustom add-log-always-start-new-record nil "If non-nil, `add-change-log-entry' will always start a new record." :version "22.1" - :type 'boolean - :group 'change-log) + :type 'boolean) (defvar add-log-buffer-file-name-function 'buffer-file-name "If non-nil, function to call to identify the full filename of a buffer. @@ -149,15 +141,13 @@ use `buffer-file-name'.") This function is called with one argument, the value of variable `buffer-file-name' in that buffer. If this is nil, the default is to use the file's name relative to the directory of the change log file." - :type '(choice (const nil) function) - :group 'change-log) + :type '(choice (const nil) function)) (defcustom change-log-version-info-enabled nil "If non-nil, enable recording version numbers with the changes." :version "21.1" - :type 'boolean - :group 'change-log) + :type 'boolean) (defcustom change-log-version-number-regexp-list (let ((re "\\([0-9]+\\.[0-9.]+\\)")) @@ -170,64 +160,54 @@ use the file's name relative to the directory of the change log file." The version number must be in group 1. Note: The search is conducted only within 10%, at the beginning of the file." :version "21.1" - :type '(repeat regexp) - :group 'change-log) + :type '(repeat regexp)) (defcustom change-log-directory-files '(".bzr" ".git" ".hg" ".svn") "List of files that cause `find-change-log' to stop in containing directory. This applies if no pre-existing ChangeLog is found. If nil, then in such a case simply use the directory containing the changed file." :version "26.1" - :type '(repeat file) - :group 'change-log) + :type '(repeat file)) (defface change-log-date '((t (:inherit font-lock-string-face))) "Face used to highlight dates in date lines." - :version "21.1" - :group 'change-log) + :version "21.1") (defface change-log-name '((t (:inherit font-lock-constant-face))) "Face for highlighting author names." - :version "21.1" - :group 'change-log) + :version "21.1") (defface change-log-email '((t (:inherit font-lock-variable-name-face))) "Face for highlighting author email addresses." - :version "21.1" - :group 'change-log) + :version "21.1") (defface change-log-file '((t (:inherit font-lock-function-name-face))) "Face for highlighting file names." - :version "21.1" - :group 'change-log) + :version "21.1") (defface change-log-list '((t (:inherit font-lock-keyword-face))) "Face for highlighting parenthesized lists of functions or variables." - :version "21.1" - :group 'change-log) + :version "21.1") (defface change-log-conditionals '((t (:inherit font-lock-variable-name-face))) "Face for highlighting conditionals of the form `[...]'." - :version "21.1" - :group 'change-log) + :version "21.1") (defface change-log-function '((t (:inherit font-lock-variable-name-face))) "Face for highlighting items of the form `<....>'." - :version "21.1" - :group 'change-log) + :version "21.1") (defface change-log-acknowledgment '((t (:inherit font-lock-comment-face))) "Face for highlighting acknowledgments." - :version "21.1" - :group 'change-log) + :version "21.1") (define-obsolete-face-alias 'change-log-acknowledgement 'change-log-acknowledgment "24.3") @@ -519,7 +499,7 @@ try to visit the file for the change under `point' instead." change-log-find-tail) (setq change-log-find-tail (condition-case nil - (apply 'change-log-goto-source-1 + (apply #'change-log-goto-source-1 (append change-log-find-head change-log-find-tail)) (error (format-message @@ -556,7 +536,7 @@ try to visit the file for the change under `point' instead." file (find-file-noselect file))) (condition-case nil (setq change-log-find-tail - (apply 'change-log-goto-source-1 change-log-find-head)) + (apply #'change-log-goto-source-1 change-log-find-head)) (error (format-message "Cannot find matches for tag `%s' in file `%s'" tag file))))))))) @@ -569,7 +549,7 @@ Compatibility function for \\[next-error] invocations." (count (abs argp)) ; how many cycles (down (< argp 0)) ; are we going down? (is argp negative?) (up (not down)) - (search-function (if up 're-search-forward 're-search-backward))) + (search-function (if up #'re-search-forward #'re-search-backward))) ;; set the starting position (goto-char (cond (reset (point-min)) @@ -589,29 +569,27 @@ Compatibility function for \\[next-error] invocations." (select-window change-log-find-window))))) (defvar change-log-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap))) - (define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment) - (define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment) - (define-key map [?\C-c ?\C-f] 'change-log-find-file) - (define-key map [?\C-c ?\C-c] 'change-log-goto-source) - (define-key map [menu-bar changelog] (cons "ChangeLog" menu-map)) - (define-key menu-map [gs] - '(menu-item "Go To Source" change-log-goto-source - :help "Go to source location of ChangeLog tag near point")) - (define-key menu-map [ff] - '(menu-item "Find File" change-log-find-file - :help "Visit the file for the change under point")) - (define-key menu-map [sep] '("--")) - (define-key menu-map [nx] - '(menu-item "Next Log-Edit Comment" add-log-edit-next-comment - :help "Cycle forward through Log-Edit mode comment history")) - (define-key menu-map [pr] - '(menu-item "Previous Log-Edit Comment" add-log-edit-prev-comment - :help "Cycle backward through Log-Edit mode comment history")) + (let ((map (make-sparse-keymap))) + (define-key map [?\C-c ?\C-p] #'add-log-edit-prev-comment) + (define-key map [?\C-c ?\C-n] #'add-log-edit-next-comment) + (define-key map [?\C-c ?\C-f] #'change-log-find-file) + (define-key map [?\C-c ?\C-c] #'change-log-goto-source) map) "Keymap for Change Log major mode.") +(easy-menu-define change-log-mode-menu change-log-mode-map + "Menu for Change Log major mode." + '("ChangeLog" + ["Previous Log-Edit Comment" add-log-edit-prev-comment + :help "Cycle backward through Log-Edit mode comment history"] + ["Next Log-Edit Comment" add-log-edit-next-comment + :help "Cycle forward through Log-Edit mode comment history"] + "---" + ["Find File" change-log-find-file + :help "Visit the file for the change under point"] + ["Go To Source" change-log-goto-source + :help "Go to source location of ChangeLog tag near point"])) + ;; It used to be called change-log-time-zone-rule but really should be ;; called add-log-time-zone-rule since it's only used from add-log-* code. (defvaralias 'change-log-time-zone-rule 'add-log-time-zone-rule) @@ -814,7 +792,7 @@ means to put log entries in a suitably named buffer." :type 'boolean :version "27.1") -(put 'add-log-dont-create-changelog-file 'safe-local-variable 'booleanp) +(put 'add-log-dont-create-changelog-file 'safe-local-variable #'booleanp) (defun add-log--pseudo-changelog-buffer-name (changelog-file-name) "Compute a suitable name for a non-file visiting ChangeLog buffer. @@ -1220,8 +1198,7 @@ file were isearch was started." "Heuristic regexp used by `add-log-current-defun' for unknown major modes. The regexp's first submatch is placed in the ChangeLog entry, in parentheses." - :type 'regexp - :group 'change-log) + :type 'regexp) (declare-function c-cpp-define-name "cc-cmds" ()) (declare-function c-defun-name "cc-cmds" ()) diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el index 932dcd78920..4c1d9eaad55 100644 --- a/lisp/vc/compare-w.el +++ b/lisp/vc/compare-w.el @@ -1,4 +1,4 @@ -;;; compare-w.el --- compare text between windows for Emacs +;;; compare-w.el --- compare text between windows for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1986, 1989, 1993, 1997, 2001-2021 Free Software ;; Foundation, Inc. @@ -52,19 +52,16 @@ any text before that point. If the function returns the same value for both windows, then the whitespace is considered to match, and is skipped." :version "24.4" ; added \240 - :type '(choice regexp function) - :group 'compare-windows) + :type '(choice regexp function)) (defcustom compare-ignore-whitespace nil "Non-nil means command `compare-windows' ignores whitespace." :type 'boolean - :group 'compare-windows :version "22.1") (defcustom compare-ignore-case nil "Non-nil means command `compare-windows' ignores case differences." - :type 'boolean - :group 'compare-windows) + :type 'boolean) (defcustom compare-windows-sync 'compare-windows-sync-default-function "Function or regexp that is used to synchronize points in two @@ -92,7 +89,6 @@ If the value of this variable is nil (option \"No sync\"), then no synchronization is performed, and the function `ding' is called to beep or flash the screen when points are mismatched." :type '(choice function regexp (const :tag "No sync" nil)) - :group 'compare-windows :version "22.1") (defcustom compare-windows-sync-string-size 32 @@ -104,7 +100,6 @@ difference regions more coarse-grained. The default value 32 is good for the most cases." :type 'integer - :group 'compare-windows :version "22.1") (defcustom compare-windows-recenter nil @@ -115,7 +110,6 @@ matching points side-by-side. The value `(-1 0)' is useful if windows are split vertically, and the value `((4) (4))' for horizontally split windows." :type '(list sexp sexp) - :group 'compare-windows :version "22.1") (defcustom compare-windows-highlight t @@ -127,19 +121,16 @@ out all highlighting later with the command `compare-windows-dehighlight'." :type '(choice (const :tag "No highlighting" nil) (const :tag "Persistent highlighting" persistent) (other :tag "Highlight until next command" t)) - :group 'compare-windows :version "22.1") (defface compare-windows-removed '((t :inherit diff-removed)) "Face for highlighting `compare-windows' differing regions in the other window." - :group 'compare-windows :version "25.1") (defface compare-windows-added '((t :inherit diff-added)) "Face for highlighting `compare-windows' differing regions in current window." - :group 'compare-windows :version "25.1") (define-obsolete-face-alias 'compare-windows 'compare-windows-added "25.1") @@ -159,7 +150,6 @@ out all highlighting later with the command `compare-windows-dehighlight'." (function-item :tag "Next window" compare-windows-get-next-window) (function :tag "Your function")) - :group 'compare-windows :version "25.1") (defun compare-windows-get-recent-window () @@ -389,7 +379,7 @@ on third call it again advances points to the next difference and so on." (setq p1 (1+ p1))))) (when p12s ;; use closest matching points (i.e. points with minimal sum) - (setq p12 (cdr (assq (apply 'min (mapcar 'car p12s)) p12s))) + (setq p12 (cdr (assq (apply #'min (mapcar #'car p12s)) p12s))) (goto-char (car p12)) (compare-windows-highlight op1 (car p12) (current-buffer) w1 op2 (cadr p12) b2 w2)) @@ -416,7 +406,7 @@ on third call it again advances points to the next difference and so on." (overlay-put compare-windows-overlay2 'window w2) (if (not (eq compare-windows-highlight 'persistent)) ;; Remove highlighting before next command is executed - (add-hook 'pre-command-hook 'compare-windows-dehighlight) + (add-hook 'pre-command-hook #'compare-windows-dehighlight) (when compare-windows-overlay1 (push (copy-overlay compare-windows-overlay1) compare-windows-overlays1) (delete-overlay compare-windows-overlay1)) @@ -427,9 +417,9 @@ on third call it again advances points to the next difference and so on." (defun compare-windows-dehighlight () "Remove highlighting created by function `compare-windows-highlight'." (interactive) - (remove-hook 'pre-command-hook 'compare-windows-dehighlight) - (mapc 'delete-overlay compare-windows-overlays1) - (mapc 'delete-overlay compare-windows-overlays2) + (remove-hook 'pre-command-hook #'compare-windows-dehighlight) + (mapc #'delete-overlay compare-windows-overlays1) + (mapc #'delete-overlay compare-windows-overlays2) (and compare-windows-overlay1 (delete-overlay compare-windows-overlay1)) (and compare-windows-overlay2 (delete-overlay compare-windows-overlay2))) diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el index 26fb6206c80..63b886362ba 100644 --- a/lisp/vc/cvs-status.el +++ b/lisp/vc/cvs-status.el @@ -28,7 +28,7 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'pcvs-util) ;;; @@ -169,7 +169,7 @@ name type) -(defsubst cvs-status-vl-to-str (vl) (mapconcat 'number-to-string vl ".")) +(defsubst cvs-status-vl-to-str (vl) (mapconcat #'number-to-string vl ".")) (defun cvs-tag->string (tag) (if (stringp tag) tag @@ -283,7 +283,7 @@ BEWARE: because of stability issues, this is not a symmetric operation." tree1 (list (cons (cvs-tag-make (butlast vl2)) tree2))))))))) (defun cvs-tag-make-tag (tag) - (let ((vl (mapcar 'string-to-number (split-string (nth 2 tag) "\\.")))) + (let ((vl (mapcar #'string-to-number (split-string (nth 2 tag) "\\.")))) (cvs-tag-make vl (nth 0 tag) (intern (nth 1 tag))))) (defun cvs-tags->tree (tags) @@ -450,10 +450,10 @@ Optional prefix ARG chooses between two representations." (tags nil) (cvs-tree-nomerge (if arg (not cvs-tree-nomerge) cvs-tree-nomerge))) (while (listp (setq tags (cvs-status-get-tags))) - (let ((tags (mapcar 'cvs-tag-make-tag tags)) + (let ((tags (mapcar #'cvs-tag-make-tag tags)) ;;(pt (save-excursion (forward-line -1) (point))) ) - (setq tags (sort tags 'cvs-tag-lessp)) + (setq tags (sort tags #'cvs-tag-lessp)) (let* ((first (car tags)) (prev (if (cvs-tag-p first) (list (car (cvs-tag->vlist first))) nil))) @@ -472,7 +472,7 @@ Optional prefix ARG chooses between two representations." (nprev (if (and cvs-tree-nomerge next (equal vlist (cvs-tag->vlist next))) prev vlist))) - (cvs-map (lambda (v _p) v) nprev prev))) + (cl-mapcar (lambda (v _p) v) nprev prev))) (after (save-excursion (newline) (cvs-tree-tags-insert (cdr tags) nprev))) @@ -484,7 +484,7 @@ Optional prefix ARG chooses between two representations." (as after (cdr as))) ((and (null as) (null vs) (null ps)) (let ((revname (cvs-status-vl-to-str vlist))) - (if (cvs-every 'identity (cvs-map 'equal prev vlist)) + (if (cl-every #'identity (cl-mapcar #'equal prev vlist)) (insert (make-string (+ 4 (length revname)) ? ) (or (cvs-tag->name tag) "")) (insert " " revname ": " (or (cvs-tag->name tag) ""))))) @@ -500,7 +500,7 @@ Optional prefix ARG chooses between two representations." (if next-eq (cons nil cvs-tree-char-space) (cons t cvs-tree-char-eob)) (cons nil (if (and (eq (cvs-tag->type tag) 'branch) - (cvs-every 'null as)) + (cl-every #'null as)) cvs-tree-char-space cvs-tree-char-hbar)))))) (insert (cdr na+char)) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 7a474201811..342b4cc32b1 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -739,7 +739,7 @@ start and end positions." "Restrict the view to the current hunk. If the prefix ARG is given, restrict the view to the current file instead." (interactive "P") - (apply 'narrow-to-region + (apply #'narrow-to-region (if arg (diff-bounds-of-file) (diff-bounds-of-hunk))) (setq-local diff-narrowed-to (if arg 'file 'hunk))) @@ -770,7 +770,7 @@ If the prefix ARG is given, restrict the view to the current file instead." file-bounds hunk-bounds)) (inhibit-read-only t)) - (apply 'kill-region bounds) + (apply #'kill-region bounds) (goto-char (car bounds)) (ignore-errors (diff-beginning-of-hunk t))))) @@ -828,7 +828,7 @@ data such as \"Index: ...\" and such." (error "No hunks") (diff-beginning-of-hunk t) (let ((inhibit-read-only t)) - (apply 'kill-region (diff-bounds-of-file))) + (apply #'kill-region (diff-bounds-of-file))) (ignore-errors (diff-beginning-of-hunk t)))) (defun diff-kill-junk () @@ -1810,7 +1810,7 @@ Whitespace differences are ignored." (if (> (- (car forw) orig) (- orig (car back))) back forw) (or back forw)))) -(define-obsolete-function-alias 'diff-xor 'xor "27.1") +(define-obsolete-function-alias 'diff-xor #'xor "27.1") (defun diff-find-source-location (&optional other-file reverse noprompt) "Find current diff location within the source file. @@ -1984,7 +1984,7 @@ With a prefix argument, try to REVERSE the hunk." (diff-hunk-kill) (diff-hunk-next))))) -(defalias 'diff-mouse-goto-source 'diff-goto-source) +(defalias 'diff-mouse-goto-source #'diff-goto-source) (defun diff-goto-source (&optional other-file event) "Jump to the corresponding source line. @@ -2003,7 +2003,7 @@ revision of the file otherwise." (if event (posn-set-point (event-end event))) (let ((buffer (when event (current-buffer))) (reverse (not (save-excursion (beginning-of-line) (looking-at "[-<]"))))) - (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched) + (pcase-let ((`(,buf ,_line-offset ,pos ,src ,_dst ,_switched) (diff-find-source-location other-file reverse))) (pop-to-buffer buf) (goto-char (+ (car pos) (cdr src))) @@ -2080,7 +2080,7 @@ For use in `add-log-current-defun-function'." (write-region (concat lead (car new)) nil file2 nil 'nomessage) (with-temp-buffer (let ((status - (apply 'call-process + (apply #'call-process `(,diff-command nil t nil ,@opts ,file1 ,file2)))) (pcase status diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index 7c4931b4b89..7bb1151602c 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -45,14 +45,12 @@ This variable is also used in the `vc-diff' command (and related commands) if the backend-specific diff switch variable isn't set (`vc-git-diff-switches' for git, for instance), and `vc-diff-switches' isn't set." - :type '(choice string (repeat string)) - :group 'diff) + :type '(choice string (repeat string))) ;;;###autoload (defcustom diff-command (purecopy "diff") "The command to use to run diff." - :type 'string - :group 'diff) + :type 'string) ;; prompt if prefix arg present (defun diff-switches () @@ -60,7 +58,7 @@ set (`vc-git-diff-switches' for git, for instance), and (read-string "Diff switches: " (if (stringp diff-switches) diff-switches - (mapconcat 'identity diff-switches " "))))) + (mapconcat #'identity diff-switches " "))))) (defun diff-sentinel (code &optional old-temp-file new-temp-file) "Code run when the diff process exits. @@ -165,7 +163,7 @@ returns the buffer used." (let* ((old-alt (diff-file-local-copy old)) (new-alt (diff-file-local-copy new)) (command - (mapconcat 'identity + (mapconcat #'identity `(,diff-command ;; Use explicitly specified switches ,@switches @@ -200,7 +198,7 @@ returns the buffer used." (if (and (not no-async) (fboundp 'make-process)) (let ((proc (start-process "Diff" buf shell-file-name shell-command-switch command))) - (set-process-filter proc 'diff-process-filter) + (set-process-filter proc #'diff-process-filter) (set-process-sentinel proc (lambda (proc _msg) (with-current-buffer (process-buffer proc) diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index fde9d4338f3..b93dfc814c0 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -87,7 +87,7 @@ options after the default ones. This variable is not for customizing the look of the differences produced by the command \\[ediff-show-diff-output]. Use the variable `ediff-custom-diff-options' for that." - :set 'ediff-set-diff-options + :set #'ediff-set-diff-options :type 'string) (ediff-defvar-local ediff-ignore-case nil diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el index 84bf063aedf..a5bb953b6d4 100644 --- a/lisp/vc/ediff-help.el +++ b/lisp/vc/ediff-help.el @@ -156,7 +156,7 @@ the value of this variable and the variables `ediff-help-message-*' in ;; the keymap that defines clicks over the quick help regions (defvar ediff-help-region-map (make-sparse-keymap)) -(define-key ediff-help-region-map [mouse-2] 'ediff-help-for-quick-help) +(define-key ediff-help-region-map [mouse-2] #'ediff-help-for-quick-help) ;; runs in the control buffer (defun ediff-set-help-overlays () diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index 3f33e6aae2e..17c4202d647 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -25,6 +25,7 @@ ;;; Code: (require 'cl-lib) +(require 'ediff-util) ;; Start compiler pacifier (defvar ediff-metajob-name) @@ -1181,8 +1182,8 @@ this variable represents.") (put ediff-fine-diff-face-Ancestor 'ediff-help-echo "A `refinement' of the current difference region") -(add-hook 'ediff-quit-hook 'ediff-cleanup-mess) -(add-hook 'ediff-suspend-hook 'ediff-default-suspend-function) +(add-hook 'ediff-quit-hook #'ediff-cleanup-mess) +(add-hook 'ediff-suspend-hook #'ediff-default-suspend-function) ;;; Overlays @@ -1312,7 +1313,8 @@ This default should work without changes." (defun ediff-paint-background-regions-in-one-buffer (buf-type unhighlight) (let ((diff-vector (eval (ediff-get-symbol-from-alist - buf-type ediff-difference-vector-alist))) + buf-type ediff-difference-vector-alist) + t)) overl diff-num) (mapcar (lambda (rec) (setq overl (ediff-get-diff-overlay-from-diff-record rec) diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el index 826cad9cc1b..ad4ef473f84 100644 --- a/lisp/vc/ediff-merg.el +++ b/lisp/vc/ediff-merg.el @@ -194,7 +194,7 @@ Buffer B." (defun ediff-set-merge-mode () (normal-mode t) - (remove-hook 'write-file-functions 'ediff-set-merge-mode t)) + (remove-hook 'write-file-functions #'ediff-set-merge-mode t)) ;; Go over all diffs starting with DIFF-NUM and copy regions into buffer C diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index d32c18be8fd..49b2890a160 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -147,15 +147,15 @@ Useful commands (type ? to hide them and free up screen): (defvar ediff-dir-diffs-buffer-map (let ((map (make-sparse-keymap))) (suppress-keymap map) - (define-key map "q" 'ediff-bury-dir-diffs-buffer) - (define-key map " " 'next-line) - (define-key map "n" 'next-line) - (define-key map "\C-?" 'previous-line) - (define-key map "p" 'previous-line) - (define-key map "C" 'ediff-dir-diff-copy-file) - (define-key map [mouse-2] 'ediff-dir-diff-copy-file) - (define-key map [delete] 'previous-line) - (define-key map [backspace] 'previous-line) + (define-key map "q" #'ediff-bury-dir-diffs-buffer) + (define-key map " " #'next-line) + (define-key map "n" #'next-line) + (define-key map "\C-?" #'previous-line) + (define-key map "p" #'previous-line) + (define-key map "C" #'ediff-dir-diff-copy-file) + (define-key map [mouse-2] #'ediff-dir-diff-copy-file) + (define-key map [delete] #'previous-line) + (define-key map [backspace] #'previous-line) map) "The keymap to be installed in the buffer showing differences between directories.") @@ -413,12 +413,11 @@ Toggled by ediff-toggle-verbose-help-meta-buffer" ) '(menu-item "Show Manual" ediff-documentation :help "Display Ediff's manual")) - (or (ediff-one-filegroup-metajob) - (progn - (define-key ediff-meta-buffer-map "=" nil) - (define-key ediff-meta-buffer-map "==" 'ediff-meta-mark-equal-files) - (define-key ediff-meta-buffer-map "=m" 'ediff-meta-mark-equal-files) - (define-key ediff-meta-buffer-map "=h" 'ediff-meta-mark-equal-files))) + (unless (ediff-one-filegroup-metajob) + (define-key ediff-meta-buffer-map "=" nil) + (define-key ediff-meta-buffer-map "==" #'ediff-meta-mark-equal-files) + (define-key ediff-meta-buffer-map "=m" #'ediff-meta-mark-equal-files) + (define-key ediff-meta-buffer-map "=h" #'ediff-meta-mark-equal-files)) (define-key menu-map [ediff-next-meta-item] @@ -430,7 +429,7 @@ Toggled by ediff-toggle-verbose-help-meta-buffer" ) (if ediff-no-emacs-help-in-control-buffer - (define-key ediff-meta-buffer-map "\C-h" 'ediff-previous-meta-item)) + (define-key ediff-meta-buffer-map "\C-h" #'ediff-previous-meta-item)) (define-key ediff-meta-buffer-map [mouse-2] ediff-meta-action-function) (use-local-map ediff-meta-buffer-map) @@ -633,7 +632,7 @@ behavior." difflist (delete "." difflist) ;; copying is needed because sort sorts via side effects difflist (sort (ediff-copy-list (delete ".." difflist)) - 'string-lessp)) + #'string-lessp)) (setq difflist (mapcar (lambda (elt) (cons elt 1)) difflist)) @@ -837,14 +836,14 @@ behavior." (ediff-draw-dir-diffs ediff-dir-difference-list)) (define-key ediff-meta-buffer-map "h" 'ediff-mark-for-hiding-at-pos) - (define-key ediff-meta-buffer-map "x" 'ediff-hide-marked-sessions) + (define-key ediff-meta-buffer-map "x" #'ediff-hide-marked-sessions) (define-key - ediff-meta-buffer-map "m" 'ediff-mark-for-operation-at-pos) + ediff-meta-buffer-map "m" #'ediff-mark-for-operation-at-pos) (define-key ediff-meta-buffer-map "u" nil) (define-key - ediff-meta-buffer-map "um" 'ediff-unmark-all-for-operation) + ediff-meta-buffer-map "um" #'ediff-unmark-all-for-operation) (define-key - ediff-meta-buffer-map "uh" 'ediff-unmark-all-for-hiding) + ediff-meta-buffer-map "uh" #'ediff-unmark-all-for-hiding) (define-key ediff-meta-buffer-map [menu-bar ediff-meta-mode ediff-hide-marked-sessions] @@ -877,7 +876,7 @@ behavior." '(menu-item "Collect diffs" ediff-collect-custom-diffs :help "Collect custom diffs of marked sessions in buffer `*Ediff Multifile Diffs*'")) (define-key - ediff-meta-buffer-map "P" 'ediff-collect-custom-diffs)) + ediff-meta-buffer-map "P" #'ediff-collect-custom-diffs)) ((ediff-patch-metajob jobname) (define-key ediff-meta-buffer-map [menu-bar ediff-meta-mode ediff-meta-show-patch] @@ -885,8 +884,8 @@ behavior." :help "Show the multi-file patch associated with this group session")) (define-key ediff-meta-buffer-map "P" 'ediff-meta-show-patch))) - (define-key ediff-meta-buffer-map "^" 'ediff-up-meta-hierarchy) - (define-key ediff-meta-buffer-map "D" 'ediff-show-dir-diffs) + (define-key ediff-meta-buffer-map "^" #'ediff-up-meta-hierarchy) + (define-key ediff-meta-buffer-map "D" #'ediff-show-dir-diffs) (define-key ediff-meta-buffer-map [menu-bar ediff-meta-mode ediff-up-meta-hierarchy] @@ -2128,7 +2127,7 @@ all marked sessions must be active." )) ;;;###autoload -(defalias 'eregistry 'ediff-show-registry) +(defalias 'eregistry #'ediff-show-registry) ;; If meta-buf doesn't exist, it is created. In that case, id doesn't have a ;; parent meta-buf diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 9909dcd5424..fc6dcf68a43 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -123,106 +123,106 @@ to invocation.") (setq ediff-mode-map (make-sparse-keymap)) (suppress-keymap ediff-mode-map) - (define-key ediff-mode-map [mouse-2] 'ediff-help-for-quick-help) - (define-key ediff-mode-map "\C-m" 'ediff-help-for-quick-help) + (define-key ediff-mode-map [mouse-2] #'ediff-help-for-quick-help) + (define-key ediff-mode-map "\C-m" #'ediff-help-for-quick-help) - (define-key ediff-mode-map "p" 'ediff-previous-difference) - (define-key ediff-mode-map "\C-?" 'ediff-previous-difference) - (define-key ediff-mode-map [delete] 'ediff-previous-difference) + (define-key ediff-mode-map "p" #'ediff-previous-difference) + (define-key ediff-mode-map "\C-?" #'ediff-previous-difference) + (define-key ediff-mode-map [delete] #'ediff-previous-difference) (define-key ediff-mode-map "\C-h" (if ediff-no-emacs-help-in-control-buffer - 'ediff-previous-difference nil)) - (define-key ediff-mode-map [backspace] 'ediff-previous-difference) - (define-key ediff-mode-map [?\S-\ ] 'ediff-previous-difference) - (define-key ediff-mode-map "n" 'ediff-next-difference) - (define-key ediff-mode-map " " 'ediff-next-difference) - (define-key ediff-mode-map "j" 'ediff-jump-to-difference) + #'ediff-previous-difference nil)) + (define-key ediff-mode-map [backspace] #'ediff-previous-difference) + (define-key ediff-mode-map [?\S-\ ] #'ediff-previous-difference) + (define-key ediff-mode-map "n" #'ediff-next-difference) + (define-key ediff-mode-map " " #'ediff-next-difference) + (define-key ediff-mode-map "j" #'ediff-jump-to-difference) (define-key ediff-mode-map "g" nil) - (define-key ediff-mode-map "ga" 'ediff-jump-to-difference-at-point) - (define-key ediff-mode-map "gb" 'ediff-jump-to-difference-at-point) - (define-key ediff-mode-map "q" 'ediff-quit) - (define-key ediff-mode-map "D" 'ediff-show-diff-output) - (define-key ediff-mode-map "z" 'ediff-suspend) - (define-key ediff-mode-map "\C-l" 'ediff-recenter) - (define-key ediff-mode-map "|" 'ediff-toggle-split) - (define-key ediff-mode-map "h" 'ediff-toggle-hilit) + (define-key ediff-mode-map "ga" #'ediff-jump-to-difference-at-point) + (define-key ediff-mode-map "gb" #'ediff-jump-to-difference-at-point) + (define-key ediff-mode-map "q" #'ediff-quit) + (define-key ediff-mode-map "D" #'ediff-show-diff-output) + (define-key ediff-mode-map "z" #'ediff-suspend) + (define-key ediff-mode-map "\C-l" #'ediff-recenter) + (define-key ediff-mode-map "|" #'ediff-toggle-split) + (define-key ediff-mode-map "h" #'ediff-toggle-hilit) (or ediff-word-mode - (define-key ediff-mode-map "@" 'ediff-toggle-autorefine)) + (define-key ediff-mode-map "@" #'ediff-toggle-autorefine)) (if ediff-narrow-job - (define-key ediff-mode-map "%" 'ediff-toggle-narrow-region)) - (define-key ediff-mode-map "~" 'ediff-swap-buffers) - (define-key ediff-mode-map "v" 'ediff-scroll-vertically) - (define-key ediff-mode-map "\C-v" 'ediff-scroll-vertically) - (define-key ediff-mode-map "^" 'ediff-scroll-vertically) - (define-key ediff-mode-map "\M-v" 'ediff-scroll-vertically) - (define-key ediff-mode-map "V" 'ediff-scroll-vertically) - (define-key ediff-mode-map "<" 'ediff-scroll-horizontally) - (define-key ediff-mode-map ">" 'ediff-scroll-horizontally) - (define-key ediff-mode-map "i" 'ediff-status-info) - (define-key ediff-mode-map "E" 'ediff-documentation) - (define-key ediff-mode-map "?" 'ediff-toggle-help) - (define-key ediff-mode-map "!" 'ediff-update-diffs) - (define-key ediff-mode-map "M" 'ediff-show-current-session-meta-buffer) - (define-key ediff-mode-map "R" 'ediff-show-registry) + (define-key ediff-mode-map "%" #'ediff-toggle-narrow-region)) + (define-key ediff-mode-map "~" #'ediff-swap-buffers) + (define-key ediff-mode-map "v" #'ediff-scroll-vertically) + (define-key ediff-mode-map "\C-v" #'ediff-scroll-vertically) + (define-key ediff-mode-map "^" #'ediff-scroll-vertically) + (define-key ediff-mode-map "\M-v" #'ediff-scroll-vertically) + (define-key ediff-mode-map "V" #'ediff-scroll-vertically) + (define-key ediff-mode-map "<" #'ediff-scroll-horizontally) + (define-key ediff-mode-map ">" #'ediff-scroll-horizontally) + (define-key ediff-mode-map "i" #'ediff-status-info) + (define-key ediff-mode-map "E" #'ediff-documentation) + (define-key ediff-mode-map "?" #'ediff-toggle-help) + (define-key ediff-mode-map "!" #'ediff-update-diffs) + (define-key ediff-mode-map "M" #'ediff-show-current-session-meta-buffer) + (define-key ediff-mode-map "R" #'ediff-show-registry) (or ediff-word-mode - (define-key ediff-mode-map "*" 'ediff-make-or-kill-fine-diffs)) + (define-key ediff-mode-map "*" #'ediff-make-or-kill-fine-diffs)) (define-key ediff-mode-map "a" nil) (define-key ediff-mode-map "b" nil) (define-key ediff-mode-map "r" nil) (cond (ediff-merge-job ;; Will barf if no ancestor - (define-key ediff-mode-map "/" 'ediff-toggle-show-ancestor) + (define-key ediff-mode-map "/" #'ediff-toggle-show-ancestor) ;; In merging, we allow only A->C and B->C copying. - (define-key ediff-mode-map "a" 'ediff-copy-A-to-C) - (define-key ediff-mode-map "b" 'ediff-copy-B-to-C) - (define-key ediff-mode-map "r" 'ediff-restore-diff-in-merge-buffer) - (define-key ediff-mode-map "s" 'ediff-shrink-window-C) - (define-key ediff-mode-map "+" 'ediff-combine-diffs) + (define-key ediff-mode-map "a" #'ediff-copy-A-to-C) + (define-key ediff-mode-map "b" #'ediff-copy-B-to-C) + (define-key ediff-mode-map "r" #'ediff-restore-diff-in-merge-buffer) + (define-key ediff-mode-map "s" #'ediff-shrink-window-C) + (define-key ediff-mode-map "+" #'ediff-combine-diffs) (define-key ediff-mode-map "$" nil) - (define-key ediff-mode-map "$$" 'ediff-toggle-show-clashes-only) - (define-key ediff-mode-map "$*" 'ediff-toggle-skip-changed-regions) - (define-key ediff-mode-map "&" 'ediff-re-merge)) + (define-key ediff-mode-map "$$" #'ediff-toggle-show-clashes-only) + (define-key ediff-mode-map "$*" #'ediff-toggle-skip-changed-regions) + (define-key ediff-mode-map "&" #'ediff-re-merge)) (ediff-3way-comparison-job - (define-key ediff-mode-map "ab" 'ediff-copy-A-to-B) - (define-key ediff-mode-map "ba" 'ediff-copy-B-to-A) - (define-key ediff-mode-map "ac" 'ediff-copy-A-to-C) - (define-key ediff-mode-map "bc" 'ediff-copy-B-to-C) + (define-key ediff-mode-map "ab" #'ediff-copy-A-to-B) + (define-key ediff-mode-map "ba" #'ediff-copy-B-to-A) + (define-key ediff-mode-map "ac" #'ediff-copy-A-to-C) + (define-key ediff-mode-map "bc" #'ediff-copy-B-to-C) (define-key ediff-mode-map "c" nil) - (define-key ediff-mode-map "ca" 'ediff-copy-C-to-A) - (define-key ediff-mode-map "cb" 'ediff-copy-C-to-B) - (define-key ediff-mode-map "ra" 'ediff-restore-diff) - (define-key ediff-mode-map "rb" 'ediff-restore-diff) - (define-key ediff-mode-map "rc" 'ediff-restore-diff) - (define-key ediff-mode-map "C" 'ediff-toggle-read-only)) + (define-key ediff-mode-map "ca" #'ediff-copy-C-to-A) + (define-key ediff-mode-map "cb" #'ediff-copy-C-to-B) + (define-key ediff-mode-map "ra" #'ediff-restore-diff) + (define-key ediff-mode-map "rb" #'ediff-restore-diff) + (define-key ediff-mode-map "rc" #'ediff-restore-diff) + (define-key ediff-mode-map "C" #'ediff-toggle-read-only)) (t ; 2-way comparison - (define-key ediff-mode-map "a" 'ediff-copy-A-to-B) - (define-key ediff-mode-map "b" 'ediff-copy-B-to-A) - (define-key ediff-mode-map "ra" 'ediff-restore-diff) - (define-key ediff-mode-map "rb" 'ediff-restore-diff)) + (define-key ediff-mode-map "a" #'ediff-copy-A-to-B) + (define-key ediff-mode-map "b" #'ediff-copy-B-to-A) + (define-key ediff-mode-map "ra" #'ediff-restore-diff) + (define-key ediff-mode-map "rb" #'ediff-restore-diff)) ) ; cond - (define-key ediff-mode-map "G" 'ediff-submit-report) + (define-key ediff-mode-map "G" #'ediff-submit-report) (define-key ediff-mode-map "#" nil) - (define-key ediff-mode-map "#h" 'ediff-toggle-regexp-match) - (define-key ediff-mode-map "#f" 'ediff-toggle-regexp-match) - (define-key ediff-mode-map "#c" 'ediff-toggle-ignore-case) + (define-key ediff-mode-map "#h" #'ediff-toggle-regexp-match) + (define-key ediff-mode-map "#f" #'ediff-toggle-regexp-match) + (define-key ediff-mode-map "#c" #'ediff-toggle-ignore-case) (or ediff-word-mode - (define-key ediff-mode-map "##" 'ediff-toggle-skip-similar)) + (define-key ediff-mode-map "##" #'ediff-toggle-skip-similar)) (define-key ediff-mode-map "o" nil) - (define-key ediff-mode-map "A" 'ediff-toggle-read-only) - (define-key ediff-mode-map "B" 'ediff-toggle-read-only) + (define-key ediff-mode-map "A" #'ediff-toggle-read-only) + (define-key ediff-mode-map "B" #'ediff-toggle-read-only) (define-key ediff-mode-map "w" nil) - (define-key ediff-mode-map "wa" 'ediff-save-buffer) - (define-key ediff-mode-map "wb" 'ediff-save-buffer) - (define-key ediff-mode-map "wd" 'ediff-save-buffer) - (define-key ediff-mode-map "=" 'ediff-inferior-compare-regions) + (define-key ediff-mode-map "wa" #'ediff-save-buffer) + (define-key ediff-mode-map "wb" #'ediff-save-buffer) + (define-key ediff-mode-map "wd" #'ediff-save-buffer) + (define-key ediff-mode-map "=" #'ediff-inferior-compare-regions) (if (and (fboundp 'ediff-show-patch-diagnostics) (ediff-patch-job)) - (define-key ediff-mode-map "P" 'ediff-show-patch-diagnostics)) + (define-key ediff-mode-map "P" #'ediff-show-patch-diagnostics)) (if ediff-3way-job (progn - (define-key ediff-mode-map "wc" 'ediff-save-buffer) - (define-key ediff-mode-map "gc" 'ediff-jump-to-difference-at-point) + (define-key ediff-mode-map "wc" #'ediff-save-buffer) + (define-key ediff-mode-map "gc" #'ediff-jump-to-difference-at-point) )) - (define-key ediff-mode-map "m" 'ediff-toggle-wide-display) + (define-key ediff-mode-map "m" #'ediff-toggle-wide-display) ;; Allow ediff-mode-map to be referenced indirectly (fset 'ediff-mode-map ediff-mode-map) diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index 47ef37a19ee..fc6ea944ae1 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -1043,8 +1043,8 @@ create a new splittable frame if none is found." (with-current-buffer ctl-buffer (let* ((frame-A (window-frame ediff-window-A)) (frame-A-parameters (frame-parameters frame-A)) - (frame-A-top (eval (cdr (assoc 'top frame-A-parameters)))) - (frame-A-left (eval (cdr (assoc 'left frame-A-parameters)))) + (frame-A-top (eval (cdr (assoc 'top frame-A-parameters)) t)) + (frame-A-left (eval (cdr (assoc 'left frame-A-parameters)) t)) (frame-A-width (frame-width frame-A)) (ctl-frame ediff-control-frame) horizontal-adjustment upward-adjustment @@ -1105,7 +1105,7 @@ It assumes that it is called from within the control buffer." (cw (frame-char-width frame-A)) (wd (- (/ (display-pixel-width) cw) 5))) (setq ediff-wide-display-orig-parameters - (list (cons 'left (max 0 (eval (cdr (assoc 'left frame-A-params))))) + (list (cons 'left (max 0 (eval (cdr (assoc 'left frame-A-params)) t))) (cons 'width (cdr (assoc 'width frame-A-params)))) ediff-wide-display-frame frame-A) (modify-frame-parameters diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index ed375738b47..3536cbf7381 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -264,7 +264,7 @@ arguments after setting up the Ediff buffers." 'ediff-files3)) ;;;###autoload -(defalias 'ediff3 'ediff-files3) +(defalias 'ediff3 #'ediff-files3) (defvar-local ediff--magic-file-name nil "Name of file where buffer's content was saved. @@ -359,7 +359,7 @@ has been saved (if not in `buffer-file-name')." (declare-function diff-latest-backup-file "diff" (fn)) ;;;###autoload -(defalias 'ediff 'ediff-files) +(defalias 'ediff #'ediff-files) ;;;###autoload (defun ediff-current-file () @@ -442,7 +442,7 @@ symbol describing the Ediff job type; it defaults to (ediff-buffers-internal buffer-A buffer-B nil startup-hooks job-name)) ;;;###autoload -(defalias 'ebuffers 'ediff-buffers) +(defalias 'ebuffers #'ediff-buffers) ;;;###autoload @@ -479,7 +479,7 @@ symbol describing the Ediff job type; it defaults to (ediff-buffers-internal buffer-A buffer-B buffer-C startup-hooks job-name)) ;;;###autoload -(defalias 'ebuffers3 'ediff-buffers3) +(defalias 'ebuffers3 #'ediff-buffers3) @@ -556,7 +556,7 @@ the same name in both. The third argument, REGEXP, is nil or a regular expression; only file names that match the regexp are considered." (interactive (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) + (default-regexp (eval ediff-default-filtering-regexp t)) f) (list (setq f (read-directory-name "Directory A to compare: " dir-A nil 'must-match)) @@ -570,14 +570,14 @@ expression; only file names that match the regexp are considered." default-regexp) nil 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) + (eval ediff-default-filtering-regexp t)) ))) (ediff-directories-internal dir1 dir2 nil regexp #'ediff-files 'ediff-directories )) ;;;###autoload -(defalias 'edirs 'ediff-directories) +(defalias 'edirs #'ediff-directories) ;;;###autoload @@ -587,7 +587,7 @@ The second argument, REGEXP, is a regular expression that filters the file names. Only the files that are under revision control are taken into account." (interactive (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) + (default-regexp (eval ediff-default-filtering-regexp t)) ) (list (read-directory-name "Directory to compare with revision:" dir-A nil 'must-match) @@ -596,14 +596,14 @@ names. Only the files that are under revision control are taken into account." "Filter filenames through regular expression" default-regexp) nil 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) + (eval ediff-default-filtering-regexp t)) ))) (ediff-directory-revisions-internal - dir1 regexp 'ediff-revision 'ediff-directory-revisions + dir1 regexp #'ediff-revision 'ediff-directory-revisions )) ;;;###autoload -(defalias 'edir-revisions 'ediff-directory-revisions) +(defalias 'edir-revisions #'ediff-directory-revisions) ;;;###autoload @@ -614,7 +614,7 @@ regular expression; only file names that match the regexp are considered." (interactive (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) + (default-regexp (eval ediff-default-filtering-regexp t)) f) (list (setq f (read-directory-name "Directory A to compare:" dir-A nil)) (setq f (read-directory-name "Directory B to compare:" @@ -632,14 +632,14 @@ regular expression; only file names that match the regexp are considered." default-regexp) nil 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) + (eval ediff-default-filtering-regexp t)) ))) (ediff-directories-internal dir1 dir2 dir3 regexp #'ediff-files3 'ediff-directories3 )) ;;;###autoload -(defalias 'edirs3 'ediff-directories3) +(defalias 'edirs3 #'ediff-directories3) ;;;###autoload (defun ediff-merge-directories (dir1 dir2 regexp &optional merge-autostore-dir) @@ -649,7 +649,7 @@ expression; only file names that match the regexp are considered. MERGE-AUTOSTORE-DIR is the directory in which to store merged files." (interactive (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) + (default-regexp (eval ediff-default-filtering-regexp t)) f) (list (setq f (read-directory-name "Directory A to merge:" dir-A nil 'must-match)) @@ -663,7 +663,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files." default-regexp) nil 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) + (eval ediff-default-filtering-regexp t)) ))) (ediff-directories-internal dir1 dir2 nil regexp #'ediff-merge-files 'ediff-merge-directories @@ -671,7 +671,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files." )) ;;;###autoload -(defalias 'edirs-merge 'ediff-merge-directories) +(defalias 'edirs-merge #'ediff-merge-directories) ;;;###autoload (defun ediff-merge-directories-with-ancestor (dir1 dir2 ancestor-dir regexp @@ -685,7 +685,7 @@ only file names that match the regexp are considered. MERGE-AUTOSTORE-DIR is the directory in which to store merged files." (interactive (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) + (default-regexp (eval ediff-default-filtering-regexp t)) f) (list (setq f (read-directory-name "Directory A to merge:" dir-A nil)) (setq f (read-directory-name "Directory B to merge:" @@ -703,7 +703,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files." default-regexp) nil 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) + (eval ediff-default-filtering-regexp t)) ))) (ediff-directories-internal dir1 dir2 ancestor-dir regexp @@ -720,7 +720,7 @@ names. Only the files that are under revision control are taken into account. MERGE-AUTOSTORE-DIR is the directory in which to store merged files." (interactive (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) + (default-regexp (eval ediff-default-filtering-regexp t)) ) (list (read-directory-name "Directory to merge with revisions:" dir-A nil 'must-match) @@ -729,15 +729,15 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files." default-regexp) nil 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) + (eval ediff-default-filtering-regexp t)) ))) (ediff-directory-revisions-internal - dir1 regexp 'ediff-merge-revisions 'ediff-merge-directory-revisions + dir1 regexp #'ediff-merge-revisions 'ediff-merge-directory-revisions nil merge-autostore-dir )) ;;;###autoload -(defalias 'edir-merge-revisions 'ediff-merge-directory-revisions) +(defalias 'edir-merge-revisions #'ediff-merge-directory-revisions) ;;;###autoload (defun ediff-merge-directory-revisions-with-ancestor (dir1 regexp @@ -749,7 +749,7 @@ names. Only the files that are under revision control are taken into account. MERGE-AUTOSTORE-DIR is the directory in which to store merged files." (interactive (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) + (default-regexp (eval ediff-default-filtering-regexp t)) ) (list (read-directory-name "Directory to merge with revisions and ancestors:" @@ -759,10 +759,10 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files." default-regexp) nil 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) + (eval ediff-default-filtering-regexp t)) ))) (ediff-directory-revisions-internal - dir1 regexp 'ediff-merge-revisions-with-ancestor + dir1 regexp #'ediff-merge-revisions-with-ancestor 'ediff-merge-directory-revisions-with-ancestor nil merge-autostore-dir )) diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el index d2d419ac786..8f7affeea4e 100644 --- a/lisp/vc/emerge.el +++ b/lisp/vc/emerge.el @@ -79,90 +79,75 @@ but can be invoked directly in `fast' mode." ;; way they number lines of a file. (defcustom emerge-diff-program "diff" "Name of the program which compares two files." - :type 'string - :group 'emerge) + :type 'string) (defcustom emerge-diff3-program "diff3" "Name of the program which compares three files. Its arguments are the ancestor file and the two variant files." - :type 'string - :group 'emerge) + :type 'string) (defcustom emerge-diff-options "" "Options to pass to `emerge-diff-program' and `emerge-diff3-program'." - :type 'string - :group 'emerge) + :type 'string) (defcustom emerge-match-diff-line (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)")) (concat "^" x "\\([acd]\\)" x "$")) "Pattern to match lines produced by diff that describe differences. This is as opposed to lines from the source files." - :type 'regexp - :group 'emerge) + :type 'regexp) (defcustom emerge-diff-ok-lines-regexp "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\)" "Regexp that matches normal output lines from `emerge-diff-program'. Lines that do not match are assumed to be error messages." - :type 'regexp - :group 'emerge) + :type 'regexp) (defcustom emerge-diff3-ok-lines-regexp "^\\([1-3]:\\|====\\| \\)" "Regexp that matches normal output lines from `emerge-diff3-program'. Lines that do not match are assumed to be error messages." - :type 'regexp - :group 'emerge) + :type 'regexp) (defcustom emerge-rcs-ci-program "ci" "Name of the program that checks in RCS revisions." - :type 'string - :group 'emerge) + :type 'string) (defcustom emerge-rcs-co-program "co" "Name of the program that checks out RCS revisions." - :type 'string - :group 'emerge) + :type 'string) (defcustom emerge-process-local-variables nil "Non-nil if Emerge should process local-variables lists in merge buffers. \(You can explicitly request processing the local-variables by executing `(hack-local-variables)'.)" - :type 'boolean - :group 'emerge) + :type 'boolean) (defcustom emerge-execute-line-deletions nil "If non-nil: `emerge-execute-line' makes no output if an input was deleted. It concludes that an input version has been deleted when an ancestor entry is present, only one A or B entry is present, and an output entry is present. If nil: In such circumstances, the A or B file that is present will be copied to the designated output file." - :type 'boolean - :group 'emerge) + :type 'boolean) (defcustom emerge-before-flag "vvvvvvvvvvvvvvvvvvvv\n" "Flag placed above the highlighted block of code. Must end with newline. Must be set before Emerge is loaded, or emerge-new-flags must be run after setting." - :type 'string - :group 'emerge) + :type 'string) (defcustom emerge-after-flag "^^^^^^^^^^^^^^^^^^^^\n" "Flag placed below the highlighted block of code. Must end with newline. Must be set before Emerge is loaded, or emerge-new-flags must be run after setting." - :type 'string - :group 'emerge) + :type 'string) ;; Hook variables (defcustom emerge-startup-hook nil "Hook to run in the merge buffer after the merge has been set up." - :type 'hook - :group 'emerge) + :type 'hook) (defcustom emerge-select-hook nil "Hook to run after a difference has been selected. The variable `n' holds the (internal) number of the difference." - :type 'hook - :group 'emerge) + :type 'hook) (defcustom emerge-unselect-hook nil "Hook to run after a difference has been unselected. The variable `n' holds the (internal) number of the difference." - :type 'hook - :group 'emerge) + :type 'hook) ;; Variables to control the default directories of the arguments to ;; Emerge commands. @@ -171,8 +156,7 @@ The variable `n' holds the (internal) number of the difference." "If nil, default dir for filenames in emerge is `default-directory'. If non-nil, filenames complete in the directory of the last argument of the same type to an `emerge-files...' command." - :type 'boolean - :group 'emerge) + :type 'boolean) (defvar emerge-last-dir-A nil "Last directory for the first file of an `emerge-files...' command.") @@ -235,15 +219,13 @@ depend on the flags." (defcustom emerge-min-visible-lines 3 "Number of lines that we want to show above and below the flags when we are displaying a difference." - :type 'integer - :group 'emerge) + :type 'integer) (defcustom emerge-temp-file-prefix (expand-file-name "emerge" temporary-file-directory) "Prefix to put on Emerge temporary file names. Do not start with `~/' or `~USERNAME/'." - :type 'string - :group 'emerge) + :type 'string) (make-obsolete-variable 'emerge-temp-file-prefix "customize `temporary-file-directory' instead." @@ -251,8 +233,7 @@ Do not start with `~/' or `~USERNAME/'." (defcustom emerge-temp-file-mode 384 ; u=rw only "Mode for Emerge temporary files." - :type 'integer - :group 'emerge) + :type 'integer) (make-obsolete-variable 'emerge-temp-file-mode "it has no effect, temporary files are always private." @@ -268,8 +249,7 @@ The template is inserted as a string, with the following interpolations: Don't forget to end the template with a newline. Note that this variable can be made local to a particular merge buffer by giving a prefix argument to `emerge-set-combine-versions-template'." - :type 'string - :group 'emerge) + :type 'string) ;; Build keymaps @@ -294,8 +274,7 @@ Makes Emerge commands directly available.") (defcustom emerge-command-prefix "\C-c\C-c" "Command prefix for Emerge commands in `edit' mode. Must be set before Emerge is loaded." - :type 'string - :group 'emerge) + :type 'string) ;; This function sets up the fixed keymaps. It is executed when the first ;; Emerge is done to allow the user maximum time to set up the global keymap. @@ -1245,8 +1224,7 @@ Otherwise, the A or B file present is copied to the output file." (defcustom emerge-merge-directories-filename-regexp "[^.]" "Regexp describing files to be processed by `emerge-merge-directories'." - :type 'regexp - :group 'emerge) + :type 'regexp) ;;;###autoload (defun emerge-merge-directories (a-dir b-dir ancestor-dir output-dir) @@ -3070,8 +3048,7 @@ See also `auto-save-file-name-p'." (defcustom emerge-metachars nil "No longer used. Emerge now uses `shell-quote-argument'." - :type '(choice (const nil) regexp) - :group 'emerge) + :type '(choice (const nil) regexp)) (make-obsolete-variable 'emerge-metachars nil "26.1") (provide 'emerge) diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el index 2ee3da70274..54ef06960f9 100644 --- a/lisp/vc/pcvs-defs.el +++ b/lisp/vc/pcvs-defs.el @@ -1,4 +1,4 @@ -;;; pcvs-defs.el --- variable definitions for PCL-CVS +;;; pcvs-defs.el --- variable definitions for PCL-CVS -*- lexical-binding: t; -*- ;; Copyright (C) 1991-2021 Free Software Foundation, Inc. @@ -71,7 +71,6 @@ versions, such as the one in SunOS-4.") (defcustom cvs-cvsrc-file (convert-standard-filename "~/.cvsrc") "Path to your cvsrc file." - :group 'pcl-cvs :type '(file)) (defvar cvs-shared-start 4 @@ -96,24 +95,20 @@ If t, they will be removed from the *cvs* buffer after every command. If `delayed', they will be removed from the *cvs* buffer before every command. If `status', they will only be removed after a `cvs-mode-status' command. Else, they will never be automatically removed from the *cvs* buffer." - :group 'pcl-cvs :type '(choice (const nil) (const status) (const delayed) (const t))) (defcustom cvs-auto-remove-directories 'handled "If `all', directory entries will never be shown. If `handled', only non-handled directories will be shown. If `empty', only non-empty directories will be shown." - :group 'pcl-cvs :type '(choice (const :tag "No" nil) (const all) (const handled) (const empty))) (defcustom cvs-auto-revert t "Non-nil if changed files should automatically be reverted." - :group 'pcl-cvs :type '(boolean)) (defcustom cvs-sort-ignore-file t "Non-nil if `cvs-mode-ignore' should sort the .cvsignore automatically." - :group 'pcl-cvs :type '(boolean)) (defcustom cvs-force-dir-tag t @@ -121,7 +116,6 @@ If `empty', only non-empty directories will be shown." Tagging should generally be applied a directory at a time, but sometimes it is useful to be able to tag a single file. The normal way to do that is to use `cvs-mode-force-command' so as to temporarily override the restrictions." - :group 'pcl-cvs :type '(boolean)) (defcustom cvs-default-ignore-marks nil @@ -130,7 +124,6 @@ Normally they run on the files that are marked (with `cvs-mode-mark'), or the file under the cursor if no files are marked. If this variable is set to a non-nil value they will by default run on the file on the current line. See also `cvs-invert-ignore-marks'." - :group 'pcl-cvs :type '(boolean)) (defcustom cvs-invert-ignore-marks @@ -143,7 +136,6 @@ current line. See also `cvs-invert-ignore-marks'." "List of cvs commands that invert the default ignore-mark behavior. Commands in this set will use the opposite default from the one set in `cvs-default-ignore-marks'." - :group 'pcl-cvs :type '(set (const "diff") (const "tag") (const "ignore"))) @@ -154,7 +146,6 @@ Non-nil means that PCL-CVS will ask confirmation before removing files except for files whose content can readily be recovered from the repository. A value of `list' means that the list of files to be deleted will be displayed when asking for confirmation." - :group 'pcl-cvs :type '(choice (const list) (const t) (const nil))) @@ -162,7 +153,6 @@ displayed when asking for confirmation." (defcustom cvs-add-default-message nil "Default message to use when adding files. If set to nil, `cvs-mode-add' will always prompt for a message." - :group 'pcl-cvs :type '(choice (const :tag "Prompt" nil) (string))) @@ -171,7 +161,6 @@ If set to nil, `cvs-mode-add' will always prompt for a message." If non-nil, `cvs-mode-find-file' will place the cursor at the beginning of the modified area. If the file is not locally modified, this will obviously have no effect." - :group 'pcl-cvs :type '(boolean)) (defcustom cvs-buffer-name-alist @@ -193,7 +182,6 @@ POSTPROC is a function that should be executed when the command terminates The CMD used for `cvs-mode-commit' is \"message\". For that special case, POSTPROC is called just after MODE with special arguments." - :group 'pcl-cvs :type '(repeat (list (choice (const "diff") (const "status") @@ -236,7 +224,6 @@ Output from cvs is placed here for asynchronous commands.") '(cvs-ediff-diff . cvs-ediff-merge) '(cvs-emerge-diff . cvs-emerge-merge)) "Pair of functions to be used for resp. diff'ing and merg'ing interactively." - :group 'pcl-cvs :type '(choice (const :tag "Ediff" (cvs-ediff-diff . cvs-ediff-merge)) (const :tag "Emerge" (cvs-emerge-diff . cvs-emerge-merge)))) @@ -255,7 +242,6 @@ Alternatives are: `samedir': reuse any cvs buffer displaying the same directory `subdir': or reuse any cvs buffer displaying any sub- or super- directory `always': reuse any cvs buffer." - :group 'pcl-cvs :type '(choice (const always) (const subdir) (const samedir) (const current))) (defvar cvs-temp-buffer nil @@ -424,8 +410,7 @@ This variable is buffer local and only used in the *cvs* buffer.") (defcustom cvs-minor-mode-prefix "\C-xc" "Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'." - :type 'string - :group 'pcl-cvs) + :type 'string) (easy-mmode-defmap cvs-minor-mode-map `((,cvs-minor-mode-prefix . cvs-mode-map) diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el index e1197176af2..21fe98dacab 100644 --- a/lisp/vc/pcvs-info.el +++ b/lisp/vc/pcvs-info.el @@ -1,4 +1,4 @@ -;;; pcvs-info.el --- internal representation of a fileinfo entry +;;; pcvs-info.el --- internal representation of a fileinfo entry -*- lexical-binding: t; -*- ;; Copyright (C) 1991-2021 Free Software Foundation, Inc. @@ -384,8 +384,8 @@ For use by the ewoc package." The ordering defined by this function is such that directories are sorted alphabetically, and inside every directory the DIRCHANGE fileinfo will appear first, followed by all files (alphabetically)." - (let ((subtypea (cvs-fileinfo->subtype a)) - (subtypeb (cvs-fileinfo->subtype b))) + (let ( ;; (subtypea (cvs-fileinfo->subtype a)) + ) ;; (subtypeb (cvs-fileinfo->subtype b)) (cond ;; Sort according to directories. ((string< (cvs-fileinfo->dir a) (cvs-fileinfo->dir b)) t) diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el index a95ea0d99da..d0b2e898b07 100644 --- a/lisp/vc/pcvs-parse.el +++ b/lisp/vc/pcvs-parse.el @@ -186,7 +186,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." (let ((type (if (consp type) (car type) type)) (subtype (if (consp type) (cdr type)))) (when dir (setq cvs-current-dir dir)) - (apply 'cvs-create-fileinfo type + (apply #'cvs-create-fileinfo type (concat cvs-current-subdir (or dir cvs-current-dir)) file (cvs-parse-msg) :subtype subtype keys)))) diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el index 57da7bf730e..75d9fe9bee1 100644 --- a/lisp/vc/pcvs-util.el +++ b/lisp/vc/pcvs-util.el @@ -1,4 +1,4 @@ -;;; pcvs-util.el --- utility functions for PCL-CVS +;;; pcvs-util.el --- utility functions for PCL-CVS -*- lexical-binding: t; -*- ;; Copyright (C) 1991-2021 Free Software Foundation, Inc. @@ -33,27 +33,9 @@ ;;;; (defsubst cvs-car (x) (if (consp x) (car x) x)) -(defalias 'cvs-cdr 'cdr-safe) +(defalias 'cvs-cdr #'cdr-safe) (defsubst cvs-append (&rest xs) - (apply 'append (mapcar (lambda (x) (if (listp x) x (list x))) xs))) - -(defsubst cvs-every (-cvs-every-f -cvs-every-l) - (while (consp -cvs-every-l) - (unless (funcall -cvs-every-f (pop -cvs-every-l)) - (setq -cvs-every-l t))) - (not -cvs-every-l)) - -(defun cvs-union (xs ys) - (let ((zs ys)) - (dolist (x xs zs) - (unless (member x ys) (push x zs))))) - -(defun cvs-map (-cvs-map-f &rest -cvs-map-ls) - (let ((accum ())) - (while (not (cvs-every 'null -cvs-map-ls)) - (push (apply -cvs-map-f (mapcar 'car -cvs-map-ls)) accum) - (setq -cvs-map-ls (mapcar 'cdr -cvs-map-ls))) - (nreverse accum))) + (apply #'append (mapcar (lambda (x) (if (listp x) x (list x))) xs))) (defun cvs-first (l &optional n) (if (null n) (car l) @@ -146,7 +128,7 @@ If NOREUSE is non-nil, always return a new buffer." "Insert a list of STRINGS into the current buffer. Uses columns to keep the listing readable but compact." (when (consp strings) - (let* ((length (apply 'max (mapcar 'length strings))) + (let* ((length (apply #'max (mapcar #'length strings))) (wwidth (1- (window-width))) (columns (min ;; At least 2 columns; at least 2 spaces between columns. @@ -174,7 +156,7 @@ arguments. If ARGS is not a list, no argument will be passed." (condition-case nil (with-temp-buffer (if args - (apply 'call-process + (apply #'call-process file nil t nil (when (listp args) args)) (insert-file-contents file)) (goto-char (point-min)) @@ -182,7 +164,7 @@ arguments. If ARGS is not a list, no argument will be passed." (if oneline (line-end-position) (point-max)))) (file-error nil))) -(define-obsolete-function-alias 'cvs-string-prefix-p 'string-prefix-p "24.3") +(define-obsolete-function-alias 'cvs-string-prefix-p #'string-prefix-p "24.3") ;;;; ;;;; file names diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 1a42c67cb1c..6e039cc6256 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -115,7 +115,7 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'ewoc) ;Ewoc was once cookie (require 'pcvs-defs) (require 'pcvs-util) @@ -513,7 +513,7 @@ If non-nil, NEW means to create a new buffer no matter what." (let* ((dir+files+rest (if (or (null fis) (not single-dir)) ;; not single-dir mode: just process the whole thing - (list "" (mapcar 'cvs-fileinfo->full-name fis) nil) + (list "" (mapcar #'cvs-fileinfo->full-name fis) nil) ;; single-dir mode: extract the same-dir-elements (let ((dir (cvs-fileinfo->dir (car fis)))) ;; output the concerned dir so the parser can translate paths @@ -2135,11 +2135,11 @@ Returns a list of FIS that should be `cvs remove'd." (eq (cvs-fileinfo->type fi) 'UNKNOWN)) (cvs-mode-marked filter cmd)))) (silent (or (not cvs-confirm-removals) - (cvs-every (lambda (fi) - (or (not (file-exists-p - (cvs-fileinfo->full-name fi))) - (cvs-applicable-p fi 'safe-rm))) - files))) + (cl-every (lambda (fi) + (or (not (file-exists-p + (cvs-fileinfo->full-name fi))) + (cvs-applicable-p fi 'safe-rm))) + files))) (tmpbuf (cvs-temp-buffer))) (when (and (not silent) (equal cvs-confirm-removals 'list)) (with-current-buffer tmpbuf diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index b0435ab53ee..07b2800c2dc 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -164,18 +164,18 @@ List of factors, used to expand/compress the time scale. See `vc-annotate'." (defvar vc-annotate-mode-map (let ((m (make-sparse-keymap))) - (define-key m "a" 'vc-annotate-revision-previous-to-line) - (define-key m "d" 'vc-annotate-show-diff-revision-at-line) - (define-key m "=" 'vc-annotate-show-diff-revision-at-line) - (define-key m "D" 'vc-annotate-show-changeset-diff-revision-at-line) - (define-key m "f" 'vc-annotate-find-revision-at-line) - (define-key m "j" 'vc-annotate-revision-at-line) - (define-key m "l" 'vc-annotate-show-log-revision-at-line) - (define-key m "n" 'vc-annotate-next-revision) - (define-key m "p" 'vc-annotate-prev-revision) - (define-key m "w" 'vc-annotate-working-revision) - (define-key m "v" 'vc-annotate-toggle-annotation-visibility) - (define-key m "\C-m" 'vc-annotate-goto-line) + (define-key m "a" #'vc-annotate-revision-previous-to-line) + (define-key m "d" #'vc-annotate-show-diff-revision-at-line) + (define-key m "=" #'vc-annotate-show-diff-revision-at-line) + (define-key m "D" #'vc-annotate-show-changeset-diff-revision-at-line) + (define-key m "f" #'vc-annotate-find-revision-at-line) + (define-key m "j" #'vc-annotate-revision-at-line) + (define-key m "l" #'vc-annotate-show-log-revision-at-line) + (define-key m "n" #'vc-annotate-next-revision) + (define-key m "p" #'vc-annotate-prev-revision) + (define-key m "w" #'vc-annotate-working-revision) + (define-key m "v" #'vc-annotate-toggle-annotation-visibility) + (define-key m "\C-m" #'vc-annotate-goto-line) m) "Local keymap used for VC-Annotate mode.") diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index d1385ea7784..de5a90dc602 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -45,9 +45,9 @@ ;;; Code: +(require 'vc-dispatcher) (eval-when-compile (require 'cl-lib) - (require 'vc-dispatcher) (require 'vc-dir)) ; vc-dir-at-event (declare-function vc-deduce-fileset "vc" @@ -66,7 +66,6 @@ (defcustom vc-bzr-program "bzr" "Name of the bzr command (excluding any arguments)." - :group 'vc-bzr :type 'string) (defcustom vc-bzr-diff-switches nil @@ -75,8 +74,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." :type '(choice (const :tag "Unspecified" nil) (const :tag "None" t) (string :tag "Argument String") - (repeat :tag "Argument List" :value ("") string)) - :group 'vc-bzr) + (repeat :tag "Argument List" :value ("") string))) (defcustom vc-bzr-annotate-switches nil "String or list of strings specifying switches for bzr annotate under VC. @@ -85,15 +83,13 @@ If nil, use the value of `vc-annotate-switches'. If t, use no switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "25.1" - :group 'vc-bzr) + :version "25.1") (defcustom vc-bzr-log-switches nil "String or list of strings specifying switches for bzr log under VC." :type '(choice (const :tag "None" nil) (string :tag "Argument String") - (repeat :tag "Argument List" :value ("") string)) - :group 'vc-bzr) + (repeat :tag "Argument List" :value ("") string))) (defcustom vc-bzr-status-switches (ignore-errors @@ -108,7 +104,6 @@ The option \"--no-classify\" should be present if your bzr supports it." :type '(choice (const :tag "None" nil) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :group 'vc-bzr :version "24.1") ;; since v0.9, bzr supports removing the progress indicators @@ -122,7 +117,7 @@ prepends `vc-bzr-status-switches' to ARGS." `("BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9) "LC_MESSAGES=C" ; Force English output ,@process-environment))) - (apply 'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program + (apply #'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program file-or-list bzr-command (if (and (string-equal "status" bzr-command) vc-bzr-status-switches) @@ -144,7 +139,7 @@ Use the current Bzr root directory as the ROOT argument to ,@process-environment)) (root (vc-bzr-root default-directory)) (buffer (format "*vc-bzr : %s*" (expand-file-name root)))) - (apply 'vc-do-async-command buffer root + (apply #'vc-do-async-command buffer root vc-bzr-program bzr-command args) buffer)) @@ -267,7 +262,8 @@ in the repository root directory of FILE." ;; If there is no parent, this must be a new repo. ;; If file is in dirstate, can only be added (b#8025). ((or (not (match-beginning 4)) - (eq (char-after (match-beginning 4)) ?a)) 'added) + (eq (char-after (match-beginning 4)) ?a)) + 'added) ((or (and (eql (string-to-number (match-string 3)) (file-attribute-size (file-attributes file))) (equal (match-string 5) @@ -280,7 +276,7 @@ in the repository root directory of FILE." (memq ?x (mapcar - 'identity + #'identity (file-attribute-modes (file-attributes file)))))) (if (eq (char-after (match-beginning 7)) @@ -374,13 +370,13 @@ If PROMPT is non-nil, prompt for the Bzr command to run." command (cadr args) args (cddr args))) (require 'vc-dispatcher) - (let ((buf (apply 'vc-bzr-async-command command args))) + (let ((buf (apply #'vc-bzr-async-command command args))) (with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr) (setq-local compile-command (concat vc-bzr-program " " command " " - (if args (mapconcat 'identity args " ") ""))))) + (if args (mapconcat #'identity args " ") ""))))) (vc-set-async-update buf)))) (defun vc-bzr-pull (prompt) @@ -424,7 +420,7 @@ default if it is available." (vc-bzr-program (car cmd)) (command (cadr cmd)) (args (cddr cmd))) - (let ((buf (apply 'vc-bzr-async-command command args))) + (let ((buf (apply #'vc-bzr-async-command command args))) (with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr))) (vc-set-async-update buf)))) @@ -512,7 +508,7 @@ in the branch repository (or whose status not be determined)." (unless (re-search-forward "^<<<<<<< " nil t) (vc-bzr-command "resolve" nil 0 buffer-file-name) ;; Remove the hook so that it is not called multiple times. - (remove-hook 'after-save-hook 'vc-bzr-resolve-when-done t)))) + (remove-hook 'after-save-hook #'vc-bzr-resolve-when-done t)))) (defun vc-bzr-find-file-hook () (when (and buffer-file-name @@ -529,7 +525,7 @@ in the branch repository (or whose status not be determined)." ;; but the one in `bzr pull' isn't, so it would be good to provide an ;; elisp function to remerge from the .BASE/OTHER/THIS files. (smerge-start-session) - (add-hook 'after-save-hook 'vc-bzr-resolve-when-done nil t) + (add-hook 'after-save-hook #'vc-bzr-resolve-when-done nil t) (vc-message-unresolved-conflicts buffer-file-name))) (defun vc-bzr-version-dirstate (dir) @@ -643,7 +639,7 @@ Returns nil if unable to find this information." ;; Could run `bzr status' in the directory and see if it succeeds, but ;; that's relatively expensive. -(defalias 'vc-bzr-responsible-p 'vc-bzr-root +(defalias 'vc-bzr-responsible-p #'vc-bzr-root "Return non-nil if FILE is (potentially) controlled by bzr. The criterion is that there is a `.bzr' directory in the same or a superior directory.") @@ -664,7 +660,7 @@ or a superior directory.") (defun vc-bzr-checkin (files comment &optional _rev) "Check FILES in to bzr with log message COMMENT." - (apply 'vc-bzr-command "commit" nil 0 files + (apply #'vc-bzr-command "commit" nil 0 files (cons "-m" (log-edit-extract-headers `(("Author" . ,(vc-bzr--sanitize-header "--author")) ("Date" . ,(vc-bzr--sanitize-header "--commit-time")) @@ -699,7 +695,7 @@ or a superior directory.") (defvar log-view-expanded-log-entry-function) (define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View" - (remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack. + (remove-hook 'log-view-mode-hook #'vc-bzr-log-view-mode) ;Deactivate the hack. (require 'add-log) (setq-local log-view-per-file-logs nil) (setq-local log-view-file-re regexp-unmatchable) @@ -745,7 +741,7 @@ If LIMIT is non-nil, show no more than this many entries." ;; the log display may not what the user wants - but I see no other ;; way of getting the above regexps working. (with-current-buffer buffer - (apply 'vc-bzr-command "log" buffer 'async files + (apply #'vc-bzr-command "log" buffer 'async files (append (if shortlog '("--line") '("--long")) ;; The extra complications here when start-revision and limit @@ -761,7 +757,8 @@ If LIMIT is non-nil, show no more than this many entries." ;; This means we don't have to use --no-aliases. ;; Is -c any different to -r in this case? "-r%s" - "-r..%s") start-revision))) + "-r..%s") + start-revision))) (if (eq vc-log-view-type 'with-diff) (list "-p")) (when limit (list "-l" (format "%s" limit))) ;; There is no sensible way to combine --limit and --forward, @@ -782,7 +779,7 @@ If LIMIT is non-nil, show no more than this many entries." (defun vc-bzr-expanded-log-entry (revision) (with-temp-buffer - (apply 'vc-bzr-command "log" t nil nil + (apply #'vc-bzr-command "log" t nil nil (append (list "--long" (format "-r%s" revision)) (if (stringp vc-bzr-log-switches) @@ -795,11 +792,11 @@ If LIMIT is non-nil, show no more than this many entries." (buffer-substring (match-end 0) (point-max))))) (defun vc-bzr-log-incoming (buffer remote-location) - (apply 'vc-bzr-command "missing" buffer 'async nil + (apply #'vc-bzr-command "missing" buffer 'async nil (list "--theirs-only" (unless (string= remote-location "") remote-location)))) (defun vc-bzr-log-outgoing (buffer remote-location) - (apply 'vc-bzr-command "missing" buffer 'async nil + (apply #'vc-bzr-command "missing" buffer 'async nil (list "--mine-only" (unless (string= remote-location "") remote-location)))) (defun vc-bzr-show-log-entry (revision) @@ -830,7 +827,7 @@ If LIMIT is non-nil, show no more than this many entries." (append ;; Only add --diff-options if there are any diff switches. (unless (zerop (length switches)) - (list "--diff-options" (mapconcat 'identity switches " "))) + (list "--diff-options" (mapconcat #'identity switches " "))) ;; This `when' is just an optimization because bzr-1.2 is *much* ;; faster when the revision argument is not given. (when (or rev1 rev2) @@ -995,7 +992,7 @@ stream. Standard error output is discarded." (defun vc-bzr-dir-status-files (dir files update-function) "Return a list of conses (file . state) for DIR." - (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files) + (apply #'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files) (vc-run-delayed (vc-bzr-after-dir-status update-function ;; "bzr status" results are relative to @@ -1010,15 +1007,15 @@ stream. Standard error output is discarded." (defvar vc-bzr-shelve-map (let ((map (make-sparse-keymap))) ;; Turn off vc-dir marking - (define-key map [mouse-2] 'ignore) - - (define-key map [down-mouse-3] 'vc-bzr-shelve-menu) - (define-key map "\C-k" 'vc-bzr-shelve-delete-at-point) - (define-key map "=" 'vc-bzr-shelve-show-at-point) - (define-key map "\C-m" 'vc-bzr-shelve-show-at-point) - (define-key map "A" 'vc-bzr-shelve-apply-and-keep-at-point) - (define-key map "P" 'vc-bzr-shelve-apply-at-point) - (define-key map "S" 'vc-bzr-shelve-snapshot) + (define-key map [mouse-2] #'ignore) + + (define-key map [down-mouse-3] #'vc-bzr-shelve-menu) + (define-key map "\C-k" #'vc-bzr-shelve-delete-at-point) + (define-key map "=" #'vc-bzr-shelve-show-at-point) + (define-key map "\C-m" #'vc-bzr-shelve-show-at-point) + (define-key map "A" #'vc-bzr-shelve-apply-and-keep-at-point) + (define-key map "P" #'vc-bzr-shelve-apply-at-point) + (define-key map "S" #'vc-bzr-shelve-snapshot) map)) (defvar vc-bzr-shelve-menu-map @@ -1211,7 +1208,7 @@ stream. Standard error output is discarded." (let ((vc-bzr-revisions '()) (default-directory (file-name-directory (car files)))) (with-temp-buffer - (apply 'vc-bzr-command "log" t 0 files + (apply #'vc-bzr-command "log" t 0 files (append '("--line") (if (stringp vc-bzr-log-switches) (list vc-bzr-log-switches) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 0adb5328bc2..ef607133e86 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -76,8 +76,7 @@ (repeat :tag "Argument List" :value ("") string)) - :version "22.1" - :group 'vc-cvs) + :version "22.1") (defcustom vc-cvs-register-switches nil "Switches for registering a file into CVS. @@ -88,8 +87,7 @@ If t, use no switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "21.1" - :group 'vc-cvs) + :version "21.1") (defcustom vc-cvs-diff-switches nil "String or list of strings specifying switches for CVS diff under VC. @@ -98,8 +96,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "21.1" - :group 'vc-cvs) + :version "21.1") (defcustom vc-cvs-annotate-switches nil "String or list of strings specifying switches for cvs annotate under VC. @@ -109,22 +106,19 @@ switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "25.1" - :group 'vc-cvs) + :version "25.1") (defcustom vc-cvs-header '("$Id\ $") "Header keywords to be inserted by `vc-insert-headers'." :version "24.1" ; no longer consult the obsolete vc-header-alist - :type '(repeat string) - :group 'vc-cvs) + :type '(repeat string)) (defcustom vc-cvs-use-edit t "Non-nil means to use `cvs edit' to \"check out\" a file. This is only meaningful if you don't use the implicit checkout model \(i.e. if you have $CVSREAD set)." :type 'boolean - :version "21.1" - :group 'vc-cvs) + :version "21.1") (defcustom vc-cvs-stay-local 'only-file "Non-nil means use local operations when possible for remote repositories. @@ -151,16 +145,14 @@ except for hosts matched by these regular expressions." (regexp :format " stay local,\n%t: %v" :tag "if it matches") (repeat :format "%v%i\n" :inline t (regexp :tag "or")))) - :version "23.1" - :group 'vc-cvs) + :version "23.1") (defcustom vc-cvs-sticky-date-format-string "%c" "Format string for mode-line display of sticky date. Format is according to `format-time-string'. Only used if `vc-cvs-sticky-tag-display' is t." :type '(string) - :version "22.1" - :group 'vc-cvs) + :version "22.1") (defcustom vc-cvs-sticky-tag-display t "Specify the mode-line display of sticky tags. @@ -198,8 +190,7 @@ displayed. Date and time is displayed for sticky dates. See also variable `vc-cvs-sticky-date-format-string'." :type '(choice boolean function) - :version "22.1" - :group 'vc-cvs) + :version "22.1") ;;; ;;; Internal variables @@ -310,7 +301,7 @@ to the CVS command." (vc-cvs-could-register file) (push (directory-file-name (file-name-directory file)) dirs))) (if dirs (vc-cvs-register dirs))) - (apply 'vc-cvs-command nil 0 files + (apply #'vc-cvs-command nil 0 files "add" (and comment (string-match "[^\t\n ]" comment) (concat "-m" comment)) @@ -346,12 +337,12 @@ its parents." (error "%s is not a valid symbolic tag name" rev) ;; If the input revision is a valid symbolic tag name, we create it ;; as a branch, commit and switch to it. - (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev)) - (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev)) + (apply #'vc-cvs-command nil 0 files "tag" "-b" (list rev)) + (apply #'vc-cvs-command nil 0 files "update" "-r" (list rev)) (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev)) files))) (let ((status (apply - 'vc-cvs-command nil 1 files + #'vc-cvs-command nil 1 files "ci" (if rev (concat "-r" rev)) (concat "-m" (car (log-edit-extract-headers nil comment))) (vc-switches 'CVS 'checkin)))) @@ -378,7 +369,7 @@ its parents." (vc-file-setprop (car files) 'vc-working-revision (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2)) - (mapc 'vc-file-clearprops files)) + (mapc #'vc-file-clearprops files)) ;; Anyway, forget the checkout model of the file, because we might have ;; guessed wrong when we found the file. After commit, we can ;; tell it from the permissions of the file (see @@ -391,7 +382,7 @@ its parents." (vc-cvs-command nil 0 files "update" "-A")))) (defun vc-cvs-find-revision (file rev buffer) - (apply 'vc-cvs-command + (apply #'vc-cvs-command buffer 0 file "-Q" ; suppress diagnostic output "update" @@ -416,7 +407,7 @@ REV is the revision to check out." (if (equal file buffer-file-name) (read-only-mode -1)))) ;; Check out a particular revision (or recreate the file). (vc-file-setprop file 'vc-working-revision nil) - (apply 'vc-cvs-command nil 0 file + (apply #'vc-cvs-command nil 0 file "-w" "update" (when rev @@ -600,7 +591,7 @@ Remaining arguments are ignored." ;; This used to append diff-switches and vc-diff-switches, ;; which was consistent with the vc-diff-switches doc at that ;; time, but not with the actual behavior of any other VC diff. - (apply 'vc-do-command (or buffer "*vc-diff*") 1 "diff" nil + (apply #'vc-do-command (or buffer "*vc-diff*") 1 "diff" nil ;; Not a CVS diff, does not use vc-cvs-diff-switches. (append (vc-switches nil 'diff) (list (file-relative-name file-oldvers) @@ -608,7 +599,7 @@ Remaining arguments are ignored." (setq status 0)) (push file invoke-cvs-diff-list))))) (when invoke-cvs-diff-list - (setq status (apply 'vc-cvs-command (or buffer "*vc-diff*") + (setq status (apply #'vc-cvs-command (or buffer "*vc-diff*") (if async 'async 1) invoke-cvs-diff-list "diff" (and oldvers (concat "-r" oldvers)) @@ -787,7 +778,7 @@ If UPDATE is non-nil, then update (resynch) any affected buffers." "A wrapper around `vc-do-command' for use in vc-cvs.el. The difference to vc-do-command is that this function always invokes `cvs', and that it passes `vc-cvs-global-switches' to it before FLAGS." - (apply 'vc-do-command (or buffer "*vc*") okstatus "cvs" files + (apply #'vc-do-command (or buffer "*vc*") okstatus "cvs" files (if (stringp vc-cvs-global-switches) (cons vc-cvs-global-switches flags) (append vc-cvs-global-switches @@ -816,7 +807,7 @@ individually should stay local." (setq default nil stay-local (cdr stay-local))) (when (consp stay-local) (setq stay-local - (mapconcat 'identity stay-local "\\|"))) + (mapconcat #'identity stay-local "\\|"))) (if (if (string-match stay-local hostname) default (not default)) 'yes 'no)))))))))))) diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el index 88f46eff059..5fd8d8e5036 100644 --- a/lisp/vc/vc-dav.el +++ b/lisp/vc/vc-dav.el @@ -1,4 +1,4 @@ -;;; vc-dav.el --- vc.el support for WebDAV +;;; vc-dav.el --- vc.el support for WebDAV -*- lexical-binding: t; -*- ;; Copyright (C) 2001, 2004-2021 Free Software Foundation, Inc. @@ -64,7 +64,7 @@ For a list of possible values, see `vc-state'." 'edited (cdr (car locks))))))) -(defun vc-dav-checkout-model (url) +(defun vc-dav-checkout-model (_url) "Indicate whether URL needs to be \"checked out\" before it can be edited. See `vc-checkout-model' for a list of possible values." ;; The only thing we can support with webdav is 'locking @@ -72,21 +72,21 @@ See `vc-checkout-model' for a list of possible values." ;; This should figure out the version # of the file somehow. What is ;; the most appropriate property in WebDAV to look at for this? -(defun vc-dav-workfile-version (url) +(defun vc-dav-workfile-version (_url) "Return the current workfile version of URL." "Unknown") -(defun vc-dav-register (url &optional _comment) +(defun vc-dav-register (_url &optional _comment) "Register URL in the DAV backend." ;; Do we need to do anything here? FIXME? ) -(defun vc-dav-checkin (url comment &optional _rev) +(defun vc-dav-checkin (_url _comment &optional _rev) "Commit changes in URL to WebDAV. COMMENT is used as a check-in comment." ;; This should PUT the resource and release any locks that we hold. ) -(defun vc-dav-checkout (url &optional rev destfile) +(defun vc-dav-checkout (_url &optional _rev _destfile) "Check out revision REV of URL into the working area. If EDITABLE is non-nil URL should be writable by the user and if @@ -101,7 +101,7 @@ write the contents to. ;; This should LOCK the resource. ) -(defun vc-dav-revert (url &optional contents-done) +(defun vc-dav-revert (_url &optional _contents-done) "Revert URL back to the current workfile version. If optional arg CONTENTS-DONE is non-nil, then the contents of FILE @@ -112,11 +112,11 @@ only needs to update the status of URL within the backend. ;; Should UNLOCK the file. ) -(defun vc-dav-print-log (url) +(defun vc-dav-print-log (_url) "Insert the revision log of URL into the *vc* buffer." ) -(defun vc-dav-diff (url &optional rev1 rev2 buffer async) +(defun vc-dav-diff (_url &optional _rev1 _rev2 _buffer _async) "Insert the diff for URL into the *vc-diff* buffer. If REV1 and REV2 are non-nil report differences from REV1 to REV2. If REV1 is nil, use the current workfile version as the older version. @@ -135,11 +135,11 @@ It should return a status of either 0 (no differences found), or ;; This should use url-dav-get-properties with a depth of `1' to get ;; all the properties. -(defun vc-dav-dir-state (url) +(defun vc-dav-dir-state (_url) "find the version control state of all files in DIR in a fast way." ) -(defun vc-dav-responsible-p (url) +(defun vc-dav-responsible-p (_url) "Return non-nil if DAV considers itself `responsible' for URL." ;; Check for DAV support on the web server. t) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 46fbf448616..eb8cf8192c1 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -302,67 +302,67 @@ See `run-hooks'." (defvar vc-dir-mode-map (let ((map (make-sparse-keymap))) ;; VC commands - (define-key map "v" 'vc-next-action) ;; C-x v v - (define-key map "=" 'vc-diff) ;; C-x v = - (define-key map "D" 'vc-root-diff) ;; C-x v D - (define-key map "i" 'vc-register) ;; C-x v i - (define-key map "+" 'vc-update) ;; C-x v + + (define-key map "v" #'vc-next-action) ;; C-x v v + (define-key map "=" #'vc-diff) ;; C-x v = + (define-key map "D" #'vc-root-diff) ;; C-x v D + (define-key map "i" #'vc-register) ;; C-x v i + (define-key map "+" #'vc-update) ;; C-x v + ;; I'd prefer some kind of symmetry with vc-update: - (define-key map "P" 'vc-push) ;; C-x v P - (define-key map "l" 'vc-print-log) ;; C-x v l - (define-key map "L" 'vc-print-root-log) ;; C-x v L - (define-key map "I" 'vc-log-incoming) ;; C-x v I - (define-key map "O" 'vc-log-outgoing) ;; C-x v O + (define-key map "P" #'vc-push) ;; C-x v P + (define-key map "l" #'vc-print-log) ;; C-x v l + (define-key map "L" #'vc-print-root-log) ;; C-x v L + (define-key map "I" #'vc-log-incoming) ;; C-x v I + (define-key map "O" #'vc-log-outgoing) ;; C-x v O ;; More confusing than helpful, probably - ;;(define-key map "R" 'vc-revert) ;; u is taken by vc-dir-unmark. - ;;(define-key map "A" 'vc-annotate) ;; g is taken by revert-buffer + ;;(define-key map "R" #'vc-revert) ;; u is taken by vc-dir-unmark. + ;;(define-key map "A" #'vc-annotate) ;; g is taken by revert-buffer ;; bound by `special-mode'. ;; Marking. - (define-key map "m" 'vc-dir-mark) - (define-key map "d" 'vc-dir-clean-files) - (define-key map "M" 'vc-dir-mark-all-files) - (define-key map "u" 'vc-dir-unmark) - (define-key map "U" 'vc-dir-unmark-all-files) - (define-key map "\C-?" 'vc-dir-unmark-file-up) - (define-key map "\M-\C-?" 'vc-dir-unmark-all-files) + (define-key map "m" #'vc-dir-mark) + (define-key map "d" #'vc-dir-clean-files) + (define-key map "M" #'vc-dir-mark-all-files) + (define-key map "u" #'vc-dir-unmark) + (define-key map "U" #'vc-dir-unmark-all-files) + (define-key map "\C-?" #'vc-dir-unmark-file-up) + (define-key map "\M-\C-?" #'vc-dir-unmark-all-files) ;; Movement. - (define-key map "n" 'vc-dir-next-line) - (define-key map " " 'vc-dir-next-line) - (define-key map "\t" 'vc-dir-next-directory) - (define-key map "p" 'vc-dir-previous-line) - (define-key map [?\S-\ ] 'vc-dir-previous-line) - (define-key map [backtab] 'vc-dir-previous-directory) + (define-key map "n" #'vc-dir-next-line) + (define-key map " " #'vc-dir-next-line) + (define-key map "\t" #'vc-dir-next-directory) + (define-key map "p" #'vc-dir-previous-line) + (define-key map [?\S-\ ] #'vc-dir-previous-line) + (define-key map [backtab] #'vc-dir-previous-directory) ;;; Rebind paragraph-movement commands. - (define-key map "\M-}" 'vc-dir-next-directory) - (define-key map "\M-{" 'vc-dir-previous-directory) - (define-key map [C-down] 'vc-dir-next-directory) - (define-key map [C-up] 'vc-dir-previous-directory) + (define-key map "\M-}" #'vc-dir-next-directory) + (define-key map "\M-{" #'vc-dir-previous-directory) + (define-key map [C-down] #'vc-dir-next-directory) + (define-key map [C-up] #'vc-dir-previous-directory) ;; The remainder. - (define-key map "f" 'vc-dir-find-file) - (define-key map "e" 'vc-dir-find-file) ; dired-mode compatibility - (define-key map "\C-m" 'vc-dir-find-file) - (define-key map "o" 'vc-dir-find-file-other-window) - (define-key map "\C-o" 'vc-dir-display-file) - (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process) - (define-key map [down-mouse-3] 'vc-dir-menu) + (define-key map "f" #'vc-dir-find-file) + (define-key map "e" #'vc-dir-find-file) ; dired-mode compatibility + (define-key map "\C-m" #'vc-dir-find-file) + (define-key map "o" #'vc-dir-find-file-other-window) + (define-key map "\C-o" #'vc-dir-display-file) + (define-key map "\C-c\C-c" #'vc-dir-kill-dir-status-process) + (define-key map [down-mouse-3] #'vc-dir-menu) (define-key map [follow-link] 'mouse-face) - (define-key map "x" 'vc-dir-hide-up-to-date) - (define-key map [?\C-k] 'vc-dir-kill-line) - (define-key map "S" 'vc-dir-search) ;; FIXME: Maybe use A like dired? - (define-key map "Q" 'vc-dir-query-replace-regexp) - (define-key map (kbd "M-s a C-s") 'vc-dir-isearch) - (define-key map (kbd "M-s a M-C-s") 'vc-dir-isearch-regexp) - (define-key map "G" 'vc-dir-ignore) + (define-key map "x" #'vc-dir-hide-up-to-date) + (define-key map [?\C-k] #'vc-dir-kill-line) + (define-key map "S" #'vc-dir-search) ;; FIXME: Maybe use A like dired? + (define-key map "Q" #'vc-dir-query-replace-regexp) + (define-key map (kbd "M-s a C-s") #'vc-dir-isearch) + (define-key map (kbd "M-s a M-C-s") #'vc-dir-isearch-regexp) + (define-key map "G" #'vc-dir-ignore) (let ((branch-map (make-sparse-keymap))) (define-key map "B" branch-map) - (define-key branch-map "c" 'vc-create-tag) - (define-key branch-map "l" 'vc-print-branch-log) - (define-key branch-map "s" 'vc-retrieve-tag)) + (define-key branch-map "c" #'vc-create-tag) + (define-key branch-map "l" #'vc-print-branch-log) + (define-key branch-map "s" #'vc-retrieve-tag)) (let ((mark-map (make-sparse-keymap))) (define-key map "*" mark-map) - (define-key mark-map "r" 'vc-dir-mark-registered-files)) + (define-key mark-map "r" #'vc-dir-mark-registered-files)) ;; Hook up the menu. (define-key map [menu-bar vc-dir-mode] @@ -506,7 +506,7 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." (t (unless noinsert (ewoc-enter-before vc-ewoc node - (apply 'vc-dir-create-fileinfo entry))) + (apply #'vc-dir-create-fileinfo entry))) (setq entries (cdr entries)) (setq entry (car entries)))))) (t @@ -522,7 +522,7 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." vc-ewoc node (vc-dir-create-fileinfo rd nil nil nil entrydir)))) ;; Now insert the node itself. (ewoc-enter-before vc-ewoc node - (apply 'vc-dir-create-fileinfo entry))) + (apply #'vc-dir-create-fileinfo entry))) (setq entries (cdr entries) entry (car entries)))))) ;; We're past the last node, all remaining entries go to the end. (unless (or node noinsert) @@ -538,10 +538,10 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir)))) ;; Now insert the node itself. (ewoc-enter-last vc-ewoc - (apply 'vc-dir-create-fileinfo entry)))))) + (apply #'vc-dir-create-fileinfo entry)))))) (when to-remove (let ((inhibit-read-only t)) - (apply 'ewoc-delete vc-ewoc (nreverse to-remove))))))) + (apply #'ewoc-delete vc-ewoc (nreverse to-remove))))))) (defun vc-dir-busy () (and (buffer-live-p vc-dir-process-buffer) @@ -882,7 +882,7 @@ system; see `vc-dir-delete-file'." The files will also be marked as deleted in the version control system." (interactive) - (mapc 'vc-delete-file (or (vc-dir-marked-files) + (mapc #'vc-delete-file (or (vc-dir-marked-files) (list (vc-dir-current-file))))) (defun vc-dir-find-file () @@ -912,13 +912,13 @@ system." "Search for a string through all marked buffers using Isearch." (interactive) (multi-isearch-files - (mapcar 'car (vc-dir-marked-only-files-and-states)))) + (mapcar #'car (vc-dir-marked-only-files-and-states)))) (defun vc-dir-isearch-regexp () "Search for a regexp through all marked buffers using Isearch." (interactive) (multi-isearch-files-regexp - (mapcar 'car (vc-dir-marked-only-files-and-states)))) + (mapcar #'car (vc-dir-marked-only-files-and-states)))) (defun vc-dir-search (regexp) "Search through all marked files for a match for REGEXP. @@ -943,13 +943,13 @@ with the command \\[tags-loop-continue]." (query-replace-read-args "Query replace regexp in marked files" t t))) (list (nth 0 common) (nth 1 common) (nth 2 common)))) - (dolist (file (mapcar 'car (vc-dir-marked-only-files-and-states))) + (dolist (file (mapcar #'car (vc-dir-marked-only-files-and-states))) (let ((buffer (get-file-buffer file))) (if (and buffer (with-current-buffer buffer buffer-read-only)) (error "File `%s' is visited read-only" file)))) (fileloop-initialize-replace - from to (mapcar 'car (vc-dir-marked-only-files-and-states)) + from to (mapcar #'car (vc-dir-marked-only-files-and-states)) (if (equal from (downcase from)) nil 'default) delimited) (fileloop-continue)) @@ -1161,7 +1161,7 @@ the *vc-dir* buffer. (add-to-list 'vc-dir-buffers (current-buffer)) ;; Make sure that if the directory buffer is killed, the update ;; process running in the background is also killed. - (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t) + (add-hook 'kill-buffer-query-functions #'vc-dir-kill-query nil t) (hack-dir-local-variables-non-file-buffer) (vc-dir-refresh))) @@ -1276,7 +1276,7 @@ Throw an error if another update process is in progress." vc-ewoc 'vc-dir-fileinfo->needs-update))) (if remaining (vc-dir-refresh-files - (mapcar 'vc-dir-fileinfo->name remaining)) + (mapcar #'vc-dir-fileinfo->name remaining)) (setq mode-line-process nil) (run-hooks 'vc-dir-refresh-hook)))))))))))) @@ -1330,7 +1330,7 @@ state of item at point, if any." (ewoc-delete vc-ewoc crt)) (setq crt prev))))) -(defalias 'vc-dir-hide-up-to-date 'vc-dir-hide-state) +(defalias 'vc-dir-hide-up-to-date #'vc-dir-hide-state) (defun vc-dir-kill-line () "Remove the current line from display." @@ -1366,7 +1366,7 @@ state of item at point, if any." (unless (vc-compatible-state (cdr crt) state) (error "When applying VC operations to multiple files, the files are required\nto be in similar VC states.\n%s in state %s clashes with %s in state %s" (car crt) (cdr crt) (caar only-files-list) state))) - (setq only-files-list (mapcar 'car only-files-list)) + (setq only-files-list (mapcar #'car only-files-list)) (when (and state (not (eq state 'unregistered))) (setq model (vc-checkout-model vc-dir-backend only-files-list)))) (list vc-dir-backend files only-files-list state model))) @@ -1437,13 +1437,13 @@ These are the commands available for use in the file status buffer: (defvar vc-dir-status-mouse-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'vc-dir-toggle-mark) + (define-key map [mouse-2] #'vc-dir-toggle-mark) map) "Local keymap for toggling mark.") (defvar vc-dir-filename-mouse-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'vc-dir-find-file-other-window) + (define-key map [mouse-2] #'vc-dir-find-file-other-window) map) "Local keymap for visiting a file.") diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 2573964c42c..2b477dff0a3 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -242,7 +242,7 @@ CODE should be a function of no arguments." ((or (null proc) (eq (process-status proc) 'exit)) ;; Make sure we've read the process's output before going further. (when proc (accept-process-output proc)) - (if (functionp code) (funcall code) (eval code))) + (if (functionp code) (funcall code) (eval code t))) ;; If a process is running, add CODE to the sentinel ((eq (process-status proc) 'run) (vc-set-mode-line-busy-indicator) @@ -267,7 +267,7 @@ and is passed 3 arguments: the COMMAND, the FILES and the FLAGS.") (defun vc-delistify (filelist) "Smash a FILELIST into a file list string suitable for info messages." ;; FIXME what about file names with spaces? - (if (not filelist) "." (mapconcat 'identity filelist " "))) + (if (not filelist) "." (mapconcat #'identity filelist " "))) (defcustom vc-tor nil "If non-nil, communicate with the repository site via Tor. @@ -331,7 +331,7 @@ case, and the process object in the asynchronous case." ;; Run asynchronously. (let ((proc (let ((process-connection-type nil)) - (apply 'start-file-process command (current-buffer) + (apply #'start-file-process command (current-buffer) command squeezed)))) (when vc-command-messages (let ((inhibit-message (eq (selected-window) (active-minibuffer-window)))) @@ -339,7 +339,7 @@ case, and the process object in the asynchronous case." ;; Get rid of the default message insertion, in case we don't ;; set a sentinel explicitly. (set-process-sentinel proc #'ignore) - (set-process-filter proc 'vc-process-filter) + (set-process-filter proc #'vc-process-filter) (setq status proc) (when vc-command-messages (vc-run-delayed @@ -351,7 +351,7 @@ case, and the process object in the asynchronous case." (let ((inhibit-message (eq (selected-window) (active-minibuffer-window)))) (message "Running in foreground: %s" full-command))) (let ((buffer-undo-list t)) - (setq status (apply 'process-file command nil t nil squeezed))) + (setq status (apply #'process-file command nil t nil squeezed))) (when (and (not (eq t okstatus)) (or (not (integerp status)) (and okstatus (< okstatus status)))) @@ -394,7 +394,7 @@ Display the buffer in some window, but don't select it." (insert "\"...\n") ;; Run in the original working directory. (let ((default-directory dir)) - (apply 'vc-do-command t 'async command nil args))) + (apply #'vc-do-command t 'async command nil args))) (setq window (display-buffer buffer)) (if window (set-window-start window new-window-start)) diff --git a/lisp/vc/vc-filewise.el b/lisp/vc/vc-filewise.el index ee73aa6f938..e1b042a7424 100644 --- a/lisp/vc/vc-filewise.el +++ b/lisp/vc/vc-filewise.el @@ -1,4 +1,4 @@ -;;; vc-filewise.el --- common functions for file-oriented back ends. +;;; vc-filewise.el --- common functions for file-oriented back ends. -*- lexical-binding: t; -*- ;; Copyright (C) 1992-1996, 1998-2021 Free Software Foundation, Inc. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 25ae26d746a..465ed8735c2 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -106,6 +106,7 @@ ;;; Code: (require 'cl-lib) +(require 'vc-dispatcher) (eval-when-compile (require 'subr-x) ; for string-trim-right (require 'vc) @@ -658,29 +659,29 @@ or an empty string if none." (defvar vc-git-stash-shared-map (let ((map (make-sparse-keymap))) - (define-key map "S" 'vc-git-stash-snapshot) - (define-key map "C" 'vc-git-stash) + (define-key map "S" #'vc-git-stash-snapshot) + (define-key map "C" #'vc-git-stash) map)) (defvar vc-git-stash-map (let ((map (make-sparse-keymap))) (set-keymap-parent map vc-git-stash-shared-map) ;; Turn off vc-dir marking - (define-key map [mouse-2] 'ignore) - - (define-key map [down-mouse-3] 'vc-git-stash-menu) - (define-key map "\C-k" 'vc-git-stash-delete-at-point) - (define-key map "=" 'vc-git-stash-show-at-point) - (define-key map "\C-m" 'vc-git-stash-show-at-point) - (define-key map "A" 'vc-git-stash-apply-at-point) - (define-key map "P" 'vc-git-stash-pop-at-point) + (define-key map [mouse-2] #'ignore) + + (define-key map [down-mouse-3] #'vc-git-stash-menu) + (define-key map "\C-k" #'vc-git-stash-delete-at-point) + (define-key map "=" #'vc-git-stash-show-at-point) + (define-key map "\C-m" #'vc-git-stash-show-at-point) + (define-key map "A" #'vc-git-stash-apply-at-point) + (define-key map "P" #'vc-git-stash-pop-at-point) map)) (defvar vc-git-stash-button-map (let ((map (make-sparse-keymap))) (set-keymap-parent map vc-git-stash-shared-map) - (define-key map [mouse-2] 'push-button) - (define-key map "\C-m" 'push-button) + (define-key map [mouse-2] #'push-button) + (define-key map "\C-m" #'push-button) map)) (defconst vc-git-stash-shared-help @@ -871,7 +872,7 @@ The car of the list is the current branch." (when dlist (vc-git-command nil 0 dlist "add")))) -(defalias 'vc-git-responsible-p 'vc-git-root) +(defalias 'vc-git-responsible-p #'vc-git-root) (defun vc-git-unregister (file) (vc-git-command nil 0 file "rm" "-f" "--cached" "--")) @@ -905,9 +906,9 @@ If toggling on, also insert its message into the buffer." (defvar vc-git-log-edit-mode-map (let ((map (make-sparse-keymap "Git-Log-Edit"))) - (define-key map "\C-c\C-s" 'vc-git-log-edit-toggle-signoff) - (define-key map "\C-c\C-n" 'vc-git-log-edit-toggle-no-verify) - (define-key map "\C-c\C-e" 'vc-git-log-edit-toggle-amend) + (define-key map "\C-c\C-s" #'vc-git-log-edit-toggle-signoff) + (define-key map "\C-c\C-n" #'vc-git-log-edit-toggle-no-verify) + (define-key map "\C-c\C-e" #'vc-git-log-edit-toggle-amend) map)) (define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git" @@ -941,7 +942,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (lambda (value) (when (equal value "yes") (list argument))))) ;; When operating on the whole tree, better pass "-a" than ".", since "." ;; fails when we're committing a merge. - (apply 'vc-git-command nil 0 (if only files) + (apply #'vc-git-command nil 0 (if only files) (nconc (if msg-file (list "commit" "-F" (file-local-name msg-file)) (list "commit" "-m")) @@ -1024,13 +1025,13 @@ If PROMPT is non-nil, prompt for the Git command to run." args (cddr args))) (setq args (nconc args extra-args)) (require 'vc-dispatcher) - (apply 'vc-do-async-command buffer root git-program command args) + (apply #'vc-do-async-command buffer root git-program command args) (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git) (setq-local compile-command (concat git-program " " command " " - (mapconcat 'identity args " "))) + (mapconcat #'identity args " "))) (setq-local compilation-directory root) ;; Either set `compilation-buffer-name-function' locally to nil ;; or use `compilation-arguments' to set `name-function'. @@ -1068,7 +1069,7 @@ This prompts for a branch to merge from." branches (cons "FETCH_HEAD" branches)) nil t))) - (apply 'vc-do-async-command buffer root vc-git-program "merge" + (apply #'vc-do-async-command buffer root vc-git-program "merge" (list merge-source)) (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git))) (vc-set-async-update buffer))) @@ -1115,7 +1116,7 @@ This prompts for a branch to merge from." (vc-git-command nil 0 nil "reset")) (vc-resynch-buffer buffer-file-name t t) ;; Remove the hook so that it is not called multiple times. - (remove-hook 'after-save-hook 'vc-git-resolve-when-done t)))) + (remove-hook 'after-save-hook #'vc-git-resolve-when-done t)))) (defun vc-git-find-file-hook () "Activate `smerge-mode' if there is a conflict." @@ -1126,7 +1127,7 @@ This prompts for a branch to merge from." (re-search-forward "^<<<<<<< " nil 'noerror))) (smerge-start-session) (when vc-git-resolve-conflicts - (add-hook 'after-save-hook 'vc-git-resolve-when-done nil 'local)) + (add-hook 'after-save-hook #'vc-git-resolve-when-done nil 'local)) (vc-message-unresolved-conflicts buffer-file-name))) ;;; HISTORY FUNCTIONS @@ -1154,7 +1155,7 @@ If LIMIT is a revision string, use it as an end-revision." ;; read-only. (let ((inhibit-read-only t)) (with-current-buffer buffer - (apply 'vc-git-command buffer + (apply #'vc-git-command buffer 'async files (append '("log" "--no-color") @@ -1224,11 +1225,11 @@ log entries." (read-shell-command "Search log with command: " (format "%s %s" vc-git-program - (mapconcat 'identity args " ")) + (mapconcat #'identity args " ")) 'vc-git-history) " " t)))) (vc-setup-buffer buffer) - (apply 'vc-git-command buffer 'async nil args))) + (apply #'vc-git-command buffer 'async nil args))) (defun vc-git-mergebase (rev1 &optional rev2) (unless rev2 (setq rev2 "HEAD")) @@ -1299,7 +1300,7 @@ or BRANCH^ (where \"^\" can be repeated)." (defun vc-git-expanded-log-entry (revision) (with-temp-buffer - (apply 'vc-git-command t nil nil (list "log" revision "-1" "--")) + (apply #'vc-git-command t nil nil (list "log" revision "-1" "--")) (goto-char (point-min)) (unless (eobp) ;; Indent the expanded log entry. @@ -1415,7 +1416,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (vc-git-command (or buffer "*vc-diff*") 1 files "difftool" "--exit-code" "--no-prompt" "-x" (concat "diff " - (mapconcat 'identity + (mapconcat #'identity (vc-switches nil 'diff) " ")) rev1 rev2 "--")))) @@ -1776,7 +1777,7 @@ The difference to vc-do-command is that this function always invokes ,@(when revert-buffer-in-progress-p '("GIT_OPTIONAL_LOCKS=0"))) process-environment))) - (apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program + (apply #'vc-do-command (or buffer "*vc*") okstatus vc-git-program ;; https://debbugs.gnu.org/16897 (unless (and (not (cdr-safe file-or-list)) (let ((file (or (car-safe file-or-list) @@ -1810,10 +1811,10 @@ The difference to vc-do-command is that this function always invokes ,@(when revert-buffer-in-progress-p '("GIT_OPTIONAL_LOCKS=0"))) process-environment))) - (apply 'process-file vc-git-program nil buffer nil "--no-pager" command args))) + (apply #'process-file vc-git-program nil buffer nil "--no-pager" command args))) (defun vc-git--out-ok (command &rest args) - (zerop (apply 'vc-git--call '(t nil) command args))) + (zerop (apply #'vc-git--call '(t nil) command args))) (defun vc-git--run-command-string (file &rest args) "Run a git command on FILE and return its output as string. @@ -1821,7 +1822,7 @@ FILE can be nil." (let* ((ok t) (str (with-output-to-string (with-current-buffer standard-output - (unless (apply 'vc-git--out-ok + (unless (apply #'vc-git--out-ok (if file (append args (list (file-relative-name file))) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index adb0fce8759..9faed10f383 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -124,8 +124,7 @@ :type '(choice (const :tag "None" nil) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "22.2" - :group 'vc-hg) + :version "22.2") (defcustom vc-hg-diff-switches t ; Hg doesn't support common args like -u "String or list of strings specifying switches for Hg diff under VC. @@ -134,8 +133,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "23.1" - :group 'vc-hg) + :version "23.1") (defcustom vc-hg-annotate-switches '("-u" "--follow") "String or list of strings specifying switches for hg annotate under VC. @@ -145,8 +143,7 @@ switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "25.1" - :group 'vc-hg) + :version "25.1") (defcustom vc-hg-revert-switches nil "String or list of strings specifying switches for hg revert @@ -154,13 +151,11 @@ under VC." :type '(choice (const :tag "None" nil) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "27.1" - :group 'vc-hg) + :version "27.1") (defcustom vc-hg-program "hg" "Name of the Mercurial executable (excluding any arguments)." - :type 'string - :group 'vc-hg) + :type 'string) (defcustom vc-hg-root-log-format `(,(concat "{rev}:{ifeq(branch, 'default','', '{branch}')}" @@ -183,7 +178,6 @@ REGEXP is a regular expression matching the resulting Mercurial output, and KEYWORDS is a list of `font-lock-keywords' for highlighting the Log View buffer." :type '(list string regexp (repeat sexp)) - :group 'vc-hg :version "24.5") (defcustom vc-hg-create-bookmark t @@ -311,8 +305,7 @@ If no list entry produces a useful revision, return `nil'." (const :tag "Active bookmark" builtin-active-bookmark) (string :tag "Hg template") (function :tag "Custom"))) - :version "26.1" - :group 'vc-hg) + :version "26.1") (defcustom vc-hg-use-file-version-for-mode-line-version nil "When enabled, the modeline contains revision information for the visited file. @@ -320,8 +313,7 @@ When not, the revision in the modeline is for the repository working copy. `nil' is the much faster setting for large repositories." :type 'boolean - :version "26.1" - :group 'vc-hg) + :version "26.1") (defun vc-hg--active-bookmark-internal (rev) (when (equal rev ".") @@ -413,8 +405,7 @@ specific file to query." "String or list of strings specifying switches for hg log under VC." :type '(choice (const :tag "None" nil) (string :tag "Argument String") - (repeat :tag "Argument List" :value ("") string)) - :group 'vc-hg) + (repeat :tag "Argument List" :value ("") string))) (autoload 'vc-setup-buffer "vc-dispatcher") @@ -442,7 +433,7 @@ If LIMIT is non-nil, show no more than this many entries." (let ((inhibit-read-only t)) (with-current-buffer buffer - (apply 'vc-hg-command buffer 'async files "log" + (apply #'vc-hg-command buffer 'async files "log" (nconc (when start-revision (list (format "-r%s:0" start-revision))) (when limit (list "-l" (format "%s" limit))) @@ -666,8 +657,7 @@ directly instead of always running Mercurial. We try to be safe against Mercurial data structure format changes and always fall back to running Mercurial directly." :type 'boolean - :version "26.1" - :group 'vc-hg) + :version "26.1") (defsubst vc-hg--read-u8 () "Read and advance over an unsigned byte. @@ -1177,7 +1167,7 @@ hg binary." "Create a new Mercurial repository." (vc-hg-command nil 0 nil "init")) -(defalias 'vc-hg-responsible-p 'vc-hg-root) +(defalias 'vc-hg-responsible-p #'vc-hg-root) (defun vc-hg-unregister (file) "Unregister FILE from hg." @@ -1200,7 +1190,7 @@ If toggling on, also insert its message into the buffer." (defvar vc-hg-log-edit-mode-map (let ((map (make-sparse-keymap "Hg-Log-Edit"))) - (define-key map "\C-c\C-e" 'vc-hg-log-edit-toggle-amend) + (define-key map "\C-c\C-e" #'vc-hg-log-edit-toggle-amend) map)) (define-derived-mode vc-hg-log-edit-mode log-edit-mode "Log-Edit/hg" @@ -1214,7 +1204,7 @@ REV is ignored." (lambda (value) (when (equal value "yes") (list "--amend"))))) - (apply 'vc-hg-command nil 0 files + (apply #'vc-hg-command nil 0 files (nconc (list "commit" "-m") (log-edit-extract-headers `(("Author" . "--user") ("Date" . "--date") @@ -1252,7 +1242,7 @@ REV is the revision to check out into WORKFILE." (unless (re-search-forward "^<<<<<<< " nil t) (vc-hg-command nil 0 buffer-file-name "resolve" "-m") ;; Remove the hook so that it is not called multiple times. - (remove-hook 'after-save-hook 'vc-hg-resolve-when-done t)))) + (remove-hook 'after-save-hook #'vc-hg-resolve-when-done t)))) (defun vc-hg-find-file-hook () (when (and buffer-file-name @@ -1268,7 +1258,7 @@ REV is the revision to check out into WORKFILE." ;; Hg may not recognize "conflict" as a state, but we can do better. (vc-file-setprop buffer-file-name 'vc-state 'conflict) (smerge-start-session) - (add-hook 'after-save-hook 'vc-hg-resolve-when-done nil t) + (add-hook 'after-save-hook #'vc-hg-resolve-when-done nil t) (vc-message-unresolved-conflicts buffer-file-name))) @@ -1443,7 +1433,7 @@ commands, which only operated on marked files." (apply #'vc-hg-command nil 0 nil command - (apply 'nconc + (apply #'nconc (mapcar (lambda (arg) (list "-r" arg)) marked-list))) (let* ((root (vc-hg-root default-directory)) (buffer (format "*vc-hg : %s*" (expand-file-name root))) @@ -1463,18 +1453,18 @@ commands, which only operated on marked files." (setq hg-program (car args) command (cadr args) args (cddr args))) - (apply 'vc-do-async-command buffer root hg-program command args) + (apply #'vc-do-async-command buffer root hg-program command args) (with-current-buffer buffer (vc-run-delayed (dolist (cmd post-processing) - (apply 'vc-do-command buffer nil hg-program nil cmd)) + (apply #'vc-do-command buffer nil hg-program nil cmd)) (vc-compilation-mode 'hg) (setq-local compile-command (concat hg-program " " command " " - (mapconcat 'identity args " ") + (mapconcat #'identity args " ") (mapconcat (lambda (args) (concat " && " hg-program " " - (mapconcat 'identity + (mapconcat #'identity args " "))) post-processing ""))) (setq-local compilation-directory root) @@ -1525,7 +1515,7 @@ This runs the command \"hg merge\"." ;; Disable pager. (process-environment (cons "HGPLAIN=1" process-environment)) (branch (vc-read-revision "Revision to merge: "))) - (apply 'vc-do-async-command buffer root vc-hg-program + (apply #'vc-do-async-command buffer root vc-hg-program (append '("--config" "ui.report_untrusted=0" "merge") (unless (string= branch "") (list branch)))) (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg))) @@ -1540,7 +1530,8 @@ This function differs from vc-do-command in that it invokes ;; Disable pager. (let ((process-environment (cons "HGPLAIN=1" process-environment)) (flags (append '("--config" "ui.report_untrusted=0") flags))) - (apply 'vc-do-command (or buffer "*vc*") okstatus vc-hg-program file-or-list + (apply #'vc-do-command (or buffer "*vc*") + okstatus vc-hg-program file-or-list (if (stringp vc-hg-global-switches) (cons vc-hg-global-switches flags) (append vc-hg-global-switches diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index f910f9d5496..4b3c829a2c6 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -50,50 +50,42 @@ (defface vc-up-to-date-state '((default :inherit vc-state-base)) "Face for VC modeline state when the file is up to date." - :version "25.1" - :group 'vc-faces) + :version "25.1") (defface vc-needs-update-state '((default :inherit vc-state-base)) "Face for VC modeline state when the file needs update." - :version "25.1" - :group 'vc-faces) + :version "25.1") (defface vc-locked-state '((default :inherit vc-state-base)) "Face for VC modeline state when the file locked." - :version "25.1" - :group 'vc-faces) + :version "25.1") (defface vc-locally-added-state '((default :inherit vc-state-base)) "Face for VC modeline state when the file is locally added." - :version "25.1" - :group 'vc-faces) + :version "25.1") (defface vc-conflict-state '((default :inherit vc-state-base)) "Face for VC modeline state when the file contains merge conflicts." - :version "25.1" - :group 'vc-faces) + :version "25.1") (defface vc-removed-state '((default :inherit vc-state-base)) "Face for VC modeline state when the file was removed from the VC system." - :version "25.1" - :group 'vc-faces) + :version "25.1") (defface vc-missing-state '((default :inherit vc-state-base)) "Face for VC modeline state when the file is missing from the file system." - :version "25.1" - :group 'vc-faces) + :version "25.1") (defface vc-edited-state '((default :inherit vc-state-base)) "Face for VC modeline state when the file is edited." - :version "25.1" - :group 'vc-faces) + :version "25.1") ;; Customization Variables (the rest is in vc.el) @@ -871,31 +863,31 @@ In the latter case, VC mode is deactivated for this buffer." ;; (autoload 'vc-prefix-map "vc" nil nil 'keymap) (defvar vc-prefix-map (let ((map (make-sparse-keymap))) - (define-key map "a" 'vc-update-change-log) - (define-key map "b" 'vc-switch-backend) - (define-key map "d" 'vc-dir) - (define-key map "g" 'vc-annotate) - (define-key map "G" 'vc-ignore) - (define-key map "h" 'vc-region-history) - (define-key map "i" 'vc-register) - (define-key map "l" 'vc-print-log) - (define-key map "L" 'vc-print-root-log) - (define-key map "I" 'vc-log-incoming) - (define-key map "O" 'vc-log-outgoing) - (define-key map "ML" 'vc-log-mergebase) - (define-key map "MD" 'vc-diff-mergebase) - (define-key map "m" 'vc-merge) - (define-key map "r" 'vc-retrieve-tag) - (define-key map "s" 'vc-create-tag) - (define-key map "u" 'vc-revert) - (define-key map "v" 'vc-next-action) - (define-key map "+" 'vc-update) + (define-key map "a" #'vc-update-change-log) + (define-key map "b" #'vc-switch-backend) + (define-key map "d" #'vc-dir) + (define-key map "g" #'vc-annotate) + (define-key map "G" #'vc-ignore) + (define-key map "h" #'vc-region-history) + (define-key map "i" #'vc-register) + (define-key map "l" #'vc-print-log) + (define-key map "L" #'vc-print-root-log) + (define-key map "I" #'vc-log-incoming) + (define-key map "O" #'vc-log-outgoing) + (define-key map "ML" #'vc-log-mergebase) + (define-key map "MD" #'vc-diff-mergebase) + (define-key map "m" #'vc-merge) + (define-key map "r" #'vc-retrieve-tag) + (define-key map "s" #'vc-create-tag) + (define-key map "u" #'vc-revert) + (define-key map "v" #'vc-next-action) + (define-key map "+" #'vc-update) ;; I'd prefer some kind of symmetry with vc-update: - (define-key map "P" 'vc-push) - (define-key map "=" 'vc-diff) - (define-key map "D" 'vc-root-diff) - (define-key map "~" 'vc-revision-other-window) - (define-key map "x" 'vc-delete-file) + (define-key map "P" #'vc-push) + (define-key map "=" #'vc-diff) + (define-key map "D" #'vc-root-diff) + (define-key map "~" #'vc-revision-other-window) + (define-key map "x" #'vc-delete-file) map)) (fset 'vc-prefix-map vc-prefix-map) (define-key ctl-x-map "v" 'vc-prefix-map) diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el index 3b610a1e4fe..ea69893071a 100644 --- a/lisp/vc/vc-mtn.el +++ b/lisp/vc/vc-mtn.el @@ -46,8 +46,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "23.1" - :group 'vc-mtn) + :version "23.1") (defcustom vc-mtn-annotate-switches nil "String or list of strings specifying switches for mtn annotate under VC. @@ -57,13 +56,11 @@ switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "25.1" - :group 'vc-mtn) + :version "25.1") (defcustom vc-mtn-program "mtn" "Name of the monotone executable." - :type 'string - :group 'vc-mtn) + :type 'string) ;; Clear up the cache to force vc-call to check again and discover ;; new functions when we reload this file. @@ -115,7 +112,7 @@ switches." (let ((process-environment ;; Avoid localization of messages so we can parse the output. (cons "LC_MESSAGES=C" process-environment))) - (apply 'vc-do-command (or buffer "*vc*") okstatus vc-mtn-program + (apply #'vc-do-command (or buffer "*vc*") okstatus vc-mtn-program files flags))) (defun vc-mtn-state (file) @@ -176,8 +173,7 @@ switches." '(("\\`[^:/#]*[:/#]" . "")) ;Drop the host part. "Rewrite rules to shorten Mtn's revision names on the mode-line." :type '(repeat (cons regexp string)) - :version "22.2" - :group 'vc-mtn) + :version "22.2") (defun vc-mtn-mode-line-string (file) "Return a string for `vc-mode-line' to put in the mode line for FILE." @@ -203,7 +199,7 @@ switches." (declare-function log-edit-extract-headers "log-edit" (headers string)) (defun vc-mtn-checkin (files comment &optional _rev) - (apply 'vc-mtn-command nil 0 files + (apply #'vc-mtn-command nil 0 files (nconc (list "commit" "-m") (log-edit-extract-headers '(("Author" . "--author") ("Date" . "--date")) @@ -227,7 +223,7 @@ switches." _SHORTLOG is ignored. If START-REVISION is non-nil, it is the newest revision to show. If LIMIT is non-nil, show no more than this many entries." - (apply 'vc-mtn-command buffer 0 files "log" + (apply #'vc-mtn-command buffer 0 files "log" (append (when start-revision (list "--from" (format "%s" start-revision))) (when limit (list "--last" (format "%s" limit)))))) @@ -258,7 +254,7 @@ If LIMIT is non-nil, show no more than this many entries." (defun vc-mtn-diff (files &optional rev1 rev2 buffer _async) "Get a difference report using monotone between two revisions of FILES." - (apply 'vc-mtn-command (or buffer "*vc-diff*") + (apply #'vc-mtn-command (or buffer "*vc-diff*") 1 ; bug#21969 files "diff" (append diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 8d64ee5cc57..6ffc1a8a2ff 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -58,8 +58,7 @@ If nil, VC itself computes this value when it is first needed." :type '(choice (const :tag "Auto" nil) (string :tag "Specified") - (const :tag "Unknown" unknown)) - :group 'vc-rcs) + (const :tag "Unknown" unknown))) (defcustom vc-rcs-register-switches nil "Switches for registering a file in RCS. @@ -70,8 +69,7 @@ If t, use no switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "21.1" - :group 'vc-rcs) + :version "21.1") (defcustom vc-rcs-diff-switches nil "String or list of strings specifying switches for RCS diff under VC. @@ -80,21 +78,18 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "21.1" - :group 'vc-rcs) + :version "21.1") (defcustom vc-rcs-header '("$Id\ $") "Header keywords to be inserted by `vc-insert-headers'." :type '(repeat string) - :version "24.1" ; no longer consult the obsolete vc-header-alist - :group 'vc-rcs) + :version "24.1") ; no longer consult the obsolete vc-header-alist (defcustom vc-rcsdiff-knows-brief nil "Indicates whether rcsdiff understands the --brief option. The value is either `yes', `no', or nil. If it is nil, VC tries to use --brief and sets this variable to remember whether it worked." - :type '(choice (const :tag "Work out" nil) (const yes) (const no)) - :group 'vc-rcs) + :type '(choice (const :tag "Work out" nil) (const yes) (const no))) ;; This needs to be autoloaded because vc-rcs-registered uses it (via ;; vc-default-registered), and vc-hooks needs to be able to check @@ -109,8 +104,7 @@ For a description of possible values, see `vc-check-master-templates'." (repeat :tag "User-specified" (choice string function))) - :version "21.1" - :group 'vc-rcs) + :version "21.1") ;;; Properties of the backend @@ -379,7 +373,7 @@ whether to remove it." "Retrieve a copy of a saved version of FILE. If FILE is a directory, attempt the checkout for all registered files beneath it." (if (file-directory-p file) - (mapc 'vc-rcs-checkout (vc-expand-dirs (list file) 'RCS)) + (mapc #'vc-rcs-checkout (vc-expand-dirs (list file) 'RCS)) (let ((file-buffer (get-file-buffer file)) switches) (message "Checking out %s..." file) @@ -445,7 +439,7 @@ attempt the checkout for all registered files beneath it." "Revert FILE to the version it was based on. If FILE is a directory, revert all registered files beneath it." (if (file-directory-p file) - (mapc 'vc-rcs-revert (vc-expand-dirs (list file) 'RCS)) + (mapc #'vc-rcs-revert (vc-expand-dirs (list file) 'RCS)) (vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f" (concat (if (eq (vc-state file) 'edited) "-u" "-r") (vc-working-revision file))))) @@ -488,7 +482,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION." If FILE is a directory, steal the lock on all registered files beneath it. Needs RCS 5.6.2 or later for -M." (if (file-directory-p file) - (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file) 'RCS)) + (mapc #'vc-rcs-steal-lock (vc-expand-dirs (list file) 'RCS)) (vc-do-command "*vc*" 0 "rcs" (vc-master-name file) "-M" (concat "-u" rev)) ;; Do a real checkout after stealing the lock, so that we see ;; expanded headers. @@ -539,7 +533,7 @@ Remaining arguments are ignored. If FILE is a directory the operation is applied to all registered files beneath it." (vc-do-command (or buffer "*vc*") 0 "rlog" - (mapcar 'vc-master-name (vc-expand-dirs files 'RCS))) + (mapcar #'vc-master-name (vc-expand-dirs files 'RCS))) (with-current-buffer (or buffer "*vc*") (vc-rcs-print-log-cleanup)) (when limit 'limit-unsupported)) @@ -1344,7 +1338,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." (push `(,(to-eol) ,(k-semi 'date (lambda () - (let ((ls (mapcar 'string-to-number + (let ((ls (mapcar #'string-to-number (split-string (buffer-substring-no-properties b e) diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index 3d3f4048052..92cce5f13a8 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -55,8 +55,7 @@ If t, use no switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "21.1" - :group 'vc-sccs) + :version "21.1") (defcustom vc-sccs-diff-switches nil "String or list of strings specifying switches for SCCS diff under VC. @@ -65,14 +64,12 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "21.1" - :group 'vc-sccs) + :version "21.1") (defcustom vc-sccs-header '("%W%") "Header keywords to be inserted by `vc-insert-headers'." :type '(repeat string) - :version "24.1" ; no longer consult the obsolete vc-header-alist - :group 'vc-sccs) + :version "24.1") ; no longer consult the obsolete vc-header-alist ;; This needs to be autoloaded because vc-sccs-registered uses it (via ;; vc-default-registered), and vc-hooks needs to be able to check @@ -87,8 +84,7 @@ For a description of possible values, see `vc-check-master-templates'." (repeat :tag "User-specified" (choice string function))) - :version "21.1" - :group 'vc-sccs) + :version "21.1") ;;; @@ -163,7 +159,7 @@ For a description of possible values, see `vc-check-master-templates'." "Write the SCCS version of input file FILE to output file OUTFILE. Optional string REV is a revision." (with-temp-buffer - (apply 'vc-sccs-do-command t 0 "get" (vc-master-name file) + (apply #'vc-sccs-do-command t 0 "get" (vc-master-name file) (append '("-s" "-p" "-k") ; -k: no keyword expansion (if rev (list (concat "-r" rev))))) (write-region nil nil outfile nil 'silent))) @@ -185,7 +181,7 @@ Optional string REV is a revision." (defun vc-sccs-do-command (buffer okstatus command file-or-list &rest flags) ;; (let ((load-path (append vc-sccs-path load-path))) ;; (apply 'vc-do-command buffer okstatus command file-or-list flags)) - (apply 'vc-do-command (or buffer "*vc*") okstatus "sccs" file-or-list command flags)) + (apply #'vc-do-command (or buffer "*vc*") okstatus "sccs" file-or-list command flags)) (defun vc-sccs-create-repo () "Create a new SCCS repository." @@ -207,7 +203,7 @@ to the SCCS command." (let ((vc-master-name (or project-file (format (car vc-sccs-master-templates) dirname basename)))) - (apply 'vc-sccs-do-command nil 0 "admin" vc-master-name + (apply #'vc-sccs-do-command nil 0 "admin" vc-master-name "-fb" (concat "-i" (file-relative-name file)) (and comment (concat "-y" comment)) @@ -225,14 +221,14 @@ to the SCCS command." (defun vc-sccs-checkin (files comment &optional rev) "SCCS-specific version of `vc-backend-checkin'." (dolist (file (vc-expand-dirs files 'SCCS)) - (apply 'vc-sccs-do-command nil 0 "delta" (vc-master-name file) + (apply #'vc-sccs-do-command nil 0 "delta" (vc-master-name file) (if rev (concat "-r" rev)) (concat "-y" comment) (vc-switches 'SCCS 'checkin)) (vc-sccs-do-command nil 0 "get" (vc-master-name file)))) (defun vc-sccs-find-revision (file rev buffer) - (apply 'vc-sccs-do-command + (apply #'vc-sccs-do-command buffer 0 "get" (vc-master-name file) "-s" ;; suppress diagnostic output "-p" @@ -247,7 +243,7 @@ If FILE is a directory, all version-controlled files beneath are checked out. EDITABLE non-nil means that the file should be writable and locked. REV is the revision to check out." (if (file-directory-p file) - (mapc 'vc-sccs-checkout (vc-expand-dirs (list file) 'SCCS)) + (mapc #'vc-sccs-checkout (vc-expand-dirs (list file) 'SCCS)) (let ((file-buffer (get-file-buffer file)) switches) (message "Checking out %s..." file) @@ -267,7 +263,7 @@ locked. REV is the revision to check out." (and rev (or (string= rev "") (not (stringp rev))) (setq rev nil)) - (apply 'vc-sccs-do-command nil 0 "get" (vc-master-name file) + (apply #'vc-sccs-do-command nil 0 "get" (vc-master-name file) "-e" (and rev (concat "-r" (vc-sccs-lookup-triple file rev))) switches)))) @@ -277,7 +273,7 @@ locked. REV is the revision to check out." "Revert FILE to the version it was based on. If FILE is a directory, revert all subfiles." (if (file-directory-p file) - (mapc 'vc-sccs-revert (vc-expand-dirs (list file) 'SCCS)) + (mapc #'vc-sccs-revert (vc-expand-dirs (list file) 'SCCS)) (vc-sccs-do-command nil 0 "unget" (vc-master-name file)) (vc-sccs-do-command nil 0 "get" (vc-master-name file)) ;; Checking out explicit revisions is not supported under SCCS, yet. @@ -288,7 +284,7 @@ revert all subfiles." (defun vc-sccs-steal-lock (file &optional rev) "Steal the lock on the current workfile for FILE and revision REV." (if (file-directory-p file) - (mapc 'vc-sccs-steal-lock (vc-expand-dirs (list file) 'SCCS)) + (mapc #'vc-sccs-steal-lock (vc-expand-dirs (list file) 'SCCS)) (vc-sccs-do-command nil 0 "unget" (vc-master-name file) "-n" (if rev (concat "-r" rev))) (vc-sccs-do-command nil 0 "get" @@ -309,7 +305,7 @@ revert all subfiles." "Print commit log associated with FILES into specified BUFFER. Remaining arguments are ignored." (setq files (vc-expand-dirs files 'SCCS)) - (vc-sccs-do-command buffer 0 "prs" (mapcar 'vc-master-name files)) + (vc-sccs-do-command buffer 0 "prs" (mapcar #'vc-master-name files)) (when limit 'limit-unsupported)) (autoload 'vc-setup-buffer "vc-dispatcher") @@ -338,7 +334,7 @@ Remaining arguments are ignored." (fake-command (format "diff%s %s" (if fake-flags - (concat " " (mapconcat 'identity fake-flags " ")) + (concat " " (mapconcat #'identity fake-flags " ")) "") (vc-delistify files))) (status 0) @@ -362,7 +358,7 @@ Remaining arguments are ignored." (cons "LC_MESSAGES=C" process-environment)) (w32-quote-process-args t) (this-status - (apply 'process-file "diff" nil t nil + (apply #'process-file "diff" nil t nil (append (vc-switches 'SCCS 'diff) (list (file-local-name oldfile) (or newfile diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el index 201d69d79a1..faba5bce2b7 100644 --- a/lisp/vc/vc-src.el +++ b/lisp/vc/vc-src.el @@ -97,13 +97,11 @@ If nil, VC itself computes this value when it is first needed." :type '(choice (const :tag "Auto" nil) (string :tag "Specified") - (const :tag "Unknown" unknown)) - :group 'vc-src) + (const :tag "Unknown" unknown))) (defcustom vc-src-program "src" "Name of the SRC executable (excluding any arguments)." - :type 'string - :group 'vc-src) + :type 'string) (defcustom vc-src-diff-switches nil "String or list of strings specifying switches for SRC diff under VC. @@ -111,8 +109,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." :type '(choice (const :tag "Unspecified" nil) (const :tag "None" t) (string :tag "Argument String") - (repeat :tag "Argument List" :value ("") string)) - :group 'vc-src) + (repeat :tag "Argument List" :value ("") string))) ;; This needs to be autoloaded because vc-src-registered uses it (via ;; vc-default-registered), and vc-hooks needs to be able to check @@ -126,8 +123,7 @@ For a description of possible values, see `vc-check-master-templates'." '("%s.src/%s,v")) (repeat :tag "User-specified" (choice string - function))) - :group 'vc-src) + function)))) ;;; Properties of the backend @@ -221,7 +217,7 @@ This function differs from vc-do-command in that it invokes `vc-src-program'." (setq file-list (list "--" file-or-list))) (file-or-list (setq file-list (cons "--" file-or-list)))) - (apply 'vc-do-command (or buffer "*vc*") 0 vc-src-program file-list flags))) + (apply #'vc-do-command (or buffer "*vc*") 0 vc-src-program file-list flags))) (defun vc-src-working-revision (file) "SRC-specific version of `vc-working-revision'." @@ -275,7 +271,7 @@ REV is the revision to check out into WORKFILE." "Revert FILE to the version it was based on. If FILE is a directory, revert all registered files beneath it." (if (file-directory-p file) - (mapc 'vc-src-revert (vc-expand-dirs (list file) 'SRC)) + (mapc #'vc-src-revert (vc-expand-dirs (list file) 'SRC)) (vc-src-command nil file "co"))) (defun vc-src-modify-change-comment (files rev comment) @@ -290,8 +286,7 @@ directory the operation is applied to all registered files beneath it." "String or list of strings specifying switches for src log under VC." :type '(choice (const :tag "None" nil) (string :tag "Argument String") - (repeat :tag "Argument List" :value ("") string)) - :group 'vc-src) + (repeat :tag "Argument List" :value ("") string))) (defun vc-src-print-log (files buffer &optional shortlog _start-revision limit) "Print commit log associated with FILES into specified BUFFER. @@ -307,7 +302,7 @@ If LIMIT is non-nil, show no more than this many entries." (let ((inhibit-read-only t)) (with-current-buffer buffer - (apply 'vc-src-command buffer files (if shortlog "list" "log") + (apply #'vc-src-command buffer files (if shortlog "list" "log") (nconc ;;(when start-revision (list (format "%s-1" start-revision))) (when limit (list "-l" (format "%s" limit))) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 22becc91cd1..c30920dd157 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -47,8 +47,7 @@ ;; FIXME there is also svnadmin. (defcustom vc-svn-program "svn" "Name of the SVN executable." - :type 'string - :group 'vc-svn) + :type 'string) ;; Might be nice if svn defaulted to non-interactive if stdin not tty. ;; https://svn.haxx.se/dev/archive-2008-05/0762.shtml @@ -64,8 +63,7 @@ hanging while prompting for authorization." (repeat :tag "Argument List" :value ("") string)) - :version "24.4" - :group 'vc-svn) + :version "24.4") (defcustom vc-svn-register-switches nil "Switches for registering a file into SVN. @@ -76,8 +74,7 @@ If t, use no switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "22.1" - :group 'vc-svn) + :version "22.1") (defcustom vc-svn-diff-switches t ;`svn' doesn't support common args like -c or -b. @@ -92,8 +89,7 @@ If you want to force an empty list of arguments, use t." (repeat :tag "Argument List" :value ("") string)) - :version "22.1" - :group 'vc-svn) + :version "22.1") (defcustom vc-svn-annotate-switches nil "String or list of strings specifying switches for svn annotate under VC. @@ -103,14 +99,12 @@ switches." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :version "25.1" - :group 'vc-svn) + :version "25.1") (defcustom vc-svn-header '("$Id\ $") "Header keywords to be inserted by `vc-insert-headers'." :version "24.1" ; no longer consult the obsolete vc-header-alist - :type '(repeat string) - :group 'vc-svn) + :type '(repeat string)) ;; We want to autoload it for use by the autoloaded version of ;; vc-svn-registered, but we want the value to be compiled at startup, not @@ -305,19 +299,19 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." The COMMENT argument is ignored This does an add but not a commit. Passes either `vc-svn-register-switches' or `vc-register-switches' to the SVN command." - (apply 'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register))) + (apply #'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register))) (defun vc-svn-root (file) (vc-find-root file vc-svn-admin-directory)) -(defalias 'vc-svn-responsible-p 'vc-svn-root) +(defalias 'vc-svn-responsible-p #'vc-svn-root) (declare-function log-edit-extract-headers "log-edit" (headers string)) (defun vc-svn-checkin (files comment &optional _extra-args-ignored) "SVN-specific version of `vc-backend-checkin'." (let ((status (apply - 'vc-svn-command nil 1 files "ci" + #'vc-svn-command nil 1 files "ci" (nconc (cons "-m" (log-edit-extract-headers nil comment)) (vc-switches 'SVN 'checkin))))) (set-buffer "*vc*") @@ -345,7 +339,7 @@ to the SVN command." (defun vc-svn-find-revision (file rev buffer) "SVN-specific retrieval of a specified version into a buffer." (let (process-file-side-effects) - (apply 'vc-svn-command + (apply #'vc-svn-command buffer 0 file "cat" (and rev (not (string= rev "")) @@ -391,7 +385,7 @@ DIRECTORY or absolute." nil ;; Check out a particular version (or recreate the file). (vc-file-setprop file 'vc-working-revision nil) - (apply 'vc-svn-command nil 0 file + (apply #'vc-svn-command nil 0 file "update" (cond ((null rev) "-rBASE") @@ -563,27 +557,27 @@ If LIMIT is non-nil, show no more than this many entries." (goto-char (point-min)) (if files (dolist (file files) - (insert "Working file: " file "\n") - (apply - 'vc-svn-command - buffer - 'async - (list file) - "log" - (append - (list - (if start-revision - (format "-r%s:1" start-revision) - ;; By default Subversion only shows the log up to the - ;; working revision, whereas we also want the log of the - ;; subsequent commits. At least that's what the - ;; vc-cvs.el code does. - "-rHEAD:0")) - (if (eq vc-log-view-type 'with-diff) - (list "--diff")) - (when limit (list "--limit" (format "%s" limit)))))) + (insert "Working file: " file "\n") + (apply + #'vc-svn-command + buffer + 'async + (list file) + "log" + (append + (list + (if start-revision + (format "-r%s:1" start-revision) + ;; By default Subversion only shows the log up to the + ;; working revision, whereas we also want the log of the + ;; subsequent commits. At least that's what the + ;; vc-cvs.el code does. + "-rHEAD:0")) + (if (eq vc-log-view-type 'with-diff) + (list "--diff")) + (when limit (list "--limit" (format "%s" limit)))))) ;; Dump log for the entire directory. - (apply 'vc-svn-command buffer 0 nil "log" + (apply #'vc-svn-command buffer 0 nil "log" (append (list (if start-revision (format "-r%s" start-revision) "-rHEAD:0")) @@ -611,8 +605,8 @@ If LIMIT is non-nil, show no more than this many entries." (if vc-svn-diff-switches (vc-switches 'SVN 'diff) (list (concat "--diff-cmd=" diff-command) "-x" - (mapconcat 'identity (vc-switches nil 'diff) " "))))) - (apply 'vc-svn-command buffer + (mapconcat #'identity (vc-switches nil 'diff) " "))))) + (apply #'vc-svn-command buffer (if async 'async 0) files "diff" (append @@ -671,7 +665,7 @@ NAME is assumed to be a URL." "A wrapper around `vc-do-command' for use in vc-svn.el. The difference to vc-do-command is that this function always invokes `svn', and that it passes `vc-svn-global-switches' to it before FLAGS." - (apply 'vc-do-command (or buffer "*vc*") okstatus vc-svn-program file-or-list + (apply #'vc-do-command (or buffer "*vc*") okstatus vc-svn-program file-or-list (if (stringp vc-svn-global-switches) (cons vc-svn-global-switches flags) (append vc-svn-global-switches flags)))) @@ -683,7 +677,7 @@ and that it passes `vc-svn-global-switches' to it before FLAGS." (unless (re-search-forward "^<<<<<<< " nil t) (vc-svn-command nil 0 buffer-file-name "resolved") ;; Remove the hook so that it is not called multiple times. - (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t)))) + (remove-hook 'after-save-hook #'vc-svn-resolve-when-done t)))) ;; Inspired by vc-arch-find-file-hook. (defun vc-svn-find-file-hook () @@ -696,7 +690,7 @@ and that it passes `vc-svn-global-switches' to it before FLAGS." ;; There are conflict markers. (progn (smerge-start-session) - (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t)) + (add-hook 'after-save-hook #'vc-svn-resolve-when-done nil t)) ;; There are no conflict markers. This is problematic: maybe it means ;; the conflict has been resolved and we should immediately call "svn ;; resolved", or it means that the file's type does not allow Svn to diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 00976a07d42..b926c3819dd 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1425,6 +1425,7 @@ first backend that could register the file is used." (let ((vc-handled-backends (list backend))) (call-interactively 'vc-register))) +;;;###autoload (defun vc-ignore (file &optional directory remove) "Ignore FILE under the VCS of DIRECTORY. |