diff options
Diffstat (limited to 'lisp')
137 files changed, 2560 insertions, 3150 deletions
diff --git a/lisp/allout.el b/lisp/allout.el index ff0b67556e0..7fcf41c4304 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1206,7 +1206,6 @@ Also refresh various data structures that hinge on the regexp." (defvar allout-mode-navigation-menu) (defvar allout-mode-misc-menu) (defun allout-produce-mode-menubar-entries () - (require 'easymenu) (easy-menu-define allout-mode-exposure-menu allout-mode-map-value "Allout outline exposure menu." diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index e5bfccdb8ba..44dc0351d45 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -429,7 +429,8 @@ being deleted." ;; positions that overlap regions previously colored; these ;; `codes' should not be applied to that overlap, so we need ;; to know where they should really start. - (setq ansi-color-context-region (if codes (list codes end-marker))))) + (setq ansi-color-context-region + (if codes (list codes (copy-marker (point))))))) ;; Clean up our temporary markers. (unless (eq start-marker (cadr ansi-color-context-region)) (set-marker start-marker nil)) diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el index 16cca055330..ac14e36c63c 100644 --- a/lisp/calc/calc-menu.el +++ b/lisp/calc/calc-menu.el @@ -781,7 +781,7 @@ :active (>= (calc-stack-size) 2) :help "The cross product in R^3"] ["(2:) dot (1:)" - calc-mult + calc-times :keys "*" :active (>= (calc-stack-size) 2) :help "The dot product"] diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el index ba52784a7a8..397354ad9c0 100644 --- a/lisp/cedet/ede/proj-comp.el +++ b/lisp/cedet/ede/proj-comp.el @@ -248,6 +248,7 @@ This will prevent rules from creating duplicate variables or rules." (defmacro proj-comp-insert-variable-once (varname &rest body) "Add VARNAME into the current Makefile if it doesn't exist. Execute BODY in a location where a value can be placed." + (declare (indent 1) (debug (sexp body))) `(let ((addcr t) (v ,varname)) (unless (re-search-backward (concat "^" v "\\s-*=") nil t) (insert v "=") @@ -255,7 +256,6 @@ Execute BODY in a location where a value can be placed." (if addcr (insert "\n")) (goto-char (point-max))) )) -(put 'proj-comp-insert-variable-once 'lisp-indent-function 1) (cl-defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program)) "Insert variables needed by the compiler THIS." diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index dc617349021..4d94d343234 100644 --- a/lisp/cedet/semantic/bovine/el.el +++ b/lisp/cedet/semantic/bovine/el.el @@ -1,4 +1,4 @@ -;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp +;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc. @@ -169,10 +169,10 @@ where: - FORM is an Elisp form read from the current buffer. - START and END are the beginning and end location of the corresponding data in the current buffer." + (declare (indent 1)) (let ((sym (make-symbol "sym"))) `(dolist (,sym ',symbols) (put ,sym 'semantic-elisp-form-parser #',parser)))) -(put 'semantic-elisp-setup-form-parser 'lisp-indent-function 1) (defmacro semantic-elisp-reuse-form-parser (symbol &rest symbols) "Reuse the form parser of SYMBOL for forms identified by SYMBOLS. @@ -210,7 +210,7 @@ Return a bovination list to use." ;;; Form parsers ;; (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (semantic-tag-new-function (symbol-name (nth 2 form)) nil @@ -234,7 +234,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (semantic-tag-new-function (symbol-name (nth 1 form)) nil @@ -256,7 +256,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form)))) (semantic-tag-new-variable (symbol-name (nth 1 form)) @@ -274,7 +274,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form)))) (semantic-tag-new-variable (symbol-name (nth 1 form)) @@ -290,7 +290,7 @@ Return a bovination list to use." (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form)))) (semantic-tag-new-variable (symbol-name (nth 1 form)) @@ -307,7 +307,7 @@ Return a bovination list to use." (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form)))) (semantic-tag (symbol-name (nth 1 form)) @@ -321,7 +321,7 @@ Return a bovination list to use." (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (semantic-tag-new-function (symbol-name (cadr (cadr form))) nil nil @@ -333,7 +333,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let* ((a2 (nth 2 form)) (a3 (nth 3 form)) (args (if (listp a2) a2 a3)) @@ -353,7 +353,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (semantic-tag-new-function (symbol-name (nth 1 form)) nil @@ -363,7 +363,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((docpart (nthcdr 4 form))) (semantic-tag-new-type (symbol-name (nth 1 form)) @@ -381,7 +381,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((slots (nthcdr 2 form))) ;; Skip doc string if present. (and (stringp (car slots)) @@ -399,7 +399,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (semantic-tag-new-function (symbol-name (nth 1 form)) nil nil @@ -410,7 +410,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((args (nth 3 form))) (semantic-tag-new-function (symbol-name (nth 1 form)) @@ -424,7 +424,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (semantic-tag-new-variable (symbol-name (nth 2 form)) nil @@ -437,7 +437,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((name (nth 1 form))) (semantic-tag-new-include (symbol-name (if (eq (car-safe name) 'quote) @@ -449,7 +449,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((name (nth 1 form))) (semantic-tag-new-package (symbol-name (if (eq (car-safe name) 'quote) @@ -500,7 +500,7 @@ into Emacs Lisp's memory." "")))) (define-mode-local-override semantic-documentation-for-tag - emacs-lisp-mode (tag &optional nosnarf) + emacs-lisp-mode (tag &optional _nosnarf) "Return the documentation string for TAG. Optional argument NOSNARF is ignored." (let ((d (semantic-tag-docstring tag))) @@ -577,7 +577,7 @@ Override function for `semantic-tag-protection'." ((string= prot "protected") 'protected)))) (define-mode-local-override semantic-tag-static-p - emacs-lisp-mode (tag &optional parent) + emacs-lisp-mode (tag &optional _parent) "Return non-nil if TAG is static in PARENT class. Overrides `semantic-nonterminal-static'." ;; This can only be true (theoretically) in a class where it is assigned. @@ -588,7 +588,7 @@ Overrides `semantic-nonterminal-static'." ;; Emacs lisp is very different from C,C++ which most context parsing ;; functions are written. Support them here. (define-mode-local-override semantic-up-context emacs-lisp-mode - (&optional point bounds-type) + (&optional _point _bounds-type) "Move up one context in an Emacs Lisp function. A Context in many languages is a block with its own local variables. In Emacs, we will move up lists and stop when one starts with one of @@ -652,7 +652,7 @@ define-mode-overload\\)\ (define-mode-local-override semantic-get-local-variables emacs-lisp-mode - (&optional point) + (&optional _point) "Return a list of local variables for POINT. Scan backwards from point at each successive function. For all occurrences of `let' or `let*', grab those variable names." diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 91944c44f5e..3c36c6cb9f8 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -189,14 +189,13 @@ will throw a warning when it encounters this symbol." (when (and (mode-local--function-overload-p newfn) (not (mode-local--overload-obsoleted-by newfn)) ;; Only throw this warning when byte compiling things. - (boundp 'byte-compile-current-file) - byte-compile-current-file - (not (string-match "cedet" byte-compile-current-file)) + (macroexp-compiling-p) + (not (string-match "cedet" (macroexp-file-name))) ) (make-obsolete-overload oldfnalias newfn when) (byte-compile-warn "%s: `%s' obsoletes overload `%s'" - byte-compile-current-file + (macroexp-file-name) newfn (with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function)) (semantic-overload-symbol-from-function oldfnalias))))) @@ -211,8 +210,7 @@ will throw a warning when it encounters this symbol." (defvaralias oldvaralias newvar) (error ;; Only throw this warning when byte compiling things. - (when (and (boundp 'byte-compile-current-file) - byte-compile-current-file) + (when (macroexp-compiling-p) (byte-compile-warn "variable `%s' obsoletes, but isn't alias of `%s'" newvar oldvaralias) diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el index d7cd8e1940c..debdfd1dc04 100644 --- a/lisp/cedet/semantic/sb.el +++ b/lisp/cedet/semantic/sb.el @@ -1,4 +1,4 @@ -;;; semantic/sb.el --- Semantic tag display for speedbar +;;; semantic/sb.el --- Semantic tag display for speedbar -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -73,10 +73,10 @@ use the `speedbar-line-file' to get this info if needed." (defmacro semantic-sb-with-tag-buffer (tag &rest forms) "Set the current buffer to the origin of TAG and execute FORMS. Restore the old current buffer when completed." + (declare (indent 1) (debug t)) `(save-excursion (semantic-sb-tag-set-buffer ,tag) ,@forms)) -(put 'semantic-sb-with-tag-buffer 'lisp-indent-function 1) ;;; Button Generation ;; @@ -294,7 +294,7 @@ TEXT TOKEN and INDENT are the details." (t (error "Ooops... not sure what to do"))) (speedbar-center-buffer-smartly)) -(defun semantic-sb-token-jump (text token indent) +(defun semantic-sb-token-jump (_text token indent) "Jump to the location specified in token. TEXT TOKEN and INDENT are the details." (let ((file diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 755d30a371b..7a64fe2fec3 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -159,13 +159,9 @@ Its name is defined in constant `wisent-log-buffer-name'." '(with-current-buffer (wisent-log-buffer) (erase-buffer))) -(defvar byte-compile-current-file) - (defun wisent-source () "Return the current source file name or nil." - (let ((source (or (and (boundp 'byte-compile-current-file) - byte-compile-current-file) - load-file-name (buffer-file-name)))) + (let ((source (macroexp-file-name))) (if source (file-relative-name source)))) @@ -2241,7 +2237,7 @@ there are any reduce/reduce conflicts." ;; output warnings. (and src (intern (format "wisent-%s--expected-conflicts" - (replace-regexp-in-string "\\.el$" "" src)))))) + (replace-regexp-in-string "\\.el\\'" "" src)))))) (when (or (not (zerop rrc-total)) (and (not (zerop src-total)) (not (= src-total (or wisent-expected-conflicts 0))) diff --git a/lisp/comint.el b/lisp/comint.el index ea69c3b1f11..5c307febe2a 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -104,6 +104,7 @@ (require 'ring) (require 'ansi-color) (require 'regexp-opt) ;For regexp-opt-charset. +(eval-when-compile (require 'subr-x)) ;; Buffer Local Variables: ;;============================================================================ @@ -2430,14 +2431,11 @@ This function could be in the list `comint-output-filter-functions'." (when (let ((case-fold-search t)) (string-match comint-password-prompt-regexp (replace-regexp-in-string "\r" "" string))) - (when (string-match "^[ \n\r\t\v\f\b\a]+" string) - (setq string (replace-match "" t t string))) - (when (string-match "\n+\\'" string) - (setq string (replace-match "" t t string))) (let ((comint--prompt-recursion-depth (1+ comint--prompt-recursion-depth))) (if (> comint--prompt-recursion-depth 10) (message "Password prompt recursion too deep") - (comint-send-invisible string))))) + (comint-send-invisible + (string-trim string "[ \n\r\t\v\f\b\a]+" "\n+")))))) ;; Low-level process communication diff --git a/lisp/cus-start.el b/lisp/cus-start.el index c0a4a6dda06..7b05f5796a4 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -302,6 +302,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; fns.c (use-dialog-box menu boolean "21.1") (use-file-dialog menu boolean "22.1") + (use-short-answers menu boolean "28.1") (focus-follows-mouse frames (choice (const :tag "Off (nil)" :value nil) diff --git a/lisp/dired.el b/lisp/dired.el index 553fb64da05..4f1c3ded092 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -60,10 +60,15 @@ 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." diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index df0beb5c9fd..534e57e06d3 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -154,7 +154,7 @@ The return value of this function is not used." (defalias 'byte-run--set-completion #'(lambda (f _args val) (list 'function-put (list 'quote f) - ''completion-predicate val))) + ''completion-predicate (list 'function val)))) (defalias 'byte-run--set-modes #'(lambda (f _args &rest val) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 25e1920cb90..4169b0756df 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1776,6 +1776,11 @@ It is too wide if it has any lines longer than the largest of ;; (byte-compile-generate-emacs19-bytecodes ;; byte-compile-generate-emacs19-bytecodes) (byte-compile-warnings byte-compile-warnings) + ;; Indicate that we're not currently loading some file. + ;; This is used in `macroexp-file-name' to make sure that + ;; loading file A which does (byte-compile-file B) won't + ;; cause macro calls in B to think they come from A. + (current-load-list (list nil)) ) (prog1 (progn ,@body) @@ -3906,20 +3911,37 @@ discarding." docstring-exp)) ;Otherwise, we don't need a closure. (cl-assert (byte-code-function-p fun)) (byte-compile-form - ;; Use symbols V0, V1 ... as placeholders for closure variables: - ;; they should be short (to save space in the .elc file), yet - ;; distinct when disassembled. - (let* ((dummy-vars (mapcar (lambda (i) (intern (format "V%d" i))) - (number-sequence 0 (1- (length env))))) - (proto-fun - (apply #'make-byte-code - (aref fun 0) (aref fun 1) - ;; Prepend dummy cells to the constant vector, - ;; to get the indices right when disassembling. - (vconcat dummy-vars (aref fun 2)) - (mapcar (lambda (i) (aref fun i)) - (number-sequence 3 (1- (length fun))))))) - `(make-closure ,proto-fun ,@env)))))) + (if (or (not docstring-exp) (stringp docstring-exp)) + ;; Use symbols V0, V1 ... as placeholders for closure variables: + ;; they should be short (to save space in the .elc file), yet + ;; distinct when disassembled. + (let* ((dummy-vars (mapcar (lambda (i) (intern (format "V%d" i))) + (number-sequence 0 (1- (length env))))) + (opt-args (mapcar (lambda (i) (aref fun i)) + (number-sequence 4 (1- (length fun))))) + (proto-fun + (apply #'make-byte-code + (aref fun 0) (aref fun 1) + ;; Prepend dummy cells to the constant vector, + ;; to get the indices right when disassembling. + (vconcat dummy-vars (aref fun 2)) + (aref fun 3) + (if docstring-exp + (cons docstring-exp (cdr opt-args)) + opt-args)))) + `(make-closure ,proto-fun ,@env)) + ;; Nontrivial doc string expression: create a bytecode object + ;; from small pieces at run time. + `(make-byte-code + ',(aref fun 0) ',(aref fun 1) + (vconcat (vector . ,env) ',(aref fun 2)) + ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun)))) + (if docstring-exp + `(,(car rest) + ,docstring-exp + ,@(cddr rest)) + rest)))) + )))) (defun byte-compile-get-closed-var (form) "Byte-compile the special `internal-get-closed-var' form." diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 28ce6b115a4..84199c16127 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -898,8 +898,8 @@ Outputs to the current buffer." (list (cl-prin1-to-string (cl--slot-descriptor-name slot)) (cl-prin1-to-string (cl--slot-descriptor-type slot)) (cl-prin1-to-string (cl--slot-descriptor-initform slot)) - (let ((doc (alist-get :documentation - (cl--slot-descriptor-props slot)))) + (let ((doc (plist-get (cl--slot-descriptor-props slot) + :documentation))) (if (not doc) "" (setq has-doc t) (substitute-command-keys doc))))) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index f06452ea174..7f7eb963423 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -232,13 +232,8 @@ one value. ;;; Declarations. -(defvar cl--compiling-file nil) -(defun cl--compiling-file () - (or cl--compiling-file - (and (boundp 'byte-compile--outbuffer) - (bufferp (symbol-value 'byte-compile--outbuffer)) - (equal (buffer-name (symbol-value 'byte-compile--outbuffer)) - " *Compiler Output*")))) +(define-obsolete-function-alias 'cl--compiling-file + #'macroexp-compiling-p "28.1") (defvar cl--proclaims-deferred nil) @@ -253,7 +248,7 @@ one value. Puts `(cl-eval-when (compile load eval) ...)' around the declarations so that they are registered at compile-time as well as run-time." (let ((body (mapcar (lambda (x) `(cl-proclaim ',x)) specs))) - (if (cl--compiling-file) `(cl-eval-when (compile load eval) ,@body) + (if (macroexp-compiling-p) `(cl-eval-when (compile load eval) ,@body) `(progn ,@body)))) ; Avoid loading cl-macs.el for cl-eval-when. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 709085a6d9e..0184fd57e25 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -545,7 +545,7 @@ its argument list allows full Common Lisp conventions." (let ((p (memq '&body args))) (if p (setcar p '&rest))) (if (memq '&environment args) (error "&environment used incorrectly")) (let ((restarg (memq '&rest args)) - (safety (if (cl--compiling-file) cl--optimize-safety 3)) + (safety (if (macroexp-compiling-p) cl--optimize-safety 3)) (keys t) (laterarg nil) (exactarg nil) minarg) (or num (setq num 0)) @@ -709,7 +709,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. \(fn (WHEN...) BODY...)" (declare (indent 1) (debug (sexp body))) - (if (and (fboundp 'cl--compiling-file) (cl--compiling-file) + (if (and (macroexp-compiling-p) (not cl--not-toplevel) (not (boundp 'for-effect))) ;Horrible kludge. (let ((comp (or (memq 'compile when) (memq :compile-toplevel when))) (cl--not-toplevel t)) @@ -738,7 +738,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. "Like `progn', but evaluates the body at load time. The result of the body appears to the compiler as a quoted constant." (declare (debug (form &optional sexp))) - (if (cl--compiling-file) + (if (macroexp-compiling-p) (let* ((temp (cl-gentemp "--cl-load-time--")) (set `(setq ,temp ,form))) (if (and (fboundp 'byte-compile-file-form-defmumble) @@ -2463,7 +2463,7 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). (fixnum `(comp-hint-fixnum ,form)) (cons `(comp-hint-cons ,form)) (otherwise form)))) - (if (not (or (not (cl--compiling-file)) + (if (not (or (not (macroexp-compiling-p)) (< cl--optimize-speed 3) (= cl--optimize-safety 3))) form @@ -2552,7 +2552,7 @@ For instance will turn off byte-compile warnings in the function. See Info node `(cl)Declarations' for details." - (if (cl--compiling-file) + (if (macroexp-compiling-p) (while specs (if (listp cl--declare-stack) (push (car specs) cl--declare-stack)) (cl--do-proclaim (pop specs) nil))) @@ -2889,7 +2889,7 @@ Supported keywords for slots are: (copier (intern (format "copy-%s" name))) (predicate (intern (format "%s-p" name))) (print-func nil) (print-auto nil) - (safety (if (cl--compiling-file) cl--optimize-safety 3)) + (safety (if (macroexp-compiling-p) cl--optimize-safety 3)) (include nil) ;; There are 4 types of structs: ;; - `vector' type: means we should use a vector, which can come @@ -3293,7 +3293,7 @@ does not contain SLOT-NAME." "Return non-nil if SYM will be bound when we run the code. Of course, we really can't know that for sure, so it's just a heuristic." (or (fboundp sym) - (and (cl--compiling-file) + (and (macroexp-compiling-p) (or (cdr (assq sym byte-compile-function-environment)) (cdr (assq sym byte-compile-macro-environment)))))) @@ -3389,7 +3389,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." "Verify that FORM is of type TYPE; signal an error if not. STRING is an optional description of the desired type." (declare (debug (place cl-type-spec &optional stringp))) - (and (or (not (cl--compiling-file)) + (and (or (not (macroexp-compiling-p)) (< cl--optimize-speed 3) (= cl--optimize-safety 3)) (macroexp-let2 macroexp-copyable-p temp form `(progn (or (cl-typep ,temp ',type) @@ -3409,7 +3409,7 @@ Other args STRING and ARGS... are arguments to be passed to `error'. They are not evaluated unless the assertion fails. If STRING is omitted, a default message listing FORM itself is used." (declare (debug (form &rest form))) - (and (or (not (cl--compiling-file)) + (and (or (not (macroexp-compiling-p)) (< cl--optimize-speed 3) (= cl--optimize-safety 3)) (let ((sargs (and show-args (delq nil (mapcar (lambda (x) diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 39b3193b2f4..8ddfb9e78ef 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -23,6 +23,9 @@ ;;; Commentary: +;; The `easy-menu-define' macro provides a convenient way to define +;; pop-up menus and/or menu bar menus. +;; ;; This is compatible with easymenu.el by Per Abrahamsen ;; but it is much simpler as it doesn't try to support other Emacs versions. ;; The code was mostly derived from lmenu.el. @@ -140,7 +143,7 @@ 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." - (declare (indent defun) (debug (symbolp body))) + (declare (indent defun) (debug (symbolp body)) (doc-string 3)) `(progn ,(if symbol `(defvar ,symbol nil ,doc)) (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) @@ -181,12 +184,12 @@ This is expected to be bound to a mouse event." (funcall (or (plist-get (get symbol 'menu-prop) :filter) - 'identity) + #'identity) (symbol-function symbol))) symbol)))) ;; These symbols are commands, but not interesting for users ;; to `M-x TAB'. - (put symbol 'completion-predicate 'ignore)) + (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))) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 45e76c751fe..6f3c7d66881 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -4369,10 +4369,6 @@ It is removed when you hit any char." (set variable (not (symbol-value variable))) (message "%s: %s" variable (symbol-value variable))) -;; We have to require easymenu (even for Emacs 18) just so -;; the easy-menu-define macro call is compiled correctly. -(require 'easymenu) - (defconst edebug-mode-menus '("Edebug" ["Stop" edebug-stop t] diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index a095ad0f6db..d3e5d03edb5 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -233,7 +233,7 @@ This method is obsolete." ,@(when eieio-backward-compatibility (let ((f (intern (format "%s-child-p" name)))) - `((defalias ',f ',testsym2) + `((defalias ',f #',testsym2) (make-obsolete ',f ,(format "use (cl-typep ... \\='%s) instead" name) "25.1")))) @@ -288,8 +288,8 @@ created by the :initarg tag." (declare (debug (form symbolp))) `(eieio-oref ,obj (quote ,slot))) -(defalias 'slot-value 'eieio-oref) -(defalias 'set-slot-value 'eieio-oset) +(defalias 'slot-value #'eieio-oref) +(defalias 'set-slot-value #'eieio-oset) (make-obsolete 'set-slot-value "use (setf (slot-value ..) ..) instead" "25.1") (defmacro oref-default (obj slot) @@ -418,7 +418,7 @@ If EXTRA, include that in the string returned to represent the symbol." (cl-check-type obj eieio-object) (eieio-class-name (eieio--object-class obj))) (define-obsolete-function-alias - 'object-class-name 'eieio-object-class-name "24.4") + 'object-class-name #'eieio-object-class-name "24.4") (defun eieio-class-parents (class) ;; FIXME: What does "(overload of variable)" mean here? @@ -446,7 +446,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function." (defmacro eieio-class-parent (class) "Return first parent class to CLASS. (overload of variable)." `(car (eieio-class-parents ,class))) -(define-obsolete-function-alias 'class-parent 'eieio-class-parent "24.4") +(define-obsolete-function-alias 'class-parent #'eieio-class-parent "24.4") (defun same-class-p (obj class) "Return t if OBJ is of class-type CLASS." @@ -461,7 +461,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function." ;; class will be checked one layer down (child-of-class-p (eieio--object-class obj) class)) ;; Backwards compatibility -(defalias 'obj-of-class-p 'object-of-class-p) +(defalias 'obj-of-class-p #'object-of-class-p) (defun child-of-class-p (child class) "Return non-nil if CHILD class is a subclass of CLASS." @@ -665,7 +665,7 @@ This class is not stored in the `parent' slot of a class vector." (setq eieio-default-superclass (cl--find-class 'eieio-default-superclass)) (define-obsolete-function-alias 'standard-class - 'eieio-default-superclass "26.1") + #'eieio-default-superclass "26.1") (cl-defgeneric make-instance (class &rest initargs) "Make a new instance of CLASS based on INITARGS. @@ -972,12 +972,12 @@ this object." This may create or delete slots, but does not affect the return value of `eq'." (error "EIEIO: `change-class' is unimplemented")) -(define-obsolete-function-alias 'change-class 'eieio-change-class "26.1") +(define-obsolete-function-alias 'change-class #'eieio-change-class "26.1") ;; Hook ourselves into help system for describing classes and methods. ;; FIXME: This is not actually needed any more since we can click on the ;; hyperlink from the constructor's docstring to see the type definition. -(add-hook 'help-fns-describe-function-functions 'eieio-help-constructor) +(add-hook 'help-fns-describe-function-functions #'eieio-help-constructor) (provide 'eieio) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index d058d3dda0b..1191fb8f8de 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -102,15 +102,6 @@ the name of the test and the result of NAME-FORM." (indent 1)) `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) -;; We use these `put' forms in addition to the (declare (indent)) in -;; the defmacro form since the `declare' alone does not lead to -;; correct indentation before the .el/.elc file is loaded. -;; Autoloading these `put' forms solves this. -;;;###autoload -(progn - ;; TODO(ohler): Figure out what these mean and make sure they are correct. - (put 'ert-with-test-buffer 'lisp-indent-function 1)) - ;;;###autoload (defun ert-kill-all-test-buffers () "Kill all test buffers that are still live." @@ -376,8 +367,7 @@ different resource directory naming scheme, set the variable name will be trimmed using `string-trim' with arguments `ert-resource-directory-trim-left-regexp' and `ert-resource-directory-trim-right-regexp'." - `(let* ((testfile ,(or (bound-and-true-p byte-compile-current-file) - (and load-in-progress load-file-name) + `(let* ((testfile ,(or (macroexp-file-name) buffer-file-name)) (default-directory (file-name-directory testfile))) (file-truename diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index e08fa7ac7b3..a5c877e53ad 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -60,7 +60,6 @@ (require 'cl-lib) (require 'debug) (require 'backtrace) -(require 'easymenu) (require 'ewoc) (require 'find-func) (require 'pp) @@ -81,15 +80,13 @@ Use nil for no limit (caution: backtrace lines can be very long)." :background "green1") (((class color) (background dark)) :background "green3")) - "Face used for expected results in the ERT results buffer." - :group 'ert) + "Face used for expected results in the ERT results buffer.") (defface ert-test-result-unexpected '((((class color) (background light)) :background "red1") (((class color) (background dark)) :background "red3")) - "Face used for unexpected results in the ERT results buffer." - :group 'ert) + "Face used for unexpected results in the ERT results buffer.") ;;; Copies/reimplementations of cl functions. @@ -224,16 +221,6 @@ it has to be wrapped in `(eval (quote ...))'. :body (lambda () ,@body))) ',name)))) -;; We use these `put' forms in addition to the (declare (indent)) in -;; the defmacro form since the `declare' alone does not lead to -;; correct indentation before the .el/.elc file is loaded. -;; Autoloading these `put' forms solves this. -;;;###autoload -(progn - ;; TODO(ohler): Figure out what these mean and make sure they are correct. - (put 'ert-deftest 'lisp-indent-function 2) - (put 'ert-info 'lisp-indent-function 1)) - (defvar ert--find-test-regexp (concat "^\\s-*(ert-deftest" find-function-space-re diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index cbbed06d7c8..2b213e2065f 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -315,7 +315,7 @@ The return value is the last VAL in the list. ;; Autoload this `put' since a user might use C-u C-M-x on an expression ;; containing a non-trivial `push' even before gv.el was loaded. ;;;###autoload -(put 'gv-place 'edebug-form-spec '(form)) ;So-called "indirect spec". +(def-edebug-elem-spec 'gv-place '(form)) ;; CL did the equivalent of: ;;(gv-define-macroexpand edebug-after (lambda (before index place) place)) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 0934e43e66a..d52aee5a4ad 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -112,7 +112,7 @@ and also to avoid outputting the warning during normal execution." (funcall (eval (cadr form))) (byte-compile-constant nil))) -(defun macroexp--compiling-p () +(defun macroexp-compiling-p () "Return non-nil if we're macroexpanding for the compiler." ;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this ;; macro-expansion will be processed by the byte-compiler, we check @@ -120,13 +120,26 @@ and also to avoid outputting the warning during normal execution." (member '(declare-function . byte-compile-macroexpand-declare-function) macroexpand-all-environment)) +(defun macroexp-file-name () + "Return the name of the file from which the code comes. +Returns nil when we do not know. +A non-nil result is expected to be reliable when called from a macro in order +to find the file in which the macro's call was found, and it should be +reliable as well when used at the top-level of a file. +Other uses risk returning non-nil value that point to the wrong file." + ;; `eval-buffer' binds `current-load-list' but not `load-file-name', + ;; so prefer using it over using `load-file-name'. + (let ((file (car (last current-load-list)))) + (or (if (stringp file) file) + (bound-and-true-p byte-compile-current-file)))) + (defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key)) (defun macroexp--warn-and-return (msg form &optional compile-only) (let ((when-compiled (lambda () (byte-compile-warn "%s" msg)))) (cond ((null msg) form) - ((macroexp--compiling-p) + ((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 diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 14112a1c147..86a0c76fd16 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -265,7 +265,8 @@ C-g to quit (cancel the whole command); "If non-nil, `read-answer' accepts single-character answers. If t, accept short (single key-press) answers to the question. If nil, require long answers. If `auto', accept short answers if -the function cell of `yes-or-no-p' is set to `y-or-n-p'." +`use-short-answers' is non-nil, or the function cell of `yes-or-no-p' +is set to `y-or-n-p'." :type '(choice (const :tag "Accept short answers" t) (const :tag "Require long answer" nil) (const :tag "Guess preference" auto)) @@ -304,7 +305,8 @@ Return a long answer even in case of accepting short ones. When `use-dialog-box' is t, pop up a dialog window to get user input." (let* ((short (if (eq read-answer-short 'auto) - (eq (symbol-function 'yes-or-no-p) 'y-or-n-p) + (or use-short-answers + (eq (symbol-function 'yes-or-no-p) 'y-or-n-p)) read-answer-short)) (answers-with-help (if (assoc "help" answers) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 51895f80273..b7fa3120c10 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4052,10 +4052,7 @@ The return value is a string (or nil in case we can't find it)." ;; the version at compile time and hardcodes it into the .elc file! (declare (pure t)) ;; Hack alert! - (let ((file - (or (if (boundp 'byte-compile-current-file) byte-compile-current-file) - load-file-name - buffer-file-name))) + (let ((file (or (macroexp-file-name) buffer-file-name))) (cond ((null file) nil) ;; Packages are normally installed into directories named "<pkg>-<vers>", diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 58584f300c9..ffc21951b64 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1437,7 +1437,11 @@ following constructs: construct." (let* ((rx--pcase-vars nil) (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps))))) - `(and (pred (string-match ,regexp)) + `(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)) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 55ce6d9426d..adfce950176 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -393,9 +393,9 @@ found or not." count)) (cl-defgeneric seq-contains (sequence elt &optional testfn) - (declare (obsolete seq-contains-p "27.1")) "Return the first element in SEQUENCE that is equal to ELT. Equality is defined by TESTFN if non-nil or by `equal' if nil." + (declare (obsolete seq-contains-p "27.1")) (seq-some (lambda (e) (when (funcall (or testfn #'equal) elt e) e)) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 39e69f5aab9..789d6325e9a 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -40,6 +40,11 @@ (t :height 0.1 :inverse-video t :extend t)) "Face used to separate sections.") +(defface shortdoc-heading + '((t :inherit variable-pitch :height 1.3 :weight bold)) + "Face used for a heading." + :version "28.1") + (defface shortdoc-section '((t :inherit variable-pitch)) "Face used for a section.") @@ -1107,7 +1112,7 @@ There can be any number of :example/:result elements." (insert "\n")) (insert (propertize (concat (substitute-command-keys data) "\n\n") - 'face '(variable-pitch (:height 1.3 :weight bold)) + 'face 'shortdoc-heading 'shortdoc-section t))) ;; There may be functions not yet defined in the data. ((fboundp (car data)) @@ -1175,7 +1180,7 @@ function's documentation in the Info manual"))) (prin1 value (current-buffer))) (insert "\n " single-arrow " " (propertize "[it depends]" - 'face 'variable-pitch) + 'face 'shortdoc-section) "\n")) (:no-value (if (stringp value) diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index be2d7c0fd8a..b734fd15a24 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -1,4 +1,4 @@ -;;; cua-rect.el --- CUA unified rectangle support +;;; cua-rect.el --- CUA unified rectangle support -*- lexical-binding: t; -*- ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. @@ -575,6 +575,7 @@ Set undo boundary if UNDO is non-nil. Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges) Perform auto-tabify after operation if TABIFY is non-nil. Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear." + (declare (indent 4)) (let* ((inhibit-field-text-motion t) (start (cua--rectangle-top)) (end (cua--rectangle-bot)) @@ -645,8 +646,6 @@ Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear." (cua--keep-active))) (setq cua--buffer-and-point-before-command nil))) -(put 'cua--rectangle-operation 'lisp-indent-function 4) - (defun cua--delete-rectangle () (let ((lines 0)) (if (not (cua--rectangle-virtual-edges)) @@ -1220,6 +1219,7 @@ The numbers are formatted according to the FORMAT string." ;;; Replace/rearrange text in current rectangle (defun cua--rectangle-aux-replace (width adjust keep replace pad format-fct &optional setup-fct) + (declare (indent 4)) ;; Process text inserted by calling SETUP-FCT or current rectangle if nil. ;; Then call FORMAT-FCT on text (if non-nil); takes two args: start and end. ;; Fill to WIDTH characters if > 0 or fill to current width if == 0. @@ -1279,8 +1279,6 @@ The numbers are formatted according to the FORMAT string." (if keep (cua--rectangle-resized))))) -(put 'cua--rectangle-aux-replace 'lisp-indent-function 4) - (defun cua--left-fill-rectangle (_start _end) (beginning-of-line) (while (< (point) (point-max)) diff --git a/lisp/epa.el b/lisp/epa.el index 572c947e4b2..bbfa2c188cc 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -183,8 +183,7 @@ You should bind this variable with `let', but do not set it globally.") (defvar epa-last-coding-system-specified nil) (defvar epa-key-list-mode-map - (let ((keymap (make-sparse-keymap)) - (menu-map (make-sparse-keymap))) + (let ((keymap (make-sparse-keymap))) (define-key keymap "\C-m" 'epa-show-key) (define-key keymap [?\t] 'forward-button) (define-key keymap [backtab] 'backward-button) @@ -204,38 +203,32 @@ You should bind this variable with `let', but do not set it globally.") (define-key keymap [?\S-\ ] 'scroll-down-command) (define-key keymap [delete] 'scroll-down-command) (define-key keymap "q" 'epa-exit-buffer) - (define-key keymap [menu-bar epa-key-list-mode] (cons "Keys" menu-map)) - (define-key menu-map [epa-key-list-unmark-key] - '(menu-item "Unmark Key" epa-unmark-key - :help "Unmark a key")) - (define-key menu-map [epa-key-list-mark-key] - '(menu-item "Mark Key" epa-mark-key - :help "Mark a key")) - (define-key menu-map [separator-epa-file] '(menu-item "--")) - (define-key menu-map [epa-verify-file] - '(menu-item "Verify File..." epa-verify-file - :help "Verify FILE")) - (define-key menu-map [epa-sign-file] - '(menu-item "Sign File..." epa-sign-file - :help "Sign FILE by SIGNERS keys selected")) - (define-key menu-map [epa-decrypt-file] - '(menu-item "Decrypt File..." epa-decrypt-file - :help "Decrypt FILE")) - (define-key menu-map [epa-encrypt-file] - '(menu-item "Encrypt File..." epa-encrypt-file - :help "Encrypt FILE for RECIPIENTS")) - (define-key menu-map [separator-epa-key-list] '(menu-item "--")) - (define-key menu-map [epa-key-list-delete-keys] - '(menu-item "Delete Keys" epa-delete-keys - :help "Delete Marked Keys")) - (define-key menu-map [epa-key-list-import-keys] - '(menu-item "Import Keys" epa-import-keys - :help "Import keys from a file")) - (define-key menu-map [epa-key-list-export-keys] - '(menu-item "Export Keys" epa-export-keys - :help "Export marked keys to a file")) keymap)) +(easy-menu-define epa-key-list-mode-menu epa-key-list-mode-map + "Menu for `epa-key-list-mode'." + '("Keys" + ["Export Keys" epa-export-keys + :help "Export marked keys to a file"] + ["Import Keys" epa-import-keys + :help "Import keys from a file"] + ["Delete Keys" epa-delete-keys + :help "Delete Marked Keys"] + "---" + ["Encrypt File..." epa-encrypt-file + :help "Encrypt file for recipients"] + ["Decrypt File..." epa-decrypt-file + :help "Decrypt file"] + ["Sign File..." epa-sign-file + :help "Sign file by signers keys selected"] + ["Verify File..." epa-verify-file + :help "Verify file"] + "---" + ["Mark Key" epa-mark-key + :help "Mark a key"] + ["Unmark Key" epa-unmark-key + :help "Unmark a key"])) + (defvar epa-key-mode-map (let ((keymap (make-sparse-keymap))) (define-key keymap "q" 'epa-exit-buffer) diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el index 3995a0564af..0e334e93bd9 100644 --- a/lisp/erc/erc-menu.el +++ b/lisp/erc/erc-menu.el @@ -28,7 +28,6 @@ ;;; Code: (require 'erc) -(require 'easymenu) (defgroup erc-menu nil "ERC menu support." diff --git a/lisp/files.el b/lisp/files.el index b0332d5a8cd..4fa1e56f794 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2728,6 +2728,7 @@ since only a single case-insensitive search through the alist is made." ("\\.scm\\.[0-9]*\\'" . scheme-mode) ("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) ("\\.bash\\'" . sh-mode) + ("/PKGBUILD\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\(shrc\\|zshrc\\|m?kshrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 4065cf08342..ee74f013930 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -2517,7 +2517,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) (let ((gnus-summary-show-article-charset-alist `((1 . ,cs)))) (gnus-summary-show-article 1)))) - (put command 'completion-predicate 'ignore) + (function-put command 'completion-predicate #'ignore) `[,(symbol-name cs) ,command t])) (sort (coding-system-list) #'string<))))) ("Washing" diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index ee98099e08b..1e0362a3bfa 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8891,15 +8891,16 @@ used to take the screenshot." retval)) ;;;###autoload -(defun message-mailto () +(defun message-mailto (&optional url) "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." +will then start up Emacs ready to compose mail. For emacsclient use + emacsclient -e '(message-mailto \"%u\")'" (interactive) ;; <a href="mailto:someone@example.com?subject=This%20is%20the%20subject&cc=someone_else@example.com&body=This%20is%20the%20body">Send email</a> (message-mail) - (message-mailto-1 (pop command-line-args-left))) + (message-mailto-1 (or url (pop command-line-args-left)))) (defun message-mailto-1 (url) (let ((args (message-parse-mailto-url url))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 407fb961e6f..91b9c512584 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1028,7 +1028,7 @@ it is displayed along with the global value." (princ (if file-name (progn (princ (format-message - " is a variable defined in `%s'.\n" + " is a variable defined in `%s'.\n\n" (if (eq file-name 'C-source) "C source code" (help-fns-short-filename file-name)))) @@ -1164,7 +1164,6 @@ it is displayed along with the global value." (with-current-buffer standard-output (help-fns--ensure-empty-line)) - (princ "Documentation:\n") (with-current-buffer standard-output (insert (or doc "Not documented as a variable.")))) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 30a1ce053c1..e6a5fe8a80e 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -30,7 +30,6 @@ ;;; Code: (require 'cl-lib) -(eval-when-compile (require 'easymenu)) (defvar help-mode-map (let ((map (make-sparse-keymap))) @@ -476,8 +475,7 @@ that." (with-current-buffer (or buffer (current-buffer)) (save-excursion (goto-char (point-min)) - ;; Skip the header-type info, though it might be useful to parse - ;; it at some stage (e.g. "function in `library'"). + ;; Skip the first bit, which has already been buttonized. (forward-paragraph) (let ((old-modified (buffer-modified-p))) (let ((stab (syntax-table)) diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index 580bd293e73..55449599fe9 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -278,14 +278,13 @@ Optional 5th argument NIL-FOR-TOO-LONG non-nil means return nil CODING-SYSTEMS is a list of coding systems. See `set-coding-system-priority'. This affects the implicit sorting of lists of coding systems returned by operations such as `find-coding-systems-region'." + (declare (indent 1) (debug t)) (let ((current (make-symbol "current"))) `(let ((,current (coding-system-priority-list))) (apply #'set-coding-system-priority ,coding-systems) (unwind-protect (progn ,@body) (apply #'set-coding-system-priority ,current))))) -;;;###autoload(put 'with-coding-priority 'lisp-indent-function 1) -(put 'with-coding-priority 'edebug-form-spec t) ;;;###autoload (defun detect-coding-with-language-environment (from to lang-env) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 67ea00665fc..f52747084b2 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -3066,28 +3066,31 @@ of each directory." ;; Don't get fooled by commented-out code. (while (re-search-forward "^[ \t]*(quail-define-package" nil t) (goto-char (match-beginning 0)) - (condition-case nil - (let ((form (read (current-buffer)))) - (with-current-buffer list-buf - (insert - (format "(register-input-method + (let (form) + (condition-case err + (progn + (setq form (read (current-buffer))) + (with-current-buffer list-buf + (insert + (format "(register-input-method %S %S '%s %S %S %S)\n" - (nth 1 form) ; PACKAGE-NAME - (nth 2 form) ; LANGUAGE - 'quail-use-package ; ACTIVATE-FUNC - (nth 3 form) ; PACKAGE-TITLE - (progn ; PACKAGE-DESCRIPTION (one line) - (string-match ".*" (nth 5 form)) - (match-string 0 (nth 5 form))) - (file-relative-name ; PACKAGE-FILENAME - (file-name-sans-extension (car pkg-list)) - (car dirnames)))))) - (error - ;; Ignore the remaining contents of this file. - (goto-char (point-max)) - (message "Some part of \"%s\" is broken" (car pkg-list)))))) + (nth 1 form) ; PACKAGE-NAME + (nth 2 form) ; LANGUAGE + 'quail-use-package ; ACTIVATE-FUNC + (nth 3 form) ; PACKAGE-TITLE + (progn ; PACKAGE-DESCRIPTION (one line) + (string-match ".*" (nth 5 form)) + (match-string 0 (nth 5 form))) + (file-relative-name ; PACKAGE-FILENAME + (file-name-sans-extension (car pkg-list)) + (car dirnames)))))) + (error + ;; Ignore the remaining contents of this file. + (goto-char (point-max)) + (message "Some part of \"%s\" is broken: %s in %s" + (car pkg-list) err form)))))) (setq pkg-list (cdr pkg-list))) (setq quail-dirs (cdr quail-dirs) dirnames (cdr dirnames)))) diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index 2e365082738..251b18c9887 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -39,7 +39,10 @@ (defun quail-define-indian-trans-package (hashtbls pkgname lang title doc) - (quail-define-package pkgname lang title t doc + ;; This is a funcall to avoid `quail-update-leim-list-file' + ;; determining that this is a quail definition (it searches for + ;; "(quail-define-package"). + (funcall #'quail-define-package pkgname lang title t doc nil nil nil nil nil nil t nil) (maphash (lambda (key val) @@ -309,7 +312,10 @@ Full key sequences are listed below:") (defun quail-define-inscript-package (char-tables key-tables pkgname lang title docstring) - (quail-define-package pkgname lang title nil docstring + ;; This is a funcall to avoid `quail-update-leim-list-file' + ;; determining that this is a quail definition (it searches for + ;; "(quail-define-package"). + (funcall #'quail-define-package pkgname lang title nil docstring nil nil nil t nil nil nil nil) (let (char-table key-table char key) (while (and char-tables key-tables) diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index af6f2f1ab02..dd953ee9df7 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -1,4 +1,4 @@ -;;; mh-acros.el --- macros used in MH-E +;;; mh-acros.el --- macros used in MH-E -*- lexical-binding: t; -*- ;; Copyright (C) 2004, 2006-2021 Free Software Foundation, Inc. @@ -49,20 +49,19 @@ ;;;###mh-autoload (defmacro mh-do-in-gnu-emacs (&rest body) "Execute BODY if in GNU Emacs." - (declare (debug t)) + (declare (debug t) (indent defun)) (unless (featurep 'xemacs) `(progn ,@body))) -(put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun) ;;;###mh-autoload (defmacro mh-do-in-xemacs (&rest body) "Execute BODY if in XEmacs." - (declare (debug t)) + (declare (debug t) (indent defun)) (when (featurep 'xemacs) `(progn ,@body))) -(put 'mh-do-in-xemacs 'lisp-indent-hook 'defun) ;;;###mh-autoload (defmacro mh-funcall-if-exists (function &rest args) "Call FUNCTION with ARGS as parameters if it exists." + (declare (debug (symbolp body))) ;; FIXME: Not clear when this should be used. If the function happens ;; not to exist at compile-time (e.g. because the corresponding package ;; wasn't loaded), then it won't ever be used :-( @@ -75,25 +74,24 @@ "Create function NAME. If FUNCTION exists, then NAME becomes an alias for FUNCTION. Otherwise, create function NAME with ARG-LIST and BODY." + (declare (indent defun) (doc-string 4) + (debug (&define name symbolp sexp def-body))) `(defalias ',name (if (fboundp ',function) ',function (lambda ,arg-list ,@body)))) -(put 'defun-mh 'lisp-indent-function 'defun) -(put 'defun-mh 'doc-string-elt 4) ;;;###mh-autoload (defmacro defmacro-mh (name macro arg-list &rest body) "Create macro NAME. If MACRO exists, then NAME becomes an alias for MACRO. Otherwise, create macro NAME with ARG-LIST and BODY." + (declare (indent defun) (doc-string 4) + (debug (&define name symbolp sexp def-body))) (let ((defined-p (fboundp macro))) (if defined-p `(defalias ',name ',macro) `(defmacro ,name ,arg-list ,@body)))) -(put 'defmacro-mh 'lisp-indent-function 'defun) -(put 'defmacro-mh 'doc-string-elt 4) - ;;; Miscellaneous @@ -127,7 +125,7 @@ Execute BODY, which can modify the folder buffer without having to worry about file locking or the read-only flag, and return its result. If SAVE-MODIFICATION-FLAG is non-nil, the buffer's modification flag is unchanged, otherwise it is cleared." - (declare (debug t)) + (declare (debug t) (indent defun)) (setq save-modification-flag (car save-modification-flag)) ; CL style `(prog1 (let ((mh-folder-updating-mod-flag (buffer-modified-p)) @@ -139,14 +137,13 @@ is unchanged, otherwise it is cleared." (mh-set-folder-modified-p mh-folder-updating-mod-flag))) ,@(if (not save-modification-flag) '((mh-set-folder-modified-p nil))))) -(put 'with-mh-folder-updating 'lisp-indent-hook 'defun) ;;;###mh-autoload (defmacro mh-in-show-buffer (show-buffer &rest body) "Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY). Display buffer SHOW-BUFFER in other window and execute BODY in it. Stronger than `save-excursion', weaker than `save-window-excursion'." - (declare (debug t)) + (declare (debug t) (indent defun)) (setq show-buffer (car show-buffer)) ; CL style `(let ((mh-in-show-buffer-saved-window (selected-window))) (switch-to-buffer-other-window ,show-buffer) @@ -155,7 +152,6 @@ Stronger than `save-excursion', weaker than `save-window-excursion'." (progn ,@body) (select-window mh-in-show-buffer-saved-window)))) -(put 'mh-in-show-buffer 'lisp-indent-hook 'defun) ;;;###mh-autoload (defmacro mh-do-at-event-location (event &rest body) @@ -163,7 +159,7 @@ Stronger than `save-excursion', weaker than `save-window-excursion'." After BODY has been executed return to original window. The modification flag of the buffer in the event window is preserved." - (declare (debug t)) + (declare (debug t) (indent defun)) (let ((event-window (make-symbol "event-window")) (event-position (make-symbol "event-position")) (original-window (make-symbol "original-window")) @@ -190,7 +186,6 @@ preserved." (goto-char ,original-position) (set-marker ,original-position nil) (select-window ,original-window)))))) -(put 'mh-do-at-event-location 'lisp-indent-hook 'defun) @@ -209,7 +204,7 @@ VAR is bound to the message on the current line as we loop starting from BEGIN till END. In each step BODY is executed. If VAR is nil then the loop is executed without any binding." - (declare (debug (symbolp body))) + (declare (debug (symbolp body)) (indent defun)) (unless (symbolp var) (error "Can not bind the non-symbol %s" var)) (let ((binding-needed-flag var)) @@ -221,7 +216,6 @@ If VAR is nil then the loop is executed without any binding." (let ,(if binding-needed-flag `((,var (mh-get-msg-num t))) ()) ,@body)) (forward-line 1))))) -(put 'mh-iterate-on-messages-in-region 'lisp-indent-hook 'defun) ;;;###mh-autoload (defmacro mh-iterate-on-range (var range &rest body) @@ -235,7 +229,7 @@ a string. In each iteration, BODY is executed. The parameter RANGE is usually created with `mh-interactive-range' in order to provide a uniform interface to MH-E functions." - (declare (debug (symbolp body))) + (declare (debug (symbolp body)) (indent defun)) (unless (symbolp var) (error "Can not bind the non-symbol %s" var)) (let ((binding-needed-flag var) @@ -263,7 +257,6 @@ MH-E functions." (when (gethash v ,seq-hash-table) (let ,(if binding-needed-flag `((,var v)) ()) ,@body)))))))) -(put 'mh-iterate-on-range 'lisp-indent-hook 'defun) (defmacro mh-dlet* (binders &rest body) "Like `let*' but always dynamically scoped." diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 07bf03b30ee..6d657afa3ed 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -1,4 +1,4 @@ -;;; mh-compat.el --- make MH-E compatible with various versions of Emacs +;;; mh-compat.el --- make MH-E compatible with various versions of Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 2006-2021 Free Software Foundation, Inc. @@ -83,6 +83,7 @@ This is an analogue of a dynamically scoped `let' that operates on the function cell of FUNCs rather than their value cell. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" + (declare (indent 1) (debug ((&rest (sexp sexp &rest form)) &rest form))) (if (fboundp 'cl-letf) `(cl-letf ,(mapcar (lambda (binding) `((symbol-function ',(car binding)) @@ -90,9 +91,6 @@ the function cell of FUNCs rather than their value cell. bindings) ,@body) `(flet ,bindings ,@body))) -(put 'mh-flet 'lisp-indent-function 1) -(put 'mh-flet 'edebug-form-spec - '((&rest (sexp sexp &rest form)) &rest form)) (defun mh-display-color-cells (&optional display) "Return the number of color cells supported by DISPLAY. diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 2eb7fbaa20c..eaf8eb55651 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -1,4 +1,4 @@ -;;; mh-e.el --- GNU Emacs interface to the MH mail system +;;; mh-e.el --- GNU Emacs interface to the MH mail system -*- lexical-binding: t; -*- ;; Copyright (C) 1985-1988, 1990, 1992-1995, 1997, 1999-2021 Free ;; Software Foundation, Inc. @@ -695,9 +695,8 @@ See documentation for `defgroup' for a description of the arguments SYMBOL, MEMBERS, DOC and ARGS. This macro is used by Emacs versions that lack the :package-version keyword, introduced in Emacs 22." - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) `(defgroup ,symbol ,members ,doc ,@(mh-strip-package-version args))) -(put 'defgroup-mh 'lisp-indent-function 'defun) (defmacro defcustom-mh (symbol value doc &rest args) "Declare SYMBOL as a customizable variable that defaults to VALUE. @@ -705,9 +704,8 @@ See documentation for `defcustom' for a description of the arguments SYMBOL, VALUE, DOC and ARGS. This macro is used by Emacs versions that lack the :package-version keyword, introduced in Emacs 22." - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) `(defcustom ,symbol ,value ,doc ,@(mh-strip-package-version args))) -(put 'defcustom-mh 'lisp-indent-function 'defun) (defmacro defface-mh (face spec doc &rest args) "Declare FACE as a customizable face that defaults to SPEC. @@ -715,9 +713,8 @@ See documentation for `defface' for a description of the arguments FACE, SPEC, DOC and ARGS. This macro is used by Emacs versions that lack the :package-version keyword, introduced in Emacs 22." - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) `(defface ,face ,spec ,doc ,@(mh-strip-package-version args))) -(put 'defface-mh 'lisp-indent-function 'defun) diff --git a/lisp/misc.el b/lisp/misc.el index 09f6011f98d..39ec9497d7f 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -41,7 +41,7 @@ The characters copied are inserted in the buffer before point." (save-excursion (beginning-of-line) (backward-char 1) - (skip-chars-backward "\ \t\n") + (skip-chars-backward " \t\n") (move-to-column cc) ;; Default is enough to copy the whole rest of the line. (setq n (if arg (prefix-numeric-value arg) (point-max))) diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index 83125742be3..b874c488a82 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -22,7 +22,7 @@ ;;; Commentary: -;; dictionary-connection allows to handle TCP-based connections in +;; dictionary-connection allows handling TCP-based connections in ;; client mode where text-based information is exchanged. There is ;; special support for handling CR LF (and the usual CR LF . CR LF ;; terminator). @@ -68,7 +68,7 @@ (defun dictionary-connection-open (server port) "Open a connection to SERVER at PORT. -A data structure identifying the connection is returned" +Return a data structure identifying the connection." (let ((process-buffer (generate-new-buffer (format " connection to %s:%s" server @@ -82,11 +82,11 @@ A data structure identifying the connection is returned" (defun dictionary-connection-status (connection) "Return the status of the CONNECTION. Possible return values are the symbols: -nil: argument is no connection object -'none: argument has no connection -'up: connection is open and buffer is existing -'down: connection is closed -'alone: connection is not associated with a buffer" + nil: argument is not a connection object + 'none: argument is not connected + 'up: connection is open and buffer is existing + 'down: connection is closed + 'alone: connection is not associated with a buffer" (when (dictionary-connection-p connection) (let ((process (dictionary-connection-process connection)) (buffer (dictionary-connection-buffer connection))) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index c6af4e66e39..aba3698a533 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -35,7 +35,6 @@ ;;; Code: (require 'cl-lib) -(require 'easymenu) (require 'custom) (require 'dictionary-connection) (require 'button) diff --git a/lisp/net/dns.el b/lisp/net/dns.el index 2045d4dfca1..90776e3c6f2 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -332,7 +332,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." (setq dns-servers (nreverse dns-servers)))) (when (executable-find "nslookup") (with-temp-buffer - (call-process "nslookup" nil t nil "localhost") + (call-process "nslookup" nil t nil "-retry=0" "-timeout=2" "localhost") (goto-char (point-min)) (when (re-search-forward "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\|[[:xdigit:]:]*\\)" nil t) @@ -492,19 +492,22 @@ If REVERSE, look up an IP address." (dns-get-txt-answer (dns-get 'answers result)) (dns-get 'data answer)))))))))) +;;;###autoload (defun dns-query (name &optional type full reverse) "Query a DNS server for NAME of TYPE. If FULL, return the entire record returned. If REVERSE, look up an IP address." - (let ((result nil)) - (dns-query-asynchronous - name - (lambda (response) - (setq result (list response))) - type full reverse) - ;; Loop until we get the callback. - (while (not result) - (sleep-for 0.01)) + (let* ((result nil) + (query-started + (dns-query-asynchronous + name + (lambda (response) + (setq result (list response))) + type full reverse))) + (if query-started + ;; Loop until we get the callback. + (while (not result) + (sleep-for 0.01))) (car result))) (provide 'dns) diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index ea96012af20..f5b47610787 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -645,6 +645,15 @@ If URL is nil it is searched at point." (add-to-list 'newsticker-url-list (list name url nil nil nil) t) (customize-variable 'newsticker-url-list)) +(defun newsticker-customize-feed (feed-name) + "Open customization buffer for `newsticker-url-list' and jump to FEED-NAME." + (interactive + (list (completing-read "Name of feed or group to edit: " + (mapcar #'car newsticker-url-list)))) + (customize-variable 'newsticker-url-list) + (when (search-forward (concat "Label: " feed-name) nil t) + (forward-line -1))) + (defun newsticker-customize () "Open the newsticker customization group." (interactive) @@ -1548,6 +1557,7 @@ argument, which is one of the items in ITEMLIST." ;; ====================================================================== (defun newsticker--insert-bytes (bytes) + "Decode BYTES and insert in current buffer." (insert (decode-coding-string bytes 'binary))) (defun newsticker--remove-whitespace (string) @@ -1587,7 +1597,7 @@ This function calls `message' with arguments STRING and ARGS, if (apply 'message string args))) (defun newsticker--decode-iso8601-date (string) - "Return ISO8601-STRING in format like `encode-time'. + "Return ISO8601-encoded STRING in format like `encode-time'. Converts from ISO-8601 to Emacs representation. If no time zone is present, this function defaults to universal time." (if string diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index a2d4d89ee55..2e207be20f9 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -119,6 +119,20 @@ applies to newsticker only." :type 'boolean :group 'newsticker-treeview) +(defcustom newsticker-treeview-use-feed-name-from-url-list-in-treeview + t + "Use the feed names from 'newsticker-url-list' for display in treeview." + :version "28.1" + :type 'boolean + :group 'newsticker-treeview) + +(defcustom newsticker-treeview-use-feed-name-from-url-list-in-itemview + t + "Use feed names from 'newsticker-url-list' in itemview." + :version "28.1" + :type 'boolean + :group 'newsticker-treeview) + (defvar newsticker-groups '("Feeds") "List of feed groups, used in the treeview frontend. @@ -738,11 +752,14 @@ for the button." (img (newsticker--image-read feed-name-symbol nil 40))) (if (and (display-images-p) img) (newsticker--insert-image img (car item)) - (insert (newsticker--real-feed-name feed-name-symbol)))) + (insert (if newsticker-treeview-use-feed-name-from-url-list-in-itemview + (symbol-name feed-name-symbol) + (newsticker--real-feed-name feed-name-symbol))))) (add-text-properties (point-min) (point) (list 'face 'newsticker-feed-face 'mouse-face 'highlight - 'help-echo "Visit in web browser." + 'help-echo (concat (newsticker--real-feed-name feed-name-symbol) + "\nClick to visit in web browser.") :nt-link (newsticker--link item) 'keymap newsticker--treeview-url-keymap)) (setq pos (point)) @@ -933,10 +950,10 @@ Optional arguments CHANGED-WIDGET and EVENT are ignored." (newsticker-treeview-mode))) (defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed - vfeed) + vfeed tooltip) "Return propertized copy of string TAG. Optional argument NUM-NEW is used for choosing face, other -arguments NT-ID, FEED, and VFEED are added as properties." +arguments NT-ID, FEED, VFEED and TOOLTIP are added as properties." ;;(message "newsticker--treeview-propertize-tag `%s' %s" feed nt-id) (let ((face 'newsticker-treeview-face) (map (make-sparse-keymap))) @@ -950,14 +967,14 @@ arguments NT-ID, FEED, and VFEED are added as properties." :nt-id nt-id :nt-feed feed :nt-vfeed vfeed - 'help-echo tag + 'help-echo tooltip 'mouse-face 'highlight))) (defun newsticker--treeview-tree-get-tag (feed-name vfeed-name &optional nt-id) "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME. Optional argument NT-ID is added to the tag's properties." - (let (tag (num-new 0)) + (let (tag tooltip (num-new 0)) (cond (vfeed-name (cond ((string= vfeed-name "new") (setq num-new (newsticker--stat-num-items-total 'new)) @@ -970,18 +987,29 @@ Optional argument NT-ID is added to the tag's properties." (setq tag (format "Obsolete items (%d)" num-new))) ((string= vfeed-name "all") (setq num-new (newsticker--stat-num-items-total)) - (setq tag (format "All items (%d)" num-new))))) + (setq tag (format "All items (%d)" num-new)))) + (setq tooltip tag)) (feed-name (setq num-new (newsticker--stat-num-items-for-group (intern feed-name) 'new 'immortal)) (setq tag (format "%s (%d)" - (newsticker--real-feed-name (intern feed-name)) - num-new)))) + (if newsticker-treeview-use-feed-name-from-url-list-in-itemview + feed-name + (newsticker--real-feed-name (intern feed-name))) + num-new)) + (setq tooltip + (if (newsticker--group-get-group feed-name) + tag + (format "%s (%d)\n%s" + feed-name + num-new + (newsticker--real-feed-name (intern feed-name))))))) (if tag (newsticker--treeview-propertize-tag tag num-new nt-id - feed-name vfeed-name)))) + feed-name vfeed-name + tooltip)))) (defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages) "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES." @@ -1434,6 +1462,15 @@ Move to next item unless DONT-PROCEED is non-nil." newsticker--treeview-current-vfeed) (newsticker--treeview-get-selected-item))) +(defun newsticker-treeview-customize-current-feed () + "Open customization buffer for `newsticker-url-list' and move to current feed." + (interactive) + (let ((cur-feed (or newsticker--treeview-current-feed + newsticker--treeview-current-vfeed))) + (if (newsticker--group-get-group cur-feed) + (message "Cannot customize groups. Please select a feed.") + (newsticker-customize-feed cur-feed)))) + (defun newsticker--treeview-set-current-node (node) "Make NODE the current node." (with-current-buffer (newsticker--treeview-tree-buffer) @@ -1995,6 +2032,7 @@ Return t if groups have changed, nil otherwise." (define-key map " " 'newsticker-treeview-next-page) (define-key map "a" 'newsticker-add-url) (define-key map "b" 'newsticker-treeview-browse-url-item) + (define-key map "c" 'newsticker-treeview-customize-current-feed) (define-key map "F" 'newsticker-treeview-prev-feed) (define-key map "f" 'newsticker-treeview-next-feed) (define-key map "g" 'newsticker-treeview-get-news) diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index ca100267f67..595d63331a4 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -1,4 +1,4 @@ -;;; sieve.el --- Utilities to manage sieve scripts +;;; sieve.el --- Utilities to manage sieve scripts -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. @@ -69,13 +69,11 @@ (defcustom sieve-new-script "<new script>" "Name of name script indicator." - :type 'string - :group 'sieve) + :type 'string) (defcustom sieve-buffer "*sieve*" "Name of sieve management buffer." - :type 'string - :group 'sieve) + :type 'string) (defcustom sieve-template "\ require \"fileinto\"; @@ -91,8 +89,7 @@ require \"fileinto\"; # } " "Template sieve script." - :type 'string - :group 'sieve) + :type 'string) ;; Internal variables: @@ -104,31 +101,36 @@ require \"fileinto\"; ;; Sieve-manage mode: +;; This function is defined by `easy-menu-define' but it's only done +;; at run time and the compiler is not aware of it. +;; FIXME: This is arguably a bug/problem in `easy-menu-define'. +(declare-function sieve-manage-mode-menu "sieve") + (defvar sieve-manage-mode-map (let ((map (make-sparse-keymap))) ;; various - (define-key map "?" 'sieve-help) - (define-key map "h" 'sieve-help) + (define-key map "?" #'sieve-help) + (define-key map "h" #'sieve-help) ;; activating - (define-key map "m" 'sieve-activate) - (define-key map "u" 'sieve-deactivate) - (define-key map "\M-\C-?" 'sieve-deactivate-all) + (define-key map "m" #'sieve-activate) + (define-key map "u" #'sieve-deactivate) + (define-key map "\M-\C-?" #'sieve-deactivate-all) ;; navigation keys - (define-key map "\C-p" 'sieve-prev-line) - (define-key map [up] 'sieve-prev-line) - (define-key map "\C-n" 'sieve-next-line) - (define-key map [down] 'sieve-next-line) - (define-key map " " 'sieve-next-line) - (define-key map "n" 'sieve-next-line) - (define-key map "p" 'sieve-prev-line) - (define-key map "\C-m" 'sieve-edit-script) - (define-key map "f" 'sieve-edit-script) - (define-key map "o" 'sieve-edit-script-other-window) - (define-key map "r" 'sieve-remove) - (define-key map "q" 'sieve-bury-buffer) - (define-key map "Q" 'sieve-manage-quit) - (define-key map [(down-mouse-2)] 'sieve-edit-script) - (define-key map [(down-mouse-3)] 'sieve-manage-mode-menu) + (define-key map "\C-p" #'sieve-prev-line) + (define-key map [up] #'sieve-prev-line) + (define-key map "\C-n" #'sieve-next-line) + (define-key map [down] #'sieve-next-line) + (define-key map " " #'sieve-next-line) + (define-key map "n" #'sieve-next-line) + (define-key map "p" #'sieve-prev-line) + (define-key map "\C-m" #'sieve-edit-script) + (define-key map "f" #'sieve-edit-script) + ;; (define-key map "o" #'sieve-edit-script-other-window) + (define-key map "r" #'sieve-remove) + (define-key map "q" #'sieve-bury-buffer) + (define-key map "Q" #'sieve-manage-quit) + (define-key map [(down-mouse-2)] #'sieve-edit-script) + (define-key map [(down-mouse-3)] #'sieve-manage-mode-menu) map) "Keymap for `sieve-manage-mode'.") @@ -159,8 +161,8 @@ require \"fileinto\"; (interactive) (bury-buffer)) -(defun sieve-activate (&optional pos) - (interactive "d") +(defun sieve-activate (&optional _pos) + (interactive) (let ((name (sieve-script-at-point)) err) (when (or (null name) (string-equal name sieve-new-script)) (error "No sieve script at point")) @@ -171,20 +173,20 @@ require \"fileinto\"; (message "Activating script %s...done" name) (message "Activating script %s...failed: %s" name (nth 2 err))))) -(defun sieve-deactivate-all (&optional pos) - (interactive "d") - (let ((name (sieve-script-at-point)) err) - (message "Deactivating scripts...") - (setq err (sieve-manage-setactive "" sieve-manage-buffer)) +(defun sieve-deactivate-all (&optional _pos) + (interactive) + (message "Deactivating scripts...") + (let (;; (name (sieve-script-at-point)) + (err (sieve-manage-setactive "" sieve-manage-buffer))) (sieve-refresh-scriptlist) (if (sieve-manage-ok-p err) (message "Deactivating scripts...done") (message "Deactivating scripts...failed: %s" (nth 2 err))))) -(defalias 'sieve-deactivate 'sieve-deactivate-all) +(defalias 'sieve-deactivate #'sieve-deactivate-all) -(defun sieve-remove (&optional pos) - (interactive "d") +(defun sieve-remove (&optional _pos) + (interactive) (let ((name (sieve-script-at-point)) err) (when (or (null name) (string-equal name sieve-new-script)) (error "No sieve script at point")) @@ -195,8 +197,8 @@ require \"fileinto\"; (sieve-refresh-scriptlist) (message "Removing sieve script %s...done" name))) -(defun sieve-edit-script (&optional pos) - (interactive "d") +(defun sieve-edit-script (&optional _pos) + (interactive) (let ((name (sieve-script-at-point))) (unless name (error "No sieve script at point")) @@ -224,11 +226,11 @@ require \"fileinto\"; (defmacro sieve-change-region (&rest body) "Turns off sieve-region before executing BODY, then re-enables it after. Used to bracket operations which move point in the sieve-buffer." + (declare (indent 0) (debug t)) `(progn (sieve-highlight nil) ,@body (sieve-highlight t))) -(put 'sieve-change-region 'lisp-indent-function 0) (defun sieve-next-line (&optional arg) (interactive) diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el index 7d74fd3c8a7..7ea6fb2e49d 100644 --- a/lisp/nxml/rng-nxml.el +++ b/lisp/nxml/rng-nxml.el @@ -24,7 +24,6 @@ ;;; Code: -(require 'easymenu) (require 'xmltok) (require 'nxml-util) (require 'nxml-ns) diff --git a/lisp/obsolete/abbrevlist.el b/lisp/obsolete/abbrevlist.el index 1d517dbd116..c9c0956903f 100644 --- a/lisp/obsolete/abbrevlist.el +++ b/lisp/obsolete/abbrevlist.el @@ -1,4 +1,4 @@ -;;; abbrevlist.el --- list one abbrev table alphabetically ordered +;;; abbrevlist.el --- list one abbrev table alphabetically ordered -*- lexical-binding: t; -*- ;; Copyright (C) 1986, 1992, 2001-2021 Free Software Foundation, Inc. ;; Suggested by a previous version by Gildea. @@ -38,7 +38,7 @@ (function (lambda (abbrev) (setq abbrev-list (cons abbrev abbrev-list)))) abbrev-table) - (setq abbrev-list (sort abbrev-list 'string-lessp)) + (setq abbrev-list (sort abbrev-list #'string-lessp)) (while abbrev-list (if (> (+ first-column 40) (window-width)) (progn diff --git a/lisp/obsolete/bruce.el b/lisp/obsolete/bruce.el index 398f315c5d4..4aa6cd200e7 100644 --- a/lisp/obsolete/bruce.el +++ b/lisp/obsolete/bruce.el @@ -1,4 +1,4 @@ -;;; bruce.el --- bruce phrase utility for overloading the Communications +;;; bruce.el --- bruce phrase utility for overloading the Communications -*- lexical-binding: t; -*- ;;; Decency Act snoops, if any. ;; Copyright (C) 1988, 1993, 1997, 2001-2021 Free Software Foundation, @@ -113,13 +113,11 @@ (defcustom bruce-phrases-file "~/bruce.lines" "Keep your favorite phrases here." - :type 'file - :group 'bruce) + :type 'file) (defcustom bruce-phrase-default-count 15 "Default number of phrases to insert." - :type 'integer - :group 'bruce) + :type 'integer) ;;;###autoload (defun bruce () diff --git a/lisp/obsolete/cc-compat.el b/lisp/obsolete/cc-compat.el index 96b036e892c..037a8e9e87c 100644 --- a/lisp/obsolete/cc-compat.el +++ b/lisp/obsolete/cc-compat.el @@ -1,4 +1,4 @@ -;;; cc-compat.el --- cc-mode compatibility with c-mode.el confusion +;;; cc-compat.el --- cc-mode compatibility with c-mode.el confusion -*- lexical-binding: t; -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -156,7 +156,7 @@ This is in addition to c-continued-statement-offset.") (if bracep 0 c-indent-level))))) -(defun cc-substatement-open-offset (langelem) +(defun cc-substatement-open-offset (_langelem) (+ c-continued-statement-offset c-continued-brace-offset)) diff --git a/lisp/obsolete/cl-compat.el b/lisp/obsolete/cl-compat.el index 4abedf3e627..619bc06122b 100644 --- a/lisp/obsolete/cl-compat.el +++ b/lisp/obsolete/cl-compat.el @@ -1,4 +1,4 @@ -;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility) +;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility) -*- lexical-binding: t; -*- ;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc. @@ -46,31 +46,23 @@ ;;; Code: -;; This used to be: -;; (or (featurep 'cl) (require 'cl)) -;; which just has the effect of fooling the byte-compiler into not -;; loading cl when compiling. However, that leads to some bogus -;; compiler warnings. Loading cl when compiling cannot do any harm, -;; because for a long time bootstrap-emacs contained 'cl, due to being -;; dumped from uncompiled files that eval-when-compile'd cl. So every -;; file was compiled with 'cl loaded. -(require 'cl) +(require 'cl-lib) ;;; Keyword routines not supported by new package. (defmacro defkeyword (x &optional doc) - (list* 'defconst x (list 'quote x) (and doc (list doc)))) + (cl-list* 'defconst x (list 'quote x) (and doc (list doc)))) (defun keyword-of (sym) (or (keywordp sym) (keywordp (intern (format ":%s" sym))))) -;;; Multiple values. Note that the new package uses a different -;;; convention for multiple values. The following definitions -;;; emulate the old convention; all function names have been changed -;;; by capitalizing the first letter: Values, Multiple-value-*, -;;; to avoid conflict with the new-style definitions in cl-macs. +;; Multiple values. Note that the new package uses a different +;; convention for multiple values. The following definitions +;; emulate the old convention; all function names have been changed +;; by capitalizing the first letter: Values, Multiple-value-*, +;; to avoid conflict with the new-style definitions in cl-macs. (defvar *mvalues-values* nil) @@ -79,7 +71,7 @@ (car val-forms)) (defun Values-list (val-forms) - (apply 'values val-forms)) + (apply #'cl-values val-forms)) (defmacro Multiple-value-list (form) (list 'let* (list '(*mvalues-values* nil) (list '*mvalues-temp* form)) @@ -95,7 +87,7 @@ (defmacro Multiple-value-bind (vars form &rest body) (declare (indent 2)) - (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body)) + (cl-list* 'multiple-value-bind vars (list 'Multiple-value-list form) body)) (defmacro Multiple-value-setq (vars form) (declare (indent 2)) @@ -103,17 +95,16 @@ (defmacro Multiple-value-prog1 (form &rest body) (declare (indent 1)) - (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body))) + (list 'prog1 form (cl-list* 'let '((*mvalues-values* nil)) body))) ;;; Routines for parsing keyword arguments. (defun build-klist (arglist keys &optional allow-others) - (let ((res (Multiple-value-call 'mapcar* 'cons (unzip-lists arglist)))) + (let ((res (Multiple-value-call #'cl-mapcar 'cons (unzip-lists arglist)))) (or allow-others - (with-suppressed-warnings ((obsolete set-difference)) - (let ((bad (set-difference (mapcar 'car res) keys))) - (if bad (error "Bad keywords: %s not in %s" bad keys))))) + (let ((bad (cl-set-difference (mapcar #'car res) keys))) + (if bad (error "Bad keywords: %s not in %s" bad keys)))) res)) (defun extract-from-klist (klist key &optional def) @@ -131,18 +122,16 @@ (funcall (or test 'eql) item elt)))) (defun safe-idiv (a b) - (with-suppressed-warnings ((obsolete signum)) - (let* ((q (/ (abs a) (abs b))) - (s (* (signum a) (signum b)))) - (Values q (- a (* s q b)) s)))) + (let* ((q (/ (abs a) (abs b))) + (s (* (cl-signum a) (cl-signum b)))) + (Values q (- a (* s q b)) s))) ;; Internal routines. (defun pair-with-newsyms (oldforms) - (with-suppressed-warnings ((obsolete mapcar*)) - (let ((newsyms (mapcar (lambda (x) (make-symbol "--cl-var--")) oldforms))) - (Values (mapcar* 'list newsyms oldforms) newsyms)))) + (let ((newsyms (mapcar (lambda (_) (make-symbol "--cl-var--")) oldforms))) + (Values (cl-mapcar #'list newsyms oldforms) newsyms))) (defun zip-lists (evens odds) (cl-mapcan 'list evens odds)) @@ -154,7 +143,7 @@ (Values (nreverse e) (nreverse o)))) (defun reassemble-argslists (list) - (let ((n (apply 'min (mapcar 'length list))) (res nil)) + (let ((n (apply #'min (mapcar #'length list))) (res nil)) (while (>= (setq n (1- n)) 0) (setq res (cons (mapcar (function (lambda (x) (elt x n))) list) res))) res)) diff --git a/lisp/obsolete/cl.el b/lisp/obsolete/cl.el index 95af29bb87f..09f9ab7b7f2 100644 --- a/lisp/obsolete/cl.el +++ b/lisp/obsolete/cl.el @@ -331,7 +331,7 @@ The two cases that are handled are: (cddr f)))) (if (and cl-closure-vars (cl--expr-contains-any body cl-closure-vars)) - (let* ((new (mapcar 'cl-gensym cl-closure-vars)) + (let* ((new (mapcar #'cl-gensym cl-closure-vars)) (sub (cl-pairlis cl-closure-vars new)) (decls nil)) (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive)) @@ -438,7 +438,7 @@ definitions, or lack thereof). (let ((func `(cl-function (lambda ,(cadr x) (cl-block ,(car x) ,@(cddr x)))))) - (when (cl--compiling-file) + (when (macroexp-compiling-p) ;; Bug#411. It would be nice to fix this. (and (get (car x) 'byte-compile) (error "Byte-compiling a redefinition of `%s' \ @@ -446,7 +446,7 @@ will not work - use `labels' instead" (symbol-name (car x)))) ;; FIXME This affects the rest of the file, when it ;; should be restricted to the flet body. (and (boundp 'byte-compile-function-environment) - (push (cons (car x) (eval func)) + (push (cons (car x) (eval func t)) byte-compile-function-environment))) (list `(symbol-function ',(car x)) func))) bindings) @@ -630,10 +630,10 @@ You can replace this macro with `gv-letplace'." ;;; Additional compatibility code. ;; For names that were clean but really aren't needed any more. -(define-obsolete-function-alias 'cl-macroexpand 'macroexpand "24.3") +(define-obsolete-function-alias 'cl-macroexpand #'macroexpand "24.3") (define-obsolete-variable-alias 'cl-macro-environment 'macroexpand-all-environment "24.3") -(define-obsolete-function-alias 'cl-macroexpand-all 'macroexpand-all "24.3") +(define-obsolete-function-alias 'cl-macroexpand-all #'macroexpand-all "24.3") ;;; Hash tables. ;; This is just kept for compatibility with code byte-compiled by Emacs-20. @@ -652,22 +652,22 @@ You can replace this macro with `gv-letplace'." (defvar cl-builtin-maphash (symbol-function 'maphash)) (make-obsolete-variable 'cl-builtin-maphash nil "24.3") -(define-obsolete-function-alias 'cl-map-keymap 'map-keymap "24.3") -(define-obsolete-function-alias 'cl-copy-tree 'copy-tree "24.3") -(define-obsolete-function-alias 'cl-gethash 'gethash "24.3") -(define-obsolete-function-alias 'cl-puthash 'puthash "24.3") -(define-obsolete-function-alias 'cl-remhash 'remhash "24.3") -(define-obsolete-function-alias 'cl-clrhash 'clrhash "24.3") -(define-obsolete-function-alias 'cl-maphash 'maphash "24.3") -(define-obsolete-function-alias 'cl-make-hash-table 'make-hash-table "24.3") -(define-obsolete-function-alias 'cl-hash-table-p 'hash-table-p "24.3") -(define-obsolete-function-alias 'cl-hash-table-count 'hash-table-count "24.3") +(define-obsolete-function-alias 'cl-map-keymap #'map-keymap "24.3") +(define-obsolete-function-alias 'cl-copy-tree #'copy-tree "24.3") +(define-obsolete-function-alias 'cl-gethash #'gethash "24.3") +(define-obsolete-function-alias 'cl-puthash #'puthash "24.3") +(define-obsolete-function-alias 'cl-remhash #'remhash "24.3") +(define-obsolete-function-alias 'cl-clrhash #'clrhash "24.3") +(define-obsolete-function-alias 'cl-maphash #'maphash "24.3") +(define-obsolete-function-alias 'cl-make-hash-table #'make-hash-table "24.3") +(define-obsolete-function-alias 'cl-hash-table-p #'hash-table-p "24.3") +(define-obsolete-function-alias 'cl-hash-table-count #'hash-table-count "24.3") (define-obsolete-function-alias 'cl-map-keymap-recursively - 'cl--map-keymap-recursively "24.3") -(define-obsolete-function-alias 'cl-map-intervals 'cl--map-intervals "24.3") -(define-obsolete-function-alias 'cl-map-extents 'cl--map-overlays "24.3") -(define-obsolete-function-alias 'cl-set-getf 'cl--set-getf "24.3") + #'cl--map-keymap-recursively "24.3") +(define-obsolete-function-alias 'cl-map-intervals #'cl--map-intervals "24.3") +(define-obsolete-function-alias 'cl-map-extents #'cl--map-overlays "24.3") +(define-obsolete-function-alias 'cl-set-getf #'cl--set-getf "24.3") (defun cl-maclisp-member (item list) (declare (obsolete member "24.3")) diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el index 735e1e0b6a6..1c1167db89b 100644 --- a/lisp/obsolete/complete.el +++ b/lisp/obsolete/complete.el @@ -1,4 +1,4 @@ -;;; complete.el --- partial completion mechanism plus other goodies +;;; complete.el --- partial completion mechanism plus other goodies -*- lexical-binding: t; -*- ;; Copyright (C) 1990-1993, 1999-2021 Free Software Foundation, Inc. @@ -102,14 +102,12 @@ If non-nil and non-t, the first character is taken literally only for file name completion." :type '(choice (const :tag "delimiter" nil) (const :tag "literal" t) - (other :tag "find-file" find-file)) - :group 'partial-completion) + (other :tag "find-file" find-file))) (defcustom PC-meta-flag t "If non-nil, TAB means PC completion and M-TAB means normal completion. Otherwise, TAB means normal completion and M-TAB means Partial Completion." - :type 'boolean - :group 'partial-completion) + :type 'boolean) (defcustom PC-word-delimiters "-_. " "A string of characters treated as word delimiters for completion. @@ -119,19 +117,16 @@ If `^' is in this string, it must not come first. If `-' is in this string, it must come first or right after `]'. In other words, if S is this string, then `[S]' must be a valid Emacs regular expression (not containing character ranges like `a-z')." - :type 'string - :group 'partial-completion) + :type 'string) (defcustom PC-include-file-path '("/usr/include" "/usr/local/include") "A list of directories in which to look for include files. If nil, means use the colon-separated path in the variable $INCPATH instead." - :type '(repeat directory) - :group 'partial-completion) + :type '(repeat directory)) (defcustom PC-disable-includes nil "If non-nil, include-file support in \\[find-file] is disabled." - :type 'boolean - :group 'partial-completion) + :type 'boolean) (defvar PC-default-bindings t "If non-nil, default partial completion key bindings are suppressed.") @@ -146,36 +141,36 @@ If nil, means use the colon-separated path in the variable $INCPATH instead." (cond ((not bind) ;; These bindings are the default bindings. It would be better to ;; restore the previous bindings. - (define-key read-expression-map "\e\t" 'lisp-complete-symbol) + (define-key read-expression-map "\e\t" #'completion-at-point) - (define-key completion-map "\t" 'minibuffer-complete) - (define-key completion-map " " 'minibuffer-complete-word) - (define-key completion-map "?" 'minibuffer-completion-help) + (define-key completion-map "\t" #'minibuffer-complete) + (define-key completion-map " " #'minibuffer-complete-word) + (define-key completion-map "?" #'minibuffer-completion-help) - (define-key must-match-map "\r" 'minibuffer-complete-and-exit) - (define-key must-match-map "\n" 'minibuffer-complete-and-exit) + (define-key must-match-map "\r" #'minibuffer-complete-and-exit) + (define-key must-match-map "\n" #'minibuffer-complete-and-exit) (define-key global-map [remap lisp-complete-symbol] nil)) (PC-default-bindings - (define-key read-expression-map "\e\t" 'PC-lisp-complete-symbol) + (define-key read-expression-map "\e\t" #'PC-lisp-complete-symbol) - (define-key completion-map "\t" 'PC-complete) - (define-key completion-map " " 'PC-complete-word) - (define-key completion-map "?" 'PC-completion-help) + (define-key completion-map "\t" #'PC-complete) + (define-key completion-map " " #'PC-complete-word) + (define-key completion-map "?" #'PC-completion-help) - (define-key completion-map "\e\t" 'PC-complete) - (define-key completion-map "\e " 'PC-complete-word) - (define-key completion-map "\e\r" 'PC-force-complete-and-exit) - (define-key completion-map "\e\n" 'PC-force-complete-and-exit) - (define-key completion-map "\e?" 'PC-completion-help) + (define-key completion-map "\e\t" #'PC-complete) + (define-key completion-map "\e " #'PC-complete-word) + (define-key completion-map "\e\r" #'PC-force-complete-and-exit) + (define-key completion-map "\e\n" #'PC-force-complete-and-exit) + (define-key completion-map "\e?" #'PC-completion-help) - (define-key must-match-map "\r" 'PC-complete-and-exit) - (define-key must-match-map "\n" 'PC-complete-and-exit) + (define-key must-match-map "\r" #'PC-complete-and-exit) + (define-key must-match-map "\n" #'PC-complete-and-exit) - (define-key must-match-map "\e\r" 'PC-complete-and-exit) - (define-key must-match-map "\e\n" 'PC-complete-and-exit) + (define-key must-match-map "\e\r" #'PC-complete-and-exit) + (define-key must-match-map "\e\n" #'PC-complete-and-exit) - (define-key global-map [remap lisp-complete-symbol] 'PC-lisp-complete-symbol))))) + (define-key global-map [remap lisp-complete-symbol] #'PC-lisp-complete-symbol))))) (defvar PC-do-completion-end nil "Internal variable used by `PC-do-completion'.") @@ -212,14 +207,15 @@ see), so that if it is neither nil nor t, Emacs shows the `*Completions*' buffer only on the second attempt to complete. That is, if TAB finds nothing to complete, the first TAB just says \"Next char not unique\" and the second TAB brings up the `*Completions*' buffer." - :global t :group 'partial-completion + :global t ;; Deal with key bindings... (PC-bindings partial-completion-mode) ;; Deal with include file feature... (cond ((not partial-completion-mode) - (remove-hook 'find-file-not-found-functions 'PC-look-for-include-file)) + (remove-hook 'find-file-not-found-functions + #'PC-look-for-include-file)) ((not PC-disable-includes) - (add-hook 'find-file-not-found-functions 'PC-look-for-include-file))) + (add-hook 'find-file-not-found-functions #'PC-look-for-include-file))) ;; Adjust the completion selection in *Completion* buffers to the way ;; we work. The default minibuffer completion code only completes the ;; text before point and leaves the text after point alone (new in @@ -229,9 +225,9 @@ second TAB brings up the `*Completions*' buffer." ;; to trick choose-completion into replacing the whole minibuffer text ;; rather than only the text before point. --Stef (funcall - (if partial-completion-mode 'add-hook 'remove-hook) + (if partial-completion-mode #'add-hook #'remove-hook) 'choose-completion-string-functions - (lambda (choice buffer &rest ignored) + (lambda (_choice buffer &rest _) ;; When completing M-: (lisp- ) with point before the ), it is ;; not appropriate to go to point-max (unlike the filename case). (if (and (not PC-goto-end) @@ -648,7 +644,7 @@ GOTO-END is non-nil, however, it instead replaces up to END." (when (string-match regex x) (push x p))) (setq basestr (try-completion "" p))) - (setq basestr (mapconcat 'list str "-")) + (setq basestr (mapconcat #'list str "-")) (delete-region beg end) (setq end (+ beg (length basestr))) (insert basestr)))) @@ -672,7 +668,7 @@ GOTO-END is non-nil, however, it instead replaces up to END." (setq PC-ignored-regexp (concat "\\(" (mapconcat - 'regexp-quote + #'regexp-quote (setq PC-ignored-extensions completion-ignored-extensions) "\\|") @@ -815,7 +811,7 @@ GOTO-END is non-nil, however, it instead replaces up to END." (eq mode 'help)) (let ((prompt-end (minibuffer-prompt-end))) (with-output-to-temp-buffer "*Completions*" - (display-completion-list (sort helpposs 'string-lessp)) + (display-completion-list (sort helpposs #'string-lessp)) (setq PC-do-completion-end end PC-goto-end goto-end) (with-current-buffer standard-output @@ -1093,7 +1089,7 @@ absolute rather than relative to some directory on the SEARCH-PATH." file-lists)))) (setq search-path (cdr search-path)))) ;; Compress out duplicates while building complete list (slloooow!) - (let ((sorted (sort (apply 'nconc file-lists) + (let ((sorted (sort (apply #'nconc file-lists) (lambda (x y) (not (string-lessp x y))))) compressed) (while sorted diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el index 91ff899c84d..69bf3ed12bc 100644 --- a/lisp/obsolete/crisp.el +++ b/lisp/obsolete/crisp.el @@ -1,4 +1,4 @@ -;;; crisp.el --- CRiSP/Brief Emacs emulator +;;; crisp.el --- CRiSP/Brief Emacs emulator -*- lexical-binding: t; -*- ;; Copyright (C) 1997-1999, 2001-2021 Free Software Foundation, Inc. @@ -66,63 +66,63 @@ (defvar crisp-mode-map (let ((map (make-sparse-keymap))) - (define-key map [(f1)] 'other-window) + (define-key map [(f1)] #'other-window) - (define-key map [(f2) (down)] 'enlarge-window) - (define-key map [(f2) (left)] 'shrink-window-horizontally) - (define-key map [(f2) (right)] 'enlarge-window-horizontally) - (define-key map [(f2) (up)] 'shrink-window) - (define-key map [(f3) (down)] 'split-window-below) - (define-key map [(f3) (right)] 'split-window-right) + (define-key map [(f2) (down)] #'enlarge-window) + (define-key map [(f2) (left)] #'shrink-window-horizontally) + (define-key map [(f2) (right)] #'enlarge-window-horizontally) + (define-key map [(f2) (up)] #'shrink-window) + (define-key map [(f3) (down)] #'split-window-below) + (define-key map [(f3) (right)] #'split-window-right) - (define-key map [(f4)] 'delete-window) - (define-key map [(control f4)] 'delete-other-windows) + (define-key map [(f4)] #'delete-window) + (define-key map [(control f4)] #'delete-other-windows) - (define-key map [(f5)] 'search-forward-regexp) - (define-key map [(f19)] 'search-forward-regexp) - (define-key map [(meta f5)] 'search-backward-regexp) + (define-key map [(f5)] #'search-forward-regexp) + (define-key map [(f19)] #'search-forward-regexp) + (define-key map [(meta f5)] #'search-backward-regexp) - (define-key map [(f6)] 'query-replace) + (define-key map [(f6)] #'query-replace) - (define-key map [(f7)] 'start-kbd-macro) - (define-key map [(meta f7)] 'end-kbd-macro) + (define-key map [(f7)] #'start-kbd-macro) + (define-key map [(meta f7)] #'end-kbd-macro) - (define-key map [(f8)] 'call-last-kbd-macro) - (define-key map [(meta f8)] 'save-kbd-macro) + (define-key map [(f8)] #'call-last-kbd-macro) + ;;(define-key map [(meta f8)] #'save-kbd-macro) ;FIXME:Unknown command? - (define-key map [(f9)] 'find-file) - (define-key map [(meta f9)] 'load-library) + (define-key map [(f9)] #'find-file) + (define-key map [(meta f9)] #'load-library) - (define-key map [(f10)] 'execute-extended-command) - (define-key map [(meta f10)] 'compile) + (define-key map [(f10)] #'execute-extended-command) + (define-key map [(meta f10)] #'compile) - (define-key map [(SunF37)] 'kill-buffer) - (define-key map [(kp-add)] 'crisp-copy-line) - (define-key map [(kp-subtract)] 'crisp-kill-line) + (define-key map [(SunF37)] #'kill-buffer) + (define-key map [(kp-add)] #'crisp-copy-line) + (define-key map [(kp-subtract)] #'crisp-kill-line) ;; just to cover all the bases (GNU Emacs, for instance) - (define-key map [(f24)] 'crisp-kill-line) - (define-key map [(insert)] 'crisp-yank-clipboard) - (define-key map [(f16)] 'crisp-set-clipboard) ; copy on Sun5 kbd - (define-key map [(f20)] 'crisp-kill-region) ; cut on Sun5 kbd - (define-key map [(f18)] 'crisp-yank-clipboard) ; paste on Sun5 kbd + (define-key map [(f24)] #'crisp-kill-line) + (define-key map [(insert)] #'crisp-yank-clipboard) + (define-key map [(f16)] #'crisp-set-clipboard) ; copy on Sun5 kbd + (define-key map [(f20)] #'crisp-kill-region) ; cut on Sun5 kbd + (define-key map [(f18)] #'crisp-yank-clipboard) ; paste on Sun5 kbd - (define-key map [(control f)] 'fill-paragraph-or-region) + ;; (define-key map [(control f)] #'fill-paragraph-or-region) (define-key map [(meta d)] (lambda () (interactive) (beginning-of-line) (kill-line))) - (define-key map [(meta e)] 'find-file) - (define-key map [(meta g)] 'goto-line) - (define-key map [(meta h)] 'help) - (define-key map [(meta i)] 'overwrite-mode) - (define-key map [(meta j)] 'bookmark-jump) - (define-key map [(meta l)] 'crisp-mark-line) - (define-key map [(meta m)] 'set-mark-command) - (define-key map [(meta n)] 'bury-buffer) - (define-key map [(meta p)] 'crisp-unbury-buffer) - (define-key map [(meta u)] 'undo) - (define-key map [(f14)] 'undo) - (define-key map [(meta w)] 'save-buffer) - (define-key map [(meta x)] 'crisp-meta-x-wrapper) + (define-key map [(meta e)] #'find-file) + (define-key map [(meta g)] #'goto-line) + (define-key map [(meta h)] #'help) + (define-key map [(meta i)] #'overwrite-mode) + (define-key map [(meta j)] #'bookmark-jump) + (define-key map [(meta l)] #'crisp-mark-line) + (define-key map [(meta m)] #'set-mark-command) + (define-key map [(meta n)] #'bury-buffer) + (define-key map [(meta p)] #'crisp-unbury-buffer) + (define-key map [(meta u)] #'undo) + (define-key map [(f14)] #'undo) + (define-key map [(meta w)] #'save-buffer) + (define-key map [(meta x)] #'crisp-meta-x-wrapper) (define-key map [(meta ?0)] (lambda () (interactive) (bookmark-set "0"))) @@ -154,21 +154,21 @@ (interactive) (bookmark-set "9"))) - (define-key map [(shift delete)] 'kill-word) - (define-key map [(shift backspace)] 'backward-kill-word) - (define-key map [(control left)] 'backward-word) - (define-key map [(control right)] 'forward-word) + (define-key map [(shift delete)] #'kill-word) + (define-key map [(shift backspace)] #'backward-kill-word) + (define-key map [(control left)] #'backward-word) + (define-key map [(control right)] #'forward-word) - (define-key map [(home)] 'crisp-home) + (define-key map [(home)] #'crisp-home) (define-key map [(control home)] (lambda () (interactive) (move-to-window-line 0))) - (define-key map [(meta home)] 'beginning-of-line) - (define-key map [(end)] 'crisp-end) + (define-key map [(meta home)] #'beginning-of-line) + (define-key map [(end)] #'crisp-end) (define-key map [(control end)] (lambda () (interactive) (move-to-window-line -1))) - (define-key map [(meta end)] 'end-of-line) + (define-key map [(meta end)] #'end-of-line) map) "Local keymap for CRiSP emulation mode. All the bindings are done here instead of globally to try and be @@ -179,8 +179,7 @@ nice to the world.") (defcustom crisp-mode-mode-line-string " *CRiSP*" "String to display in the mode line when CRiSP emulation mode is enabled." - :type 'string - :group 'crisp) + :type 'string) ;;;###autoload (defcustom crisp-mode nil @@ -190,20 +189,18 @@ indicates CRiSP mode is enabled. Setting this variable directly does not take effect; use either M-x customize or the function `crisp-mode'." - :set (lambda (symbol value) (crisp-mode (if value 1 0))) - :initialize 'custom-initialize-default + :set (lambda (_symbol value) (crisp-mode (if value 1 0))) + :initialize #'custom-initialize-default :require 'crisp :version "20.4" - :type 'boolean - :group 'crisp) + :type 'boolean) (defcustom crisp-override-meta-x t "Controls overriding the normal Emacs M-x key binding in the CRiSP emulator. Normally the CRiSP emulator rebinds M-x to `save-buffers-exit-emacs', and provides the usual M-x functionality on the F10 key. If this variable is non-nil, M-x will exit Emacs." - :type 'boolean - :group 'crisp) + :type 'boolean) (defcustom crisp-load-scroll-all nil "Controls loading of the Scroll Lock in the CRiSP emulator. @@ -212,18 +209,15 @@ package when enabling the CRiSP emulator. If this variable is nil when you start the CRiSP emulator, it does not load the scroll-all package." - :type 'boolean - :group 'crisp) + :type 'boolean) (defcustom crisp-load-hook nil "Hooks to run after loading the CRiSP emulator package." - :type 'hook - :group 'crisp) + :type 'hook) (defcustom crisp-mode-hook nil "Hook run by the function `crisp-mode'." - :type 'hook - :group 'crisp) + :type 'hook) (defconst crisp-version "1.34" "The version of the CRiSP emulator.") @@ -370,11 +364,11 @@ normal CRiSP binding) and when it is nil M-x will run (if crisp-load-scroll-all (require 'scroll-all)) (if (featurep 'scroll-all) - (define-key crisp-mode-map [(meta f1)] 'scroll-all-mode)))) + (define-key crisp-mode-map [(meta f1)] #'scroll-all-mode)))) ;; People might use Apropos on `brief'. ;;;###autoload -(defalias 'brief-mode 'crisp-mode) +(defalias 'brief-mode #'crisp-mode) (run-hooks 'crisp-load-hook) (provide 'crisp) diff --git a/lisp/obsolete/cust-print.el b/lisp/obsolete/cust-print.el index c7342b61ae7..01fcd38199c 100644 --- a/lisp/obsolete/cust-print.el +++ b/lisp/obsolete/cust-print.el @@ -1,4 +1,4 @@ -;;; cust-print.el --- handles print-level and print-circle +;;; cust-print.el --- handles print-level and print-circle -*- lexical-binding: t; -*- ;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc. @@ -118,9 +118,6 @@ ;; Emacs 18 doesn't have defalias. ;; Provide def for byte compiler. -(eval-and-compile - (or (fboundp 'defalias) (fset 'defalias 'fset))) - ;; Variables: ;;========================================================= @@ -141,8 +138,7 @@ If non-nil, components at levels equal to or greater than `print-level' are printed simply as `#'. The object to be printed is at level 0, and if the object is a list or vector, its top-level components are at level 1." - :type '(choice (const nil) integer) - :group 'cust-print) + :type '(choice (const nil) integer)) (defcustom print-circle nil @@ -157,14 +153,12 @@ If non-nil, shared substructures anywhere in the structure are printed with `#N=' before the first occurrence (in the order of the print representation) and `#N#' in place of each subsequent occurrence, where N is a positive decimal integer." - :type 'boolean - :group 'cust-print) + :type 'boolean) (defcustom custom-print-vectors nil "Non-nil if printing of vectors should obey `print-level' and `print-length'." - :type 'boolean - :group 'cust-print) + :type 'boolean) ;; Custom printers @@ -201,7 +195,7 @@ Any pair that has the same PREDICATE is first removed." (cust-print-update-custom-printers)) -(defun cust-print-use-custom-printer (object) +(defun cust-print-use-custom-printer (_object) ;; Default function returns nil. nil) @@ -231,11 +225,11 @@ Any pair that has the same PREDICATE is first removed." (defalias (car symbol-pair) (symbol-function (car (cdr symbol-pair))))) -(defun cust-print-original-princ (object &optional stream)) ; dummy def +(defun cust-print-original-princ (_object &optional _stream) nil) ; dummy def ;; Save emacs routines. (if (not (fboundp 'cust-print-original-prin1)) - (mapc 'cust-print-set-function-cell + (mapc #'cust-print-set-function-cell '((cust-print-original-prin1 prin1) (cust-print-original-princ princ) (cust-print-original-print print) @@ -243,14 +237,15 @@ Any pair that has the same PREDICATE is first removed." (cust-print-original-format format) (cust-print-original-message message) (cust-print-original-error error)))) - +(declare-function cust-print-original-format "cust-print") +(declare-function cust-print-original-message "cust-print") (defun custom-print-install () "Replace print functions with general, customizable, Lisp versions. The Emacs subroutines are saved away, and you can reinstall them by running `custom-print-uninstall'." (interactive) - (mapc 'cust-print-set-function-cell + (mapc #'cust-print-set-function-cell '((prin1 custom-prin1) (princ custom-princ) (print custom-print) @@ -264,7 +259,7 @@ by running `custom-print-uninstall'." (defun custom-print-uninstall () "Reset print functions to their Emacs subroutines." (interactive) - (mapc 'cust-print-set-function-cell + (mapc #'cust-print-set-function-cell '((prin1 cust-print-original-prin1) (princ cust-print-original-princ) (print cust-print-original-print) @@ -275,22 +270,20 @@ by running `custom-print-uninstall'." )) t) -(defalias 'custom-print-funcs-installed-p 'custom-print-installed-p) +(defalias 'custom-print-funcs-installed-p #'custom-print-installed-p) (defun custom-print-installed-p () "Return t if custom-print is currently installed, nil otherwise." (eq (symbol-function 'custom-prin1) (symbol-function 'prin1))) -(put 'with-custom-print-funcs 'edebug-form-spec '(body)) -(put 'with-custom-print 'edebug-form-spec '(body)) - -(defalias 'with-custom-print-funcs 'with-custom-print) (defmacro with-custom-print (&rest body) "Temporarily install the custom print package while executing BODY." + (declare (debug t)) `(unwind-protect (progn (custom-print-install) ,@body) (custom-print-uninstall))) +(defalias 'with-custom-print-funcs #'with-custom-print) ;; Lisp replacements for prin1 and princ, and for some subrs that use them @@ -369,7 +362,7 @@ vector, or symbol args. The format specification for such args should be `%s' in any case, so a string argument will also work. The string is generated with `custom-prin1-to-string', which quotes quotable characters." - (apply 'cust-print-original-format fmt + (apply #'cust-print-original-format fmt (mapcar (function (lambda (arg) (if (or (listp arg) (vectorp arg) (symbolp arg)) (custom-prin1-to-string arg) @@ -393,7 +386,7 @@ See `custom-format' for the details." ;; because the echo area requires special handling ;; to avoid duplicating the output. ;; cust-print-original-message does it right. - (apply 'cust-print-original-message fmt + (apply #'cust-print-original-message fmt (mapcar (function (lambda (arg) (if (or (listp arg) (vectorp arg) (symbolp arg)) (custom-prin1-to-string arg) @@ -406,7 +399,7 @@ See `custom-format' for the details." This is the custom-print replacement for the standard `error'. See `custom-format' for the details." - (signal 'error (list (apply 'custom-format fmt args)))) + (signal 'error (list (apply #'custom-format fmt args)))) @@ -417,9 +410,9 @@ See `custom-format' for the details." (defvar circle-table) (defvar cust-print-current-level) -(defun cust-print-original-printer (object)) ; One of the standard printers. -(defun cust-print-low-level-prin (object)) ; Used internally. -(defun cust-print-prin (object)) ; Call this to print recursively. +(defun cust-print-original-printer (_object) nil) ; One of the standard printers. +(defun cust-print-low-level-prin (_object) nil) ; Used internally. +(defun cust-print-prin (_object) nil) ; Call this to print recursively. (defun cust-print-top-level (object stream emacs-printer) ;; Set up for printing. diff --git a/lisp/obsolete/erc-compat.el b/lisp/obsolete/erc-compat.el index 203ef079c14..9972e927e61 100644 --- a/lisp/obsolete/erc-compat.el +++ b/lisp/obsolete/erc-compat.el @@ -1,4 +1,4 @@ -;;; erc-compat.el --- ERC compatibility code for XEmacs +;;; erc-compat.el --- ERC compatibility code for XEmacs -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc. @@ -31,8 +31,7 @@ (require 'format-spec) ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") -(defalias 'erc-define-minor-mode 'define-minor-mode) -(put 'erc-define-minor-mode 'edebug-form-spec 'define-minor-mode) +(defalias 'erc-define-minor-mode #'define-minor-mode) (defun erc-decode-coding-string (s coding-system) "Decode S using CODING-SYSTEM." @@ -73,7 +72,7 @@ are placed. Note that this should end with a directory separator.") (defun erc-replace-match-subexpression-in-string - (newtext string match subexp start &optional fixedcase literal) + (newtext string _match subexp _start &optional fixedcase literal) "Replace the subexpression SUBEXP of the last match in STRING with NEWTEXT. MATCH is the text which matched the subexpression (see `match-string'). START is the beginning position of the last match (see `match-beginning'). diff --git a/lisp/obsolete/erc-hecomplete.el b/lisp/obsolete/erc-hecomplete.el index fce79f7f34f..36b08d56f7b 100644 --- a/lisp/obsolete/erc-hecomplete.el +++ b/lisp/obsolete/erc-hecomplete.el @@ -1,4 +1,4 @@ -;;; erc-hecomplete.el --- Provides Nick name completion for ERC +;;; erc-hecomplete.el --- Provides Nick name completion for ERC -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2002, 2004, 2006-2021 Free Software Foundation, ;; Inc. @@ -39,8 +39,8 @@ ;;;###autoload (autoload 'erc-hecomplete-mode "erc-hecomplete" nil t) (define-erc-module hecomplete nil "Complete nick at point." - ((add-hook 'erc-complete-functions 'erc-hecomplete)) - ((remove-hook 'erc-complete-functions 'erc-hecomplete))) + ((add-hook 'erc-complete-functions #'erc-hecomplete)) + ((remove-hook 'erc-complete-functions #'erc-hecomplete))) (defun erc-hecomplete () "Complete nick at point. @@ -70,15 +70,13 @@ or you may use an arbitrary lisp expression." erc-nick-completion-exclude-myself) (repeat :tag "List" (string :tag "Nick")) function - sexp) - :group 'erc-hecomplete) + sexp)) (defcustom erc-nick-completion-ignore-case t "Non-nil means don't consider case significant in nick completion. Case will be automatically corrected when non-nil. For instance if you type \"dely TAB\" the word completes and changes to \"delYsid\"." - :group 'erc-hecomplete :type 'boolean) (defun erc-nick-completion-exclude-myself () @@ -95,7 +93,6 @@ typing \"f o TAB\" will directly give you foobar. Use this with (defcustom erc-nick-completion-postfix ": " "When `erc-complete' is used in the first word after the prompt, add this string when a unique expansion was found." - :group 'erc-hecomplete :type 'string) (defun erc-command-list () diff --git a/lisp/obsolete/eudcb-ph.el b/lisp/obsolete/eudcb-ph.el index c7212e3fdb7..187879ce2f7 100644 --- a/lisp/obsolete/eudcb-ph.el +++ b/lisp/obsolete/eudcb-ph.el @@ -1,4 +1,4 @@ -;;; eudcb-ph.el --- Emacs Unified Directory Client - CCSO PH/QI Backend +;;; eudcb-ph.el --- Emacs Unified Directory Client - CCSO PH/QI Backend -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. @@ -69,7 +69,7 @@ defaulting to `eudc-default-return-attributes'." query " ")) (if return-fields - (concat " return " (mapconcat 'symbol-name return-fields " "))))) + (concat " return " (mapconcat #'symbol-name return-fields " "))))) (and (> (length request) 6) (eudc-ph-do-request request) (eudc-ph-parse-query-result return-fields)))) @@ -189,7 +189,7 @@ SERVER is either a string naming the server or a list (NAME PORT)." (with-current-buffer (process-buffer process) (eudc-ph-send-command process "quit") (eudc-ph-read-response process) - (run-at-time 2 nil 'delete-process process))) + (run-at-time 2 nil #'delete-process process))) (defun eudc-ph-send-command (process command) (goto-char (point-max)) diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el index 8848c89c62f..baed8be7663 100644 --- a/lisp/obsolete/fast-lock.el +++ b/lisp/obsolete/fast-lock.el @@ -1,4 +1,4 @@ -;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode +;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode -*- lexical-binding: t; -*- ;; Copyright (C) 1994-1998, 2001-2021 Free Software Foundation, Inc. @@ -190,18 +190,6 @@ (defvar font-lock-face-list) (eval-when-compile - ;; We use this to preserve or protect things when modifying text properties. - (defmacro save-buffer-state (varlist &rest body) - "Bind variables according to VARLIST and eval BODY restoring buffer state." - `(let* (,@(append varlist - '((modified (buffer-modified-p)) (buffer-undo-list t) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark buffer-file-name buffer-file-truename))) - ,@body - (when (and (not modified) (buffer-modified-p)) - (set-buffer-modified-p nil)))) - (put 'save-buffer-state 'lisp-indent-function 1) ;; ;; We use this to verify that a face should be saved. (defmacro fast-lock-save-facep (face) @@ -244,8 +232,7 @@ for buffers in Rmail mode, and size is irrelevant otherwise." (symbol :tag "name")) (radio :tag "Size" (const :tag "none" nil) - (integer :tag "size"))))) - :group 'fast-lock) + (integer :tag "size")))))) (defcustom fast-lock-cache-directories '("~/.emacs-flc") ; - `internal', keep each file's Font Lock cache file in the same file. @@ -271,8 +258,7 @@ to avoid the possibility of using the cache of another user." :type '(repeat (radio (directory :tag "directory") (cons :tag "Matching" (regexp :tag "regexp") - (directory :tag "directory")))) - :group 'fast-lock) + (directory :tag "directory"))))) (put 'fast-lock-cache-directories 'risky-local-variable t) (defcustom fast-lock-save-events '(kill-buffer kill-emacs) @@ -282,23 +268,20 @@ If concurrent editing sessions use the same associated cache file for a file's buffer, then you should add `save-buffer' to this list." :type '(set (const :tag "buffer saving" save-buffer) (const :tag "buffer killing" kill-buffer) - (const :tag "emacs killing" kill-emacs)) - :group 'fast-lock) + (const :tag "emacs killing" kill-emacs))) (defcustom fast-lock-save-others t "If non-nil, save Font Lock cache files irrespective of file owner. If nil, means only buffer files known to be owned by you can have associated Font Lock cache files saved. Ownership may be unknown for networked files." - :type 'boolean - :group 'fast-lock) + :type 'boolean) (defcustom fast-lock-verbose font-lock-verbose "If non-nil, means show status messages for cache processing. If a number, only buffers greater than this size have processing messages." :type '(choice (const :tag "never" nil) (other :tag "always" t) - (integer :tag "size")) - :group 'fast-lock) + (integer :tag "size"))) (defvar fast-lock-save-faces (when (featurep 'xemacs) @@ -455,8 +438,7 @@ See `fast-lock-mode'." ;; Flag so that a cache will be saved later even if the file is never saved. (setq fast-lock-cache-timestamp nil)) -(defalias 'fast-lock-after-unfontify-buffer - 'ignore) +(defalias 'fast-lock-after-unfontify-buffer #'ignore) ;; Miscellaneous Functions: @@ -473,7 +455,7 @@ See `fast-lock-mode'." (defun fast-lock-save-caches-before-kill-emacs () ;; Do `fast-lock-save-cache's if `kill-emacs' is on `fast-lock-save-events'. (when (memq 'kill-emacs fast-lock-save-events) - (mapcar 'fast-lock-save-cache (buffer-list)))) + (mapcar #'fast-lock-save-cache (buffer-list)))) (defun fast-lock-cache-directory (directory create) "Return usable directory based on DIRECTORY. @@ -534,7 +516,7 @@ See `fast-lock-cache-directory'." (function (lambda (c) (or (cdr (assq c chars-alist)) (list c)))))) (concat (file-name-as-directory (expand-file-name directory)) - (mapconcat 'char-to-string (apply 'append (mapcar mapchars bufile)) "") + (mapconcat #'char-to-string (apply #'append (mapcar mapchars bufile)) "") ".flc")))) ;; Font Lock Cache Processing Functions: @@ -581,7 +563,7 @@ See `fast-lock-cache-directory'." (defun fast-lock-cache-data (version timestamp syntactic-keywords syntactic-properties keywords face-properties - &rest ignored) + &rest _ignored) ;; Find value of syntactic keywords in case it is a symbol. (setq font-lock-syntactic-keywords (font-lock-eval-keywords font-lock-syntactic-keywords)) @@ -708,86 +690,26 @@ See `fast-lock-get-face-properties'." "Add `syntax-table' and `face' text properties to the current buffer. Any existing `syntax-table' and `face' text properties are removed first. See `fast-lock-get-face-properties'." - (save-buffer-state (plist regions) - (save-restriction - (widen) - (font-lock-unfontify-region (point-min) (point-max)) - ;; - ;; Set the `syntax-table' property for each start/end region. - (while syntactic-properties - (setq plist (list 'syntax-table (car (car syntactic-properties))) - regions (cdr (car syntactic-properties)) - syntactic-properties (cdr syntactic-properties)) - (while regions - (add-text-properties (nth 0 regions) (nth 1 regions) plist) - (setq regions (nthcdr 2 regions)))) - ;; - ;; Set the `face' property for each start/end region. - (while face-properties - (setq plist (list 'face (car (car face-properties))) - regions (cdr (car face-properties)) - face-properties (cdr face-properties)) - (while regions - (add-text-properties (nth 0 regions) (nth 1 regions) plist) - (setq regions (nthcdr 2 regions))))))) + (with-silent-modifications + (let ((inhibit-point-motion-hooks t)) + (save-restriction + (widen) + (font-lock-unfontify-region (point-min) (point-max)) + ;; + ;; Set the `syntax-table' property for each start/end region. + (pcase-dolist (`(,plist . ,regions) syntactic-properties) + (while regions + (add-text-properties (nth 0 regions) (nth 1 regions) plist) + (setq regions (nthcdr 2 regions)))) + ;; + ;; Set the `face' property for each start/end region. + (pcase-dolist (`(,plist . ,regions) face-properties) + (while regions + (add-text-properties (nth 0 regions) (nth 1 regions) plist) + (setq regions (nthcdr 2 regions)))))))) ;; Functions for XEmacs: -(when (featurep 'xemacs) - ;; - ;; It would be better to use XEmacs' `map-extents' over extents with a - ;; `font-lock' property, but `face' properties are on different extents. - (defun fast-lock-get-face-properties () - "Return a list of `face' text properties in the current buffer. -Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) -where VALUE is a `face' property value and STARTx and ENDx are positions. -Only those `face' VALUEs in `fast-lock-save-faces' are returned." - (save-restriction - (widen) - (let ((properties ()) cell) - (map-extents - (function (lambda (extent ignore) - (let ((value (extent-face extent))) - ;; We're only interested if it's one of `fast-lock-save-faces'. - (when (and value (fast-lock-save-facep value)) - (let ((start (extent-start-position extent)) - (end (extent-end-position extent))) - ;; Make or add to existing list of regions with the same - ;; `face' property value. - (if (setq cell (assoc value properties)) - (setcdr cell (cons start (cons end (cdr cell)))) - (push (list value start end) properties)))) - ;; Return nil to keep `map-extents' going. - nil)))) - properties))) - ;; - ;; XEmacs does not support the `syntax-table' text property. - (defalias 'fast-lock-get-syntactic-properties - 'ignore) - ;; - ;; Make extents just like XEmacs' font-lock.el does. - (defun fast-lock-add-properties (syntactic-properties face-properties) - "Set `face' text properties in the current buffer. -Any existing `face' text properties are removed first. -See `fast-lock-get-face-properties'." - (save-restriction - (widen) - (font-lock-unfontify-region (point-min) (point-max)) - ;; Set the `face' property, etc., for each start/end region. - (while face-properties - (let ((face (car (car face-properties))) - (regions (cdr (car face-properties)))) - (while regions - (font-lock-set-face (nth 0 regions) (nth 1 regions) face) - (setq regions (nthcdr 2 regions))) - (setq face-properties (cdr face-properties)))) - ;; XEmacs does not support the `syntax-table' text property. - )) - ;; - ;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook. - (add-hook 'font-lock-after-fontify-buffer-hook - 'fast-lock-after-fontify-buffer)) - (unless (boundp 'font-lock-syntactic-keywords) (defvar font-lock-syntactic-keywords nil)) @@ -795,14 +717,14 @@ See `fast-lock-get-face-properties'." (defvar font-lock-inhibit-thing-lock nil)) (unless (fboundp 'font-lock-compile-keywords) - (defalias 'font-lock-compile-keywords 'identity)) + (defalias 'font-lock-compile-keywords #'identity)) (unless (fboundp 'font-lock-eval-keywords) (defun font-lock-eval-keywords (keywords) (if (symbolp keywords) (font-lock-eval-keywords (if (fboundp keywords) (funcall keywords) - (eval keywords))) + (eval keywords t))) keywords))) (unless (fboundp 'font-lock-value-in-major-mode) @@ -817,10 +739,10 @@ See `fast-lock-get-face-properties'." ;; Install ourselves: -(add-hook 'after-save-hook 'fast-lock-save-cache-after-save-file) -(add-hook 'kill-buffer-hook 'fast-lock-save-cache-before-kill-buffer) +(add-hook 'after-save-hook #'fast-lock-save-cache-after-save-file) +(add-hook 'kill-buffer-hook #'fast-lock-save-cache-before-kill-buffer) (unless noninteractive - (add-hook 'kill-emacs-hook 'fast-lock-save-caches-before-kill-emacs)) + (add-hook 'kill-emacs-hook #'fast-lock-save-caches-before-kill-emacs)) ;;;###autoload (when (fboundp 'add-minor-mode) diff --git a/lisp/obsolete/gs.el b/lisp/obsolete/gs.el index 6ab3fc59380..5a82c6b05f0 100644 --- a/lisp/obsolete/gs.el +++ b/lisp/obsolete/gs.el @@ -1,4 +1,4 @@ -;;; gs.el --- interface to Ghostscript +;;; gs.el --- interface to Ghostscript -*- lexical-binding: t; -*- ;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc. @@ -205,7 +205,7 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful." (gs-set-ghostview-window-prop frame spec img-width img-height) (gs-set-ghostview-colors-window-prop frame pixel-colors) (setenv "GHOSTVIEW" window-and-pixmap-id) - (setq gs (apply 'start-process "gs" "*GS*" gs-program + (setq gs (apply #'start-process "gs" "*GS*" gs-program (gs-options gs-device file))) (set-process-query-on-exit-flag gs nil) gs) diff --git a/lisp/obsolete/gulp.el b/lisp/obsolete/gulp.el index 0fbaa1cc4f8..6ec2f4f772c 100644 --- a/lisp/obsolete/gulp.el +++ b/lisp/obsolete/gulp.el @@ -1,4 +1,4 @@ -;;; gulp.el --- ask for updates for Lisp packages +;;; gulp.el --- ask for updates for Lisp packages -*- lexical-binding: t; -*- ;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc. @@ -37,18 +37,15 @@ (defcustom gulp-discard "^;+ *Maintainer: *\\(FSF\\|emacs-devel@gnu\\.org\\) *$" "The regexp matching the packages not requiring the request for updates." :version "24.4" ; added emacs-devel - :type 'regexp - :group 'gulp) + :type 'regexp) (defcustom gulp-tmp-buffer "*gulp*" "The name of the temporary buffer." - :type 'string - :group 'gulp) + :type 'string) (defcustom gulp-max-len 2000 "Distance into a Lisp source file to scan for keywords." - :type 'integer - :group 'gulp) + :type 'integer) (defcustom gulp-request-header (concat @@ -57,8 +54,7 @@ I'm going to start pretesting a new version of GNU Emacs soon, so I'd like to ask if you have any updates for the Emacs packages you work on. You're listed as the maintainer of the following package(s):\n\n") "The starting text of a gulp message." - :type 'string - :group 'gulp) + :type 'string) (defcustom gulp-request-end (concat @@ -75,8 +71,7 @@ of information to include. Thanks.") "The closing text in a gulp message." - :type 'string - :group 'gulp) + :type 'string) (declare-function mail-subject "sendmail" ()) (declare-function mail-send "sendmail" ()) diff --git a/lisp/obsolete/html2text.el b/lisp/obsolete/html2text.el index f01561bd12c..be0553cb3ae 100644 --- a/lisp/obsolete/html2text.el +++ b/lisp/obsolete/html2text.el @@ -1,4 +1,4 @@ -;;; html2text.el --- a simple html to plain text converter -*- coding: utf-8 -*- +;;; html2text.el --- a simple html to plain text converter -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. diff --git a/lisp/obsolete/info-edit.el b/lisp/obsolete/info-edit.el index c8a187c08ee..c53616d80e7 100644 --- a/lisp/obsolete/info-edit.el +++ b/lisp/obsolete/info-edit.el @@ -36,7 +36,7 @@ (define-obsolete-variable-alias 'Info-edit-map 'Info-edit-mode-map "24.1") (defvar Info-edit-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map text-mode-map) - (define-key map "\C-c\C-c" 'Info-cease-edit) + (define-key map "\C-c\C-c" #'Info-cease-edit) map) "Local keymap used within `e' command of Info.") diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index 58cada13747..a7fd6ccb5f5 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -1,4 +1,4 @@ -;;; iswitchb.el --- switch between buffers using substrings +;;; iswitchb.el --- switch between buffers using substrings -*- lexical-binding: t; -*- ;; Copyright (C) 1996-1997, 2000-2021 Free Software Foundation, Inc. @@ -258,8 +258,7 @@ "Non-nil if searching of buffer names should ignore case. If this is non-nil but the user input has any upper case letters, matching is temporarily case sensitive." - :type 'boolean - :group 'iswitchb) + :type 'boolean) (defcustom iswitchb-buffer-ignore '("^ ") @@ -267,8 +266,7 @@ is temporarily case sensitive." For example, traditional behavior is not to list buffers whose names begin with a space, for which the regexp is `^ '. See the source file for example functions that filter buffer names." - :type '(repeat (choice regexp function)) - :group 'iswitchb) + :type '(repeat (choice regexp function))) (put 'iswitchb-buffer-ignore 'risky-local-variable t) (defcustom iswitchb-max-to-show nil @@ -277,8 +275,7 @@ If this value is N, and N is greater than the number of matching buffers, the first N/2 and the last N/2 matching buffers are shown. This can greatly speed up iswitchb if you have a multitude of buffers open." - :type '(choice (const :tag "Show all" nil) integer) - :group 'iswitchb) + :type '(choice (const :tag "Show all" nil) integer)) (defcustom iswitchb-use-virtual-buffers nil "If non-nil, refer to past buffers when none match. @@ -289,8 +286,7 @@ enabled if this variable is configured to a non-nil value." :set (function (lambda (sym value) (if value (recentf-mode 1)) - (set sym value))) - :group 'iswitchb) + (set sym value)))) (defvar iswitchb-virtual-buffers nil) @@ -299,8 +295,7 @@ enabled if this variable is configured to a non-nil value." The most useful values are `iswitchb-completion-help', which pops up a window with completion alternatives, or `iswitchb-next-match' or `iswitchb-prev-match', which cycle the buffer list." - :type 'hook - :group 'iswitchb) + :type 'hook) ;; Examples for setting the value of iswitchb-buffer-ignore ;;(defun iswitchb-ignore-c-mode (name) @@ -328,46 +323,38 @@ Possible values: (const display) (const otherframe) (const maybe-frame) - (const always-frame)) - :group 'iswitchb) + (const always-frame))) (defcustom iswitchb-regexp nil "Non-nil means that `iswitchb' will do regexp matching. Value can be toggled within `iswitchb' using `iswitchb-toggle-regexp'." - :type 'boolean - :group 'iswitchb) + :type 'boolean) (defcustom iswitchb-newbuffer t "Non-nil means create new buffer if no buffer matches substring. See also `iswitchb-prompt-newbuffer'." - :type 'boolean - :group 'iswitchb) + :type 'boolean) (defcustom iswitchb-prompt-newbuffer t "Non-nil means prompt user to confirm before creating new buffer. See also `iswitchb-newbuffer'." - :type 'boolean - :group 'iswitchb) + :type 'boolean) (defcustom iswitchb-use-faces t "Non-nil means use font-lock faces for showing first match." - :type 'boolean - :group 'iswitchb) + :type 'boolean) (defcustom iswitchb-use-frame-buffer-list nil "Non-nil means use the currently selected frame's buffer list." - :type 'boolean - :group 'iswitchb) + :type 'boolean) (defcustom iswitchb-make-buflist-hook nil "Hook to run when list of matching buffers is created." - :type 'hook - :group 'iswitchb) + :type 'hook) (defcustom iswitchb-delim "," "Delimiter to put between buffer names when displaying results." - :type 'string - :group 'iswitchb) + :type 'string) (defcustom iswitchb-all-frames 'visible "Argument to pass to `walk-windows' when iswitchb is finding buffers. @@ -375,8 +362,7 @@ See documentation of `walk-windows' for useful values." :type '(choice (const :tag "Selected frame only" nil) (const :tag "All existing frames" t) (const :tag "All visible frames" visible) - (const :tag "All frames on this terminal" 0)) - :group 'iswitchb) + (const :tag "All frames on this terminal" 0))) (defcustom iswitchb-minibuffer-setup-hook nil "Iswitchb-specific customization of minibuffer setup. @@ -387,37 +373,32 @@ For instance: \\='\(lambda () (set (make-local-variable \\='max-mini-window-height) 3))) will constrain the minibuffer to a maximum height of 3 lines when iswitchb is running." - :type 'hook - :group 'iswitchb) + :type 'hook) (defface iswitchb-single-match '((t (:inherit font-lock-comment-face))) "Iswitchb face for single matching buffer name." - :version "22.1" - :group 'iswitchb) + :version "22.1") (defface iswitchb-current-match '((t (:inherit font-lock-function-name-face))) "Iswitchb face for current matching buffer name." - :version "22.1" - :group 'iswitchb) + :version "22.1") (defface iswitchb-virtual-matches '((t (:inherit font-lock-builtin-face))) "Iswitchb face for matching virtual buffer names. See also `iswitchb-use-virtual-buffers'." - :version "22.1" - :group 'iswitchb) + :version "22.1") (defface iswitchb-invalid-regexp '((t (:inherit font-lock-warning-face))) "Iswitchb face for indicating invalid regexp. " - :version "22.1" - :group 'iswitchb) + :version "22.1") ;; Do we need the variable iswitchb-use-mycompletion? @@ -465,18 +446,18 @@ interfere with other minibuffer usage.") (defvar iswitchb-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) - (define-key map "?" 'iswitchb-completion-help) - (define-key map "\C-s" 'iswitchb-next-match) - (define-key map "\C-r" 'iswitchb-prev-match) - (define-key map [?\C-.] 'iswitchb-next-match) - (define-key map [?\C-,] 'iswitchb-prev-match) - (define-key map "\t" 'iswitchb-complete) - (define-key map "\C-j" 'iswitchb-select-buffer-text) - (define-key map "\C-t" 'iswitchb-toggle-regexp) - (define-key map "\C-x\C-f" 'iswitchb-find-file) - (define-key map "\C-c" 'iswitchb-toggle-case) - (define-key map "\C-k" 'iswitchb-kill-buffer) - (define-key map "\C-m" 'iswitchb-exit-minibuffer) + (define-key map "?" #'iswitchb-completion-help) + (define-key map "\C-s" #'iswitchb-next-match) + (define-key map "\C-r" #'iswitchb-prev-match) + (define-key map [?\C-.] #'iswitchb-next-match) + (define-key map [?\C-,] #'iswitchb-prev-match) + (define-key map "\t" #'iswitchb-complete) + (define-key map "\C-j" #'iswitchb-select-buffer-text) + (define-key map "\C-t" #'iswitchb-toggle-regexp) + (define-key map "\C-x\C-f" #'iswitchb-find-file) + (define-key map "\C-c" #'iswitchb-toggle-case) + (define-key map "\C-k" #'iswitchb-kill-buffer) + (define-key map "\C-m" #'iswitchb-exit-minibuffer) map) "Minibuffer keymap for `iswitchb-buffer'.") @@ -596,17 +577,17 @@ the selection process begins. Used by isearchb.el." (let ((map (copy-keymap minibuffer-local-map)) buf-sel iswitchb-final-text icomplete-mode) ; prevent icomplete starting up - (define-key map "?" 'iswitchb-completion-help) - (define-key map "\C-s" 'iswitchb-next-match) - (define-key map "\C-r" 'iswitchb-prev-match) - (define-key map "\t" 'iswitchb-complete) - (define-key map "\C-j" 'iswitchb-select-buffer-text) - (define-key map "\C-t" 'iswitchb-toggle-regexp) - (define-key map "\C-x\C-f" 'iswitchb-find-file) - (define-key map "\C-n" 'iswitchb-toggle-ignore) - (define-key map "\C-c" 'iswitchb-toggle-case) - (define-key map "\C-k" 'iswitchb-kill-buffer) - (define-key map "\C-m" 'iswitchb-exit-minibuffer) + (define-key map "?" #'iswitchb-completion-help) + (define-key map "\C-s" #'iswitchb-next-match) + (define-key map "\C-r" #'iswitchb-prev-match) + (define-key map "\t" #'iswitchb-complete) + (define-key map "\C-j" #'iswitchb-select-buffer-text) + (define-key map "\C-t" #'iswitchb-toggle-regexp) + (define-key map "\C-x\C-f" #'iswitchb-find-file) + (define-key map "\C-n" #'iswitchb-toggle-ignore) + (define-key map "\C-c" #'iswitchb-toggle-case) + (define-key map "\C-k" #'iswitchb-kill-buffer) + (define-key map "\C-m" #'iswitchb-exit-minibuffer) (setq iswitchb-mode-map map) (run-hooks 'iswitchb-define-mode-map-hook) @@ -946,9 +927,9 @@ If `iswitchb-change-word-sub' cannot be found in WORD, return nil." (if iswitchb-regexp subs (regexp-quote subs))) - (setq res (mapcar 'iswitchb-word-matching-substring lis)) + (setq res (mapcar #'iswitchb-word-matching-substring lis)) (setq res (delq nil res)) ;; remove any nil elements (shouldn't happen) - (setq alist (mapcar 'iswitchb-makealist res)) ;; could use an OBARRAY + (setq alist (mapcar #'iswitchb-makealist res)) ;; could use an OBARRAY ;; try-completion returns t if there is an exact match. (let ((completion-ignore-case (iswitchb-case))) @@ -1148,43 +1129,6 @@ For details of keybindings, do `\\[describe-function] iswitchb'." (setq iswitchb-method 'otherframe) (iswitchb)) -;;; XEmacs hack for showing default buffer - -;; The first time we enter the minibuffer, Emacs puts up the default -;; buffer to switch to, but XEmacs doesn't -- presumably there is a -;; subtle difference in the two versions of post-command-hook. The -;; default is shown for both whenever we delete all of our text -;; though, indicating its just a problem the first time we enter the -;; function. To solve this, we use another entry hook for emacs to -;; show the default the first time we enter the minibuffer. - -(defun iswitchb-init-XEmacs-trick () - "Display default buffer when first entering minibuffer. -This is a hack for XEmacs, and should really be handled by `iswitchb-exhibit'." - (if (iswitchb-entryfn-p) - (progn - (iswitchb-exhibit) - (goto-char (point-min))))) - -;; add this hook for XEmacs only. -(if (featurep 'xemacs) - (add-hook 'iswitchb-minibuffer-setup-hook - 'iswitchb-init-XEmacs-trick)) - -;;; XEmacs / backspace key -;; For some reason, if the backspace key is pressed in XEmacs, the -;; line gets confused, so I've added a simple key definition to make -;; backspace act like the normal delete key. - -(defun iswitchb-xemacs-backspacekey () - "Bind backspace to `backward-delete-char'." - (define-key iswitchb-mode-map '[backspace] 'backward-delete-char) - (define-key iswitchb-mode-map '[(meta backspace)] 'backward-kill-word)) - -(if (featurep 'xemacs) - (add-hook 'iswitchb-define-mode-map-hook - 'iswitchb-xemacs-backspacekey)) - ;;; ICOMPLETE TYPE CODE (defun iswitchb-exhibit () @@ -1273,7 +1217,7 @@ Modified from `icomplete-completions'." iswitchb-virtual-buffers))) (setq head (cdr head))) (setq iswitchb-virtual-buffers (nreverse iswitchb-virtual-buffers) - comps (mapcar 'car iswitchb-virtual-buffers)) + comps (mapcar #'car iswitchb-virtual-buffers)) (let ((comp comps)) (while comp (put-text-property 0 (length (car comp)) @@ -1323,8 +1267,9 @@ Modified from `icomplete-completions'." (most-len (length most)) most-is-exact (alternatives - (mapconcat (if most 'iswitchb-output-completion - 'identity) comps iswitchb-delim))) + (mapconcat (if most #'iswitchb-output-completion + #'identity) + comps iswitchb-delim))) (concat @@ -1356,8 +1301,8 @@ Modified from `icomplete-completions'." Copied from `icomplete-minibuffer-setup-hook'." (when (iswitchb-entryfn-p) (set (make-local-variable 'iswitchb-use-mycompletion) t) - (add-hook 'pre-command-hook 'iswitchb-pre-command nil t) - (add-hook 'post-command-hook 'iswitchb-post-command nil t) + (add-hook 'pre-command-hook #'iswitchb-pre-command nil t) + (add-hook 'post-command-hook #'iswitchb-post-command nil t) (run-hooks 'iswitchb-minibuffer-setup-hook))) (defun iswitchb-pre-command () @@ -1416,10 +1361,10 @@ See the variable `iswitchb-case' for details." Iswitchb mode is a global minor mode that enables switching between buffers using substrings. See `iswitchb' for details." - nil nil iswitchb-global-map :global t :group 'iswitchb + nil nil iswitchb-global-map :global t (if iswitchb-mode - (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup) - (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))) + (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup) + (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))) (provide 'iswitchb) diff --git a/lisp/obsolete/landmark.el b/lisp/obsolete/landmark.el index ae15109beaa..cc4fd19c389 100644 --- a/lisp/obsolete/landmark.el +++ b/lisp/obsolete/landmark.el @@ -163,51 +163,50 @@ (defcustom landmark-mode-hook nil "If non-nil, its value is called on entry to Landmark mode." - :type 'hook - :group 'landmark) + :type 'hook) (defvar landmark-mode-map (let ((map (make-sparse-keymap))) ;; Key bindings for cursor motion. - (define-key map "y" 'landmark-move-nw) ; y - (define-key map "u" 'landmark-move-ne) ; u - (define-key map "b" 'landmark-move-sw) ; b - (define-key map "n" 'landmark-move-se) ; n - (define-key map "h" 'backward-char) ; h - (define-key map "l" 'forward-char) ; l - (define-key map "j" 'landmark-move-down) ; j - (define-key map "k" 'landmark-move-up) ; k - - (define-key map [kp-7] 'landmark-move-nw) - (define-key map [kp-9] 'landmark-move-ne) - (define-key map [kp-1] 'landmark-move-sw) - (define-key map [kp-3] 'landmark-move-se) - (define-key map [kp-4] 'backward-char) - (define-key map [kp-6] 'forward-char) - (define-key map [kp-2] 'landmark-move-down) - (define-key map [kp-8] 'landmark-move-up) - - (define-key map "\C-n" 'landmark-move-down) ; C-n - (define-key map "\C-p" 'landmark-move-up) ; C-p + (define-key map "y" #'landmark-move-nw) ; y + (define-key map "u" #'landmark-move-ne) ; u + (define-key map "b" #'landmark-move-sw) ; b + (define-key map "n" #'landmark-move-se) ; n + (define-key map "h" #'backward-char) ; h + (define-key map "l" #'forward-char) ; l + (define-key map "j" #'landmark-move-down) ; j + (define-key map "k" #'landmark-move-up) ; k + + (define-key map [kp-7] #'landmark-move-nw) + (define-key map [kp-9] #'landmark-move-ne) + (define-key map [kp-1] #'landmark-move-sw) + (define-key map [kp-3] #'landmark-move-se) + (define-key map [kp-4] #'backward-char) + (define-key map [kp-6] #'forward-char) + (define-key map [kp-2] #'landmark-move-down) + (define-key map [kp-8] #'landmark-move-up) + + (define-key map "\C-n" #'landmark-move-down) ; C-n + (define-key map "\C-p" #'landmark-move-up) ; C-p ;; Key bindings for entering Human moves. - (define-key map "X" 'landmark-human-plays) ; X - (define-key map "x" 'landmark-human-plays) ; x - - (define-key map " " 'landmark-start-robot) ; SPC - (define-key map [down-mouse-1] 'landmark-start-robot) - (define-key map [drag-mouse-1] 'landmark-click) - (define-key map [mouse-1] 'landmark-click) - (define-key map [down-mouse-2] 'landmark-click) - (define-key map [mouse-2] 'landmark-mouse-play) - (define-key map [drag-mouse-2] 'landmark-mouse-play) - - (define-key map [remap previous-line] 'landmark-move-up) - (define-key map [remap next-line] 'landmark-move-down) - (define-key map [remap beginning-of-line] 'landmark-beginning-of-line) - (define-key map [remap end-of-line] 'landmark-end-of-line) - (define-key map [remap undo] 'landmark-human-takes-back) - (define-key map [remap advertised-undo] 'landmark-human-takes-back) + (define-key map "X" #'landmark-human-plays) ; X + (define-key map "x" #'landmark-human-plays) ; x + + (define-key map " " #'landmark-start-robot) ; SPC + (define-key map [down-mouse-1] #'landmark-start-robot) + (define-key map [drag-mouse-1] #'landmark-click) + (define-key map [mouse-1] #'landmark-click) + (define-key map [down-mouse-2] #'landmark-click) + (define-key map [mouse-2] #'landmark-mouse-play) + (define-key map [drag-mouse-2] #'landmark-mouse-play) + + (define-key map [remap previous-line] #'landmark-move-up) + (define-key map [remap next-line] #'landmark-move-down) + (define-key map [remap beginning-of-line] #'landmark-beginning-of-line) + (define-key map [remap end-of-line] #'landmark-end-of-line) + (define-key map [remap undo] #'landmark-human-takes-back) + (define-key map [remap advertised-undo] #'landmark-human-takes-back) map) "Local keymap to use in Landmark mode.") @@ -219,14 +218,12 @@ (defface landmark-font-lock-face-O '((((class color)) :foreground "red") (t :weight bold)) "Face to use for Emacs's O." - :version "22.1" - :group 'landmark) + :version "22.1") (defface landmark-font-lock-face-X '((((class color)) :foreground "green") (t :weight bold)) "Face to use for your X." - :version "22.1" - :group 'landmark) + :version "22.1") (defvar landmark-font-lock-keywords '(("O" . 'landmark-font-lock-face-O) @@ -1132,12 +1129,10 @@ this program to add a random element to the way moves were made.") "If non-nil, print \"One moment please\" when a new board is generated. The drawback of this is you don't see how many moves the last run took because it is overwritten by \"One moment please\"." - :type 'boolean - :group 'landmark) + :type 'boolean) (defcustom landmark-output-moves t "If non-nil, output number of moves so far on a move-by-move basis." - :type 'boolean - :group 'landmark) + :type 'boolean) (defun landmark-weights-debug () @@ -1153,7 +1148,7 @@ because it is overwritten by \"One moment please\"." (defun landmark-print-distance () (insert (format "tree: %S \n" (landmark-calc-distance-of-robot-from 'landmark-tree))) - (mapc 'landmark-print-distance-int landmark-directions)) + (mapc #'landmark-print-distance-int landmark-directions)) ;;(setq direction 'landmark-n) @@ -1166,10 +1161,10 @@ because it is overwritten by \"One moment please\"." (defun landmark-nslify-wts () (interactive) - (let ((l (apply 'append (mapcar 'landmark-nslify-wts-int landmark-directions)))) + (let ((l (apply #'append (mapcar #'landmark-nslify-wts-int landmark-directions)))) (insert (format "set data_value WTS \n %s \n" l)) (insert (format "/* max: %S min: %S */" - (eval (cons 'max l)) (eval (cons 'min l)))))) + (apply #'max l) (apply #'min l))))) (defun landmark-print-wts-int (direction) (mapc (lambda (target-direction) @@ -1184,7 +1179,7 @@ because it is overwritten by \"One moment please\"." (interactive) (with-current-buffer "*landmark-wts*" (insert "==============================\n") - (mapc 'landmark-print-wts-int landmark-directions))) + (mapc #'landmark-print-wts-int landmark-directions))) (defun landmark-print-moves (moves) (interactive) @@ -1204,7 +1199,7 @@ because it is overwritten by \"One moment please\"." (interactive) (with-current-buffer "*landmark-y,s,noise*" (insert "==============================\n") - (mapc 'landmark-print-y-s-noise-int landmark-directions))) + (mapc #'landmark-print-y-s-noise-int landmark-directions))) (defun landmark-print-smell-int (direction) (insert (format "%S: smell: %S \n" @@ -1216,7 +1211,7 @@ because it is overwritten by \"One moment please\"." (with-current-buffer "*landmark-smell*" (insert "==============================\n") (insert (format "tree: %S \n" (get 'z 't))) - (mapc 'landmark-print-smell-int landmark-directions))) + (mapc #'landmark-print-smell-int landmark-directions))) (defun landmark-print-w0-int (direction) (insert (format "%S: w0: %S \n" @@ -1227,7 +1222,7 @@ because it is overwritten by \"One moment please\"." (interactive) (with-current-buffer "*landmark-w0*" (insert "==============================\n") - (mapc 'landmark-print-w0-int landmark-directions))) + (mapc #'landmark-print-w0-int landmark-directions))) (defun landmark-blackbox () (with-current-buffer "*landmark-blackbox*" @@ -1252,36 +1247,31 @@ because it is overwritten by \"One moment please\"." (defun landmark-print-wts-blackbox () (interactive) - (mapc 'landmark-print-wts-int landmark-directions)) + (mapc #'landmark-print-wts-int landmark-directions)) ;;;_ - learning parameters (defcustom landmark-bound 0.005 "The maximum that w0j may be." - :type 'number - :group 'landmark) + :type 'number) (defcustom landmark-c 1.0 "A factor applied to modulate the increase in wij. Used in the function landmark-update-normal-weights." - :type 'number - :group 'landmark) + :type 'number) (defcustom landmark-c-naught 0.5 "A factor applied to modulate the increase in w0j. Used in the function landmark-update-naught-weights." - :type 'number - :group 'landmark) + :type 'number) (defvar landmark-initial-w0 0.0) (defvar landmark-initial-wij 0.0) (defcustom landmark-no-payoff 0 "The amount of simulation cycles that have occurred with no movement. Used to move the robot when he is stuck in a rut for some reason." - :type 'integer - :group 'landmark) + :type 'integer) (defcustom landmark-max-stall-time 2 "The maximum number of cycles that the robot can remain stuck in a place. After this limit is reached, landmark-random-move is called to push him out of it." - :type 'integer - :group 'landmark) + :type 'integer) ;;;_ + Randomizing functions @@ -1346,7 +1336,8 @@ push him out of it." (put 'landmark-e 'y (/ landmark-board-height 2)) (put 'landmark-e 'sym 4) - (mapc 'landmark-plot-internal '(landmark-n landmark-s landmark-e landmark-w landmark-tree))) + (mapc #'landmark-plot-internal + '(landmark-n landmark-s landmark-e landmark-w landmark-tree))) @@ -1434,7 +1425,7 @@ push him out of it." ;;;_ + Functions to move robot (defun landmark-confidence-for (target-direction) - (apply '+ + (apply #'+ (get target-direction 'w0) (mapcar (lambda (direction) (* @@ -1494,13 +1485,13 @@ push him out of it." (landmark-random-move) (progn (landmark-calc-confidences) - (mapc 'landmark-y landmark-directions) + (mapc #'landmark-y landmark-directions) (landmark-move))) (landmark-calc-payoff) - (mapc 'landmark-update-normal-weights landmark-directions) - (mapc 'landmark-update-naught-weights landmark-directions) + (mapc #'landmark-update-normal-weights landmark-directions) + (mapc #'landmark-update-naught-weights landmark-directions) (if landmark-debug (landmark-weights-debug))) (landmark-terminate-game nil)) @@ -1536,8 +1527,8 @@ If the game is finished, this command requests for another game." (landmark-calc-payoff) - (mapc 'landmark-update-normal-weights landmark-directions) - (mapc 'landmark-update-naught-weights landmark-directions) + (mapc #'landmark-update-normal-weights landmark-directions) + (mapc #'landmark-update-naught-weights landmark-directions) (landmark-amble-robot) ))))))) @@ -1576,7 +1567,7 @@ If the game is finished, this command requests for another game." (if (not save-weights) (progn - (mapc 'landmark-fix-weights-for landmark-directions) + (mapc #'landmark-fix-weights-for landmark-directions) (dolist (direction landmark-directions) (put direction 'w0 landmark-initial-w0))) (message "Weights preserved for this run.")) @@ -1618,7 +1609,7 @@ If the game is finished, this command requests for another game." ;;;_ + landmark-test-run () ;;;###autoload -(defalias 'landmark-repeat 'landmark-test-run) +(defalias 'landmark-repeat #'landmark-test-run) ;;;###autoload (defun landmark-test-run () "Run 100 Landmark games, each time saving the weights from the previous game." @@ -1670,13 +1661,13 @@ Use \\[describe-mode] for more info." (if landmark-one-moment-please (message "One moment, please...")) (landmark-start-game landmark-n landmark-m) - (eval (cons 'landmark-init - (cond - ((= parg 1) '(t nil)) - ((= parg 2) '(t t)) - ((= parg 3) '(nil t)) - ((= parg 4) '(nil nil)) - (t '(nil t)))))))) + (apply #'landmark-init + (cond + ((= parg 1) '(t nil)) + ((= parg 2) '(t t)) + ((= parg 3) '(nil t)) + ((= parg 4) '(nil nil)) + (t '(nil t))))))) ;;;_ + Local variables diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el index e1a01913bea..34bf85f864c 100644 --- a/lisp/obsolete/lazy-lock.el +++ b/lisp/obsolete/lazy-lock.el @@ -1,4 +1,4 @@ -;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode +;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode -*- lexical-binding: t; -*- ;; Copyright (C) 1994-1998, 2001-2021 Free Software Foundation, Inc. @@ -270,30 +270,14 @@ (eval-when-compile (require 'cl-lib)) (eval-when-compile - ;; We use this to preserve or protect things when modifying text properties. - (defmacro save-buffer-state (varlist &rest body) - "Bind variables according to VARLIST and eval BODY restoring buffer state." - `(let* (,@(append varlist - '((modified (buffer-modified-p)) - (buffer-undo-list t) - (inhibit-read-only t) - (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark - buffer-file-name - buffer-file-truename))) - ,@body - (when (and (not modified) (buffer-modified-p)) - (restore-buffer-modified-p nil)))) - (put 'save-buffer-state 'lisp-indent-function 1) ;; ;; We use this for clarity and speed. Naughty but nice. (defmacro do-while (test &rest body) "(do-while TEST BODY...): eval BODY... and repeat if TEST yields non-nil. The order of execution is thus BODY, TEST, BODY, TEST and so on until TEST returns nil." - `(while (progn ,@body ,test))) - (put 'do-while 'lisp-indent-function (get 'while 'lisp-indent-function))) + (declare (indent 1) (debug t)) + `(while (progn ,@body ,test)))) (defgroup lazy-lock nil "Font Lock support mode to fontify lazily." @@ -326,8 +310,7 @@ The value of this variable is used when Lazy Lock mode is turned on." (symbol :tag "name")) (radio :tag "Size" (const :tag "none" nil) - (integer :tag "size"))))) - :group 'lazy-lock) + (integer :tag "size")))))) (defcustom lazy-lock-defer-on-the-fly t "If non-nil, means fontification after a change should be deferred. @@ -346,8 +329,7 @@ The value of this variable is used when Lazy Lock mode is turned on." (set :menu-tag "mode specific" :tag "modes" :value (not) (const :tag "Except" not) - (repeat :inline t (symbol :tag "mode")))) - :group 'lazy-lock) + (repeat :inline t (symbol :tag "mode"))))) (defcustom lazy-lock-defer-on-scrolling nil "If non-nil, means fontification after a scroll should be deferred. @@ -371,8 +353,7 @@ makes little sense if `lazy-lock-defer-contextually' is non-nil.) The value of this variable is used when Lazy Lock mode is turned on." :type '(choice (const :tag "never" nil) (const :tag "always" t) - (other :tag "eventually" eventually)) - :group 'lazy-lock) + (other :tag "eventually" eventually))) (defcustom lazy-lock-defer-contextually 'syntax-driven "If non-nil, means deferred fontification should be syntactically true. @@ -389,8 +370,7 @@ buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil. The value of this variable is used when Lazy Lock mode is turned on." :type '(choice (const :tag "never" nil) (const :tag "always" t) - (other :tag "syntax-driven" syntax-driven)) - :group 'lazy-lock) + (other :tag "syntax-driven" syntax-driven))) (defcustom lazy-lock-defer-time 0.25 "Time in seconds to delay before beginning deferred fontification. @@ -401,8 +381,7 @@ variables `lazy-lock-defer-on-the-fly', `lazy-lock-defer-on-scrolling' and The value of this variable is used when Lazy Lock mode is turned on." :type '(choice (const :tag "never" nil) - (number :tag "seconds")) - :group 'lazy-lock) + (number :tag "seconds"))) (defcustom lazy-lock-stealth-time 30 "Time in seconds to delay before beginning stealth fontification. @@ -411,16 +390,14 @@ If nil, means stealth fontification is never performed. The value of this variable is used when Lazy Lock mode is turned on." :type '(choice (const :tag "never" nil) - (number :tag "seconds")) - :group 'lazy-lock) + (number :tag "seconds"))) (defcustom lazy-lock-stealth-lines (if font-lock-maximum-decoration 100 250) "Maximum size of a chunk of stealth fontification. Each iteration of stealth fontification can fontify this number of lines. To speed up input response during stealth fontification, at the cost of stealth taking longer to fontify, you could reduce the value of this variable." - :type '(integer :tag "lines") - :group 'lazy-lock) + :type '(integer :tag "lines")) (defcustom lazy-lock-stealth-load (if (condition-case nil (load-average) (error)) 200) @@ -435,8 +412,7 @@ See also `lazy-lock-stealth-nice'." :type (if (condition-case nil (load-average) (error)) '(choice (const :tag "never" nil) (integer :tag "load")) - '(const :format "%t: unsupported\n" nil)) - :group 'lazy-lock) + '(const :format "%t: unsupported\n" nil))) (defcustom lazy-lock-stealth-nice 0.125 "Time in seconds to pause between chunks of stealth fontification. @@ -447,14 +423,12 @@ To reduce machine load during stealth fontification, at the cost of stealth taking longer to fontify, you could increase the value of this variable. See also `lazy-lock-stealth-load'." :type '(choice (const :tag "never" nil) - (number :tag "seconds")) - :group 'lazy-lock) + (number :tag "seconds"))) (defcustom lazy-lock-stealth-verbose (and (not lazy-lock-defer-contextually) (not (null font-lock-verbose))) "If non-nil, means stealth fontification should show status messages." - :type 'boolean - :group 'lazy-lock) + :type 'boolean) ;; User Functions: @@ -580,30 +554,30 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'." ;; Add hook if lazy-lock.el is fontifying on scrolling or is deferring. (when (or fontifying defer-change defer-scroll defer-context) (add-hook 'window-scroll-functions (if defer-scroll - 'lazy-lock-defer-after-scroll - 'lazy-lock-fontify-after-scroll) + #'lazy-lock-defer-after-scroll + #'lazy-lock-fontify-after-scroll) nil t)) ;; ;; Add hook if lazy-lock.el is fontifying and is not deferring changes. (when (and fontifying (not defer-change) (not defer-context)) - (add-hook 'before-change-functions 'lazy-lock-arrange-before-change nil t)) + (add-hook 'before-change-functions #'lazy-lock-arrange-before-change nil t)) ;; ;; Replace Font Lock mode hook. - (remove-hook 'after-change-functions 'font-lock-after-change-function t) + (remove-hook 'after-change-functions #'font-lock-after-change-function t) (add-hook 'after-change-functions (cond ((and defer-change defer-context) - 'lazy-lock-defer-rest-after-change) + #'lazy-lock-defer-rest-after-change) (defer-change - 'lazy-lock-defer-line-after-change) + #'lazy-lock-defer-line-after-change) (defer-context - 'lazy-lock-fontify-rest-after-change) + #'lazy-lock-fontify-rest-after-change) (t - 'lazy-lock-fontify-line-after-change)) + #'lazy-lock-fontify-line-after-change)) nil t) ;; ;; Add package-specific hook. - (add-hook 'outline-view-change-hook 'lazy-lock-fontify-after-visage nil t) - (add-hook 'hs-hide-hook 'lazy-lock-fontify-after-visage nil t)) + (add-hook 'outline-view-change-hook #'lazy-lock-fontify-after-visage nil t) + (add-hook 'hs-hide-hook #'lazy-lock-fontify-after-visage nil t)) (defun lazy-lock-install-timers (dtime stime) ;; Schedule or re-schedule the deferral and stealth timers. @@ -616,13 +590,13 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'." (when (cdr defer) (cancel-timer (cdr defer))) (setcar lazy-lock-timers (cons dtime (and dtime - (run-with-idle-timer dtime t 'lazy-lock-fontify-after-defer)))))) + (run-with-idle-timer dtime t #'lazy-lock-fontify-after-defer)))))) (unless (eq stime (car (cdr lazy-lock-timers))) (let ((stealth (cdr lazy-lock-timers))) (when (cdr stealth) (cancel-timer (cdr stealth))) (setcdr lazy-lock-timers (cons stime (and stime - (run-with-idle-timer stime t 'lazy-lock-fontify-after-idle))))))) + (run-with-idle-timer stime t #'lazy-lock-fontify-after-idle))))))) (defun lazy-lock-unstall () ;; @@ -640,21 +614,21 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'." (save-restriction (widen) (lazy-lock-fontify-region (point-min) (point-max)))))) - (add-hook 'after-change-functions 'font-lock-after-change-function nil t)) + (add-hook 'after-change-functions #'font-lock-after-change-function nil t)) ;; ;; Remove the text properties. (lazy-lock-after-unfontify-buffer) ;; ;; Remove the fontification hooks. - (remove-hook 'window-scroll-functions 'lazy-lock-fontify-after-scroll t) - (remove-hook 'window-scroll-functions 'lazy-lock-defer-after-scroll t) - (remove-hook 'before-change-functions 'lazy-lock-arrange-before-change t) - (remove-hook 'after-change-functions 'lazy-lock-fontify-line-after-change t) - (remove-hook 'after-change-functions 'lazy-lock-fontify-rest-after-change t) - (remove-hook 'after-change-functions 'lazy-lock-defer-line-after-change t) - (remove-hook 'after-change-functions 'lazy-lock-defer-rest-after-change t) - (remove-hook 'outline-view-change-hook 'lazy-lock-fontify-after-visage t) - (remove-hook 'hs-hide-hook 'lazy-lock-fontify-after-visage t)) + (remove-hook 'window-scroll-functions #'lazy-lock-fontify-after-scroll t) + (remove-hook 'window-scroll-functions #'lazy-lock-defer-after-scroll t) + (remove-hook 'before-change-functions #'lazy-lock-arrange-before-change t) + (remove-hook 'after-change-functions #'lazy-lock-fontify-line-after-change t) + (remove-hook 'after-change-functions #'lazy-lock-fontify-rest-after-change t) + (remove-hook 'after-change-functions #'lazy-lock-defer-line-after-change t) + (remove-hook 'after-change-functions #'lazy-lock-defer-rest-after-change t) + (remove-hook 'outline-view-change-hook #'lazy-lock-fontify-after-visage t) + (remove-hook 'hs-hide-hook #'lazy-lock-fontify-after-visage t)) ;; Hook functions. @@ -682,7 +656,7 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'." ;; result in an unnecessary trigger after this if we did not cancel it now. (set-window-redisplay-end-trigger window nil)) -(defun lazy-lock-defer-after-scroll (window window-start) +(defun lazy-lock-defer-after-scroll (window _window-start) ;; Called from `window-scroll-functions'. ;; Defer fontification following the scroll. Save the current buffer so that ;; we subsequently fontify in all windows showing the buffer. @@ -750,7 +724,7 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'." (defalias 'lazy-lock-fontify-line-after-change ;; Called from `after-change-functions'. ;; Fontify the current change. - 'font-lock-after-change-function) + #'font-lock-after-change-function) (defun lazy-lock-fontify-rest-after-change (beg end old-len) ;; Called from `after-change-functions'. @@ -758,29 +732,29 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'." ;; buffer. Save the current buffer so that we subsequently fontify in all ;; windows showing the buffer. (lazy-lock-fontify-line-after-change beg end old-len) - (save-buffer-state nil + (with-silent-modifications (unless (memq (current-buffer) lazy-lock-buffers) (push (current-buffer) lazy-lock-buffers)) (save-restriction (widen) (remove-text-properties end (point-max) '(lazy-lock nil))))) -(defun lazy-lock-defer-line-after-change (beg end old-len) +(defun lazy-lock-defer-line-after-change (beg end _old-len) ;; Called from `after-change-functions'. ;; Defer fontification of the current change. Save the current buffer so ;; that we subsequently fontify in all windows showing the buffer. - (save-buffer-state nil + (with-silent-modifications (unless (memq (current-buffer) lazy-lock-buffers) (push (current-buffer) lazy-lock-buffers)) (remove-text-properties (max (1- beg) (point-min)) (min (1+ end) (point-max)) '(lazy-lock nil)))) -(defun lazy-lock-defer-rest-after-change (beg end old-len) +(defun lazy-lock-defer-rest-after-change (beg _end _old-len) ;; Called from `after-change-functions'. ;; Defer fontification of the rest of the buffer. Save the current buffer so ;; that we subsequently fontify in all windows showing the buffer. - (save-buffer-state nil + (with-silent-modifications (unless (memq (current-buffer) lazy-lock-buffers) (push (current-buffer) lazy-lock-buffers)) (save-restriction @@ -809,10 +783,10 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'." (setq lazy-lock-buffers (cdr lazy-lock-buffers))))) ;; Add hook if fontification should now be defer-driven in this buffer. (when (and lazy-lock-mode lazy-lock-defer-on-scrolling - (memq 'lazy-lock-fontify-after-scroll window-scroll-functions) + (memq #'lazy-lock-fontify-after-scroll window-scroll-functions) (not (or (input-pending-p) (lazy-lock-unfontified-p)))) - (remove-hook 'window-scroll-functions 'lazy-lock-fontify-after-scroll t) - (add-hook 'window-scroll-functions 'lazy-lock-defer-after-scroll nil t))) + (remove-hook 'window-scroll-functions #'lazy-lock-fontify-after-scroll t) + (add-hook 'window-scroll-functions #'lazy-lock-defer-after-scroll nil t))) (defun lazy-lock-fontify-after-idle () ;; Called from `timer-idle-list'. @@ -868,14 +842,14 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'." ;; Called from `font-lock-after-fontify-buffer'. ;; Mark the current buffer as fontified. ;; This is a conspiracy hack between lazy-lock.el and font-lock.el. - (save-buffer-state nil + (with-silent-modifications (add-text-properties (point-min) (point-max) '(lazy-lock t)))) (defun lazy-lock-after-unfontify-buffer () ;; Called from `font-lock-after-unfontify-buffer'. ;; Mark the current buffer as unfontified. ;; This is a conspiracy hack between lazy-lock.el and font-lock.el. - (save-buffer-state nil + (with-silent-modifications (remove-text-properties (point-min) (point-max) '(lazy-lock nil)))) ;; Fontification functions. @@ -888,27 +862,27 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'." (widen) (when (setq beg (text-property-any beg end 'lazy-lock nil)) (save-excursion - (save-match-data - (save-buffer-state - (next) - ;; Find successive unfontified regions between BEG and END. - (condition-case data - (do-while beg - (setq next (or (text-property-any beg end 'lazy-lock t) end)) - ;; Make sure the region end points are at beginning of line. - (goto-char beg) - (unless (bolp) - (beginning-of-line) - (setq beg (point))) - (goto-char next) - (unless (bolp) - (forward-line) - (setq next (point))) - ;; Fontify the region, then flag it as fontified. - (font-lock-fontify-region beg next) - (add-text-properties beg next '(lazy-lock t)) - (setq beg (text-property-any next end 'lazy-lock nil))) - ((error quit) (message "Fontifying region...%s" data))))))))) + (with-silent-modifications + (let ((inhibit-point-motion-hooks t)) + ;; Find successive unfontified regions between BEG and END. + (condition-case data + (do-while beg + (let ((next (or (text-property-any beg end 'lazy-lock t) + end))) + ;; Make sure the region end points are at beginning of line. + (goto-char beg) + (unless (bolp) + (beginning-of-line) + (setq beg (point))) + (goto-char next) + (unless (bolp) + (forward-line) + (setq next (point))) + ;; Fontify the region, then flag it as fontified. + (font-lock-fontify-region beg next) + (add-text-properties beg next '(lazy-lock t)) + (setq beg (text-property-any next end 'lazy-lock nil)))) + ((error quit) (message "Fontifying region...%s" data))))))))) (defun lazy-lock-fontify-chunk () ;; Fontify the nearest chunk, for stealth, in the current buffer. @@ -1036,8 +1010,8 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'." ;; Install ourselves: -(add-hook 'window-size-change-functions 'lazy-lock-fontify-after-resize) -(add-hook 'redisplay-end-trigger-functions 'lazy-lock-fontify-after-trigger) +(add-hook 'window-size-change-functions #'lazy-lock-fontify-after-resize) +(add-hook 'redisplay-end-trigger-functions #'lazy-lock-fontify-after-trigger) (unless (assq 'lazy-lock-mode minor-mode-alist) (setq minor-mode-alist (append minor-mode-alist '((lazy-lock-mode nil))))) diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el index f274dfb926d..9676d6b28e9 100644 --- a/lisp/obsolete/longlines.el +++ b/lisp/obsolete/longlines.el @@ -1,4 +1,4 @@ -;;; longlines.el --- automatically wrap long lines -*- coding:utf-8 -*- +;;; longlines.el --- automatically wrap long lines -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2001, 2004-2021 Free Software Foundation, Inc. @@ -48,7 +48,6 @@ Otherwise, you can perform filling using `fill-paragraph' or `auto-fill-mode'. In any case, the soft newlines will be removed when the file is saved to disk." - :group 'longlines :type 'boolean) (defcustom longlines-wrap-follows-window-size nil @@ -60,7 +59,6 @@ with differing widths. If the value is an integer, that specifies the distance from the right edge of the window at which wrapping occurs. For any other non-nil value, wrapping occurs 2 characters from the right edge." - :group 'longlines :type 'boolean) (defcustom longlines-show-hard-newlines nil @@ -68,13 +66,11 @@ non-nil value, wrapping occurs 2 characters from the right edge." \(The variable `longlines-show-effect' controls what they look like.) You can also enable the display temporarily, using the command `longlines-show-hard-newlines'." - :group 'longlines :type 'boolean) (defcustom longlines-show-effect (propertize "¶\n" 'face 'escape-glyph) "A string to display when showing hard newlines. This is used when `longlines-show-hard-newlines' is on." - :group 'longlines :type 'string) ;;; Internal variables @@ -110,23 +106,23 @@ always call `fill-paragraph' to fill individual paragraphs. If the variable `longlines-show-hard-newlines' is non-nil, hard newlines are indicated with a symbol." - :group 'longlines :lighter " ll" + :lighter " ll" (if longlines-mode ;; Turn on longlines mode (progn (use-hard-newlines 1 'never) (set (make-local-variable 'require-final-newline) nil) (add-to-list 'buffer-file-format 'longlines) - (add-hook 'change-major-mode-hook 'longlines-mode-off nil t) - (add-hook 'before-revert-hook 'longlines-before-revert-hook nil t) + (add-hook 'change-major-mode-hook #'longlines-mode-off nil t) + (add-hook 'before-revert-hook #'longlines-before-revert-hook nil t) (make-local-variable 'buffer-substring-filters) (make-local-variable 'longlines-auto-wrap) (set (make-local-variable 'isearch-search-fun-function) - 'longlines-search-function) + #'longlines-search-function) (set (make-local-variable 'replace-search-function) - 'longlines-search-forward) + #'longlines-search-forward) (set (make-local-variable 'replace-re-search-function) - 'longlines-re-search-forward) + #'longlines-re-search-forward) (add-to-list 'buffer-substring-filters 'longlines-encode-string) (when longlines-wrap-follows-window-size (let ((dw (if (and (integerp longlines-wrap-follows-window-size) @@ -138,7 +134,7 @@ newlines are indicated with a symbol." (set (make-local-variable 'fill-column) (- (window-width) dw))) (add-hook 'window-configuration-change-hook - 'longlines-window-change-function nil t)) + #'longlines-window-change-function nil t)) (let ((buffer-undo-list t) (inhibit-read-only t) (inhibit-modification-hooks t) @@ -160,21 +156,22 @@ newlines are indicated with a symbol." ;; Hacks to make longlines play nice with various modes. (cond ((eq major-mode 'mail-mode) - (add-hook 'mail-setup-hook 'longlines-decode-buffer nil t) + (declare-function mail-indent-citation "sendmail" ()) + (add-hook 'mail-setup-hook #'longlines-decode-buffer nil t) (or mail-citation-hook - (add-hook 'mail-citation-hook 'mail-indent-citation nil t)) - (add-hook 'mail-citation-hook 'longlines-decode-region nil t)) + (add-hook 'mail-citation-hook #'mail-indent-citation nil t)) + (add-hook 'mail-citation-hook #'longlines-decode-region nil t)) ((eq major-mode 'message-mode) - (add-hook 'message-setup-hook 'longlines-decode-buffer nil t) + (add-hook 'message-setup-hook #'longlines-decode-buffer nil t) (make-local-variable 'message-indent-citation-function) (if (not (listp message-indent-citation-function)) (setq message-indent-citation-function (list message-indent-citation-function))) - (add-to-list 'message-indent-citation-function - 'longlines-decode-region t))) + (add-hook 'message-indent-citation-function + #'longlines-decode-region t t))) - (add-hook 'after-change-functions 'longlines-after-change-function nil t) - (add-hook 'post-command-hook 'longlines-post-command-function nil t) + (add-hook 'after-change-functions #'longlines-after-change-function nil t) + (add-hook 'post-command-hook #'longlines-post-command-function nil t) (when longlines-auto-wrap (auto-fill-mode 0))) ;; Turn off longlines mode @@ -190,12 +187,12 @@ newlines are indicated with a symbol." (widen) (longlines-encode-region (point-min) (point-max)) (setq longlines-decoded nil)))) - (remove-hook 'change-major-mode-hook 'longlines-mode-off t) - (remove-hook 'after-change-functions 'longlines-after-change-function t) - (remove-hook 'post-command-hook 'longlines-post-command-function t) - (remove-hook 'before-revert-hook 'longlines-before-revert-hook t) + (remove-hook 'change-major-mode-hook #'longlines-mode-off t) + (remove-hook 'after-change-functions #'longlines-after-change-function t) + (remove-hook 'post-command-hook #'longlines-post-command-function t) + (remove-hook 'before-revert-hook #'longlines-before-revert-hook t) (remove-hook 'window-configuration-change-hook - 'longlines-window-change-function t) + #'longlines-window-change-function t) (when longlines-wrap-follows-window-size (kill-local-variable 'fill-column)) (kill-local-variable 'isearch-search-fun-function) @@ -482,17 +479,17 @@ This is called by `window-configuration-change-hook'." ;;; Loading and saving (defun longlines-before-revert-hook () - (add-hook 'after-revert-hook 'longlines-after-revert-hook nil t) + (add-hook 'after-revert-hook #'longlines-after-revert-hook nil t) (longlines-mode 0)) (defun longlines-after-revert-hook () - (remove-hook 'after-revert-hook 'longlines-after-revert-hook t) + (remove-hook 'after-revert-hook #'longlines-after-revert-hook t) (longlines-mode 1)) (add-to-list 'format-alist (list 'longlines "Automatically wrap long lines." nil nil - 'longlines-encode-region t nil)) + #'longlines-encode-region t nil)) ;;; Unloading diff --git a/lisp/obsolete/mailpost.el b/lisp/obsolete/mailpost.el index 2f74faf1d6c..5b3a76e2f79 100644 --- a/lisp/obsolete/mailpost.el +++ b/lisp/obsolete/mailpost.el @@ -1,4 +1,4 @@ -;;; mailpost.el --- RMAIL coupler to /usr/uci/post mailer +;;; mailpost.el --- RMAIL coupler to /usr/uci/post mailer -*- lexical-binding: t; -*- ;; This is in the public domain ;; since Delp distributed it in 1986 without a copyright notice. @@ -76,7 +76,7 @@ site-init." (with-current-buffer errbuf (erase-buffer)))) (with-file-modes 384 (setq temfile (make-temp-file ",rpost"))) - (apply 'call-process + (apply #'call-process (append (list (if (boundp 'post-mail-program) post-mail-program "/usr/uci/lib/mh/post") diff --git a/lisp/obsolete/mantemp.el b/lisp/obsolete/mantemp.el index 287a5a732ca..97e70f29841 100644 --- a/lisp/obsolete/mantemp.el +++ b/lisp/obsolete/mantemp.el @@ -1,4 +1,4 @@ -;;; mantemp.el --- create manual template instantiations from g++ 2.7.2 output +;;; mantemp.el --- create manual template instantiations from g++ 2.7.2 output -*- lexical-binding: t; -*- ;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc. diff --git a/lisp/obsolete/meese.el b/lisp/obsolete/meese.el index 81739dfa6cb..7443bacc8b2 100644 --- a/lisp/obsolete/meese.el +++ b/lisp/obsolete/meese.el @@ -1,4 +1,4 @@ -;;; meese.el --- protect the impressionable young minds of America +;;; meese.el --- protect the impressionable young minds of America -*- lexical-binding: t; -*- ;; This is in the public domain on account of being distributed since ;; 1985 or 1986 without a copyright notice. diff --git a/lisp/obsolete/messcompat.el b/lisp/obsolete/messcompat.el index fa73dc7a0fd..be252395e45 100644 --- a/lisp/obsolete/messcompat.el +++ b/lisp/obsolete/messcompat.el @@ -1,4 +1,4 @@ -;;; messcompat.el --- making message mode compatible with mail mode +;;; messcompat.el --- making message mode compatible with mail mode -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. diff --git a/lisp/obsolete/metamail.el b/lisp/obsolete/metamail.el index ef97e8aa55c..72237239ddb 100644 --- a/lisp/obsolete/metamail.el +++ b/lisp/obsolete/metamail.el @@ -1,4 +1,4 @@ -;;; metamail.el --- Metamail interface for GNU Emacs +;;; metamail.el --- Metamail interface for GNU Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1993, 1996, 2001-2021 Free Software Foundation, Inc. @@ -44,13 +44,11 @@ (defcustom metamail-program-name "metamail" "Metamail program name." - :type 'string - :group 'metamail) + :type 'string) (defcustom metamail-mailer-name "emacs" "Mailer name set to MM_MAILER environment variable." - :type 'string - :group 'metamail) + :type 'string) (defvar metamail-environment '("KEYHEADS=*" "MM_QUIET=1") "Environment variables passed to `metamail'. @@ -65,8 +63,7 @@ It is not expected to be altered globally by `set' or `setq'. Instead, change its value temporary using `let' or `let*' form. `-m MAILER' argument is automatically generated from the `metamail-mailer-name' variable." - :type '(repeat (string :tag "Switch")) - :group 'metamail) + :type '(repeat (string :tag "Switch"))) ;;;###autoload (defun metamail-interpret-header () @@ -193,7 +190,7 @@ redisplayed as output is inserted." (list "-m" (or metamail-mailer-name "emacs")) (list metafile)))) ;; `metamail' may not delete the temporary file! - (condition-case error + (condition-case nil (delete-file metafile) (error nil)) ))) diff --git a/lisp/obsolete/mouse-sel.el b/lisp/obsolete/mouse-sel.el index 608596e882b..36d9dc658c7 100644 --- a/lisp/obsolete/mouse-sel.el +++ b/lisp/obsolete/mouse-sel.el @@ -1,4 +1,4 @@ -;;; mouse-sel.el --- multi-click selection support +;;; mouse-sel.el --- multi-click selection support -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1995, 2001-2021 Free Software Foundation, Inc. @@ -146,20 +146,17 @@ If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end of the region nearest to where the mouse last was. If nil, point will always be placed at the beginning of the region." - :type 'boolean - :group 'mouse-sel) + :type 'boolean) (defcustom mouse-sel-cycle-clicks t "If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks." - :type 'boolean - :group 'mouse-sel) + :type 'boolean) (defcustom mouse-sel-default-bindings t "Control mouse bindings." :type '(choice (const :tag "none" nil) (const :tag "cut and paste" interprogram-cut-paste) - (other :tag "default bindings" t)) - :group 'mouse-sel) + (other :tag "default bindings" t))) ;;=== Key bindings ======================================================== @@ -216,14 +213,13 @@ the mouse position (or point, if `mouse-yank-at-point' is non-nil). - mouse-2 while selecting or extending copies selection to the kill ring; mouse-1 or mouse-3 kills it." :global t - :group 'mouse-sel (if mouse-sel-mode (progn ;; If mouse-2 has never been done by the user, initialize the ;; `event-kind' property to ensure that `follow-link' clicks ;; are interpreted correctly. (put 'mouse-2 'event-kind 'mouse-click) - (add-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook) + (add-hook 'x-lost-selection-functions #'mouse-sel-lost-selection-hook) (when mouse-sel-default-bindings ;; Save original bindings and replace them with new ones. (setq mouse-sel-original-bindings @@ -240,7 +236,7 @@ kill ring; mouse-1 or mouse-3 kills it." #'mouse-sel--ignore)))) ;; Restore original bindings - (remove-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook) + (remove-hook 'x-lost-selection-functions #'mouse-sel-lost-selection-hook) (dolist (binding mouse-sel-original-bindings) (global-set-key (car binding) (cdr binding))) ;; Restore the old values of these variables, diff --git a/lisp/obsolete/nnir.el b/lisp/obsolete/nnir.el index 147efed0057..337d83ccca1 100644 --- a/lisp/obsolete/nnir.el +++ b/lisp/obsolete/nnir.el @@ -228,8 +228,7 @@ with three items unique to nnir summary buffers: If nil this will use `gnus-summary-line-format'." :version "24.1" - :type '(choice (const :tag "gnus-summary-line-format" nil) string) - :group 'nnir) + :type '(choice (const :tag "gnus-summary-line-format" nil) string)) (defcustom nnir-ignored-newsgroups "" @@ -237,8 +236,7 @@ If nil this will use `gnus-summary-line-format'." Any newsgroup in the active file matching this regexp will be skipped when searching." :version "24.1" - :type '(regexp) - :group 'nnir) + :type '(regexp)) (defcustom nnir-imap-default-search-key "whole message" "The default IMAP search key for an nnir search. @@ -246,19 +244,16 @@ Must be one of the keys in `nnir-imap-search-arguments'. To use raw imap queries by default set this to \"imap\"." :version "24.1" :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) - nnir-imap-search-arguments)) - :group 'nnir) + nnir-imap-search-arguments))) (defcustom nnir-swish++-configuration-file (expand-file-name "~/Mail/swish++.conf") "Configuration file for swish++." - :type '(file) - :group 'nnir) + :type '(file)) (defcustom nnir-swish++-program "search" "Name of swish++ search executable." - :type '(string) - :group 'nnir) + :type '(string)) (defcustom nnir-swish++-additional-switches '() "A list of strings, to be given as additional arguments to swish++. @@ -267,8 +262,7 @@ Note that this should be a list. I.e., do NOT use the following: (setq nnir-swish++-additional-switches \"-i -w\") ; wrong Instead, use this: (setq nnir-swish++-additional-switches \\='(\"-i\" \"-w\"))" - :type '(repeat (string)) - :group 'nnir) + :type '(repeat (string))) (defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/") "The prefix to remove from swish++ file names to get group names. @@ -277,8 +271,7 @@ expression. This variable is very similar to `nnir-namazu-remove-prefix', except that it is for swish++, not Namazu." - :type '(regexp) - :group 'nnir) + :type '(regexp)) ;; Swish-E. ;; URL: http://swish-e.org/ @@ -293,21 +286,18 @@ that it is for swish++, not Namazu." This could be a server parameter. It is never consulted once `nnir-swish-e-index-files', which should be used instead, has been customized." - :type '(file) - :group 'nnir) + :type '(file)) (defcustom nnir-swish-e-index-files (list nnir-swish-e-index-file) "List of index files for swish-e. This could be a server parameter." - :type '(repeat (file)) - :group 'nnir) + :type '(repeat (file))) (defcustom nnir-swish-e-program "swish-e" "Name of swish-e search executable. This cannot be a server parameter." - :type '(string) - :group 'nnir) + :type '(string)) (defcustom nnir-swish-e-additional-switches '() "A list of strings, to be given as additional arguments to swish-e. @@ -318,8 +308,7 @@ Instead, use this: (setq nnir-swish-e-additional-switches \\='(\"-i\" \"-w\")) This could be a server parameter." - :type '(repeat (string)) - :group 'nnir) + :type '(repeat (string))) (defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/") "The prefix to remove from swish-e file names to get group names. @@ -330,15 +319,13 @@ This variable is very similar to `nnir-namazu-remove-prefix', except that it is for swish-e, not Namazu. This could be a server parameter." - :type '(regexp) - :group 'nnir) + :type '(regexp)) ;; HyREX engine, see <URL:http://ls6-www.cs.uni-dortmund.de/> (defcustom nnir-hyrex-program "nnir-search" "Name of the nnir-search executable." - :type '(string) - :group 'nnir) + :type '(string)) (defcustom nnir-hyrex-additional-switches '() "A list of strings, to be given as additional arguments for nnir-search. @@ -346,13 +333,11 @@ Note that this should be a list. I.e., do NOT use the following: (setq nnir-hyrex-additional-switches \"-ddl ddl.xml -c nnir\") ; wrong ! Instead, use this: (setq nnir-hyrex-additional-switches \\='(\"-ddl\" \"ddl.xml\" \"-c\" \"nnir\"))" - :type '(repeat (string)) - :group 'nnir) + :type '(repeat (string))) (defcustom nnir-hyrex-index-directory (getenv "HOME") "Index directory for HyREX." - :type '(directory) - :group 'nnir) + :type '(directory)) (defcustom nnir-hyrex-remove-prefix (concat (getenv "HOME") "/Mail/") "The prefix to remove from HyREX file names to get group names. @@ -364,20 +349,17 @@ setting: (setq nnir-hyrex-remove-prefix \"/home/john/Mail/\") Note the trailing slash. Removing this prefix gives \"mail/misc/42\". `nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to arrive at the correct group name, \"mail.misc\"." - :type '(directory) - :group 'nnir) + :type '(directory)) ;; Namazu engine, see <URL:http://www.namazu.org/> (defcustom nnir-namazu-program "namazu" "Name of Namazu search executable." - :type '(string) - :group 'nnir) + :type '(string)) (defcustom nnir-namazu-index-directory (expand-file-name "~/Mail/namazu/") "Index directory for Namazu." - :type '(directory) - :group 'nnir) + :type '(directory)) (defcustom nnir-namazu-additional-switches '() "A list of strings, to be given as additional arguments to namazu. @@ -388,8 +370,7 @@ Note that this should be a list. I.e., do NOT use the following: (setq nnir-namazu-additional-switches \"-i -w\") ; wrong Instead, use this: (setq nnir-namazu-additional-switches \\='(\"-i\" \"-w\"))" - :type '(repeat (string)) - :group 'nnir) + :type '(repeat (string))) (defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/") "The prefix to remove from Namazu file names to get group names. @@ -401,14 +382,12 @@ setting: (setq nnir-namazu-remove-prefix \"/home/john/Mail/\") Note the trailing slash. Removing this prefix gives \"mail/misc/42\". `nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to arrive at the correct group name, \"mail.misc\"." - :type '(directory) - :group 'nnir) + :type '(directory)) (defcustom nnir-notmuch-program "notmuch" "Name of notmuch search executable." :version "24.1" - :type '(string) - :group 'nnir) + :type '(string)) (defcustom nnir-notmuch-additional-switches '() "A list of strings, to be given as additional arguments to notmuch. @@ -418,8 +397,7 @@ Note that this should be a list. I.e., do NOT use the following: Instead, use this: (setq nnir-notmuch-additional-switches \\='(\"-i\" \"-w\"))" :version "24.1" - :type '(repeat (string)) - :group 'nnir) + :type '(repeat (string))) (defcustom nnir-notmuch-remove-prefix (regexp-quote (or (getenv "MAILDIR") (expand-file-name "~/Mail"))) @@ -430,8 +408,7 @@ expression. This variable is very similar to `nnir-namazu-remove-prefix', except that it is for notmuch, not Namazu." :version "27.1" - :type '(regexp) - :group 'nnir) + :type '(regexp)) (defcustom nnir-notmuch-filter-group-names-function nil "Whether and how to use Gnus group names as \"path:\" search terms. @@ -457,7 +434,7 @@ like so: `((imap nnir-run-imap ((criteria "Imap Search in" ; Prompt - ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing + ,(mapcar #'car nnir-imap-search-arguments) ; alist for completing nil ; allow any user input nil ; initial value nnir-imap-search-argument-history ; the history to use @@ -495,7 +472,6 @@ Add an entry here when adding a new search engine.") (defcustom nnir-method-default-engines '((nnimap . imap)) "Alist of default search engines keyed by server method." :version "27.1" - :group 'nnir :type `(repeat (cons (choice (const nnimap) (const nntp) (const nnspool) (const nneething) (const nndir) (const nnmbox) (const nnml) (const nnmh) (const nndraft) @@ -573,7 +549,7 @@ extensions." (or groups (gnus-server-get-active srv nnir-ignored-newsgroups)))) (message "Opening server %s" server) (apply - 'vconcat + #'vconcat (catch 'found (mapcar #'(lambda (group) @@ -1214,7 +1190,7 @@ construct path: search terms (see the variable (error "No directory found in method specification of server %s" server)) (apply - 'vconcat + #'vconcat (mapcar (lambda (x) (let ((group x) artlist) @@ -1247,7 +1223,7 @@ construct path: search terms (see the variable (error "Cannot locate directory for group")) (save-excursion (apply - 'call-process "find" nil t + #'call-process "find" nil t "find" group "-maxdepth" "1" "-type" "f" "-name" "[0-9]*" "-exec" "grep" @@ -1260,7 +1236,8 @@ construct path: search terms (see the variable (let* ((path (split-string (buffer-substring (point) - (line-end-position)) "/" t)) + (line-end-position)) + "/" t)) (art (string-to-number (car (last path))))) (while (string= "." (car path)) (setq path (cdr path))) @@ -1359,7 +1336,7 @@ Query for the specs, or use SPECS." (query-spec (or (cdr (assq 'nnir-query-spec specs)) (apply - 'append + #'append (list (cons 'query (read-string "Query: " nil 'nnir-search-history))) (when nnir-extra-parms @@ -1370,7 +1347,7 @@ Query for the specs, or use SPECS." (list (cons 'nnir-query-spec query-spec) (cons 'nnir-group-spec group-spec)))) -(define-obsolete-function-alias 'nnir-get-active 'gnus-server-get-active "28.1") +(define-obsolete-function-alias 'nnir-get-active #'gnus-server-get-active "28.1") ;; The end. (provide 'nnir) diff --git a/lisp/obsolete/old-emacs-lock.el b/lisp/obsolete/old-emacs-lock.el index 07bccd90711..90ff93e03b1 100644 --- a/lisp/obsolete/old-emacs-lock.el +++ b/lisp/obsolete/old-emacs-lock.el @@ -1,4 +1,4 @@ -;;; emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked +;;; emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked -*- lexical-binding: t; -*- ;; Copyright (C) 1994, 1997, 2001-2021 Free Software Foundation, Inc. @@ -90,12 +90,12 @@ If the buffer is locked, signal error and display its name." (setq emacs-lock-from-exiting t))) (unless noninteractive - (add-hook 'kill-emacs-hook 'check-emacs-lock)) -(add-hook 'kill-buffer-hook 'emacs-lock-check-buffer-lock) -(add-hook 'shell-mode-hook 'emacs-lock-was-buffer-locked) -(add-hook 'shell-mode-hook 'emacs-lock-shell-sentinel) -(add-hook 'telnet-mode-hook 'emacs-lock-was-buffer-locked) -(add-hook 'telnet-mode-hook 'emacs-lock-shell-sentinel) + (add-hook 'kill-emacs-hook #'check-emacs-lock)) +(add-hook 'kill-buffer-hook #'emacs-lock-check-buffer-lock) +(add-hook 'shell-mode-hook #'emacs-lock-was-buffer-locked) +(add-hook 'shell-mode-hook #'emacs-lock-shell-sentinel) +(add-hook 'telnet-mode-hook #'emacs-lock-was-buffer-locked) +(add-hook 'telnet-mode-hook #'emacs-lock-shell-sentinel) (provide 'emacs-lock) diff --git a/lisp/obsolete/otodo-mode.el b/lisp/obsolete/otodo-mode.el index 58c385adad4..add17b265b4 100644 --- a/lisp/obsolete/otodo-mode.el +++ b/lisp/obsolete/otodo-mode.el @@ -1,4 +1,4 @@ -;;; todo-mode.el --- major mode for editing TODO list files +;;; todo-mode.el --- major mode for editing TODO list files -*- lexical-binding: t; -*- ;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc. @@ -280,26 +280,21 @@ every day and it may also be marked on every day of the calendar. Using \"&%%(equal (calendar-current-date) date)\" instead will only show and mark todo entries for today, but may slow down processing of the diary file somewhat." - :type 'string - :group 'todo) + :type 'string) (defcustom todo-file-do (locate-user-emacs-file "todo-do" ".todo-do") "TODO mode list file." :version "24.4" ; added locate-user-emacs-file - :type 'file - :group 'todo) + :type 'file) (defcustom todo-file-done (locate-user-emacs-file "todo-done" ".todo-done") "TODO mode archive file." :version "24.4" ; added locate-user-emacs-file - :type 'file - :group 'todo) + :type 'file) (defcustom todo-mode-hook nil "TODO mode hooks." - :type 'hook - :group 'todo) + :type 'hook) (defcustom todo-edit-mode-hook nil "TODO Edit mode hooks." - :type 'hook - :group 'todo) + :type 'hook) (defcustom todo-insert-threshold 0 "TODO mode insertion accuracy. @@ -314,8 +309,7 @@ your item just before that point. If you set the threshold to, e.g. 8, it will stop as soon as the window size drops below that amount and will insert the item in the approximate center of that window." - :type 'integer - :group 'todo) + :type 'integer) (defvar todo-edit-buffer " *TODO Edit*" "TODO Edit buffer name.") (defcustom todo-file-top (locate-user-emacs-file "todo-top" ".todo-top") @@ -324,32 +318,26 @@ window." Not in TODO format, but diary compatible. Automatically generated when `todo-save-top-priorities' is non-nil." :version "24.4" ; added locate-user-emacs-file - :type 'string - :group 'todo) + :type 'string) (defcustom todo-print-function 'ps-print-buffer-with-faces "Function to print the current buffer." - :type 'symbol - :group 'todo) + :type 'symbol) (defcustom todo-show-priorities 1 "Default number of priorities to show by \\[todo-top-priorities]. 0 means show all entries." - :type 'integer - :group 'todo) + :type 'integer) (defcustom todo-print-priorities 0 "Default number of priorities to print by \\[todo-print]. 0 means print all entries." - :type 'integer - :group 'todo) + :type 'integer) (defcustom todo-remove-separator t "Non-nil to remove category separators in\ \\[todo-top-priorities] and \\[todo-print]." - :type 'boolean - :group 'todo) + :type 'boolean) (defcustom todo-save-top-priorities-too t "Non-nil makes `todo-save' automatically save top-priorities in `todo-file-top'." - :type 'boolean - :group 'todo) + :type 'boolean) ;; Thanks for the ISO time stamp format go to Karl Eichwalder <ke@suse.de> ;; My format string for the appt.el package is "%3b %2d, %y, %02I:%02M%p". @@ -358,17 +346,14 @@ Automatically generated when `todo-save-top-priorities' is non-nil." "%:y-%02m-%02d %02H:%02M" "TODO mode time string format for done entries. For details see the variable `time-stamp-format'." - :type 'string - :group 'todo) + :type 'string) (defcustom todo-entry-prefix-function 'todo-entry-timestamp-initials "Function producing text to insert at start of todo entry." - :type 'symbol - :group 'todo) + :type 'symbol) (defcustom todo-initials (or (getenv "INITIALS") (user-login-name)) "Initials of todo item author." - :type 'string - :group 'todo) + :type 'string) (defun todo-entry-timestamp-initials () "Prepend timestamp and your initials to the head of a TODO entry." @@ -395,25 +380,25 @@ Use `todo-categories' instead.") (defvar todo-mode-map (let ((map (make-keymap))) (suppress-keymap map t) - (define-key map "+" 'todo-forward-category) - (define-key map "-" 'todo-backward-category) - (define-key map "d" 'todo-file-item) ;done/delete - (define-key map "e" 'todo-edit-item) - (define-key map "E" 'todo-edit-multiline) - (define-key map "f" 'todo-file-item) - (define-key map "i" 'todo-insert-item) - (define-key map "I" 'todo-insert-item-here) - (define-key map "j" 'todo-jump-to-category) - (define-key map "k" 'todo-delete-item) - (define-key map "l" 'todo-lower-item) - (define-key map "n" 'todo-forward-item) - (define-key map "p" 'todo-backward-item) - (define-key map "P" 'todo-print) - (define-key map "q" 'todo-quit) - (define-key map "r" 'todo-raise-item) - (define-key map "s" 'todo-save) - (define-key map "S" 'todo-save-top-priorities) - (define-key map "t" 'todo-top-priorities) + (define-key map "+" #'todo-forward-category) + (define-key map "-" #'todo-backward-category) + (define-key map "d" #'todo-file-item) ;done/delete + (define-key map "e" #'todo-edit-item) + (define-key map "E" #'todo-edit-multiline) + (define-key map "f" #'todo-file-item) + (define-key map "i" #'todo-insert-item) + (define-key map "I" #'todo-insert-item-here) + (define-key map "j" #'todo-jump-to-category) + (define-key map "k" #'todo-delete-item) + (define-key map "l" #'todo-lower-item) + (define-key map "n" #'todo-forward-item) + (define-key map "p" #'todo-backward-item) + (define-key map "P" #'todo-print) + (define-key map "q" #'todo-quit) + (define-key map "r" #'todo-raise-item) + (define-key map "s" #'todo-save) + (define-key map "S" #'todo-save-top-priorities) + (define-key map "t" #'todo-top-priorities) map) "TODO mode keymap.") @@ -451,7 +436,7 @@ Use `todo-categories' instead.") (search-forward-regexp (concat "^" todo-category-end)) (narrow-to-region begin (line-beginning-position)) (goto-char (point-min))))) -(defalias 'todo-cat-slct 'todo-category-select) +(defalias 'todo-cat-slct #'todo-category-select) (defun todo-forward-category () "Go forward to TODO list of next category." @@ -459,7 +444,7 @@ Use `todo-categories' instead.") (setq todo-category-number (mod (1+ todo-category-number) (length todo-categories))) (todo-category-select)) -(defalias 'todo-cmd-forw 'todo-forward-category) +(defalias 'todo-cmd-forw #'todo-forward-category) (defun todo-backward-category () "Go back to TODO list of previous category." @@ -467,14 +452,14 @@ Use `todo-categories' instead.") (setq todo-category-number (mod (1- todo-category-number) (length todo-categories))) (todo-category-select)) -(defalias 'todo-cmd-back 'todo-backward-category) +(defalias 'todo-cmd-back #'todo-backward-category) (defun todo-backward-item () "Select previous entry of TODO list." (interactive) (search-backward-regexp (concat "^" (regexp-quote todo-prefix)) nil t) (message "")) -(defalias 'todo-cmd-prev 'todo-backward-item) +(defalias 'todo-cmd-prev #'todo-backward-item) (defun todo-forward-item (&optional count) "Select COUNT-th next entry of TODO list." @@ -485,7 +470,7 @@ Use `todo-categories' instead.") nil 'goto-end count) (beginning-of-line) (message "")) -(defalias 'todo-cmd-next 'todo-forward-item) +(defalias 'todo-cmd-next #'todo-forward-item) (defun todo-save () "Save the TODO list." @@ -494,7 +479,7 @@ Use `todo-categories' instead.") (save-restriction (save-buffer))) (if todo-save-top-priorities-too (todo-save-top-priorities))) -(defalias 'todo-cmd-save 'todo-save) +(defalias 'todo-cmd-save #'todo-save) (defun todo-quit () "Done with TODO list for now." @@ -503,7 +488,7 @@ Use `todo-categories' instead.") (todo-save) (message "") (bury-buffer)) -(defalias 'todo-cmd-done 'todo-quit) +(defalias 'todo-cmd-done #'todo-quit) (defun todo-edit-item () "Edit current TODO list entry." @@ -518,7 +503,7 @@ Use `todo-categories' instead.") (todo-backward-item) (message "")))) (error "No TODO list entry to edit"))) -(defalias 'todo-cmd-edit 'todo-edit-item) +(defalias 'todo-cmd-edit #'todo-edit-item) (defun todo-edit-multiline () "Set up a buffer for editing a multiline TODO list entry." @@ -622,7 +607,7 @@ category." (category (if arg (todo-completing-read) current-category))) (todo-add-item-non-interactively new-item category)))) -(defalias 'todo-cmd-inst 'todo-insert-item) +(defalias 'todo-cmd-inst #'todo-insert-item) (defun todo-insert-item-here () "Insert a new TODO list entry directly above the entry at point. @@ -650,7 +635,7 @@ If point is on an empty line, insert the entry there." (setq todo-previous-answer (y-or-n-p (format-message "More important than `%s'? " item))))) todo-previous-answer) -(defalias 'todo-ask-p 'todo-more-important-p) +(defalias 'todo-ask-p #'todo-more-important-p) (defun todo-delete-item () "Delete current TODO list entry." @@ -664,7 +649,7 @@ If point is on an empty line, insert the entry there." (todo-backward-item)) (message "")) (error "No TODO list entry to delete"))) -(defalias 'todo-cmd-kill 'todo-delete-item) +(defalias 'todo-cmd-kill #'todo-delete-item) (defun todo-raise-item () "Raise priority of current entry." @@ -677,7 +662,7 @@ If point is on an empty line, insert the entry there." (insert item "\n")) (message "")) (error "No TODO list entry to raise"))) -(defalias 'todo-cmd-rais 'todo-raise-item) +(defalias 'todo-cmd-rais #'todo-raise-item) (defun todo-lower-item () "Lower priority of current entry." @@ -691,7 +676,7 @@ If point is on an empty line, insert the entry there." (insert item "\n")) (message "")) (error "No TODO list entry to lower"))) -(defalias 'todo-cmd-lowr 'todo-lower-item) +(defalias 'todo-cmd-lowr #'todo-lower-item) (defun todo-file-item (&optional comment) "File the current TODO list entry away, annotated with an optional COMMENT." diff --git a/lisp/obsolete/patcomp.el b/lisp/obsolete/patcomp.el index 8545f0721fa..2c35cb07007 100644 --- a/lisp/obsolete/patcomp.el +++ b/lisp/obsolete/patcomp.el @@ -1,4 +1,4 @@ -;;; patcomp.el --- used by patch files to update Emacs releases +;;; patcomp.el --- used by patch files to update Emacs releases -*- lexical-binding: t; -*- ;; This file is part of GNU Emacs. diff --git a/lisp/obsolete/pc-mode.el b/lisp/obsolete/pc-mode.el index d4c90c2b298..cf0bc28b110 100644 --- a/lisp/obsolete/pc-mode.el +++ b/lisp/obsolete/pc-mode.el @@ -1,4 +1,4 @@ -;;; pc-mode.el --- emulate certain key bindings used on PCs +;;; pc-mode.el --- emulate certain key bindings used on PCs -*- lexical-binding: t; -*- ;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc. @@ -40,16 +40,16 @@ C-Escape does list-buffers." (define-key function-key-map [delete] "\C-d") (define-key function-key-map [M-delete] [?\M-d]) (define-key function-key-map [C-delete] [?\M-d]) - (global-set-key [C-M-delete] 'kill-sexp) - (global-set-key [C-backspace] 'backward-kill-word) - (global-set-key [M-backspace] 'undo) + (global-set-key [C-M-delete] #'kill-sexp) + (global-set-key [C-backspace] #'backward-kill-word) + (global-set-key [M-backspace] #'undo) - (global-set-key [C-escape] 'list-buffers) + (global-set-key [C-escape] #'list-buffers) - (global-set-key [home] 'beginning-of-line) - (global-set-key [end] 'end-of-line) - (global-set-key [C-home] 'beginning-of-buffer) - (global-set-key [C-end] 'end-of-buffer)) + (global-set-key [home] #'beginning-of-line) + (global-set-key [end] #'end-of-line) + (global-set-key [C-home] #'beginning-of-buffer) + (global-set-key [C-end] #'end-of-buffer)) (provide 'pc-mode) diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el index 3f184881096..59828759e66 100644 --- a/lisp/obsolete/pc-select.el +++ b/lisp/obsolete/pc-select.el @@ -1,4 +1,4 @@ -;;; pc-select.el --- emulate mark, cut, copy and paste from Motif +;;; pc-select.el --- emulate mark, cut, copy and paste from Motif -*- lexical-binding: t; -*- ;;; (or MAC GUI or MS-windoze (bah)) look-and-feel ;;; including key bindings. @@ -94,25 +94,21 @@ The scroll commands normally generate an error if you try to scroll past the top or bottom of the buffer. This is annoying when selecting text with these commands. If you set this variable to non-nil, these errors are suppressed." - :type 'boolean - :group 'pc-select) + :type 'boolean) (defcustom pc-select-selection-keys-only nil "Non-nil means only bind the basic selection keys when started. Other keys that emulate pc-behavior will be untouched. This gives mostly Emacs-like behavior with only the selection keys enabled." - :type 'boolean - :group 'pc-select) + :type 'boolean) (defcustom pc-select-meta-moves-sexps nil "Non-nil means move sexp-wise with Meta key, otherwise move word-wise." - :type 'boolean - :group 'pc-select) + :type 'boolean) (defcustom pc-selection-mode-hook nil "The hook to run when PC Selection mode is toggled." - :type 'hook - :group 'pc-select) + :type 'hook) (defvar pc-select-saved-settings-alist nil "The values of the variables before PC Selection mode was toggled on. @@ -320,7 +316,6 @@ but before calling PC Selection mode): ;; FIXME: bring pc-bindings-mode here ? nil nil nil - :group 'pc-select :global t (if pc-selection-mode diff --git a/lisp/obsolete/pgg-def.el b/lisp/obsolete/pgg-def.el index 425093832f8..4d30e326148 100644 --- a/lisp/obsolete/pgg-def.el +++ b/lisp/obsolete/pgg-def.el @@ -1,4 +1,4 @@ -;;; pgg-def.el --- functions/macros for defining PGG functions +;;; pgg-def.el --- functions/macros for defining PGG functions -*- lexical-binding: t; -*- ;; Copyright (C) 1999, 2002-2021 Free Software Foundation, Inc. @@ -32,47 +32,39 @@ (defcustom pgg-default-scheme 'gpg "Default PGP scheme." - :group 'pgg :type '(choice (const :tag "GnuPG" gpg) (const :tag "PGP 5" pgp5) (const :tag "PGP" pgp))) (defcustom pgg-default-user-id (user-login-name) "User ID of your default identity." - :group 'pgg :type 'string) (defcustom pgg-default-keyserver-address "subkeys.pgp.net" "Host name of keyserver." - :group 'pgg :type 'string) (defcustom pgg-query-keyserver nil "Whether PGG queries keyservers for missing keys when verifying messages." :version "22.1" - :group 'pgg :type 'boolean) (defcustom pgg-encrypt-for-me t "If t, encrypt all outgoing messages with user's public key." - :group 'pgg :type 'boolean) (defcustom pgg-cache-passphrase t "If t, cache passphrase." - :group 'pgg :type 'boolean) (defcustom pgg-passphrase-cache-expiry 16 "How many seconds the passphrase is cached. Whether the passphrase is cached at all is controlled by `pgg-cache-passphrase'." - :group 'pgg :type 'integer) (defcustom pgg-passphrase-coding-system nil "Coding system to encode passphrase." - :group 'pgg :type 'coding-system) (defvar pgg-messages-coding-system nil diff --git a/lisp/obsolete/pgg-gpg.el b/lisp/obsolete/pgg-gpg.el index 90255fe2f7d..d06a485b975 100644 --- a/lisp/obsolete/pgg-gpg.el +++ b/lisp/obsolete/pgg-gpg.el @@ -1,4 +1,4 @@ -;;; pgg-gpg.el --- GnuPG support for PGG. +;;; pgg-gpg.el --- GnuPG support for PGG. -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc. @@ -37,23 +37,19 @@ (defcustom pgg-gpg-program "gpg" "The GnuPG executable." - :group 'pgg-gpg :type 'string) (defcustom pgg-gpg-extra-args nil "Extra arguments for every GnuPG invocation." - :group 'pgg-gpg :type '(repeat (string :tag "Argument"))) (defcustom pgg-gpg-recipient-argument "--recipient" "GnuPG option to specify recipient." - :group 'pgg-gpg :type '(choice (const :tag "New `--recipient' option" "--recipient") (const :tag "Old `--remote-user' option" "--remote-user"))) (defcustom pgg-gpg-use-agent t "Whether to use gnupg agent for key caching." - :group 'pgg-gpg :type 'boolean) (defvar pgg-gpg-user-id nil @@ -97,7 +93,7 @@ passphrase-with-newline (coding-system-change-eol-conversion pgg-passphrase-coding-system 'unix))) - (pgg-clear-string passphrase-with-newline)) + (clear-string passphrase-with-newline)) (setq encoded-passphrase-with-new-line passphrase-with-newline passphrase-with-newline nil)) (process-send-string process encoded-passphrase-with-new-line)) @@ -125,9 +121,9 @@ (if (= 127 exit-status) (error "%s could not be found" program)))) (if passphrase-with-newline - (pgg-clear-string passphrase-with-newline)) + (clear-string passphrase-with-newline)) (if encoded-passphrase-with-new-line - (pgg-clear-string encoded-passphrase-with-new-line)) + (clear-string encoded-passphrase-with-new-line)) (if (and process (eq 'run (process-status process))) (interrupt-process process)) (if (file-exists-p output-file-name) diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el index edb5d4f6775..2c76365a415 100644 --- a/lisp/obsolete/pgg-parse.el +++ b/lisp/obsolete/pgg-parse.el @@ -1,4 +1,4 @@ -;;; pgg-parse.el --- OpenPGP packet parsing +;;; pgg-parse.el --- OpenPGP packet parsing -*- lexical-binding: t; -*- ;; Copyright (C) 1999, 2002-2021 Free Software Foundation, Inc. @@ -44,14 +44,12 @@ (defcustom pgg-parse-public-key-algorithm-alist '((1 . RSA) (2 . RSA-E) (3 . RSA-S) (16 . ELG-E) (17 . DSA) (20 . ELG)) "Alist of the assigned number to the public key algorithm." - :group 'pgg-parse :type '(repeat (cons (sexp :tag "Number") (sexp :tag "Type")))) (defcustom pgg-parse-symmetric-key-algorithm-alist '((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128)) "Alist of the assigned number to the symmetric key algorithm." - :group 'pgg-parse :type '(repeat (cons (sexp :tag "Number") (sexp :tag "Type")))) @@ -59,7 +57,6 @@ '((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2) (8 . SHA256) (9 . SHA384) (10 . SHA512)) "Alist of the assigned number to the cryptographic hash algorithm." - :group 'pgg-parse :type '(repeat (cons (sexp :tag "Number") (sexp :tag "Type")))) @@ -68,7 +65,6 @@ (1 . ZIP) (2 . ZLIB)) "Alist of the assigned number to the compression algorithm." - :group 'pgg-parse :type '(repeat (cons (sexp :tag "Number") (sexp :tag "Type")))) @@ -87,13 +83,11 @@ (48 . "Certification revocation signature") (64 . "Timestamp signature.")) "Alist of the assigned number to the signature type." - :group 'pgg-parse :type '(repeat (cons (sexp :tag "Number") (sexp :tag "Type")))) (defcustom pgg-ignore-packet-checksum t; XXX "If non-nil checksum of each ascii armored packet will be ignored." - :group 'pgg-parse :type 'boolean) (defvar pgg-armor-header-lines @@ -148,7 +142,7 @@ ;; `(string-to-number-list (pgg-read-body-string ,ptag)) ) -(defalias 'pgg-skip-bytes 'forward-char) +(defalias 'pgg-skip-bytes #'forward-char) (defmacro pgg-skip-header (ptag) `(pgg-skip-bytes (nth 2 ,ptag))) @@ -345,7 +339,7 @@ ;; 100 to 110 = internal or user-defined )) -(defun pgg-parse-signature-packet (ptag) +(defun pgg-parse-signature-packet (_ptag) (let* ((signature-version (pgg-byte-after)) (result (list (cons 'version signature-version))) hashed-material field n) @@ -411,7 +405,7 @@ pgg-parse-hash-algorithm-alist))) result)) -(defun pgg-parse-public-key-encrypted-session-key-packet (ptag) +(defun pgg-parse-public-key-encrypted-session-key-packet (_ptag) (let (result) (pgg-set-alist result 'version (pgg-read-byte)) @@ -425,7 +419,7 @@ pgg-parse-public-key-algorithm-alist))) result)) -(defun pgg-parse-symmetric-key-encrypted-session-key-packet (ptag) +(defun pgg-parse-symmetric-key-encrypted-session-key-packet (_ptag) (let (result) (pgg-set-alist result 'version @@ -436,7 +430,7 @@ pgg-parse-symmetric-key-algorithm-alist))) result)) -(defun pgg-parse-public-key-packet (ptag) +(defun pgg-parse-public-key-packet (_ptag) (let* ((key-version (pgg-read-byte)) (result (list (cons 'version key-version))) field) diff --git a/lisp/obsolete/pgg-pgp.el b/lisp/obsolete/pgg-pgp.el index e02032a6a57..665be0b2e2c 100644 --- a/lisp/obsolete/pgg-pgp.el +++ b/lisp/obsolete/pgg-pgp.el @@ -1,4 +1,4 @@ -;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG. +;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG. -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc. @@ -35,23 +35,19 @@ (defcustom pgg-pgp-program "pgp" "PGP 2.* and 6.* executable." - :group 'pgg-pgp :type 'string) (defcustom pgg-pgp-shell-file-name "/bin/sh" "File name to load inferior shells from. Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." - :group 'pgg-pgp :type 'string) (defcustom pgg-pgp-shell-command-switch "-c" "Switch used to have the shell execute its command line argument." - :group 'pgg-pgp :type 'string) (defcustom pgg-pgp-extra-args nil "Extra arguments for every PGP invocation." - :group 'pgg-pgp :type '(choice (const :tag "None" nil) (string :tag "Arguments"))) @@ -112,7 +108,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (delete-file errors-file-name) (file-error nil))))) -(defun pgg-pgp-lookup-key (string &optional type) +(defun pgg-pgp-lookup-key (string &optional _type) "Search keys associated with STRING." (let ((args (list "+batchmode" "+language=en" "-kv" string))) (with-current-buffer (get-buffer-create pgg-output-buffer) @@ -133,7 +129,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (defun pgg-pgp-encrypt-region (start end recipients &optional sign passphrase) "Encrypt the current region between START and END." (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) - (passphrase (or passphrase + (_passphrase (or passphrase (when sign (pgg-read-passphrase (format "PGP passphrase for %s: " @@ -143,10 +139,11 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (concat "+encrypttoself=off +verbose=1 +batchmode +language=us -fate " (if (or recipients pgg-encrypt-for-me) - (mapconcat 'shell-quote-argument + (mapconcat #'shell-quote-argument (append recipients (if pgg-encrypt-for-me - (list pgg-pgp-user-id))) " ")) + (list pgg-pgp-user-id))) + " ")) (if sign (concat " -s -u " (shell-quote-argument pgg-pgp-user-id)))))) (pgg-pgp-process-region start end nil pgg-pgp-program args) (pgg-process-when-success nil))) @@ -203,6 +200,7 @@ passphrase cache or user." (let* ((orig-file (pgg-make-temp-file "pgg")) (args "+verbose=1 +batchmode +language=us")) (with-file-modes 448 + (defvar jam-zcat-filename-list) (let ((coding-system-for-write 'binary) jka-compr-compression-info-list jam-zcat-filename-list) (write-region start end orig-file))) diff --git a/lisp/obsolete/pgg-pgp5.el b/lisp/obsolete/pgg-pgp5.el index 42ff1ca2bd6..d9523172418 100644 --- a/lisp/obsolete/pgg-pgp5.el +++ b/lisp/obsolete/pgg-pgp5.el @@ -1,4 +1,4 @@ -;;; pgg-pgp5.el --- PGP 5.* support for PGG. +;;; pgg-pgp5.el --- PGP 5.* support for PGG. -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc. @@ -35,38 +35,31 @@ (defcustom pgg-pgp5-pgpe-program "pgpe" "PGP 5.* `pgpe' executable." - :group 'pgg-pgp5 :type 'string) (defcustom pgg-pgp5-pgps-program "pgps" "PGP 5.* `pgps' executable." - :group 'pgg-pgp5 :type 'string) (defcustom pgg-pgp5-pgpk-program "pgpk" "PGP 5.* `pgpk' executable." - :group 'pgg-pgp5 :type 'string) (defcustom pgg-pgp5-pgpv-program "pgpv" "PGP 5.* `pgpv' executable." - :group 'pgg-pgp5 :type 'string) (defcustom pgg-pgp5-shell-file-name "/bin/sh" "File name to load inferior shells from. Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." - :group 'pgg-pgp5 :type 'string) (defcustom pgg-pgp5-shell-command-switch "-c" "Switch used to have the shell execute its command line argument." - :group 'pgg-pgp5 :type 'string) (defcustom pgg-pgp5-extra-args nil "Extra arguments for every PGP 5.* invocation." - :group 'pgg-pgp5 :type '(choice (const :tag "None" nil) (string :tag "Arguments"))) @@ -128,7 +121,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (delete-file errors-file-name) (file-error nil))))) -(defun pgg-pgp5-lookup-key (string &optional type) +(defun pgg-pgp5-lookup-key (string &optional _type) "Search keys associated with STRING." (let ((args (list "+language=en" "-l" string))) (with-current-buffer (get-buffer-create pgg-output-buffer) @@ -145,7 +138,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (defun pgg-pgp5-encrypt-region (start end recipients &optional sign passphrase) "Encrypt the current region between START and END." (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) - (passphrase (or passphrase + (_passphrase (or passphrase (when sign (pgg-read-passphrase (format "PGP passphrase for %s: " @@ -209,6 +202,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (let ((orig-file (pgg-make-temp-file "pgg")) (args '("+verbose=1" "+batchmode=1" "+language=us"))) (with-file-modes 448 + (defvar jam-zcat-filename-list) ;Not sure where this comes from. (let ((coding-system-for-write 'binary) jka-compr-compression-info-list jam-zcat-filename-list) (write-region start end orig-file))) diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el index ec93eeb93f8..5ed59933f23 100644 --- a/lisp/obsolete/pgg.el +++ b/lisp/obsolete/pgg.el @@ -1,4 +1,4 @@ -;;; pgg.el --- glue for the various PGP implementations. +;;; pgg.el --- glue for the various PGP implementations. -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc. @@ -27,99 +27,19 @@ (require 'pgg-def) (require 'pgg-parse) -(autoload 'run-at-time "timer") (eval-when-compile (require 'cl-lib)) ;;; @ utility functions ;;; -(eval-when-compile - (when (featurep 'xemacs) - (defmacro pgg-run-at-time-1 (time repeat function args) - (if (condition-case nil - (let ((delete-itimer 'delete-itimer) - (itimer-driver-start 'itimer-driver-start) - (itimer-value 'itimer-value) - (start-itimer 'start-itimer)) - (unless (or (symbol-value 'itimer-process) - (symbol-value 'itimer-timer)) - (funcall itimer-driver-start)) - ;; Check whether there is a bug to which the difference of - ;; the present time and the time when the itimer driver was - ;; woken up is subtracted from the initial itimer value. - (let* ((inhibit-quit t) - (ctime (current-time)) - (itimer-timer-last-wakeup - (prog1 - ctime - (setcar ctime (1- (car ctime))))) - (itimer-list nil) - (itimer (funcall start-itimer "pgg-run-at-time" - 'ignore 5))) - (sleep-for 0.1) ;; Accept the timeout interrupt. - (prog1 - (> (funcall itimer-value itimer) 0) - (funcall delete-itimer itimer)))) - (error nil)) - `(let ((time ,time)) - (apply #'start-itimer "pgg-run-at-time" - ,function (if time (max time 1e-9) 1e-9) - ,repeat nil t ,args)) - `(let ((time ,time) - (itimers (list nil))) - (setcar - itimers - (apply #'start-itimer "pgg-run-at-time" - (lambda (itimers repeat function &rest args) - (let ((itimer (car itimers))) - (if repeat - (progn - (set-itimer-function - itimer - (lambda (itimer repeat function &rest args) - (set-itimer-restart itimer repeat) - (set-itimer-function itimer function) - (set-itimer-function-arguments itimer args) - (apply function args))) - (set-itimer-function-arguments - itimer - (append (list itimer repeat function) args))) - (set-itimer-function - itimer - (lambda (itimer function &rest args) - (delete-itimer itimer) - (apply function args))) - (set-itimer-function-arguments - itimer - (append (list itimer function) args))))) - 1e-9 (if time (max time 1e-9) 1e-9) - nil t itimers ,repeat ,function ,args))))))) - -(eval-and-compile - (if (featurep 'xemacs) - (progn - (defun pgg-run-at-time (time repeat function &rest args) - "Emulating function run as `run-at-time'. -TIME should be nil meaning now, or a number of seconds from now. -Return an itimer object which can be used in either `delete-itimer' -or `cancel-timer'." - (pgg-run-at-time-1 time repeat function args)) - (defun pgg-cancel-timer (timer) - "Emulate cancel-timer for xemacs." - (let ((delete-itimer 'delete-itimer)) - (funcall delete-itimer timer)))) - (defalias 'pgg-run-at-time 'run-at-time) - (defalias 'pgg-cancel-timer 'cancel-timer))) - (defun pgg-invoke (func scheme &rest args) (progn (require (intern (format "pgg-%s" scheme))) - (apply 'funcall (intern (format "pgg-%s-%s" scheme func)) args))) - -(put 'pgg-save-coding-system 'lisp-indent-function 2) + (apply #'funcall (intern (format "pgg-%s-%s" scheme func)) args))) (defmacro pgg-save-coding-system (start end &rest body) + (declare (indent 2) (debug t)) `(if (called-interactively-p 'interactive) (let ((buffer (current-buffer))) (with-temp-buffer @@ -209,23 +129,16 @@ regulate cache behavior." (let* ((key (if notruncate key (pgg-truncate-key-identifier key))) (interned-timer-key (intern-soft key pgg-pending-timers)) (old-timer (symbol-value interned-timer-key)) - new-timer) + ) ;; new-timer (when old-timer (cancel-timer old-timer) (unintern interned-timer-key pgg-pending-timers)) (set (intern key pgg-passphrase-cache) passphrase) (set (intern key pgg-pending-timers) - (pgg-run-at-time pgg-passphrase-cache-expiry nil - #'pgg-remove-passphrase-from-cache - key notruncate)))) - -(if (fboundp 'clear-string) - (defalias 'pgg-clear-string 'clear-string) - (defun pgg-clear-string (string) - (fillarray string ?_))) - -(declare-function pgg-clear-string "pgg" (string)) + (run-at-time pgg-passphrase-cache-expiry nil + #'pgg-remove-passphrase-from-cache + key notruncate)))) (defun pgg-remove-passphrase-from-cache (key &optional notruncate) "Omit passphrase associated with KEY in time-limited passphrase cache. @@ -245,10 +158,10 @@ regulate cache behavior." (interned-timer-key (intern-soft key pgg-pending-timers)) (old-timer (symbol-value interned-timer-key))) (when passphrase - (pgg-clear-string passphrase) + (clear-string passphrase) (unintern key pgg-passphrase-cache)) (when old-timer - (pgg-cancel-timer old-timer) + (cancel-timer old-timer) (unintern interned-timer-key pgg-pending-timers)))) (defmacro pgg-convert-lbt-region (start end lbt) @@ -265,9 +178,8 @@ regulate cache behavior." (while (re-search-forward "\r$" pgg-conversion-end t) (replace-match "")))))) -(put 'pgg-as-lbt 'lisp-indent-function 3) - (defmacro pgg-as-lbt (start end lbt &rest body) + (declare (indent 3) (debug t)) `(let ((inhibit-read-only t) buffer-read-only buffer-undo-list) @@ -277,9 +189,8 @@ regulate cache behavior." (push nil buffer-undo-list) (ignore-errors (undo)))) -(put 'pgg-process-when-success 'lisp-indent-function 0) - (defmacro pgg-process-when-success (&rest body) + (declare (indent 0) (debug t)) `(with-current-buffer pgg-output-buffer (if (zerop (buffer-size)) nil ,@body t))) @@ -377,7 +288,7 @@ passphrase cache or user." If optional PASSPHRASE is not specified, it will be obtained from the passphrase cache or user." (interactive "r") - (let* ((buf (current-buffer)) + (let* (;; (buf (current-buffer)) (status (pgg-save-coding-system start end (pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme) diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el index 29931d9bda4..d7020f0d074 100644 --- a/lisp/obsolete/rcompile.el +++ b/lisp/obsolete/rcompile.el @@ -1,4 +1,4 @@ -;;; rcompile.el --- run a compilation on a remote machine +;;; rcompile.el --- run a compilation on a remote machine -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc. @@ -76,14 +76,12 @@ (defcustom remote-compile-host nil "Host for remote compilations." - :type '(choice string (const nil)) - :group 'remote-compile) + :type '(choice string (const nil))) (defcustom remote-compile-user nil "User for remote compilations. nil means use the value returned by \\[user-login-name]." - :type '(choice string (const nil)) - :group 'remote-compile) + :type '(choice string (const nil))) (defcustom remote-compile-run-before nil "Command to run before compilation. @@ -91,18 +89,15 @@ This can be used for setting up environment variables, since rsh does not invoke the shell as a login shell and files like .login \(tcsh) and .bash_profile \(bash) are not run. nil means run no commands." - :type '(choice string (const nil)) - :group 'remote-compile) + :type '(choice string (const nil))) (defcustom remote-compile-prompt-for-host nil "Non-nil means prompt for host if not available from filename." - :type 'boolean - :group 'remote-compile) + :type 'boolean) (defcustom remote-compile-prompt-for-user nil "Non-nil means prompt for user if not available from filename." - :type 'boolean - :group 'remote-compile) + :type 'boolean) ;;;; internal variables @@ -123,7 +118,7 @@ nil means run no commands." "Compile the current buffer's directory on HOST. Log in as USER. See \\[compile]." (interactive - (let (host user command prompt l l-host l-user) + (let (host user command prompt) ;; l l-host l-user (setq prompt (if (stringp remote-compile-host) (format "Compile on host (default %s): " remote-compile-host) @@ -153,7 +148,7 @@ See \\[compile]." (setq remote-compile-user user)) ((null remote-compile-user) (setq remote-compile-user (user-login-name)))) - (let* (localname ;; Pacify byte-compiler. + (let* (;; localname ;; Pacify byte-compiler. (compile-command (format "%s %s -l %s \"(%scd %s; %s)\"" remote-shell-program diff --git a/lisp/obsolete/s-region.el b/lisp/obsolete/s-region.el index bcb5279d115..4d4c39e9b11 100644 --- a/lisp/obsolete/s-region.el +++ b/lisp/obsolete/s-region.el @@ -1,4 +1,4 @@ -;;; s-region.el --- set region using shift key +;;; s-region.el --- set region using shift key -*- lexical-binding: t; -*- ;; Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc. @@ -112,11 +112,11 @@ to global keymap." [M-next] [M-previous] [M-home] [M-end])) (or (global-key-binding [C-insert]) - (global-set-key [C-insert] 'copy-region-as-kill)) + (global-set-key [C-insert] #'copy-region-as-kill)) (or (global-key-binding [S-delete]) - (global-set-key [S-delete] 'kill-region)) + (global-set-key [S-delete] #'kill-region)) (or (global-key-binding [S-insert]) - (global-set-key [S-insert] 'yank)) + (global-set-key [S-insert] #'yank)) (provide 's-region) diff --git a/lisp/obsolete/sb-image.el b/lisp/obsolete/sb-image.el index 53ecfb7f268..e9a507f0086 100644 --- a/lisp/obsolete/sb-image.el +++ b/lisp/obsolete/sb-image.el @@ -1,4 +1,4 @@ -;;; sb-image --- Image management for speedbar +;;; sb-image --- Image management for speedbar -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2003, 2005-2019, 2021 Free Software Foundation, ;; Inc. diff --git a/lisp/obsolete/sregex.el b/lisp/obsolete/sregex.el index ac5f62dd67e..96d6b7aebf0 100644 --- a/lisp/obsolete/sregex.el +++ b/lisp/obsolete/sregex.el @@ -1,4 +1,4 @@ -;;; sregex.el --- symbolic regular expressions +;;; sregex.el --- symbolic regular expressions -*- lexical-binding: t; -*- ;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc. @@ -246,15 +246,15 @@ (defvar sregex--current-sregex nil) (defun sregex-info () nil) (defmacro sregex-save-match-data (&rest forms) (cons 'save-match-data forms)) -(defun sregex-replace-match (r &optional f l str subexp x) +(defun sregex-replace-match (r &optional f l str subexp _x) (replace-match r f l str subexp)) -(defun sregex-match-string (c &optional i x) (match-string c i)) -(defun sregex-match-string-no-properties (count &optional in-string sregex) +(defun sregex-match-string (c &optional i _x) (match-string c i)) +(defun sregex-match-string-no-properties (count &optional in-string _sregex) (match-string-no-properties count in-string)) -(defun sregex-match-beginning (count &optional sregex) (match-beginning count)) -(defun sregex-match-end (count &optional sregex) (match-end count)) -(defun sregex-match-data (&optional sregex) (match-data)) -(defun sregex-backref-num (n &optional sregex) n) +(defun sregex-match-beginning (count &optional _sregex) (match-beginning count)) +(defun sregex-match-end (count &optional _sregex) (match-end count)) +(defun sregex-match-data (&optional _sregex) (match-data)) +(defun sregex-backref-num (n &optional _sregex) n) (defun sregex (&rest exps) @@ -525,23 +525,23 @@ has one of the following forms: (concat "\\(?:" re "\\)") re)))) -(defun sregex--group (exps combine) (concat "\\(" (sregex--sequence exps nil) "\\)")) +(defun sregex--group (exps _combine) (concat "\\(" (sregex--sequence exps nil) "\\)")) -(defun sregex--backref (exps combine) (concat "\\" (int-to-string (car exps)))) -(defun sregex--opt (exps combine) (concat (sregex--sequence exps 'suffix) "?")) -(defun sregex--0+ (exps combine) (concat (sregex--sequence exps 'suffix) "*")) -(defun sregex--1+ (exps combine) (concat (sregex--sequence exps 'suffix) "+")) +(defun sregex--backref (exps _combine) (concat "\\" (int-to-string (car exps)))) +(defun sregex--opt (exps _combine) (concat (sregex--sequence exps 'suffix) "?")) +(defun sregex--0+ (exps _combine) (concat (sregex--sequence exps 'suffix) "*")) +(defun sregex--1+ (exps _combine) (concat (sregex--sequence exps 'suffix) "+")) -(defun sregex--char (exps combine) (sregex--char-aux nil exps)) -(defun sregex--not-char (exps combine) (sregex--char-aux t exps)) +(defun sregex--char (exps _combine) (sregex--char-aux nil exps)) +(defun sregex--not-char (exps _combine) (sregex--char-aux t exps)) -(defun sregex--syntax (exps combine) (format "\\s%c" (car exps))) -(defun sregex--not-syntax (exps combine) (format "\\S%c" (car exps))) +(defun sregex--syntax (exps _combine) (format "\\s%c" (car exps))) +(defun sregex--not-syntax (exps _combine) (format "\\S%c" (car exps))) (defun sregex--regex (exps combine) (if combine (concat "\\(?:" (car exps) "\\)") (car exps))) -(defun sregex--repeat (exps combine) +(defun sregex--repeat (exps _combine) (let* ((min (or (pop exps) 0)) (minstr (number-to-string min)) (max (pop exps))) diff --git a/lisp/obsolete/starttls.el b/lisp/obsolete/starttls.el index 451c7eb2ffc..0ca486324fd 100644 --- a/lisp/obsolete/starttls.el +++ b/lisp/obsolete/starttls.el @@ -1,4 +1,4 @@ -;;; starttls.el --- STARTTLS functions +;;; starttls.el --- STARTTLS functions -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -126,28 +126,24 @@ This program is used when GnuTLS is used, i.e. when `starttls-use-gnutls' is non-nil." :version "22.1" - :type 'string - :group 'starttls) + :type 'string) (defcustom starttls-program "starttls" "The program to run in a subprocess to open an TLSv1 connection. This program is used when the `starttls' command is used, i.e. when `starttls-use-gnutls' is nil." - :type 'string - :group 'starttls) + :type 'string) (defcustom starttls-use-gnutls (not (executable-find starttls-program)) "Whether to use GnuTLS instead of the `starttls' command." :version "22.1" - :type 'boolean - :group 'starttls) + :type 'boolean) (defcustom starttls-extra-args nil "Extra arguments to `starttls-program'. These apply when the `starttls' command is used, i.e. when `starttls-use-gnutls' is nil." - :type '(repeat string) - :group 'starttls) + :type '(repeat string)) (defcustom starttls-extra-arguments nil "Extra arguments to `starttls-gnutls-program'. @@ -157,14 +153,12 @@ For example, non-TLS compliant servers may require \(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to find out which parameters are available." :version "22.1" - :type '(repeat string) - :group 'starttls) + :type '(repeat string)) (defcustom starttls-process-connection-type nil "Value for `process-connection-type' to use when starting STARTTLS process." :version "22.1" - :type 'boolean - :group 'starttls) + :type 'boolean) (defcustom starttls-connect "- Simple Client Mode:\n\n" "Regular expression indicating successful connection. @@ -173,8 +167,7 @@ The default is what GnuTLS's \"gnutls-cli\" outputs." ;; in the application read/write phase. If the logic, or the string ;; itself, is modified, this must be updated. :version "22.1" - :type 'regexp - :group 'starttls) + :type 'regexp) (defcustom starttls-failure "\\*\\*\\* Handshake has failed" "Regular expression indicating failed TLS handshake. @@ -182,8 +175,7 @@ The default is what GnuTLS's \"gnutls-cli\" outputs." ;; GnuTLS cli.c:do_handshake() prints this string on failure. If the ;; logic, or the string itself, is modified, this must be updated. :version "22.1" - :type 'regexp - :group 'starttls) + :type 'regexp) (defcustom starttls-success "- Compression: " "Regular expression indicating completed TLS handshakes. @@ -193,8 +185,7 @@ The default is what GnuTLS's \"gnutls-cli\" outputs." ;; last. If that logic, or the string itself, is modified, this ;; must be updated. :version "22.1" - :type 'regexp - :group 'starttls) + :type 'regexp) (defun starttls-negotiate-gnutls (process) "Negotiate TLS on PROCESS opened by `open-starttls-stream'. @@ -296,9 +287,8 @@ GnuTLS requires a port number." starttls-gnutls-program starttls-program)))) -(defalias 'starttls-any-program-available 'starttls-available-p) -(make-obsolete 'starttls-any-program-available 'starttls-available-p - "2011-08-02") +(define-obsolete-function-alias 'starttls-any-program-available + #'starttls-available-p "2011-08-02") (provide 'starttls) diff --git a/lisp/obsolete/sup-mouse.el b/lisp/obsolete/sup-mouse.el index f3db27f567e..4e312e968b3 100644 --- a/lisp/obsolete/sup-mouse.el +++ b/lisp/obsolete/sup-mouse.el @@ -1,4 +1,4 @@ -;;; sup-mouse.el --- supdup mouse support for lisp machines +;;; sup-mouse.el --- supdup mouse support for lisp machines -*- lexical-binding: t; -*- ;; Copyright (C) 1985-1986, 2001-2021 Free Software Foundation, Inc. diff --git a/lisp/obsolete/terminal.el b/lisp/obsolete/terminal.el index bde656dfa6a..d28c4a172fd 100644 --- a/lisp/obsolete/terminal.el +++ b/lisp/obsolete/terminal.el @@ -1,4 +1,4 @@ -;;; terminal.el --- terminal emulator for GNU Emacs +;;; terminal.el --- terminal emulator for GNU Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1986-1989, 1993-1994, 2001-2021 Free Software ;; Foundation, Inc. @@ -58,22 +58,19 @@ to the emulator program itself. Type this character twice to send it through the emulator. Type ? after typing it for a list of possible commands. This variable is local to each terminal-emulator buffer." - :type 'character - :group 'terminal) + :type 'character) (defcustom terminal-scrolling t ;;>> Setting this to t sort-of defeats my whole aim in writing this package... "If non-nil, the terminal-emulator will losingly `scroll' when output occurs past the bottom of the screen. If nil, output will win and `wrap' to the top of the screen. This variable is local to each terminal-emulator buffer." - :type 'boolean - :group 'terminal) + :type 'boolean) (defcustom terminal-more-processing t "If non-nil, do more-processing. This variable is local to each terminal-emulator buffer." - :type 'boolean - :group 'terminal) + :type 'boolean) ;; If you are the sort of loser who uses scrolling without more breaks ;; and expects to actually see anything, you should probably set this to @@ -84,8 +81,7 @@ terminal-emulator before a screen redisplay is forced. Set this to a large value for greater throughput, set it smaller for more frequent updates but overall slower performance." - :type 'integer - :group 'terminal) + :type 'integer) (defvar terminal-more-break-insertion "*** More break -- Press space to continue ***") @@ -94,7 +90,7 @@ performance." (if terminal-meta-map nil (let ((map (make-sparse-keymap))) - (define-key map [t] 'te-pass-through) + (define-key map [t] #'te-pass-through) (setq terminal-meta-map map))) (defvar terminal-map nil) @@ -104,8 +100,8 @@ performance." ;; Prevent defining [menu-bar] as te-pass-through ;; so we allow the global menu bar to be visible. (define-key map [menu-bar] (make-sparse-keymap)) - (define-key map [t] 'te-pass-through) - (define-key map [switch-frame] 'handle-switch-frame) + (define-key map [t] #'te-pass-through) + (define-key map [switch-frame] #'handle-switch-frame) (define-key map "\e" terminal-meta-map) ;;(define-key map "\C-l" ;; (lambda () (interactive) (te-pass-through) (redraw-display))) @@ -115,22 +111,22 @@ performance." (if terminal-escape-map nil (let ((map (make-sparse-keymap))) - (define-key map [t] 'undefined) + (define-key map [t] #'undefined) (let ((s "0")) (while (<= (aref s 0) ?9) - (define-key map s 'digit-argument) + (define-key map s #'digit-argument) (aset s 0 (1+ (aref s 0))))) - (define-key map "b" 'switch-to-buffer) - (define-key map "o" 'other-window) - (define-key map "e" 'te-set-escape-char) - (define-key map "\C-l" 'redraw-display) - (define-key map "\C-o" 'te-flush-pending-output) - (define-key map "m" 'te-toggle-more-processing) - (define-key map "x" 'te-escape-extended-command) + (define-key map "b" #'switch-to-buffer) + (define-key map "o" #'other-window) + (define-key map "e" #'te-set-escape-char) + (define-key map "\C-l" #'redraw-display) + (define-key map "\C-o" #'te-flush-pending-output) + (define-key map "m" #'te-toggle-more-processing) + (define-key map "x" #'te-escape-extended-command) ;;>> What use is this? Why is it in the default terminal-emulator map? - (define-key map "w" 'te-edit) - (define-key map "?" 'te-escape-help) - (define-key map (char-to-string help-char) 'te-escape-help) + (define-key map "w" #'te-edit) + (define-key map "?" #'te-escape-help) + (define-key map (char-to-string help-char) #'te-escape-help) (setq terminal-escape-map map))) (defvar te-escape-command-alist nil) @@ -161,14 +157,14 @@ performance." (if terminal-more-break-map nil (let ((map (make-sparse-keymap))) - (define-key map [t] 'te-more-break-unread) - (define-key map (char-to-string help-char) 'te-more-break-help) - (define-key map " " 'te-more-break-resume) - (define-key map "\C-l" 'redraw-display) - (define-key map "\C-o" 'te-more-break-flush-pending-output) + (define-key map [t] #'te-more-break-unread) + (define-key map (char-to-string help-char) #'te-more-break-help) + (define-key map " " #'te-more-break-resume) + (define-key map "\C-l" #'redraw-display) + (define-key map "\C-o" #'te-more-break-flush-pending-output) ;;>>> this isn't right - ;(define-key map "\^?" 'te-more-break-flush-pending-output) ;DEL - (define-key map "\r" 'te-more-break-advance-one-line) + ;(define-key map "\^?" #'te-more-break-flush-pending-output) ;DEL + (define-key map "\r" #'te-more-break-advance-one-line) (setq terminal-more-break-map map))) @@ -525,7 +521,7 @@ lets you type a terminal emulator command." (if terminal-edit-map nil (setq terminal-edit-map (make-sparse-keymap)) - (define-key terminal-edit-map "\C-c\C-c" 'terminal-cease-edit)) + (define-key terminal-edit-map "\C-c\C-c" #'terminal-cease-edit)) ;; Terminal Edit mode is suitable only for specially formatted data. (put 'terminal-edit-mode 'mode-class 'special) @@ -1140,10 +1136,10 @@ subprocess started." ;; Then finally start the program we wanted. (format "%s; exec %s" te-stty-string - (mapconcat 'te-quote-arg-for-sh + (mapconcat #'te-quote-arg-for-sh (cons program args) " ")))) - (set-process-filter te-process 'te-filter) - (set-process-sentinel te-process 'te-sentinel)) + (set-process-filter te-process #'te-filter) + (set-process-sentinel te-process #'te-sentinel)) (error (fundamental-mode) (signal (car err) (cdr err)))) (setq inhibit-quit t) ;sport death @@ -1151,8 +1147,8 @@ subprocess started." (run-hooks 'terminal-mode-hook) (message "Entering Emacs terminal-emulator... Type %s %s for help" (single-key-description terminal-escape-char) - (mapconcat 'single-key-description - (where-is-internal 'te-escape-help terminal-escape-map t) + (mapconcat #'single-key-description + (where-is-internal #'te-escape-help terminal-escape-map t) " "))) @@ -1292,7 +1288,7 @@ in the directory specified by `te-terminfo-directory'." (directory-file-name te-terminfo-directory)) process-environment))) (set-process-sentinel (start-process "tic" nil "tic" file-name) - 'te-tic-sentinel)))) + #'te-tic-sentinel)))) (directory-file-name te-terminfo-directory)) (defun te-create-termcap () diff --git a/lisp/obsolete/tls.el b/lisp/obsolete/tls.el index 67a497f9412..5cba18d7897 100644 --- a/lisp/obsolete/tls.el +++ b/lisp/obsolete/tls.el @@ -1,4 +1,4 @@ -;;; tls.el --- TLS/SSL support via wrapper around GnuTLS +;;; tls.el --- TLS/SSL support via wrapper around GnuTLS -*- lexical-binding: t; -*- ;; Copyright (C) 1996-1999, 2002-2021 Free Software Foundation, Inc. @@ -70,8 +70,7 @@ Client data stream begins after the last character this matches. The default matches the output of \"gnutls-cli\" (version 2.0.1)." :version "22.2" - :type 'regexp - :group 'tls) + :type 'regexp) (defcustom tls-program '("gnutls-cli --x509cafile %t -p %p %h" @@ -104,22 +103,19 @@ successful negotiation." (repeat :inline t :tag "Other" (string))) (list :tag "List of commands" (repeat :tag "Command" (string)))) - :version "26.1" ; remove s_client - :group 'tls) + :version "26.1") (defcustom tls-process-connection-type nil "Value for `process-connection-type' to use when starting TLS process." :version "22.1" - :type 'boolean - :group 'tls) + :type 'boolean) (defcustom tls-success "- Handshake was completed\\|SSL handshake has read " "Regular expression indicating completed TLS handshakes. The default is what GnuTLS's \"gnutls-cli\" outputs." ;; or OpenSSL's \"openssl s_client\" :version "22.1" - :type 'regexp - :group 'tls) + :type 'regexp) (defcustom tls-checktrust nil "Indicate if certificates should be checked against trusted root certs. @@ -137,8 +133,7 @@ consider trustworthy, e.g.: :type '(choice (const :tag "Always" t) (const :tag "Never" nil) (const :tag "Ask" ask)) - :version "23.1" ;; No Gnus - :group 'tls) + :version "23.1") (defcustom tls-untrusted "- Peer's certificate is NOT trusted\\|Verify return code: \\([^0] \\|.[^ ]\\)" @@ -147,8 +142,7 @@ The default is what GnuTLS's \"gnutls-cli\" returns in the event of unsuccessful verification." ;; or OpenSSL's \"openssl s_client\" :type 'regexp - :version "23.1" ;; No Gnus - :group 'tls) + :version "23.1") (defcustom tls-hostmismatch "# The hostname in the certificate does NOT match" @@ -158,20 +152,13 @@ name of the host you are connecting to, gnutls-cli issues a warning to this effect. There is no such feature in openssl. Set this to nil if you want to ignore host name mismatches." :type 'regexp - :version "23.1" ;; No Gnus - :group 'tls) + :version "23.1") (defcustom tls-certtool-program "certtool" "Name of GnuTLS certtool. Used by `tls-certificate-information'." :version "22.1" - :type 'string - :group 'tls) - -(defalias 'tls-format-message - (if (fboundp 'format-message) 'format-message - ;; for Emacs < 25, and XEmacs, don't worry about quote translation. - 'format)) + :type 'string) (defun tls-certificate-information (der) "Parse X.509 certificate in DER format into an assoc list." @@ -272,7 +259,7 @@ Fourth arg PORT is an integer specifying a port to connect to." (message "The certificate presented by `%s' is \ NOT trusted." host)) (not (yes-or-no-p - (tls-format-message "\ + (format-message "\ The certificate presented by `%s' is NOT trusted. Accept anyway? " host))))) (and tls-hostmismatch (save-excursion diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el index 78d88cf3774..1340618f055 100644 --- a/lisp/obsolete/tpu-edt.el +++ b/lisp/obsolete/tpu-edt.el @@ -1,4 +1,4 @@ -;;; tpu-edt.el --- Emacs emulating TPU emulating EDT +;;; tpu-edt.el --- Emacs emulating TPU emulating EDT -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc. @@ -289,18 +289,15 @@ ;;; (defcustom tpu-kill-buffers-silently nil "If non-nil, TPU-edt kills modified buffers without asking." - :type 'boolean - :group 'tpu) + :type 'boolean) (defcustom tpu-percent-scroll 75 "Percentage of the screen to scroll for next/previous screen commands." - :type 'integer - :group 'tpu) + :type 'integer) (defcustom tpu-pan-columns 16 "Number of columns the tpu-pan functions scroll left or right." - :type 'integer - :group 'tpu) + :type 'integer) ;;; @@ -313,17 +310,17 @@ ;; that term/*.el does its job to map the escape sequence to the right ;; key-symbol. - (define-key map [up] 'tpu-move-to-beginning) ; up-arrow - (define-key map [down] 'tpu-move-to-end) ; down-arrow - (define-key map [right] 'end-of-line) ; right-arrow - (define-key map [left] 'beginning-of-line) ; left-arrow + (define-key map [up] #'tpu-move-to-beginning) ; up-arrow + (define-key map [down] #'tpu-move-to-end) ; down-arrow + (define-key map [right] #'end-of-line) ; right-arrow + (define-key map [left] #'beginning-of-line) ; left-arrow ;; (define-key map [find] nil) ; Find ;; (define-key map [insert] nil) ; Insert Here - (define-key map [delete] 'tpu-store-text) ; Remove - (define-key map [select] 'tpu-unselect) ; Select - (define-key map [prior] 'tpu-previous-window) ; Prev Screen - (define-key map [next] 'tpu-next-window) ; Next Screen + (define-key map [delete] #'tpu-store-text) ; Remove + (define-key map [select] #'tpu-unselect) ; Select + (define-key map [prior] #'tpu-previous-window) ; Prev Screen + (define-key map [next] #'tpu-next-window) ; Next Screen ;; (define-key map [f1] nil) ; F1 ;; (define-key map [f2] nil) ; F2 @@ -339,45 +336,45 @@ ;; (define-key map [f12] nil) ; F12 ;; (define-key map [f13] nil) ; F13 ;; (define-key map [f14] nil) ; F14 - (define-key map [help] 'describe-bindings) ; HELP + (define-key map [help] #'describe-bindings) ; HELP ;; (define-key map [menu] nil) ; DO - (define-key map [f17] 'tpu-drop-breadcrumb) ; F17 + (define-key map [f17] #'tpu-drop-breadcrumb) ; F17 ;; (define-key map [f18] nil) ; F18 ;; (define-key map [f19] nil) ; F19 ;; (define-key map [f20] nil) ; F20 - (define-key map [kp-f1] 'keyboard-quit) ; PF1 - (define-key map [kp-f2] 'help-for-help) ; PF2 - (define-key map [kp-f3] 'tpu-search) ; PF3 - (define-key map [kp-f4] 'tpu-undelete-lines) ; PF4 - (define-key map [kp-0] 'open-line) ; KP0 - (define-key map [kp-1] 'tpu-change-case) ; KP1 - (define-key map [kp-2] 'tpu-delete-to-eol) ; KP2 - (define-key map [kp-3] 'tpu-special-insert) ; KP3 - (define-key map [kp-4] 'tpu-move-to-end) ; KP4 - (define-key map [kp-5] 'tpu-move-to-beginning) ; KP5 - (define-key map [kp-6] 'tpu-paste) ; KP6 - (define-key map [kp-7] 'execute-extended-command) ; KP7 - (define-key map [kp-8] 'tpu-fill) ; KP8 - (define-key map [kp-9] 'tpu-replace) ; KP9 - (define-key map [kp-subtract] 'tpu-undelete-words) ; KP- - (define-key map [kp-separator] 'tpu-undelete-char) ; KP, - (define-key map [kp-decimal] 'tpu-unselect) ; KP. - (define-key map [kp-enter] 'tpu-substitute) ; KPenter + (define-key map [kp-f1] #'keyboard-quit) ; PF1 + (define-key map [kp-f2] #'help-for-help) ; PF2 + (define-key map [kp-f3] #'tpu-search) ; PF3 + (define-key map [kp-f4] #'tpu-undelete-lines) ; PF4 + (define-key map [kp-0] #'open-line) ; KP0 + (define-key map [kp-1] #'tpu-change-case) ; KP1 + (define-key map [kp-2] #'tpu-delete-to-eol) ; KP2 + (define-key map [kp-3] #'tpu-special-insert) ; KP3 + (define-key map [kp-4] #'tpu-move-to-end) ; KP4 + (define-key map [kp-5] #'tpu-move-to-beginning) ; KP5 + (define-key map [kp-6] #'tpu-paste) ; KP6 + (define-key map [kp-7] #'execute-extended-command) ; KP7 + (define-key map [kp-8] #'tpu-fill) ; KP8 + (define-key map [kp-9] #'tpu-replace) ; KP9 + (define-key map [kp-subtract] #'tpu-undelete-words) ; KP- + (define-key map [kp-separator] #'tpu-undelete-char) ; KP, + (define-key map [kp-decimal] #'tpu-unselect) ; KP. + (define-key map [kp-enter] #'tpu-substitute) ; KPenter ;; - (define-key map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A + (define-key map "\C-A" #'tpu-toggle-overwrite-mode) ; ^A ;; (define-key map "\C-B" nil) ; ^B ;; (define-key map "\C-C" nil) ; ^C ;; (define-key map "\C-D" nil) ; ^D ;; (define-key map "\C-E" nil) ; ^E - (define-key map "\C-F" 'set-visited-file-name) ; ^F - (define-key map "\C-g" 'keyboard-quit) ; safety first - (define-key map "\C-h" 'delete-other-windows) ; BS - (define-key map "\C-i" 'other-window) ; TAB + (define-key map "\C-F" #'set-visited-file-name) ; ^F + (define-key map "\C-g" #'keyboard-quit) ; safety first + (define-key map "\C-h" #'delete-other-windows) ; BS + (define-key map "\C-i" #'other-window) ; TAB ;; (define-key map "\C-J" nil) ; ^J - (define-key map "\C-K" 'tpu-define-macro-key) ; ^K - (define-key map "\C-l" 'downcase-region) ; ^L + (define-key map "\C-K" #'tpu-define-macro-key) ; ^K + (define-key map "\C-l" #'downcase-region) ; ^L ;; (define-key map "\C-M" nil) ; ^M ;; (define-key map "\C-N" nil) ; ^N ;; (define-key map "\C-O" nil) ; ^O @@ -385,104 +382,104 @@ ;; (define-key map "\C-Q" nil) ; ^Q ;; (define-key map "\C-R" nil) ; ^R ;; (define-key map "\C-S" nil) ; ^S - (define-key map "\C-T" 'tpu-toggle-control-keys) ; ^T - (define-key map "\C-u" 'upcase-region) ; ^U + (define-key map "\C-T" #'tpu-toggle-control-keys) ; ^T + (define-key map "\C-u" #'upcase-region) ; ^U ;; (define-key map "\C-V" nil) ; ^V - (define-key map "\C-w" 'tpu-write-current-buffers) ; ^W + (define-key map "\C-w" #'tpu-write-current-buffers) ; ^W ;; (define-key map "\C-X" nil) ; ^X ;; (define-key map "\C-Y" nil) ; ^Y ;; (define-key map "\C-Z" nil) ; ^Z - (define-key map " " 'undo) ; SPC + (define-key map " " #'undo) ; SPC ;; (define-key map "!" nil) ; ! ;; (define-key map "#" nil) ; # - (define-key map "$" 'tpu-add-at-eol) ; $ - (define-key map "%" 'tpu-goto-percent) ; % + (define-key map "$" #'tpu-add-at-eol) ; $ + (define-key map "%" #'tpu-goto-percent) ; % ;; (define-key map "&" nil) ; & ;; (define-key map "(" nil) ; ( ;; (define-key map ")" nil) ; ) - (define-key map "*" 'tpu-toggle-regexp) ; * + (define-key map "*" #'tpu-toggle-regexp) ; * ;; (define-key map "+" nil) ; + - (define-key map "," 'tpu-goto-breadcrumb) ; , - (define-key map "-" 'negative-argument) ; - - (define-key map "." 'tpu-drop-breadcrumb) ; . - (define-key map "/" 'tpu-emacs-replace) ; / - (define-key map "0" 'digit-argument) ; 0 - (define-key map "1" 'digit-argument) ; 1 - (define-key map "2" 'digit-argument) ; 2 - (define-key map "3" 'digit-argument) ; 3 - (define-key map "4" 'digit-argument) ; 4 - (define-key map "5" 'digit-argument) ; 5 - (define-key map "6" 'digit-argument) ; 6 - (define-key map "7" 'digit-argument) ; 7 - (define-key map "8" 'digit-argument) ; 8 - (define-key map "9" 'digit-argument) ; 9 + (define-key map "," #'tpu-goto-breadcrumb) ; , + (define-key map "-" #'negative-argument) ; - + (define-key map "." #'tpu-drop-breadcrumb) ; . + (define-key map "/" #'tpu-emacs-replace) ; / + (define-key map "0" #'digit-argument) ; 0 + (define-key map "1" #'digit-argument) ; 1 + (define-key map "2" #'digit-argument) ; 2 + (define-key map "3" #'digit-argument) ; 3 + (define-key map "4" #'digit-argument) ; 4 + (define-key map "5" #'digit-argument) ; 5 + (define-key map "6" #'digit-argument) ; 6 + (define-key map "7" #'digit-argument) ; 7 + (define-key map "8" #'digit-argument) ; 8 + (define-key map "9" #'digit-argument) ; 9 ;; (define-key map ":" nil) ; : - (define-key map ";" 'tpu-trim-line-ends) ; ; + (define-key map ";" #'tpu-trim-line-ends) ; ; ;; (define-key map "<" nil) ; < ;; (define-key map "=" nil) ; = ;; (define-key map ">" nil) ; > - (define-key map "?" 'tpu-spell-check) ; ? - ;; (define-key map "A" 'tpu-toggle-newline-and-indent) ; A - ;; (define-key map "B" 'tpu-next-buffer) ; B - ;; (define-key map "C" 'repeat-complex-command) ; C - ;; (define-key map "D" 'shell-command) ; D - ;; (define-key map "E" 'tpu-exit) ; E - ;; (define-key map "F" 'tpu-cursor-free-mode) ; F - ;; (define-key map "G" 'tpu-get) ; G + (define-key map "?" #'tpu-spell-check) ; ? + ;; (define-key map "A" #'tpu-toggle-newline-and-indent) ; A + ;; (define-key map "B" #'tpu-next-buffer) ; B + ;; (define-key map "C" #'repeat-complex-command) ; C + ;; (define-key map "D" #'shell-command) ; D + ;; (define-key map "E" #'tpu-exit) ; E + ;; (define-key map "F" #'tpu-cursor-free-mode) ; F + ;; (define-key map "G" #'tpu-get) ; G ;; (define-key map "H" nil) ; H - ;; (define-key map "I" 'tpu-include) ; I - ;; (define-key map "K" 'tpu-kill-buffer) ; K - (define-key map "L" 'tpu-what-line) ; L - ;; (define-key map "M" 'buffer-menu) ; M - ;; (define-key map "N" 'tpu-next-file-buffer) ; N - ;; (define-key map "O" 'occur) ; O - (define-key map "P" 'lpr-buffer) ; P - ;; (define-key map "Q" 'tpu-quit) ; Q - ;; (define-key map "R" 'tpu-toggle-rectangle) ; R - ;; (define-key map "S" 'replace) ; S - ;; (define-key map "T" 'tpu-line-to-top-of-window) ; T - ;; (define-key map "U" 'undo) ; U - ;; (define-key map "V" 'tpu-version) ; V - ;; (define-key map "W" 'save-buffer) ; W - ;; (define-key map "X" 'tpu-save-all-buffers-kill-emacs) ; X - ;; (define-key map "Y" 'copy-region-as-kill) ; Y - ;; (define-key map "Z" 'suspend-emacs) ; Z - (define-key map "[" 'blink-matching-open) ; [ + ;; (define-key map "I" #'tpu-include) ; I + ;; (define-key map "K" #'tpu-kill-buffer) ; K + (define-key map "L" #'tpu-what-line) ; L + ;; (define-key map "M" #'buffer-menu) ; M + ;; (define-key map "N" #'tpu-next-file-buffer) ; N + ;; (define-key map "O" #'occur) ; O + (define-key map "P" #'lpr-buffer) ; P + ;; (define-key map "Q" #'tpu-quit) ; Q + ;; (define-key map "R" #'tpu-toggle-rectangle) ; R + ;; (define-key map "S" #'replace) ; S + ;; (define-key map "T" #'tpu-line-to-top-of-window) ; T + ;; (define-key map "U" #'undo) ; U + ;; (define-key map "V" #'tpu-version) ; V + ;; (define-key map "W" #'save-buffer) ; W + ;; (define-key map "X" #'tpu-save-all-buffers-kill-emacs) ; X + ;; (define-key map "Y" #'copy-region-as-kill) ; Y + ;; (define-key map "Z" #'suspend-emacs) ; Z + (define-key map "[" #'blink-matching-open) ; [ ;; (define-key map "\\" nil) ; \ - (define-key map "]" 'blink-matching-open) ; ] - (define-key map "^" 'tpu-add-at-bol) ; ^ - (define-key map "_" 'split-window-below) ; - - (define-key map "`" 'what-line) ; ` - (define-key map "a" 'tpu-toggle-newline-and-indent) ; a - (define-key map "b" 'tpu-next-buffer) ; b - (define-key map "c" 'repeat-complex-command) ; c - (define-key map "d" 'shell-command) ; d - (define-key map "e" 'tpu-exit) ; e - (define-key map "f" 'tpu-cursor-free-mode) ; f - (define-key map "g" 'tpu-get) ; g + (define-key map "]" #'blink-matching-open) ; ] + (define-key map "^" #'tpu-add-at-bol) ; ^ + (define-key map "_" #'split-window-below) ; - + (define-key map "`" #'what-line) ; ` + (define-key map "a" #'tpu-toggle-newline-and-indent) ; a + (define-key map "b" #'tpu-next-buffer) ; b + (define-key map "c" #'repeat-complex-command) ; c + (define-key map "d" #'shell-command) ; d + (define-key map "e" #'tpu-exit) ; e + (define-key map "f" #'tpu-cursor-free-mode) ; f + (define-key map "g" #'tpu-get) ; g ;; (define-key map "h" nil) ; h - (define-key map "i" 'tpu-include) ; i - (define-key map "k" 'tpu-kill-buffer) ; k - (define-key map "l" 'goto-line) ; l - (define-key map "m" 'buffer-menu) ; m - (define-key map "n" 'tpu-next-file-buffer) ; n - (define-key map "o" 'occur) ; o - (define-key map "p" 'lpr-region) ; p - (define-key map "q" 'tpu-quit) ; q - (define-key map "r" 'tpu-toggle-rectangle) ; r - (define-key map "s" 'replace) ; s - (define-key map "t" 'tpu-line-to-top-of-window) ; t - (define-key map "u" 'undo) ; u - (define-key map "v" 'tpu-version) ; v - (define-key map "w" 'save-buffer) ; w - (define-key map "x" 'tpu-save-all-buffers-kill-emacs) ; x - (define-key map "y" 'copy-region-as-kill) ; y - (define-key map "z" 'suspend-emacs) ; z + (define-key map "i" #'tpu-include) ; i + (define-key map "k" #'tpu-kill-buffer) ; k + (define-key map "l" #'goto-line) ; l + (define-key map "m" #'buffer-menu) ; m + (define-key map "n" #'tpu-next-file-buffer) ; n + (define-key map "o" #'occur) ; o + (define-key map "p" #'lpr-region) ; p + (define-key map "q" #'tpu-quit) ; q + (define-key map "r" #'tpu-toggle-rectangle) ; r + (define-key map "s" #'replace) ; s + (define-key map "t" #'tpu-line-to-top-of-window) ; t + (define-key map "u" #'undo) ; u + (define-key map "v" #'tpu-version) ; v + (define-key map "w" #'save-buffer) ; w + (define-key map "x" #'tpu-save-all-buffers-kill-emacs) ; x + (define-key map "y" #'copy-region-as-kill) ; y + (define-key map "z" #'suspend-emacs) ; z ;; (define-key map "{" nil) ; { - (define-key map "|" 'split-window-right) ; | + (define-key map "|" #'split-window-right) ; | ;; (define-key map "}" nil) ; } - (define-key map "~" 'exchange-point-and-mark) ; ~ - (define-key map "\177" 'delete-window) ; <X] + (define-key map "~" #'exchange-point-and-mark) ; ~ + (define-key map "\177" #'delete-window) ; <X] map) "Maps the function keys on the VT100 keyboard preceded by PF1. GOLD is the ASCII 7-bit escape sequence <ESC>OP.") @@ -492,12 +489,12 @@ GOLD is the ASCII 7-bit escape sequence <ESC>OP.") ;; Previously defined in CSI-map. We now presume that term/*.el does ;; its job to map the escape sequence to the right key-symbol. - (define-key map [find] 'tpu-search) ; Find - (define-key map [insert] 'tpu-paste) ; Insert Here - (define-key map [delete] 'tpu-cut) ; Remove - (define-key map [select] 'tpu-select) ; Select - (define-key map [prior] 'tpu-scroll-window-down) ; Prev Screen - (define-key map [next] 'tpu-scroll-window-up) ; Next Screen + (define-key map [find] #'tpu-search) ; Find + (define-key map [insert] #'tpu-paste) ; Insert Here + (define-key map [delete] #'tpu-cut) ; Remove + (define-key map [select] #'tpu-select) ; Select + (define-key map [prior] #'tpu-scroll-window-down) ; Prev Screen + (define-key map [next] #'tpu-scroll-window-up) ; Next Screen ;; (define-key map [f1] nil) ; F1 ;; (define-key map [f2] nil) ; F2 @@ -508,14 +505,14 @@ GOLD is the ASCII 7-bit escape sequence <ESC>OP.") ;; (define-key map [f7] nil) ; F7 ;; (define-key map [f8] nil) ; F8 ;; (define-key map [f9] nil) ; F9 - (define-key map [f10] 'tpu-exit) ; F10 - (define-key map [f11] 'tpu-insert-escape) ; F11 (ESC) - (define-key map [f12] 'tpu-next-beginning-of-line) ; F12 (BS) - (define-key map [f13] 'tpu-delete-previous-word) ; F13 (LF) - (define-key map [f14] 'tpu-toggle-overwrite-mode) ; F14 - (define-key map [help] 'tpu-help) ; HELP - (define-key map [menu] 'execute-extended-command) ; DO - (define-key map [f17] 'tpu-goto-breadcrumb) ; F17 + (define-key map [f10] #'tpu-exit) ; F10 + (define-key map [f11] #'tpu-insert-escape) ; F11 (ESC) + (define-key map [f12] #'tpu-next-beginning-of-line) ; F12 (BS) + (define-key map [f13] #'tpu-delete-previous-word) ; F13 (LF) + (define-key map [f14] #'tpu-toggle-overwrite-mode) ; F14 + (define-key map [help] #'tpu-help) ; HELP + (define-key map [menu] #'execute-extended-command) ; DO + (define-key map [f17] #'tpu-goto-breadcrumb) ; F17 ;; (define-key map [f18] nil) ; F18 ;; (define-key map [f19] nil) ; F19 ;; (define-key map [f20] nil) ; F20 @@ -525,28 +522,28 @@ GOLD is the ASCII 7-bit escape sequence <ESC>OP.") ;; its job to map the escape sequence to the right key-symbol. (define-key map [kp-f1] tpu-gold-map) ; GOLD map ;; - (define-key map [up] 'tpu-previous-line) ; up - (define-key map [down] 'tpu-next-line) ; down - (define-key map [right] 'tpu-forward-char) ; right - (define-key map [left] 'tpu-backward-char) ; left - - (define-key map [kp-f2] 'tpu-help) ; PF2 - (define-key map [kp-f3] 'tpu-search-again) ; PF3 - (define-key map [kp-f4] 'tpu-delete-current-line) ; PF4 - (define-key map [kp-0] 'tpu-line) ; KP0 - (define-key map [kp-1] 'tpu-word) ; KP1 - (define-key map [kp-2] 'tpu-end-of-line) ; KP2 - (define-key map [kp-3] 'tpu-char) ; KP3 - (define-key map [kp-4] 'tpu-advance-direction) ; KP4 - (define-key map [kp-5] 'tpu-backup-direction) ; KP5 - (define-key map [kp-6] 'tpu-cut) ; KP6 - (define-key map [kp-7] 'tpu-page) ; KP7 - (define-key map [kp-8] 'tpu-scroll-window) ; KP8 - (define-key map [kp-9] 'tpu-append-region) ; KP9 - (define-key map [kp-subtract] 'tpu-delete-current-word) ; KP- - (define-key map [kp-separator] 'tpu-delete-current-char) ; KP, - (define-key map [kp-decimal] 'tpu-select) ; KP. - (define-key map [kp-enter] 'newline) ; KPenter + (define-key map [up] #'tpu-previous-line) ; up + (define-key map [down] #'tpu-next-line) ; down + (define-key map [right] #'tpu-forward-char) ; right + (define-key map [left] #'tpu-backward-char) ; left + + (define-key map [kp-f2] #'tpu-help) ; PF2 + (define-key map [kp-f3] #'tpu-search-again) ; PF3 + (define-key map [kp-f4] #'tpu-delete-current-line) ; PF4 + (define-key map [kp-0] #'tpu-line) ; KP0 + (define-key map [kp-1] #'tpu-word) ; KP1 + (define-key map [kp-2] #'tpu-end-of-line) ; KP2 + (define-key map [kp-3] #'tpu-char) ; KP3 + (define-key map [kp-4] #'tpu-advance-direction) ; KP4 + (define-key map [kp-5] #'tpu-backup-direction) ; KP5 + (define-key map [kp-6] #'tpu-cut) ; KP6 + (define-key map [kp-7] #'tpu-page) ; KP7 + (define-key map [kp-8] #'tpu-scroll-window) ; KP8 + (define-key map [kp-9] #'tpu-append-region) ; KP9 + (define-key map [kp-subtract] #'tpu-delete-current-word) ; KP- + (define-key map [kp-separator] #'tpu-delete-current-char) ; KP, + (define-key map [kp-decimal] #'tpu-select) ; KP. + (define-key map [kp-enter] #'newline) ; KPenter map) "TPU-edt global keymap.") @@ -883,7 +880,7 @@ With argument, fill and justify." if no region is selected." (interactive) (let ((m (tpu-mark))) - (apply 'ispell-region + (apply #'ispell-region (if m (if (> m (point)) (list (point) m) (list m (point))) @@ -970,14 +967,14 @@ and the total number of lines in the buffer." ;;;###autoload (define-minor-mode tpu-edt-mode "Toggle TPU/edt emulation on or off." - :global t :group 'tpu + :global t (if tpu-edt-mode (tpu-edt-on) (tpu-edt-off))) -(defalias 'TPU-EDT-MODE 'tpu-edt-mode) +(defalias 'TPU-EDT-MODE #'tpu-edt-mode) ;;;###autoload -(defalias 'tpu-edt 'tpu-edt-on) -(defalias 'TPU-EDT 'tpu-edt-on) +(defalias 'tpu-edt #'tpu-edt-on) +(defalias 'TPU-EDT #'tpu-edt-on) ;; Note: The following functions have no `tpu-' prefix. This is unavoidable. ;; The real TPU/edt editor has interactive commands with these names, @@ -985,42 +982,42 @@ and the total number of lines in the buffer." ;; to work. Therefore it really is necessary to define these functions, ;; even in cases where they redefine existing Emacs functions. -(defalias 'exit 'tpu-exit) -(defalias 'EXIT 'tpu-exit) +(defalias 'exit #'tpu-exit) +(defalias 'EXIT #'tpu-exit) -(defalias 'Get 'tpu-get) -(defalias 'GET 'tpu-get) +(defalias 'Get #'tpu-get) +(defalias 'GET #'tpu-get) -(defalias 'include 'tpu-include) -(defalias 'INCLUDE 'tpu-include) +(defalias 'include #'tpu-include) +(defalias 'INCLUDE #'tpu-include) -(defalias 'quit 'tpu-quit) -(defalias 'QUIT 'tpu-quit) +(defalias 'quit #'tpu-quit) +(defalias 'QUIT #'tpu-quit) -(defalias 'spell 'tpu-spell-check) -(defalias 'SPELL 'tpu-spell-check) +(defalias 'spell #'tpu-spell-check) +(defalias 'SPELL #'tpu-spell-check) -(defalias 'what\ line 'tpu-what-line) -(defalias 'WHAT\ LINE 'tpu-what-line) +(defalias 'what\ line #'tpu-what-line) +(defalias 'WHAT\ LINE #'tpu-what-line) -(defalias 'replace 'tpu-lm-replace) -(defalias 'REPLACE 'tpu-lm-replace) +(defalias 'replace #'tpu-lm-replace) +(defalias 'REPLACE #'tpu-lm-replace) -(defalias 'help 'tpu-help) -(defalias 'HELP 'tpu-help) +(defalias 'help #'tpu-help) +(defalias 'HELP #'tpu-help) -(defalias 'set\ cursor\ free 'tpu-set-cursor-free) -(defalias 'SET\ CURSOR\ FREE 'tpu-set-cursor-free) +(defalias 'set\ cursor\ free #'tpu-set-cursor-free) +(defalias 'SET\ CURSOR\ FREE #'tpu-set-cursor-free) -(defalias 'set\ cursor\ bound 'tpu-set-cursor-bound) -(defalias 'SET\ CURSOR\ BOUND 'tpu-set-cursor-bound) +(defalias 'set\ cursor\ bound #'tpu-set-cursor-bound) +(defalias 'SET\ CURSOR\ BOUND #'tpu-set-cursor-bound) -(defalias 'set\ scroll\ margins 'tpu-set-scroll-margins) -(defalias 'SET\ SCROLL\ MARGINS 'tpu-set-scroll-margins) +(defalias 'set\ scroll\ margins #'tpu-set-scroll-margins) +(defalias 'SET\ SCROLL\ MARGINS #'tpu-set-scroll-margins) ;; Real TPU error messages end in periods. ;; Define this to avoid openly flouting Emacs coding standards. -(defalias 'tpu-error 'error) +(defalias 'tpu-error #'error) ;;; @@ -1227,7 +1224,7 @@ and the total number of lines in the buffer." "Bind a set of keystrokes to a single key, or key combination." (interactive) (setq tpu-saved-control-r (global-key-binding "\C-r")) - (global-set-key "\C-r" 'tpu-end-define-macro-key) + (global-set-key "\C-r" #'tpu-end-define-macro-key) (start-kbd-macro nil)) @@ -1361,18 +1358,18 @@ If an argument is specified, don't set the search direction." (if (not arg) (setq tpu-searching-forward tpu-advance)) (cond (tpu-searching-forward (cond (tpu-regexp-p - (fset 'tpu-emacs-search 're-search-forward) - (fset 'tpu-emacs-rev-search 're-search-backward)) + (fset 'tpu-emacs-search #'re-search-forward) + (fset 'tpu-emacs-rev-search #'re-search-backward)) (t - (fset 'tpu-emacs-search 'search-forward) - (fset 'tpu-emacs-rev-search 'search-backward)))) + (fset 'tpu-emacs-search #'search-forward) + (fset 'tpu-emacs-rev-search #'search-backward)))) (t (cond (tpu-regexp-p - (fset 'tpu-emacs-search 're-search-backward) - (fset 'tpu-emacs-rev-search 're-search-forward)) + (fset 'tpu-emacs-search #'re-search-backward) + (fset 'tpu-emacs-rev-search #'re-search-forward)) (t - (fset 'tpu-emacs-search 'search-backward) - (fset 'tpu-emacs-rev-search 'search-forward)))))) + (fset 'tpu-emacs-search #'search-backward) + (fset 'tpu-emacs-rev-search #'search-forward)))))) (defun tpu-search-internal (pat &optional quiet) "Search for a string or regular expression." @@ -2203,18 +2200,18 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll." ;; Standard Emacs settings under xterm in function-key-map map ;; "\eOM" to [kp-enter] and [kp-enter] to RET, but since the output of the map ;; is not fed back into the map, the key stays as kp-enter :-(. -(define-key minibuffer-local-map [kp-enter] 'exit-minibuffer) +(define-key minibuffer-local-map [kp-enter] #'exit-minibuffer) ;; These are not necessary because they are inherited. ;; (define-key minibuffer-local-ns-map [kp-enter] 'exit-minibuffer) ;; (define-key minibuffer-local-completion-map [kp-enter] 'exit-minibuffer) -(define-key minibuffer-local-must-match-map [kp-enter] 'minibuffer-complete-and-exit) +(define-key minibuffer-local-must-match-map [kp-enter] #'minibuffer-complete-and-exit) ;;; ;;; Minibuffer map additions to set search direction ;;; -(define-key minibuffer-local-map [kp-4] 'tpu-search-forward-exit) ;KP4 -(define-key minibuffer-local-map [kp-5] 'tpu-search-backward-exit) ;KP5 +(define-key minibuffer-local-map [kp-4] #'tpu-search-forward-exit) ;KP4 +(define-key minibuffer-local-map [kp-5] #'tpu-search-backward-exit) ;KP5 ;;; @@ -2223,19 +2220,19 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll." (defvar tpu-control-keys-map (let ((map (make-sparse-keymap))) - (define-key map "\C-\\" 'quoted-insert) ; ^\ - (define-key map "\C-a" 'tpu-toggle-overwrite-mode) ; ^A - (define-key map "\C-b" 'repeat-complex-command) ; ^B - (define-key map "\C-e" 'tpu-current-end-of-line) ; ^E - (define-key map "\C-h" 'tpu-next-beginning-of-line) ; ^H (BS) - (define-key map "\C-j" 'tpu-delete-previous-word) ; ^J (LF) - (define-key map "\C-k" 'tpu-define-macro-key) ; ^K - (define-key map "\C-l" 'tpu-insert-formfeed) ; ^L (FF) - (define-key map "\C-r" 'recenter) ; ^R - (define-key map "\C-u" 'tpu-delete-to-bol) ; ^U - (define-key map "\C-v" 'tpu-quoted-insert) ; ^V - (define-key map "\C-w" 'redraw-display) ; ^W - (define-key map "\C-z" 'tpu-exit) ; ^Z + (define-key map "\C-\\" #'quoted-insert) ; ^\ + (define-key map "\C-a" #'tpu-toggle-overwrite-mode) ; ^A + (define-key map "\C-b" #'repeat-complex-command) ; ^B + (define-key map "\C-e" #'tpu-current-end-of-line) ; ^E + (define-key map "\C-h" #'tpu-next-beginning-of-line) ; ^H (BS) + (define-key map "\C-j" #'tpu-delete-previous-word) ; ^J (LF) + (define-key map "\C-k" #'tpu-define-macro-key) ; ^K + (define-key map "\C-l" #'tpu-insert-formfeed) ; ^L (FF) + (define-key map "\C-r" #'recenter) ; ^R + (define-key map "\C-u" #'tpu-delete-to-bol) ; ^U + (define-key map "\C-v" #'tpu-quoted-insert) ; ^V + (define-key map "\C-w" #'redraw-display) ; ^W + (define-key map "\C-z" #'tpu-exit) ; ^Z map)) (defun tpu-set-control-keys () @@ -2285,18 +2282,18 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll." (defun tpu-arrow-history nil "Modify minibuffer maps to use arrows for history recall." (interactive) - (dolist (cur (where-is-internal 'tpu-previous-line)) - (define-key read-expression-map cur 'tpu-previous-history-element) - (define-key minibuffer-local-map cur 'tpu-previous-history-element) + (dolist (cur (where-is-internal #'tpu-previous-line)) + (define-key read-expression-map cur #'tpu-previous-history-element) + (define-key minibuffer-local-map cur #'tpu-previous-history-element) ;; These are inherited anyway. --Stef ;; (define-key minibuffer-local-ns-map cur 'tpu-previous-history-element) ;; (define-key minibuffer-local-completion-map cur 'tpu-previous-history-element) ;; (define-key minibuffer-local-must-match-map cur 'tpu-previous-history-element) ) - (dolist (cur (where-is-internal 'tpu-next-line)) - (define-key read-expression-map cur 'tpu-next-history-element) - (define-key minibuffer-local-map cur 'tpu-next-history-element) + (dolist (cur (where-is-internal #'tpu-next-line)) + (define-key read-expression-map cur #'tpu-next-history-element) + (define-key minibuffer-local-map cur #'tpu-next-history-element) ;; These are inherited anyway. --Stef ;; (define-key minibuffer-local-ns-map cur 'tpu-next-history-element) ;; (define-key minibuffer-local-completion-map cur 'tpu-next-history-element) @@ -2382,7 +2379,7 @@ If FILE is nil, try to load a default file. The default file names are (use-global-map global-map) ;; Then do the normal TPU setup. (transient-mark-mode t) - (add-hook 'post-command-hook 'tpu-search-highlight) + (add-hook 'post-command-hook #'tpu-search-highlight) (tpu-set-mode-line t) (tpu-advance-direction) ;; set page delimiter, display line truncation, and scrolling like TPU @@ -2406,7 +2403,7 @@ If FILE is nil, try to load a default file. The default file names are "Turn off TPU/edt emulation. Note that the keypad is left on." (interactive) (tpu-reset-control-keys nil) - (remove-hook 'post-command-hook 'tpu-search-highlight) + (remove-hook 'post-command-hook #'tpu-search-highlight) (tpu-set-mode-line nil) (while tpu-edt-old-global-values (let ((varval (pop tpu-edt-old-global-values))) diff --git a/lisp/obsolete/tpu-extras.el b/lisp/obsolete/tpu-extras.el index 10b9c893721..5d59945c562 100644 --- a/lisp/obsolete/tpu-extras.el +++ b/lisp/obsolete/tpu-extras.el @@ -1,4 +1,4 @@ -;;; tpu-extras.el --- scroll margins and free cursor mode for TPU-edt +;;; tpu-extras.el --- scroll margins and free cursor mode for TPU-edt -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc. @@ -144,12 +144,12 @@ the previous line when starting from a line beginning." ;;; Hooks -- Set cursor free in picture mode. ;;; Clean up when writing a file from cursor free mode. -(add-hook 'picture-mode-hook 'tpu-set-cursor-free) +(add-hook 'picture-mode-hook #'tpu-set-cursor-free) (defun tpu-trim-line-ends-if-needed () "Eliminate whitespace at ends of lines, if the cursor is free." (if (and (buffer-modified-p) tpu-cursor-free-mode) (tpu-trim-line-ends))) -(add-hook 'before-save-hook 'tpu-trim-line-ends-if-needed) +(add-hook 'before-save-hook #'tpu-trim-line-ends-if-needed) ;;; Utility routines for implementing scroll margins diff --git a/lisp/obsolete/tpu-mapper.el b/lisp/obsolete/tpu-mapper.el index 2735820ae49..d23068ac469 100644 --- a/lisp/obsolete/tpu-mapper.el +++ b/lisp/obsolete/tpu-mapper.el @@ -1,4 +1,4 @@ -;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file +;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1995, 2001-2021 Free Software Foundation, Inc. diff --git a/lisp/obsolete/url-ns.el b/lisp/obsolete/url-ns.el index fff3be95453..b62ad829990 100644 --- a/lisp/obsolete/url-ns.el +++ b/lisp/obsolete/url-ns.el @@ -1,4 +1,4 @@ -;;; url-ns.el --- Various netscape-ish functions for proxy definitions +;;; url-ns.el --- Various netscape-ish functions for proxy definitions -*- lexical-binding: t; -*- ;; Copyright (C) 1997-1999, 2004-2021 Free Software Foundation, Inc. @@ -55,9 +55,9 @@ (if (or (/= (length netc) (length ipc)) (/= (length ipc) (length maskc))) nil - (setq netc (mapcar 'string-to-number netc) - ipc (mapcar 'string-to-number ipc) - maskc (mapcar 'string-to-number maskc)) + (setq netc (mapcar #'string-to-number netc) + ipc (mapcar #'string-to-number ipc) + maskc (mapcar #'string-to-number maskc)) (and (= (logand (nth 0 netc) (nth 0 maskc)) (logand (nth 0 ipc) (nth 0 maskc))) @@ -79,24 +79,23 @@ (if (not (and (file-exists-p file) (file-readable-p file))) (message "Could not open %s for reading" file) - (save-excursion - (let ((false nil) - (true t)) - (setq url-ns-user-prefs (make-hash-table :size 13 :test 'equal)) - (set-buffer (get-buffer-create " *ns-parse*")) - (erase-buffer) - (insert-file-contents file) - (goto-char (point-min)) - (while (re-search-forward "^//" nil t) - (replace-match ";;")) - (goto-char (point-min)) - (while (re-search-forward "^user_pref(" nil t) - (replace-match "(url-ns-set-user-pref ")) - (goto-char (point-min)) - (while (re-search-forward "\"," nil t) - (replace-match "\"")) - (goto-char (point-min)) - (eval-buffer))))) + (setq url-ns-user-prefs (make-hash-table :size 13 :test 'equal)) + (with-current-buffer (get-buffer-create " *ns-parse*") + (erase-buffer) + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward "^//" nil t) + (replace-match ";;")) + (goto-char (point-min)) + (while (re-search-forward "^user_pref(" nil t) + (replace-match "(url-ns-set-user-pref ")) + (goto-char (point-min)) + (while (re-search-forward "\"," nil t) + (replace-match "\"")) + (goto-char (point-min)) + (with-suppressed-warnings ((lexical true false)) + (dlet ((false nil) (true t)) + (eval-buffer)))))) (defun url-ns-set-user-pref (key val) (puthash key val url-ns-user-prefs)) diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el index 80a2094d804..00e7d26cd75 100644 --- a/lisp/obsolete/vc-arch.el +++ b/lisp/obsolete/vc-arch.el @@ -81,8 +81,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-arch) + :version "23.1") (define-obsolete-variable-alias 'vc-arch-command 'vc-arch-program "23.1") @@ -92,8 +91,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (setq candidates (cdr candidates))) (or (car candidates) "tla")) "Name of the Arch executable." - :type 'string - :group 'vc-arch) + :type 'string) ;; Clear up the cache to force vc-call to check again and discover ;; new functions when we reload this file. @@ -341,7 +339,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see ("--" . permissions-changed) ("-/" . permissions-changed) ;directory )) - (state-map-regexp (regexp-opt (mapcar 'car state-map) t)) + (state-map-regexp (regexp-opt (mapcar #'car state-map) t)) (entry-regexp (concat "^" state-map-regexp " \\(.*\\)$")) result) (goto-char (point-min)) @@ -387,8 +385,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (defcustom vc-arch-mode-line-rewrite '(("\\`.*--\\(.*--.*\\)--\\(v?\\).*-\\([0-9]+\\)\\'" . "\\2\\3[\\1]")) "Rewrite rules to shorten Arch's revision names on the mode-line." - :type '(repeat (cons regexp string)) - :group 'vc-arch) + :type '(repeat (cons regexp string))) (defun vc-arch-mode-line-string (file) "Return a string for `vc-mode-line' to put in the mode line for FILE." @@ -420,7 +417,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see ;; The .rej file is obsolete. (condition-case nil (delete-file rej) (error nil)) ;; Remove the hook so that it is not called multiple times. - (remove-hook 'after-save-hook 'vc-arch-delete-rej-if-obsolete t)))))) + (remove-hook 'after-save-hook #'vc-arch-delete-rej-if-obsolete t)))))) (defun vc-arch-find-file-hook () (let ((rej (concat buffer-file-name ".rej"))) @@ -433,7 +430,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (condition-case nil (delete-file rej) (error nil)) (smerge-mode 1) (add-hook 'after-save-hook - 'vc-arch-delete-rej-if-obsolete nil t) + #'vc-arch-delete-rej-if-obsolete nil t) (message "There are unresolved conflicts in this file"))) (message "There are unresolved conflicts in %s" (file-name-nondirectory rej)))))) @@ -488,11 +485,11 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (defun vc-arch-rename-file (old new) (vc-arch-command nil 0 new "mv" (file-relative-name old))) -(defalias 'vc-arch-responsible-p 'vc-arch-root) +(defalias 'vc-arch-responsible-p #'vc-arch-root) (defun vc-arch-command (buffer okstatus file &rest flags) "A wrapper around `vc-do-command' for use in vc-arch.el." - (apply 'vc-do-command (or buffer "*vc*") okstatus vc-arch-program file flags)) + (apply #'vc-do-command (or buffer "*vc*") okstatus vc-arch-program file flags)) ;;; Completion of versions and revisions. @@ -571,7 +568,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (when (string-match "-\\([0-9]+\\)\\'" f) (cons (string-to-number (match-string 1 f)) f))) (directory-files dir nil nil 'nosort))) - 'car-less-than-car)) + #'car-less-than-car)) (subdirs nil)) (when (cddr revs) (dotimes (_i (/ (length revs) 2)) @@ -600,26 +597,26 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (let* ((archives (directory-files rl-dir 'full directory-files-no-dot-files-regexp)) (categories - (apply 'append + (apply #'append (mapcar (lambda (dir) (when (file-directory-p dir) (directory-files dir 'full directory-files-no-dot-files-regexp))) archives))) (branches - (apply 'append + (apply #'append (mapcar (lambda (dir) (when (file-directory-p dir) (directory-files dir 'full directory-files-no-dot-files-regexp))) categories))) (versions - (apply 'append + (apply #'append (mapcar (lambda (dir) (when (file-directory-p dir) (directory-files dir 'full "--.*--"))) branches)))) - (mapc 'vc-arch-trim-one-revlib versions)) + (mapc #'vc-arch-trim-one-revlib versions)) )) (defvar vc-arch-extra-menu-map diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el index eee00b43a26..91baa4d28ef 100644 --- a/lisp/obsolete/vi.el +++ b/lisp/obsolete/vi.el @@ -1,4 +1,4 @@ -;;; vi.el --- major mode for emulating "vi" editor under GNU Emacs +;;; vi.el --- major mode for emulating "vi" editor under GNU Emacs -*- lexical-binding: t; -*- ;; This file is in the public domain because the authors distributed it ;; without a copyright notice before the US signed the Bern Convention. @@ -48,7 +48,7 @@ (defvar vi-mode-old-case-fold) (if (null (where-is-internal 'vi-switch-mode (current-local-map))) - (define-key ctl-x-map "~" 'vi-switch-mode)) + (define-key ctl-x-map "~" #'vi-switch-mode)) (defvar vi-tilde-map nil "Keymap used for \\[vi-switch-mode] prefix key. Link to various major modes.") @@ -56,24 +56,24 @@ (if vi-tilde-map nil (setq vi-tilde-map (make-keymap)) - (define-key vi-tilde-map "a" 'abbrev-mode) - (define-key vi-tilde-map "c" 'c-mode) - (define-key vi-tilde-map "d" 'vi-debugging) - (define-key vi-tilde-map "e" 'emacs-lisp-mode) - (define-key vi-tilde-map "f" 'auto-fill-mode) - (define-key vi-tilde-map "g" 'prolog-mode) - (define-key vi-tilde-map "h" 'hanoi) - (define-key vi-tilde-map "i" 'info-mode) - (define-key vi-tilde-map "l" 'lisp-mode) - (define-key vi-tilde-map "n" 'nroff-mode) - (define-key vi-tilde-map "o" 'overwrite-mode) - (define-key vi-tilde-map "O" 'outline-mode) - (define-key vi-tilde-map "P" 'picture-mode) - (define-key vi-tilde-map "r" 'vi-readonly-mode) - (define-key vi-tilde-map "t" 'text-mode) - (define-key vi-tilde-map "v" 'vi-mode) - (define-key vi-tilde-map "x" 'tex-mode) - (define-key vi-tilde-map "~" 'vi-back-to-old-mode)) + (define-key vi-tilde-map "a" #'abbrev-mode) + (define-key vi-tilde-map "c" #'c-mode) + (define-key vi-tilde-map "d" #'vi-debugging) + (define-key vi-tilde-map "e" #'emacs-lisp-mode) + (define-key vi-tilde-map "f" #'auto-fill-mode) + (define-key vi-tilde-map "g" #'prolog-mode) + (define-key vi-tilde-map "h" #'hanoi) + ;; (define-key vi-tilde-map "i" #'info-mode) + (define-key vi-tilde-map "l" #'lisp-mode) + (define-key vi-tilde-map "n" #'nroff-mode) + (define-key vi-tilde-map "o" #'overwrite-mode) + (define-key vi-tilde-map "O" #'outline-mode) + (define-key vi-tilde-map "P" #'picture-mode) + (define-key vi-tilde-map "r" #'vi-readonly-mode) + (define-key vi-tilde-map "t" #'text-mode) + (define-key vi-tilde-map "v" #'vi-mode) + (define-key vi-tilde-map "x" #'tex-mode) + (define-key vi-tilde-map "~" #'vi-back-to-old-mode)) (defun vi-switch-mode (arg mode-char) "Switch the major mode of current buffer as specified by the following char \\{vi-tilde-map}" @@ -123,143 +123,143 @@ command extensions.") (put 'vi-undefined 'suppress-keymap t) (if vi-com-map nil (setq vi-com-map (make-keymap)) -;;(fillarray vi-com-map 'vi-undefined) - (define-key vi-com-map "\C-@" 'vi-mark-region) ; extension - (define-key vi-com-map "\C-a" 'vi-ask-for-info) ; extension - (define-key vi-com-map "\C-b" 'vi-backward-windowful) - (define-key vi-com-map "\C-c" 'vi-do-old-mode-C-c-command) ; extension - (define-key vi-com-map "\C-d" 'vi-scroll-down-window) - (define-key vi-com-map "\C-e" 'vi-expose-line-below) - (define-key vi-com-map "\C-f" 'vi-forward-windowful) - (define-key vi-com-map "\C-g" 'keyboard-quit) - (define-key vi-com-map "\C-i" 'indent-relative-first-indent-point) ; TAB - (define-key vi-com-map "\C-j" 'vi-next-line) ; LFD - (define-key vi-com-map "\C-k" 'vi-kill-line) ; extension - (define-key vi-com-map "\C-l" 'recenter) - (define-key vi-com-map "\C-m" 'vi-next-line-first-nonwhite) ; RET - (define-key vi-com-map "\C-n" 'vi-next-line) - (define-key vi-com-map "\C-o" 'vi-split-open-line) - (define-key vi-com-map "\C-p" 'previous-line) - (define-key vi-com-map "\C-q" 'vi-query-replace) ; extension - (define-key vi-com-map "\C-r" 'vi-isearch-backward) ; modification - (define-key vi-com-map "\C-s" 'vi-isearch-forward) ; extension - (define-key vi-com-map "\C-t" 'vi-transpose-objects) ; extension - (define-key vi-com-map "\C-u" 'vi-scroll-up-window) - (define-key vi-com-map "\C-v" 'scroll-up-command) ; extension - (define-key vi-com-map "\C-w" 'vi-kill-region) ; extension +;;(fillarray vi-com-map #'vi-undefined) + (define-key vi-com-map "\C-@" #'vi-mark-region) ; extension + (define-key vi-com-map "\C-a" #'vi-ask-for-info) ; extension + (define-key vi-com-map "\C-b" #'vi-backward-windowful) + (define-key vi-com-map "\C-c" #'vi-do-old-mode-C-c-command) ; extension + (define-key vi-com-map "\C-d" #'vi-scroll-down-window) + (define-key vi-com-map "\C-e" #'vi-expose-line-below) + (define-key vi-com-map "\C-f" #'vi-forward-windowful) + (define-key vi-com-map "\C-g" #'keyboard-quit) + (define-key vi-com-map "\C-i" #'indent-relative-first-indent-point) ; TAB + (define-key vi-com-map "\C-j" #'vi-next-line) ; LFD + (define-key vi-com-map "\C-k" #'vi-kill-line) ; extension + (define-key vi-com-map "\C-l" #'recenter) + (define-key vi-com-map "\C-m" #'vi-next-line-first-nonwhite) ; RET + (define-key vi-com-map "\C-n" #'vi-next-line) + (define-key vi-com-map "\C-o" #'vi-split-open-line) + (define-key vi-com-map "\C-p" #'previous-line) + (define-key vi-com-map "\C-q" #'vi-query-replace) ; extension + (define-key vi-com-map "\C-r" #'vi-isearch-backward) ; modification + (define-key vi-com-map "\C-s" #'vi-isearch-forward) ; extension + (define-key vi-com-map "\C-t" #'vi-transpose-objects) ; extension + (define-key vi-com-map "\C-u" #'vi-scroll-up-window) + (define-key vi-com-map "\C-v" #'scroll-up-command) ; extension + (define-key vi-com-map "\C-w" #'vi-kill-region) ; extension (define-key vi-com-map "\C-x" 'Control-X-prefix) ; extension - (define-key vi-com-map "\C-y" 'vi-expose-line-above) - (define-key vi-com-map "\C-z" 'suspend-emacs) + (define-key vi-com-map "\C-y" #'vi-expose-line-above) + (define-key vi-com-map "\C-z" #'suspend-emacs) (define-key vi-com-map "\e" 'ESC-prefix); C-[ (ESC) - (define-key vi-com-map "\C-\\" 'vi-unimplemented) - (define-key vi-com-map "\C-]" 'find-tag) - (define-key vi-com-map "\C-^" 'vi-locate-def) ; extension - (define-key vi-com-map "\C-_" 'vi-undefined) - - (define-key vi-com-map " " 'forward-char) - (define-key vi-com-map "!" 'vi-operator) - (define-key vi-com-map "\"" 'vi-char-argument) - (define-key vi-com-map "#" 'universal-argument) ; extension - (define-key vi-com-map "$" 'end-of-line) - (define-key vi-com-map "%" 'vi-find-matching-paren) - (define-key vi-com-map "&" 'vi-unimplemented) - (define-key vi-com-map "'" 'vi-goto-line-mark) - (define-key vi-com-map "(" 'backward-sexp) - (define-key vi-com-map ")" 'forward-sexp) - (define-key vi-com-map "*" 'vi-name-last-change-or-macro) ; extension - (define-key vi-com-map "+" 'vi-next-line-first-nonwhite) - (define-key vi-com-map "," 'vi-reverse-last-find-char) - (define-key vi-com-map "-" 'vi-previous-line-first-nonwhite) - (define-key vi-com-map "." 'vi-redo-last-change-command) - (define-key vi-com-map "/" 'vi-search-forward) - (define-key vi-com-map "0" 'beginning-of-line) - - (define-key vi-com-map "1" 'vi-digit-argument) - (define-key vi-com-map "2" 'vi-digit-argument) - (define-key vi-com-map "3" 'vi-digit-argument) - (define-key vi-com-map "4" 'vi-digit-argument) - (define-key vi-com-map "5" 'vi-digit-argument) - (define-key vi-com-map "6" 'vi-digit-argument) - (define-key vi-com-map "7" 'vi-digit-argument) - (define-key vi-com-map "8" 'vi-digit-argument) - (define-key vi-com-map "9" 'vi-digit-argument) - - (define-key vi-com-map ":" 'vi-ex-cmd) - (define-key vi-com-map ";" 'vi-repeat-last-find-char) - (define-key vi-com-map "<" 'vi-operator) - (define-key vi-com-map "=" 'vi-operator) - (define-key vi-com-map ">" 'vi-operator) - (define-key vi-com-map "?" 'vi-search-backward) - (define-key vi-com-map "@" 'vi-call-named-change-or-macro) ; extension - - (define-key vi-com-map "A" 'vi-append-at-end-of-line) - (define-key vi-com-map "B" 'vi-backward-blank-delimited-word) - (define-key vi-com-map "C" 'vi-change-rest-of-line) - (define-key vi-com-map "D" 'vi-kill-line) - (define-key vi-com-map "E" 'vi-end-of-blank-delimited-word) - (define-key vi-com-map "F" 'vi-backward-find-char) - (define-key vi-com-map "G" 'vi-goto-line) - (define-key vi-com-map "H" 'vi-home-window-line) - (define-key vi-com-map "I" 'vi-insert-before-first-nonwhite) - (define-key vi-com-map "J" 'vi-join-lines) - (define-key vi-com-map "K" 'vi-undefined) - (define-key vi-com-map "L" 'vi-last-window-line) - (define-key vi-com-map "M" 'vi-middle-window-line) - (define-key vi-com-map "N" 'vi-reverse-last-search) - (define-key vi-com-map "O" 'vi-open-above) - (define-key vi-com-map "P" 'vi-put-before) - (define-key vi-com-map "Q" 'vi-quote-words) ; extension - (define-key vi-com-map "R" 'vi-replace-chars) - (define-key vi-com-map "S" 'vi-substitute-lines) - (define-key vi-com-map "T" 'vi-backward-upto-char) - (define-key vi-com-map "U" 'vi-unimplemented) - (define-key vi-com-map "V" 'vi-undefined) - (define-key vi-com-map "W" 'vi-forward-blank-delimited-word) - (define-key vi-com-map "X" 'call-last-kbd-macro) ; modification/extension - (define-key vi-com-map "Y" 'vi-yank-line) + (define-key vi-com-map "\C-\\" #'vi-unimplemented) + (define-key vi-com-map "\C-]" #'xref-find-definitions) + (define-key vi-com-map "\C-^" #'vi-locate-def) ; extension + (define-key vi-com-map "\C-_" #'vi-undefined) + + (define-key vi-com-map " " #'forward-char) + (define-key vi-com-map "!" #'vi-operator) + (define-key vi-com-map "\"" #'vi-char-argument) + (define-key vi-com-map "#" #'universal-argument) ; extension + (define-key vi-com-map "$" #'end-of-line) + (define-key vi-com-map "%" #'vi-find-matching-paren) + (define-key vi-com-map "&" #'vi-unimplemented) + (define-key vi-com-map "'" #'vi-goto-line-mark) + (define-key vi-com-map "(" #'backward-sexp) + (define-key vi-com-map ")" #'forward-sexp) + (define-key vi-com-map "*" #'vi-name-last-change-or-macro) ; extension + (define-key vi-com-map "+" #'vi-next-line-first-nonwhite) + (define-key vi-com-map "," #'vi-reverse-last-find-char) + (define-key vi-com-map "-" #'vi-previous-line-first-nonwhite) + (define-key vi-com-map "." #'vi-redo-last-change-command) + (define-key vi-com-map "/" #'vi-search-forward) + (define-key vi-com-map "0" #'beginning-of-line) + + (define-key vi-com-map "1" #'vi-digit-argument) + (define-key vi-com-map "2" #'vi-digit-argument) + (define-key vi-com-map "3" #'vi-digit-argument) + (define-key vi-com-map "4" #'vi-digit-argument) + (define-key vi-com-map "5" #'vi-digit-argument) + (define-key vi-com-map "6" #'vi-digit-argument) + (define-key vi-com-map "7" #'vi-digit-argument) + (define-key vi-com-map "8" #'vi-digit-argument) + (define-key vi-com-map "9" #'vi-digit-argument) + + (define-key vi-com-map ":" #'vi-ex-cmd) + (define-key vi-com-map ";" #'vi-repeat-last-find-char) + (define-key vi-com-map "<" #'vi-operator) + (define-key vi-com-map "=" #'vi-operator) + (define-key vi-com-map ">" #'vi-operator) + (define-key vi-com-map "?" #'vi-search-backward) + (define-key vi-com-map "@" #'vi-call-named-change-or-macro) ; extension + + (define-key vi-com-map "A" #'vi-append-at-end-of-line) + (define-key vi-com-map "B" #'vi-backward-blank-delimited-word) + (define-key vi-com-map "C" #'vi-change-rest-of-line) + (define-key vi-com-map "D" #'vi-kill-line) + (define-key vi-com-map "E" #'vi-end-of-blank-delimited-word) + (define-key vi-com-map "F" #'vi-backward-find-char) + (define-key vi-com-map "G" #'vi-goto-line) + (define-key vi-com-map "H" #'vi-home-window-line) + (define-key vi-com-map "I" #'vi-insert-before-first-nonwhite) + (define-key vi-com-map "J" #'vi-join-lines) + (define-key vi-com-map "K" #'vi-undefined) + (define-key vi-com-map "L" #'vi-last-window-line) + (define-key vi-com-map "M" #'vi-middle-window-line) + (define-key vi-com-map "N" #'vi-reverse-last-search) + (define-key vi-com-map "O" #'vi-open-above) + (define-key vi-com-map "P" #'vi-put-before) + (define-key vi-com-map "Q" #'vi-quote-words) ; extension + (define-key vi-com-map "R" #'vi-replace-chars) + (define-key vi-com-map "S" #'vi-substitute-lines) + (define-key vi-com-map "T" #'vi-backward-upto-char) + (define-key vi-com-map "U" #'vi-unimplemented) + (define-key vi-com-map "V" #'vi-undefined) + (define-key vi-com-map "W" #'vi-forward-blank-delimited-word) + (define-key vi-com-map "X" #'call-last-kbd-macro) ; modification/extension + (define-key vi-com-map "Y" #'vi-yank-line) (define-key vi-com-map "Z" (make-sparse-keymap)) ;allow below prefix command - (define-key vi-com-map "ZZ" 'vi-save-all-and-exit) - - (define-key vi-com-map "[" 'vi-unimplemented) - (define-key vi-com-map "\\" 'vi-operator) ; extension for vi-narrow-op - (define-key vi-com-map "]" 'vi-unimplemented) - (define-key vi-com-map "^" 'back-to-indentation) - (define-key vi-com-map "_" 'vi-undefined) - (define-key vi-com-map "`" 'vi-goto-char-mark) - - (define-key vi-com-map "a" 'vi-insert-after) - (define-key vi-com-map "b" 'backward-word) - (define-key vi-com-map "c" 'vi-operator) - (define-key vi-com-map "d" 'vi-operator) - (define-key vi-com-map "e" 'vi-end-of-word) - (define-key vi-com-map "f" 'vi-forward-find-char) - (define-key vi-com-map "g" 'vi-beginning-of-buffer) ; extension - (define-key vi-com-map "h" 'backward-char) - (define-key vi-com-map "i" 'vi-insert-before) - (define-key vi-com-map "j" 'vi-next-line) - (define-key vi-com-map "k" 'previous-line) - (define-key vi-com-map "l" 'forward-char) - (define-key vi-com-map "m" 'vi-set-mark) - (define-key vi-com-map "n" 'vi-repeat-last-search) - (define-key vi-com-map "o" 'vi-open-below) - (define-key vi-com-map "p" 'vi-put-after) - (define-key vi-com-map "q" 'vi-replace) - (define-key vi-com-map "r" 'vi-replace-1-char) - (define-key vi-com-map "s" 'vi-substitute-chars) - (define-key vi-com-map "t" 'vi-forward-upto-char) - (define-key vi-com-map "u" 'undo) - (define-key vi-com-map "v" 'vi-verify-spelling) - (define-key vi-com-map "w" 'vi-forward-word) - (define-key vi-com-map "x" 'vi-kill-char) - (define-key vi-com-map "y" 'vi-operator) - (define-key vi-com-map "z" 'vi-adjust-window) - - (define-key vi-com-map "{" 'backward-paragraph) - (define-key vi-com-map "|" 'vi-goto-column) - (define-key vi-com-map "}" 'forward-paragraph) - (define-key vi-com-map "~" 'vi-change-case) - (define-key vi-com-map "\177" 'delete-backward-char)) + (define-key vi-com-map "ZZ" #'vi-save-all-and-exit) + + (define-key vi-com-map "[" #'vi-unimplemented) + (define-key vi-com-map "\\" #'vi-operator) ; extension for vi-narrow-op + (define-key vi-com-map "]" #'vi-unimplemented) + (define-key vi-com-map "^" #'back-to-indentation) + (define-key vi-com-map "_" #'vi-undefined) + (define-key vi-com-map "`" #'vi-goto-char-mark) + + (define-key vi-com-map "a" #'vi-insert-after) + (define-key vi-com-map "b" #'backward-word) + (define-key vi-com-map "c" #'vi-operator) + (define-key vi-com-map "d" #'vi-operator) + (define-key vi-com-map "e" #'vi-end-of-word) + (define-key vi-com-map "f" #'vi-forward-find-char) + (define-key vi-com-map "g" #'vi-beginning-of-buffer) ; extension + (define-key vi-com-map "h" #'backward-char) + (define-key vi-com-map "i" #'vi-insert-before) + (define-key vi-com-map "j" #'vi-next-line) + (define-key vi-com-map "k" #'previous-line) + (define-key vi-com-map "l" #'forward-char) + (define-key vi-com-map "m" #'vi-set-mark) + (define-key vi-com-map "n" #'vi-repeat-last-search) + (define-key vi-com-map "o" #'vi-open-below) + (define-key vi-com-map "p" #'vi-put-after) + (define-key vi-com-map "q" #'vi-replace) + (define-key vi-com-map "r" #'vi-replace-1-char) + (define-key vi-com-map "s" #'vi-substitute-chars) + (define-key vi-com-map "t" #'vi-forward-upto-char) + (define-key vi-com-map "u" #'undo) + (define-key vi-com-map "v" #'vi-verify-spelling) + (define-key vi-com-map "w" #'vi-forward-word) + (define-key vi-com-map "x" #'vi-kill-char) + (define-key vi-com-map "y" #'vi-operator) + (define-key vi-com-map "z" #'vi-adjust-window) + + (define-key vi-com-map "{" #'backward-paragraph) + (define-key vi-com-map "|" #'vi-goto-column) + (define-key vi-com-map "}" #'forward-paragraph) + (define-key vi-com-map "~" #'vi-change-case) + (define-key vi-com-map "\177" #'delete-backward-char)) (put 'backward-char 'point-moving-unit 'char) (put 'vi-next-line 'point-moving-unit 'line) @@ -1182,7 +1182,7 @@ SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)." (defun vi-narrow-op (motion-command arg) "Narrow to region specified by MOTION-COMMAND with ARG." (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range)) reg) + (begin (car range)) (end (cdr range))) (if (= begin end) nil ; point not moved, abort op (narrow-to-region begin end)))) diff --git a/lisp/obsolete/vip.el b/lisp/obsolete/vip.el index 08085e51d74..16906b68a67 100644 --- a/lisp/obsolete/vip.el +++ b/lisp/obsolete/vip.el @@ -1,4 +1,4 @@ -;;; vip.el --- a VI Package for GNU Emacs +;;; vip.el --- a VI Package for GNU Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2021 Free Software ;; Foundation, Inc. @@ -95,13 +95,11 @@ (defcustom vip-shift-width 8 "The number of columns shifted by > and < command." - :type 'integer - :group 'vip) + :type 'integer) (defcustom vip-re-replace nil "If t then do regexp replace, if nil then do string replace." - :type 'boolean - :group 'vip) + :type 'boolean) (defvar vip-d-char nil "The character remembered by the vi \"r\" command.") @@ -120,13 +118,11 @@ (defcustom vip-search-wrap-around t "If t, search wraps around." - :type 'boolean - :group 'vip) + :type 'boolean) (defcustom vip-re-search nil "If t, search is reg-exp search, otherwise vanilla search." - :type 'boolean - :group 'vip) + :type 'boolean) (defvar vip-s-string nil "Last vip search string.") @@ -136,24 +132,20 @@ (defcustom vip-case-fold-search nil "If t, search ignores cases." - :type 'boolean - :group 'vip) + :type 'boolean) (defcustom vip-re-query-replace nil "If t then do regexp replace, if nil then do string replace." - :type 'boolean - :group 'vip) + :type 'boolean) (defcustom vip-open-with-indent nil "If t, indent when open a new line." - :type 'boolean - :group 'vip) + :type 'boolean) (defcustom vip-help-in-insert-mode nil "If t then C-h is bound to help-command in insert mode. If nil then it is bound to `delete-backward-char'." - :type 'boolean - :group 'vip) + :type 'boolean) (defvar vip-quote-string "> " "String inserted at the beginning of region.") @@ -169,131 +161,131 @@ If nil then it is bound to `delete-backward-char'." (defvar vip-mode-map (let ((map (make-keymap))) - (define-key map "\C-a" 'beginning-of-line) - (define-key map "\C-b" 'vip-scroll-back) - (define-key map "\C-c" 'vip-ctl-c) - (define-key map "\C-d" 'vip-scroll-up) - (define-key map "\C-e" 'vip-scroll-up-one) - (define-key map "\C-f" 'vip-scroll) - (define-key map "\C-g" 'vip-keyboard-quit) - (define-key map "\C-h" 'help-command) - (define-key map "\C-m" 'vip-scroll-back) - (define-key map "\C-n" 'vip-other-window) - (define-key map "\C-o" 'vip-open-line-at-point) - (define-key map "\C-u" 'vip-scroll-down) - (define-key map "\C-x" 'vip-ctl-x) - (define-key map "\C-y" 'vip-scroll-down-one) - (define-key map "\C-z" 'vip-change-mode-to-emacs) - (define-key map "\e" 'vip-ESC) - - (define-key map [?\S-\ ] 'vip-scroll-back) - (define-key map " " 'vip-scroll) - (define-key map "!" 'vip-command-argument) - (define-key map "\"" 'vip-command-argument) - (define-key map "#" 'vip-command-argument) - (define-key map "$" 'vip-goto-eol) - (define-key map "%" 'vip-paren-match) - (define-key map "&" 'vip-nil) - (define-key map "'" 'vip-goto-mark-and-skip-white) - (define-key map "(" 'vip-backward-sentence) - (define-key map ")" 'vip-forward-sentence) - (define-key map "*" 'call-last-kbd-macro) - (define-key map "+" 'vip-next-line-at-bol) - (define-key map "," 'vip-repeat-find-opposite) - (define-key map "-" 'vip-previous-line-at-bol) - (define-key map "." 'vip-repeat) - (define-key map "/" 'vip-search-forward) - - (define-key map "0" 'vip-beginning-of-line) - (define-key map "1" 'vip-digit-argument) - (define-key map "2" 'vip-digit-argument) - (define-key map "3" 'vip-digit-argument) - (define-key map "4" 'vip-digit-argument) - (define-key map "5" 'vip-digit-argument) - (define-key map "6" 'vip-digit-argument) - (define-key map "7" 'vip-digit-argument) - (define-key map "8" 'vip-digit-argument) - (define-key map "9" 'vip-digit-argument) - - (define-key map ":" 'vip-ex) - (define-key map ";" 'vip-repeat-find) - (define-key map "<" 'vip-command-argument) - (define-key map "=" 'vip-command-argument) - (define-key map ">" 'vip-command-argument) - (define-key map "?" 'vip-search-backward) - (define-key map "@" 'vip-nil) - - (define-key map "A" 'vip-Append) - (define-key map "B" 'vip-backward-Word) - (define-key map "C" 'vip-ctl-c-equivalent) - (define-key map "D" 'vip-kill-line) - (define-key map "E" 'vip-end-of-Word) - (define-key map "F" 'vip-find-char-backward) - (define-key map "G" 'vip-goto-line) - (define-key map "H" 'vip-window-top) - (define-key map "I" 'vip-Insert) - (define-key map "J" 'vip-join-lines) - (define-key map "K" 'vip-kill-buffer) - (define-key map "L" 'vip-window-bottom) - (define-key map "M" 'vip-window-middle) - (define-key map "N" 'vip-search-Next) - (define-key map "O" 'vip-Open-line) - (define-key map "P" 'vip-Put-back) - (define-key map "Q" 'vip-query-replace) - (define-key map "R" 'vip-replace-string) - (define-key map "S" 'vip-switch-to-buffer-other-window) - (define-key map "T" 'vip-goto-char-backward) - (define-key map "U" 'vip-nil) - (define-key map "V" 'vip-find-file-other-window) - (define-key map "W" 'vip-forward-Word) - (define-key map "X" 'vip-ctl-x-equivalent) - (define-key map "Y" 'vip-yank-line) - (define-key map "ZZ" 'save-buffers-kill-emacs) - - (define-key map "[" 'vip-nil) - (define-key map "\\" 'vip-escape-to-emacs) - (define-key map "]" 'vip-nil) - (define-key map "^" 'vip-bol-and-skip-white) - (define-key map "_" 'vip-nil) - (define-key map "`" 'vip-goto-mark) - - (define-key map "a" 'vip-append) - (define-key map "b" 'vip-backward-word) - (define-key map "c" 'vip-command-argument) - (define-key map "d" 'vip-command-argument) - (define-key map "e" 'vip-end-of-word) - (define-key map "f" 'vip-find-char-forward) - (define-key map "g" 'vip-info-on-file) - (define-key map "h" 'vip-backward-char) - (define-key map "i" 'vip-insert) - (define-key map "j" 'vip-next-line) - (define-key map "k" 'vip-previous-line) - (define-key map "l" 'vip-forward-char) - (define-key map "m" 'vip-mark-point) - (define-key map "n" 'vip-search-next) - (define-key map "o" 'vip-open-line) - (define-key map "p" 'vip-put-back) - (define-key map "q" 'vip-nil) - (define-key map "r" 'vip-replace-char) - (define-key map "s" 'vip-switch-to-buffer) - (define-key map "t" 'vip-goto-char-forward) - (define-key map "u" 'vip-undo) - (define-key map "v" 'vip-find-file) - (define-key map "w" 'vip-forward-word) - (define-key map "x" 'vip-delete-char) - (define-key map "y" 'vip-command-argument) - (define-key map "zH" 'vip-line-to-top) - (define-key map "zM" 'vip-line-to-middle) - (define-key map "zL" 'vip-line-to-bottom) - (define-key map "z\C-m" 'vip-line-to-top) - (define-key map "z." 'vip-line-to-middle) - (define-key map "z-" 'vip-line-to-bottom) - - (define-key map "{" 'vip-backward-paragraph) - (define-key map "|" 'vip-goto-col) - (define-key map "}" 'vip-forward-paragraph) - (define-key map "~" 'vip-nil) - (define-key map "\177" 'vip-delete-backward-char) + (define-key map "\C-a" #'beginning-of-line) + (define-key map "\C-b" #'vip-scroll-back) + (define-key map "\C-c" #'vip-ctl-c) + (define-key map "\C-d" #'vip-scroll-up) + (define-key map "\C-e" #'vip-scroll-up-one) + (define-key map "\C-f" #'vip-scroll) + (define-key map "\C-g" #'vip-keyboard-quit) + (define-key map "\C-h" #'help-command) + (define-key map "\C-m" #'vip-scroll-back) + (define-key map "\C-n" #'vip-other-window) + (define-key map "\C-o" #'vip-open-line-at-point) + (define-key map "\C-u" #'vip-scroll-down) + (define-key map "\C-x" #'vip-ctl-x) + (define-key map "\C-y" #'vip-scroll-down-one) + (define-key map "\C-z" #'vip-change-mode-to-emacs) + (define-key map "\e" #'vip-ESC) + + (define-key map [?\S-\ ] #'vip-scroll-back) + (define-key map " " #'vip-scroll) + (define-key map "!" #'vip-command-argument) + (define-key map "\"" #'vip-command-argument) + (define-key map "#" #'vip-command-argument) + (define-key map "$" #'vip-goto-eol) + (define-key map "%" #'vip-paren-match) + (define-key map "&" #'vip-nil) + (define-key map "'" #'vip-goto-mark-and-skip-white) + (define-key map "(" #'vip-backward-sentence) + (define-key map ")" #'vip-forward-sentence) + (define-key map "*" #'call-last-kbd-macro) + (define-key map "+" #'vip-next-line-at-bol) + (define-key map "," #'vip-repeat-find-opposite) + (define-key map "-" #'vip-previous-line-at-bol) + (define-key map "." #'vip-repeat) + (define-key map "/" #'vip-search-forward) + + (define-key map "0" #'vip-beginning-of-line) + (define-key map "1" #'vip-digit-argument) + (define-key map "2" #'vip-digit-argument) + (define-key map "3" #'vip-digit-argument) + (define-key map "4" #'vip-digit-argument) + (define-key map "5" #'vip-digit-argument) + (define-key map "6" #'vip-digit-argument) + (define-key map "7" #'vip-digit-argument) + (define-key map "8" #'vip-digit-argument) + (define-key map "9" #'vip-digit-argument) + + (define-key map ":" #'vip-ex) + (define-key map ";" #'vip-repeat-find) + (define-key map "<" #'vip-command-argument) + (define-key map "=" #'vip-command-argument) + (define-key map ">" #'vip-command-argument) + (define-key map "?" #'vip-search-backward) + (define-key map "@" #'vip-nil) + + (define-key map "A" #'vip-Append) + (define-key map "B" #'vip-backward-Word) + (define-key map "C" #'vip-ctl-c-equivalent) + (define-key map "D" #'vip-kill-line) + (define-key map "E" #'vip-end-of-Word) + (define-key map "F" #'vip-find-char-backward) + (define-key map "G" #'vip-goto-line) + (define-key map "H" #'vip-window-top) + (define-key map "I" #'vip-Insert) + (define-key map "J" #'vip-join-lines) + (define-key map "K" #'vip-kill-buffer) + (define-key map "L" #'vip-window-bottom) + (define-key map "M" #'vip-window-middle) + (define-key map "N" #'vip-search-Next) + (define-key map "O" #'vip-Open-line) + (define-key map "P" #'vip-Put-back) + (define-key map "Q" #'vip-query-replace) + (define-key map "R" #'vip-replace-string) + (define-key map "S" #'vip-switch-to-buffer-other-window) + (define-key map "T" #'vip-goto-char-backward) + (define-key map "U" #'vip-nil) + (define-key map "V" #'vip-find-file-other-window) + (define-key map "W" #'vip-forward-Word) + (define-key map "X" #'vip-ctl-x-equivalent) + (define-key map "Y" #'vip-yank-line) + (define-key map "ZZ" #'save-buffers-kill-emacs) + + (define-key map "[" #'vip-nil) + (define-key map "\\" #'vip-escape-to-emacs) + (define-key map "]" #'vip-nil) + (define-key map "^" #'vip-bol-and-skip-white) + (define-key map "_" #'vip-nil) + (define-key map "`" #'vip-goto-mark) + + (define-key map "a" #'vip-append) + (define-key map "b" #'vip-backward-word) + (define-key map "c" #'vip-command-argument) + (define-key map "d" #'vip-command-argument) + (define-key map "e" #'vip-end-of-word) + (define-key map "f" #'vip-find-char-forward) + (define-key map "g" #'vip-info-on-file) + (define-key map "h" #'vip-backward-char) + (define-key map "i" #'vip-insert) + (define-key map "j" #'vip-next-line) + (define-key map "k" #'vip-previous-line) + (define-key map "l" #'vip-forward-char) + (define-key map "m" #'vip-mark-point) + (define-key map "n" #'vip-search-next) + (define-key map "o" #'vip-open-line) + (define-key map "p" #'vip-put-back) + (define-key map "q" #'vip-nil) + (define-key map "r" #'vip-replace-char) + (define-key map "s" #'vip-switch-to-buffer) + (define-key map "t" #'vip-goto-char-forward) + (define-key map "u" #'vip-undo) + (define-key map "v" #'vip-find-file) + (define-key map "w" #'vip-forward-word) + (define-key map "x" #'vip-delete-char) + (define-key map "y" #'vip-command-argument) + (define-key map "zH" #'vip-line-to-top) + (define-key map "zM" #'vip-line-to-middle) + (define-key map "zL" #'vip-line-to-bottom) + (define-key map "z\C-m" #'vip-line-to-top) + (define-key map "z." #'vip-line-to-middle) + (define-key map "z-" #'vip-line-to-bottom) + + (define-key map "{" #'vip-backward-paragraph) + (define-key map "|" #'vip-goto-col) + (define-key map "}" #'vip-forward-paragraph) + (define-key map "~" #'vip-nil) + (define-key map "\177" #'vip-delete-backward-char) map)) (defun vip-version () @@ -306,8 +298,8 @@ If nil then it is bound to `delete-backward-char'." ;;;###autoload (defun vip-setup () "Set up bindings for C-x 7 and C-z that are useful for VIP users." - (define-key ctl-x-map "7" 'vip-buffer-in-two-windows) - (global-set-key "\C-z" 'vip-change-mode-to-vi)) + (define-key ctl-x-map "7" #'vip-buffer-in-two-windows) + (global-set-key "\C-z" #'vip-change-mode-to-vi)) (defmacro vip-loop (count body) "(COUNT BODY) Execute BODY COUNT times." @@ -375,13 +367,13 @@ No message." vip-emacs-local-map))) (vip-change-mode-line "Insert") (use-local-map vip-insert-local-map) - (define-key vip-insert-local-map "\e" 'vip-change-mode-to-vi) - (define-key vip-insert-local-map "\C-z" 'vip-ESC) + (define-key vip-insert-local-map "\e" #'vip-change-mode-to-vi) + (define-key vip-insert-local-map "\C-z" #'vip-ESC) (define-key vip-insert-local-map "\C-h" - (if vip-help-in-insert-mode 'help-command - 'delete-backward-char)) + (if vip-help-in-insert-mode #'help-command + #'delete-backward-char)) (define-key vip-insert-local-map "\C-w" - 'vip-delete-backward-word)) + #'vip-delete-backward-word)) ((eq new-mode 'emacs-mode) (vip-change-mode-line "Emacs:") (use-local-map vip-emacs-local-map))) @@ -461,13 +453,13 @@ Type `n' to quit this window for now.\n") ARG is used as the prefix value for the executed command. If EVENTS is a list of events, which become the beginning of the command." (interactive "P") - (let (com key (old-map (current-local-map))) + (let (com (old-map (current-local-map))) (if events (setq unread-command-events (append events unread-command-events))) (setq prefix-arg arg) (use-local-map vip-emacs-local-map) (unwind-protect - (setq com (key-binding (setq key (read-key-sequence nil)))) + (setq com (key-binding (read-key-sequence nil))) (use-local-map old-map)) (command-execute com prefix-arg) (setq prefix-arg nil) ;; reset prefix arg @@ -617,7 +609,7 @@ obtained so far, and COM is the command part obtained so far." (defun vip-command-argument (arg) "Accept a motion command as an argument." (interactive "P") - (condition-case conditions + (condition-case nil (vip-prefix-arg-com last-command-event (cond ((null arg) nil) @@ -918,11 +910,11 @@ each line in the region." (defun vip-read-string (prompt &optional init) (setq vip-save-minibuffer-local-map (copy-keymap minibuffer-local-map)) - (define-key minibuffer-local-map "\C-h" 'backward-char) - (define-key minibuffer-local-map "\C-w" 'backward-word) - (define-key minibuffer-local-map "\e" 'exit-minibuffer) + (define-key minibuffer-local-map "\C-h" #'backward-char) + (define-key minibuffer-local-map "\C-w" #'backward-word) + (define-key minibuffer-local-map "\e" #'exit-minibuffer) (let (str) - (condition-case conditions + (condition-case nil (setq str (read-string prompt init)) (quit (setq minibuffer-local-map vip-save-minibuffer-local-map) @@ -2651,7 +2643,7 @@ a token has type \(command, address, end-mark) and value." (progn (with-output-to-temp-buffer " *delete text*" (princ (buffer-substring (point) (mark)))) - (condition-case conditions + (condition-case nil (vip-read-string "[Hit return to continue] ") (quit (save-excursion (kill-buffer " *delete text*")) @@ -2759,7 +2751,7 @@ a token has type \(command, address, end-mark) and value." (progn (with-output-to-temp-buffer " *text*" (princ (buffer-substring (point) (mark)))) - (condition-case conditions + (condition-case nil (progn (vip-read-string "[Hit return to continue] ") (ex-line-subr com (point) (mark))) @@ -2829,12 +2821,9 @@ a token has type \(command, address, end-mark) and value." (define-key ex-map char (or (lookup-key vip-mode-map char) 'vip-nil))) (define-key vip-mode-map char - (eval - (list 'quote - (cons 'lambda - (list '(count) - '(interactive "p") - (list 'execute-kbd-macro string 'count)))))))) + (lambda (count) + (interactive "p") + (execute-kbd-macro string count))))) (defun ex-unmap () "ex unmap" @@ -2892,10 +2881,7 @@ a token has type \(command, address, end-mark) and value." (with-no-warnings (insert-file file))))) -(defun ex-set () - (eval (list 'setq - (read-variable "Variable: ") - (eval (read-minibuffer "Value: "))))) +(defalias 'ex-set #'set-variable) (defun ex-shell () "ex shell" @@ -2935,7 +2921,7 @@ vip-s-string" (setq ex-addresses (cons (car ex-addresses) ex-addresses))))) ;(setq G opt-g) (let ((beg (car ex-addresses)) (end (car (cdr ex-addresses))) - (cont t) eol-mark) + eol-mark) ;;(cont t) (save-excursion (vip-enlarge-region beg end) (let ((limit (save-excursion diff --git a/lisp/obsolete/ws-mode.el b/lisp/obsolete/ws-mode.el index d1ced86c468..235a1d7e43d 100644 --- a/lisp/obsolete/ws-mode.el +++ b/lisp/obsolete/ws-mode.el @@ -41,144 +41,144 @@ (defvar wordstar-C-k-map (let ((map (make-keymap))) (define-key map " " ()) - (define-key map "0" 'ws-set-marker-0) - (define-key map "1" 'ws-set-marker-1) - (define-key map "2" 'ws-set-marker-2) - (define-key map "3" 'ws-set-marker-3) - (define-key map "4" 'ws-set-marker-4) - (define-key map "5" 'ws-set-marker-5) - (define-key map "6" 'ws-set-marker-6) - (define-key map "7" 'ws-set-marker-7) - (define-key map "8" 'ws-set-marker-8) - (define-key map "9" 'ws-set-marker-9) - (define-key map "b" 'ws-begin-block) - (define-key map "\C-b" 'ws-begin-block) - (define-key map "c" 'ws-copy-block) - (define-key map "\C-c" 'ws-copy-block) - (define-key map "d" 'save-buffers-kill-emacs) - (define-key map "\C-d" 'save-buffers-kill-emacs) - (define-key map "f" 'find-file) - (define-key map "\C-f" 'find-file) - (define-key map "h" 'ws-show-markers) - (define-key map "\C-h" 'ws-show-markers) - (define-key map "i" 'ws-indent-block) - (define-key map "\C-i" 'ws-indent-block) - (define-key map "k" 'ws-end-block) - (define-key map "\C-k" 'ws-end-block) - (define-key map "p" 'ws-print-block) - (define-key map "\C-p" 'ws-print-block) - (define-key map "q" 'kill-emacs) - (define-key map "\C-q" 'kill-emacs) - (define-key map "r" 'insert-file) - (define-key map "\C-r" 'insert-file) - (define-key map "s" 'save-some-buffers) - (define-key map "\C-s" 'save-some-buffers) - (define-key map "t" 'ws-mark-word) - (define-key map "\C-t" 'ws-mark-word) - (define-key map "u" 'ws-exdent-block) - (define-key map "\C-u" 'keyboard-quit) - (define-key map "v" 'ws-move-block) - (define-key map "\C-v" 'ws-move-block) - (define-key map "w" 'ws-write-block) - (define-key map "\C-w" 'ws-write-block) - (define-key map "x" 'save-buffers-kill-emacs) - (define-key map "\C-x" 'save-buffers-kill-emacs) - (define-key map "y" 'ws-delete-block) - (define-key map "\C-y" 'ws-delete-block) + (define-key map "0" #'ws-set-marker-0) + (define-key map "1" #'ws-set-marker-1) + (define-key map "2" #'ws-set-marker-2) + (define-key map "3" #'ws-set-marker-3) + (define-key map "4" #'ws-set-marker-4) + (define-key map "5" #'ws-set-marker-5) + (define-key map "6" #'ws-set-marker-6) + (define-key map "7" #'ws-set-marker-7) + (define-key map "8" #'ws-set-marker-8) + (define-key map "9" #'ws-set-marker-9) + (define-key map "b" #'ws-begin-block) + (define-key map "\C-b" #'ws-begin-block) + (define-key map "c" #'ws-copy-block) + (define-key map "\C-c" #'ws-copy-block) + (define-key map "d" #'save-buffers-kill-emacs) + (define-key map "\C-d" #'save-buffers-kill-emacs) + (define-key map "f" #'find-file) + (define-key map "\C-f" #'find-file) + (define-key map "h" #'ws-show-markers) + (define-key map "\C-h" #'ws-show-markers) + (define-key map "i" #'ws-indent-block) + (define-key map "\C-i" #'ws-indent-block) + (define-key map "k" #'ws-end-block) + (define-key map "\C-k" #'ws-end-block) + (define-key map "p" #'ws-print-block) + (define-key map "\C-p" #'ws-print-block) + (define-key map "q" #'kill-emacs) + (define-key map "\C-q" #'kill-emacs) + (define-key map "r" #'insert-file) + (define-key map "\C-r" #'insert-file) + (define-key map "s" #'save-some-buffers) + (define-key map "\C-s" #'save-some-buffers) + (define-key map "t" #'ws-mark-word) + (define-key map "\C-t" #'ws-mark-word) + (define-key map "u" #'ws-exdent-block) + (define-key map "\C-u" #'keyboard-quit) + (define-key map "v" #'ws-move-block) + (define-key map "\C-v" #'ws-move-block) + (define-key map "w" #'ws-write-block) + (define-key map "\C-w" #'ws-write-block) + (define-key map "x" #'save-buffers-kill-emacs) + (define-key map "\C-x" #'save-buffers-kill-emacs) + (define-key map "y" #'ws-delete-block) + (define-key map "\C-y" #'ws-delete-block) map)) (defvar wordstar-C-o-map (let ((map (make-keymap))) (define-key map " " ()) - (define-key map "c" 'wordstar-center-line) - (define-key map "\C-c" 'wordstar-center-line) - (define-key map "b" 'switch-to-buffer) - (define-key map "\C-b" 'switch-to-buffer) - (define-key map "j" 'justify-current-line) - (define-key map "\C-j" 'justify-current-line) - (define-key map "k" 'kill-buffer) - (define-key map "\C-k" 'kill-buffer) - (define-key map "l" 'list-buffers) - (define-key map "\C-l" 'list-buffers) - (define-key map "m" 'auto-fill-mode) - (define-key map "\C-m" 'auto-fill-mode) - (define-key map "r" 'set-fill-column) - (define-key map "\C-r" 'set-fill-column) - (define-key map "\C-u" 'keyboard-quit) - (define-key map "wd" 'delete-other-windows) - (define-key map "wh" 'split-window-right) - (define-key map "wo" 'other-window) - (define-key map "wv" 'split-window-below) + (define-key map "c" #'wordstar-center-line) + (define-key map "\C-c" #'wordstar-center-line) + (define-key map "b" #'switch-to-buffer) + (define-key map "\C-b" #'switch-to-buffer) + (define-key map "j" #'justify-current-line) + (define-key map "\C-j" #'justify-current-line) + (define-key map "k" #'kill-buffer) + (define-key map "\C-k" #'kill-buffer) + (define-key map "l" #'list-buffers) + (define-key map "\C-l" #'list-buffers) + (define-key map "m" #'auto-fill-mode) + (define-key map "\C-m" #'auto-fill-mode) + (define-key map "r" #'set-fill-column) + (define-key map "\C-r" #'set-fill-column) + (define-key map "\C-u" #'keyboard-quit) + (define-key map "wd" #'delete-other-windows) + (define-key map "wh" #'split-window-right) + (define-key map "wo" #'other-window) + (define-key map "wv" #'split-window-below) map)) (defvar wordstar-C-q-map (let ((map (make-keymap))) (define-key map " " ()) - (define-key map "0" 'ws-find-marker-0) - (define-key map "1" 'ws-find-marker-1) - (define-key map "2" 'ws-find-marker-2) - (define-key map "3" 'ws-find-marker-3) - (define-key map "4" 'ws-find-marker-4) - (define-key map "5" 'ws-find-marker-5) - (define-key map "6" 'ws-find-marker-6) - (define-key map "7" 'ws-find-marker-7) - (define-key map "8" 'ws-find-marker-8) - (define-key map "9" 'ws-find-marker-9) - (define-key map "a" 'ws-query-replace) - (define-key map "\C-a" 'ws-query-replace) - (define-key map "b" 'ws-goto-block-begin) - (define-key map "\C-b" 'ws-goto-block-begin) - (define-key map "c" 'end-of-buffer) - (define-key map "\C-c" 'end-of-buffer) - (define-key map "d" 'end-of-line) - (define-key map "\C-d" 'end-of-line) - (define-key map "f" 'ws-search) - (define-key map "\C-f" 'ws-search) - (define-key map "k" 'ws-goto-block-end) - (define-key map "\C-k" 'ws-goto-block-end) - (define-key map "l" 'ws-undo) - (define-key map "\C-l" 'ws-undo) - (define-key map "p" 'ws-last-cursorp) - (define-key map "\C-p" 'ws-last-cursorp) - (define-key map "r" 'beginning-of-buffer) - (define-key map "\C-r" 'beginning-of-buffer) - (define-key map "s" 'beginning-of-line) - (define-key map "\C-s" 'beginning-of-line) - (define-key map "\C-u" 'keyboard-quit) - (define-key map "w" 'ws-last-error) - (define-key map "\C-w" 'ws-last-error) - (define-key map "y" 'ws-kill-eol) - (define-key map "\C-y" 'ws-kill-eol) - (define-key map "\177" 'ws-kill-bol) + (define-key map "0" #'ws-find-marker-0) + (define-key map "1" #'ws-find-marker-1) + (define-key map "2" #'ws-find-marker-2) + (define-key map "3" #'ws-find-marker-3) + (define-key map "4" #'ws-find-marker-4) + (define-key map "5" #'ws-find-marker-5) + (define-key map "6" #'ws-find-marker-6) + (define-key map "7" #'ws-find-marker-7) + (define-key map "8" #'ws-find-marker-8) + (define-key map "9" #'ws-find-marker-9) + (define-key map "a" #'ws-query-replace) + (define-key map "\C-a" #'ws-query-replace) + (define-key map "b" #'ws-goto-block-begin) + (define-key map "\C-b" #'ws-goto-block-begin) + (define-key map "c" #'end-of-buffer) + (define-key map "\C-c" #'end-of-buffer) + (define-key map "d" #'end-of-line) + (define-key map "\C-d" #'end-of-line) + (define-key map "f" #'ws-search) + (define-key map "\C-f" #'ws-search) + (define-key map "k" #'ws-goto-block-end) + (define-key map "\C-k" #'ws-goto-block-end) + (define-key map "l" #'ws-undo) + (define-key map "\C-l" #'ws-undo) + ;; (define-key map "p" #'ws-last-cursorp) + ;; (define-key map "\C-p" #'ws-last-cursorp) + (define-key map "r" #'beginning-of-buffer) + (define-key map "\C-r" #'beginning-of-buffer) + (define-key map "s" #'beginning-of-line) + (define-key map "\C-s" #'beginning-of-line) + (define-key map "\C-u" #'keyboard-quit) + (define-key map "w" #'ws-last-error) + (define-key map "\C-w" #'ws-last-error) + (define-key map "y" #'ws-kill-eol) + (define-key map "\C-y" #'ws-kill-eol) + (define-key map "\177" #'ws-kill-bol) map)) (defvar wordstar-mode-map (let ((map (make-keymap))) - (define-key map "\C-a" 'backward-word) - (define-key map "\C-b" 'fill-paragraph) - (define-key map "\C-c" 'scroll-up-command) - (define-key map "\C-d" 'forward-char) - (define-key map "\C-e" 'previous-line) - (define-key map "\C-f" 'forward-word) - (define-key map "\C-g" 'delete-char) - (define-key map "\C-h" 'backward-char) - (define-key map "\C-i" 'indent-for-tab-command) - (define-key map "\C-j" 'help-for-help) + (define-key map "\C-a" #'backward-word) + (define-key map "\C-b" #'fill-paragraph) + (define-key map "\C-c" #'scroll-up-command) + (define-key map "\C-d" #'forward-char) + (define-key map "\C-e" #'previous-line) + (define-key map "\C-f" #'forward-word) + (define-key map "\C-g" #'delete-char) + (define-key map "\C-h" #'backward-char) + (define-key map "\C-i" #'indent-for-tab-command) + (define-key map "\C-j" #'help-for-help) (define-key map "\C-k" wordstar-C-k-map) - (define-key map "\C-l" 'ws-repeat-search) - (define-key map "\C-n" 'open-line) + (define-key map "\C-l" #'ws-repeat-search) + (define-key map "\C-n" #'open-line) (define-key map "\C-o" wordstar-C-o-map) - (define-key map "\C-p" 'quoted-insert) + (define-key map "\C-p" #'quoted-insert) (define-key map "\C-q" wordstar-C-q-map) - (define-key map "\C-r" 'scroll-down-command) - (define-key map "\C-s" 'backward-char) - (define-key map "\C-t" 'kill-word) - (define-key map "\C-u" 'keyboard-quit) - (define-key map "\C-v" 'overwrite-mode) - (define-key map "\C-w" 'scroll-down-line) - (define-key map "\C-x" 'next-line) - (define-key map "\C-y" 'kill-complete-line) - (define-key map "\C-z" 'scroll-up-line) + (define-key map "\C-r" #'scroll-down-command) + (define-key map "\C-s" #'backward-char) + (define-key map "\C-t" #'kill-word) + (define-key map "\C-u" #'keyboard-quit) + (define-key map "\C-v" #'overwrite-mode) + (define-key map "\C-w" #'scroll-down-line) + (define-key map "\C-x" #'next-line) + (define-key map "\C-y" #'kill-complete-line) + (define-key map "\C-z" #'scroll-up-line) map)) ;; wordstar-C-j-map not yet implemented diff --git a/lisp/obsolete/yow.el b/lisp/obsolete/yow.el index 76485f989c1..ca8de4f9224 100644 --- a/lisp/obsolete/yow.el +++ b/lisp/obsolete/yow.el @@ -1,4 +1,4 @@ -;;; yow.el --- quote random zippyisms +;;; yow.el --- quote random zippyisms -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc. @@ -39,8 +39,7 @@ (defcustom yow-file (expand-file-name "yow.lines" data-directory) "File containing pertinent pinhead phrases." - :type 'file - :group 'yow) + :type 'file) (defconst yow-load-message "Am I CONSING yet?...") (defconst yow-after-load-message "I have SEEN the CONSING!!") diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index b9799d2abe8..8a4aa2b1be0 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -3224,6 +3224,15 @@ s Search for keywords M Like m, but only TODO entries (defvar org-agenda-overriding-cmd nil) (defvar org-agenda-overriding-arguments nil) (defvar org-agenda-overriding-cmd-arguments nil) + +(defun org-let (list &rest body) ;FIXME: So many kittens are suffering here. + (declare (indent 1)) + (eval (cons 'let (cons list body)))) + +(defun org-let2 (list1 list2 &rest body) ;FIXME: Where did our karma go? + (declare (indent 2)) + (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) + (defun org-agenda-run-series (name series) "Run agenda NAME as a SERIES of agenda commands." (org-let (nth 1 series) '(org-agenda-prepare name)) diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index b7319d638ed..31f5f78eae0 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -4206,6 +4206,7 @@ looking into captions: (lambda (b) (and (org-element-map b \\='latex-snippet #\\='identity nil t) b)) nil nil nil t)" + (declare (indent 2)) ;; Ensure TYPES and NO-RECURSION are a list, even of one element. (let* ((types (if (listp types) types (list types))) (no-recursion (if (listp no-recursion) no-recursion @@ -4299,7 +4300,6 @@ looking into captions: (funcall --walk-tree data) ;; Return value in a proper order. (nreverse --acc))))) -(put 'org-element-map 'lisp-indent-function 2) ;; The following functions are internal parts of the parser. ;; diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 56afdf6ef19..ac6691db0d5 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -627,18 +627,10 @@ program is needed for, so that the error message can be more informative." (let ((message-log-max nil)) (apply #'message args))) -(defun org-let (list &rest body) - (eval (cons 'let (cons list body)))) -(put 'org-let 'lisp-indent-function 1) - -(defun org-let2 (list1 list2 &rest body) - (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) -(put 'org-let2 'lisp-indent-function 2) - (defun org-eval (form) "Eval FORM and return result." (condition-case error - (eval form) + (eval form t) (error (format "%%![Error: %s]" error)))) (defvar org-outline-regexp) ; defined in org.el @@ -1241,31 +1233,29 @@ Return 0. if S is not recognized as a valid value." When ADDITIONAL-KEYS is not nil, also include SPC and DEL in the allowed keys for scrolling, as expected in the export dispatch window." - (let ((scrlup (if additional-keys '(?\s 22) 22)) - (scrldn (if additional-keys `(?\d 134217846) 134217846))) - (eval - `(cl-case ,key - ;; C-n - (14 (if (not (pos-visible-in-window-p (point-max))) - (ignore-errors (scroll-up 1)) - (message "End of buffer") - (sit-for 1))) - ;; C-p - (16 (if (not (pos-visible-in-window-p (point-min))) - (ignore-errors (scroll-down 1)) - (message "Beginning of buffer") - (sit-for 1))) - ;; SPC or - (,scrlup - (if (not (pos-visible-in-window-p (point-max))) - (scroll-up nil) - (message "End of buffer") - (sit-for 1))) - ;; DEL - (,scrldn (if (not (pos-visible-in-window-p (point-min))) - (scroll-down nil) - (message "Beginning of buffer") - (sit-for 1))))))) + (let ((scrlup (if additional-keys '(?\s ?\C-v) ?\C-v)) + (scrldn (if additional-keys `(?\d ?\M-v) ?\M-v))) + (pcase key + (?\C-n (if (not (pos-visible-in-window-p (point-max))) + (ignore-errors (scroll-up 1)) + (message "End of buffer") + (sit-for 1))) + (?\C-p (if (not (pos-visible-in-window-p (point-min))) + (ignore-errors (scroll-down 1)) + (message "Beginning of buffer") + (sit-for 1))) + ;; SPC or + ((guard (memq key scrlup)) + (if (not (pos-visible-in-window-p (point-max))) + (scroll-up nil) + (message "End of buffer") + (sit-for 1))) + ;; DEL + ((guard (memq key scrldn)) + (if (not (pos-visible-in-window-p (point-min))) + (scroll-down nil) + (message "Beginning of buffer") + (sit-for 1)))))) (provide 'org-macs) diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index dddd19fa0a3..50f65a1215e 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -772,41 +772,41 @@ static char * dot3d_xpm[] = { (defun bubbles-set-graphics-theme-ascii () "Set graphics theme to `ascii'." - (interactive) + (interactive nil bubbles-mode) (setq bubbles-graphics-theme 'ascii) (bubbles--update-faces-or-images)) (defun bubbles-set-graphics-theme-circles () "Set graphics theme to `circles'." - (interactive) + (interactive nil bubbles-mode) (setq bubbles-graphics-theme 'circles) (bubbles--initialize-images) (bubbles--update-faces-or-images)) (defun bubbles-set-graphics-theme-squares () "Set graphics theme to `squares'." - (interactive) + (interactive nil bubbles-mode) (setq bubbles-graphics-theme 'squares) (bubbles--initialize-images) (bubbles--update-faces-or-images)) (defun bubbles-set-graphics-theme-diamonds () "Set graphics theme to `diamonds'." - (interactive) + (interactive nil bubbles-mode) (setq bubbles-graphics-theme 'diamonds) (bubbles--initialize-images) (bubbles--update-faces-or-images)) (defun bubbles-set-graphics-theme-balls () "Set graphics theme to `balls'." - (interactive) + (interactive nil bubbles-mode) (setq bubbles-graphics-theme 'balls) (bubbles--initialize-images) (bubbles--update-faces-or-images)) (defun bubbles-set-graphics-theme-emacs () "Set graphics theme to `emacs'." - (interactive) + (interactive nil bubbles-mode) (setq bubbles-graphics-theme 'emacs) (bubbles--initialize-images) (bubbles--update-faces-or-images)) @@ -914,7 +914,7 @@ columns on its right towards the left. (defun bubbles-quit () "Quit Bubbles." - (interactive) + (interactive nil bubbles-mode) (message "bubbles-quit") (bury-buffer)) @@ -1165,7 +1165,7 @@ Use optional parameter POS instead of point if given." (defun bubbles-plop () "Remove active bubbles region." - (interactive) + (interactive nil bubbles-mode) (when (and bubbles--playing (> bubbles--neighborhood-score 0)) (setq bubbles--save-data (list bubbles--score (buffer-string))) @@ -1249,7 +1249,7 @@ Use optional parameter POS instead of point if given." (defun bubbles-undo () "Undo last move." - (interactive) + (interactive nil bubbles-mode) (when bubbles--save-data (let ((inhibit-read-only t) (pos (point))) diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index 9b2626b19da..47ed6e28b58 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -292,7 +292,7 @@ The most useful commands are: (defun decipher-keypress () "Enter a plaintext or ciphertext character." - (interactive) + (interactive nil decipher-mode) (let ((decipher-function 'decipher-set-map) buffer-read-only) ;Make buffer writable (save-excursion @@ -346,7 +346,7 @@ The most useful commands are: (defun decipher-undo () "Undo a change in Decipher mode." - (interactive) + (interactive nil decipher-mode) ;; If we don't get all the way thru, make last-command indicate that ;; for the following command. (setq this-command t) @@ -487,7 +487,7 @@ The most useful commands are: This records the current alphabet so you can return to it later. You may have any number of checkpoints. Type `\\[decipher-restore-checkpoint]' to restore a checkpoint." - (interactive "sCheckpoint description: ") + (interactive "sCheckpoint description: " decipher-mode) (or (stringp desc) (setq desc "")) (let (alphabet @@ -514,7 +514,7 @@ If point is not on a checkpoint line, moves to the first checkpoint line. If point is on a checkpoint, restores that checkpoint. Type `\\[decipher-make-checkpoint]' to make a checkpoint." - (interactive) + (interactive nil decipher-mode) (beginning-of-line) (if (looking-at "%!\\([A-Z ]+\\)!") ;; Restore this checkpoint: @@ -542,7 +542,7 @@ Type `\\[decipher-make-checkpoint]' to make a checkpoint." This fills any blanks in the cipher alphabet with the unused letters in alphabetical order. Use this when you have a keyword cipher and you have determined the keyword." - (interactive) + (interactive nil decipher-mode) (let ((cipher-char ?A) (ptr decipher-alphabet) buffer-read-only ;Make buffer writable @@ -559,7 +559,7 @@ you have determined the keyword." (defun decipher-show-alphabet () "Display the current cipher alphabet in the message line." - (interactive) + (interactive nil decipher-mode) (message "%s" (mapconcat (lambda (a) (concat @@ -572,7 +572,7 @@ you have determined the keyword." "Reprocess the buffer using the alphabet from the top. This regenerates all deciphered plaintext and clears the undo list. You should use this if you edit the ciphertext." - (interactive) + (interactive nil decipher-mode) (message "Reprocessing buffer...") (let (alphabet buffer-read-only ;Make buffer writable @@ -616,13 +616,13 @@ You should use this if you edit the ciphertext." (defun decipher-frequency-count () "Display the frequency count in the statistics buffer." - (interactive) + (interactive nil decipher-mode) (decipher-analyze) (decipher-display-regexp "^A" "^[A-Z][A-Z]")) (defun decipher-digram-list () "Display the list of digrams in the statistics buffer." - (interactive) + (interactive nil decipher-mode) (decipher-analyze) (decipher-display-regexp "[A-Z][A-Z] +[0-9]" "^$")) @@ -639,7 +639,7 @@ words, and ends 3 words (`*' represents a space). X comes before 8 different letters, after 7 different letters, and is next to a total of 11 different letters. It occurs 14 times, making up 9% of the ciphertext." - (interactive (list (upcase (following-char)))) + (interactive (list (upcase (following-char))) decipher-mode) (decipher-analyze) (let (start end) (with-current-buffer (decipher-stats-buffer) diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index d92c8c35b1b..d569bf898c9 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -1,4 +1,4 @@ -;;; antlr-mode.el --- major mode for ANTLR grammar files +;;; antlr-mode.el --- major mode for ANTLR grammar files -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -87,95 +87,13 @@ (require 'easymenu) (require 'cc-mode) -;; Just to get the rid of the byte compiler warning. The code for -;; this function and its friends are too complex for their own good. -(declare-function cond-emacs-xemacs-macfn "antlr-mode" (args &optional msg)) - -;; General Emacs/XEmacs-compatibility compile-time macros -(eval-when-compile - (defmacro cond-emacs-xemacs (&rest args) - (cond-emacs-xemacs-macfn - args "`cond-emacs-xemacs' must return exactly one element")) - (defun cond-emacs-xemacs-macfn (args &optional msg) - (if (atom args) args - (and (eq (car args) :@) (null msg) ; (:@ ...spliced...) - (setq args (cdr args) - msg "(:@ ....) must return exactly one element")) - (let ((ignore (if (featurep 'xemacs) :EMACS :XEMACS)) - (mode :BOTH) code) - (while (consp args) - (if (memq (car args) '(:EMACS :XEMACS :BOTH)) (setq mode (pop args))) - (if (atom args) - (or args (error "Used selector %s without elements" mode)) - (or (eq ignore mode) - (push (cond-emacs-xemacs-macfn (car args)) code)) - (pop args))) - (cond (msg (if (or args (cdr code)) (error msg) (car code))) - ((or (null args) (eq ignore mode)) (nreverse code)) - (t (nconc (nreverse code) args)))))) - ;; Emacs/XEmacs-compatibility `defun': remove interactive "_" for Emacs, use - ;; existing functions when they are `fboundp', provide shortcuts if they are - ;; known to be defined in a specific Emacs branch (for short .elc) - (defmacro defunx (name arglist &rest definition) - (let ((xemacsp (featurep 'xemacs)) reuses) - (while (memq (car definition) - '(:try :emacs-and-try :xemacs-and-try)) - (if (eq (pop definition) (if xemacsp :xemacs-and-try :emacs-and-try)) - (setq reuses (car definition) - definition nil) - (push (pop definition) reuses))) - (if (and reuses (symbolp reuses)) - `(defalias ',name ',reuses) - (let* ((docstring (if (stringp (car definition)) (pop definition))) - (spec (and (not xemacsp) - (eq (car-safe (car definition)) 'interactive) - (null (cddar definition)) - (cadar definition)))) - (if (and (stringp spec) - (not (string-equal spec "")) - (eq (aref spec 0) ?_)) - (setq definition - (cons (if (string-equal spec "_") - '(interactive) - `(interactive ,(substring spec 1))) - (cdr definition)))) - (if (null reuses) - `(defun ,name ,arglist ,docstring - ,@(cond-emacs-xemacs-macfn definition)) - ;; no dynamic docstring in this case - `(eval-and-compile ; no warnings in Emacs - (defalias ',name - (cond ,@(mapcar (lambda (func) `((fboundp ',func) ',func)) - (nreverse reuses)) - (t ,(if definition - `(lambda ,arglist ,docstring - ,@(cond-emacs-xemacs-macfn definition)) - 'ignore)))))))))) - (defmacro ignore-errors-x (&rest body) - (let ((specials '((scan-sexps . 4) (scan-lists . 5))) - spec nils) - (if (and (featurep 'xemacs) - (null (cdr body)) (consp (car body)) - (setq spec (assq (caar body) specials)) - (>= (setq nils (- (cdr spec) (length (car body)))) 0)) - `(,@(car body) ,@(make-list nils nil) t) - `(ignore-errors ,@body))))) - ;; More compile-time-macros (eval-when-compile (defmacro save-buffer-state-x (&rest body) ; similar to EMACS/lazy-lock.el - (let ((modified (with-no-warnings (gensym "save-buffer-state-x-modified-")))) - `(let ((,modified (buffer-modified-p))) - (unwind-protect - (let ((buffer-undo-list t) (inhibit-read-only t) - ,@(unless (featurep 'xemacs) - '((inhibit-point-motion-hooks t) deactivate-mark)) - (inhibit-modification-hooks t) - buffer-file-name buffer-file-truename) - ,@body) - (and (not ,modified) (buffer-modified-p) - (set-buffer-modified-p nil))))))) -(put 'save-buffer-state-x 'lisp-indent-function 0) + (declare (debug t) (indent 0)) + `(let ((inhibit-point-motion-hooks t)) + (with-silent-modifications + ,@body)))) (defvar outline-level) (defvar imenu-use-markers) @@ -188,7 +106,7 @@ ;; Additional to the `defalias' below, we must set `antlr-c-forward-sws' to ;; `c-forward-syntactic-ws' when `c-forward-sws' is not defined after requiring ;; cc-mode. -(defalias 'antlr-c-forward-sws 'c-forward-sws) +(defalias 'antlr-c-forward-sws #'c-forward-sws) ;;;;########################################################################## @@ -231,7 +149,6 @@ value of `antlr-language' if the first group in the string matched by REGEXP in `antlr-language-limit-n-regexp' is one of the OPTION-VALUEs. An OPTION-VALUE of nil denotes the fallback element. MODELINE-STRING is also displayed in the mode line next to \"Antlr\"." - :group 'antlr :type '(repeat (group :value (java-mode "") (function :tag "Major mode") (string :tag "Mode line string") @@ -245,7 +162,6 @@ also displayed in the mode line next to \"Antlr\"." Looks like \(LIMIT . REGEXP). Search for REGEXP from the beginning of the buffer to LIMIT and use the first group in the matched string to set the language according to `antlr-language-alist'." - :group 'antlr :type '(cons (choice :tag "Limit" (const :tag "No" nil) (integer :value 0)) regexp)) @@ -259,7 +175,6 @@ the language according to `antlr-language-alist'." If nil, the actions with their surrounding braces are hidden. If a number, do not hide the braces, only hide the contents if its length is greater than this number." - :group 'antlr :type '(choice (const :tag "Completely hidden" nil) (integer :tag "Hidden if longer than" :value 3))) @@ -268,7 +183,6 @@ greater than this number." If nil, no continuation line of a block comment is changed. If t, they are changed according to `c-indentation-line'. When not nil and not t, they are only changed by \\[antlr-indent-command]." - :group 'antlr :type '(radio (const :tag "No" nil) (const :tag "Always" t) (sexp :tag "With TAB" :format "%t" :value tab))) @@ -282,7 +196,6 @@ The first element whose MAJOR-MODE is nil or equal to `major-mode' and whose REGEXP is nil or matches variable `buffer-file-name' is used to set `tab-width' and `indent-tabs-mode'. This is useful to support both ANTLR's and Java's indentation styles. Used by `antlr-set-tabs'." - :group 'antlr :type '(repeat (group :value (antlr-mode nil 8 nil) (choice (const :tag "All" nil) (function :tag "Major mode")) @@ -294,14 +207,12 @@ ANTLR's and Java's indentation styles. Used by `antlr-set-tabs'." "If non-nil, cc-mode indentation style used for `antlr-mode'. See `c-set-style' and for details, where the most interesting part in `c-style-alist' is the value of `c-basic-offset'." - :group 'antlr :type '(choice (const nil) regexp)) (defcustom antlr-indent-item-regexp "[]}):;|&]" ; & is local ANTLR extension (SGML's and-connector) "Regexp matching lines which should be indented by one TAB less. See `antlr-indent-line' and command \\[antlr-indent-command]." - :group 'antlr :type 'regexp) (defcustom antlr-indent-at-bol-alist @@ -316,7 +227,6 @@ If `antlr-language' equals to a MODE, the line starting at the first non-whitespace is matched by the corresponding REGEXP, and the line is part of a header action, indent the line at column 0 instead according to the normal rules of `antlr-indent-line'." - :group 'antlr :type '(repeat (cons (function :tag "Major mode") regexp))) ;; adopt indentation to cc-engine @@ -337,7 +247,6 @@ to the normal rules of `antlr-indent-line'." "Non-nil, if the major mode menu should include option submenus. If nil, the menu just includes a command to insert options. Otherwise, it includes four submenus to insert file/grammar/rule/subrule options." - :group 'antlr :type 'boolean) (defcustom antlr-tool-version 20701 @@ -349,7 +258,6 @@ version correct option values when using \\[antlr-insert-option]. Don't use a number smaller than 20600 since the stored history of Antlr's options starts with v2.06.00, see `antlr-options-alists'. You can make this variable buffer-local." - :group 'antlr :type 'integer) (defcustom antlr-options-auto-colon t @@ -358,7 +266,6 @@ A `:' is only inserted if this value is non-nil, if a rule or subrule option is inserted with \\[antlr-insert-option], if there was no rule or subrule options section before, and if a `:' is not already present after the section, ignoring whitespace, comments and the init action." - :group 'antlr :type 'boolean) (defcustom antlr-options-style nil @@ -369,7 +276,6 @@ identifier. The only style symbol used in the default value of `antlr-options-alist' is `language-as-string'. See also `antlr-read-value'." - :group 'antlr :type '(repeat (symbol :tag "Style symbol"))) (defcustom antlr-options-push-mark t @@ -380,7 +286,6 @@ number, only set mark if point was outside the options area before and the number of lines between point and the insert position is greater than this value. Otherwise, only set mark if point was outside the options area before." - :group 'antlr :type '(radio (const :tag "No" nil) (const :tag "Always" t) (integer :tag "Lines between" :value 10) @@ -391,7 +296,6 @@ options area before." This string is only used if the option to insert did not exist before or if there was no `=' after it. In other words, the spacing around an existing `=' won't be changed when changing an option value." - :group 'antlr :type 'string) @@ -576,13 +480,11 @@ AS-STRING is non-nil and is either t or a symbol which is a member of "Command used in \\[antlr-run-tool] to run the Antlr tool. This variable should include all options passed to Antlr except the option \"-glib\" which is automatically suggested if necessary." - :group 'antlr :type 'string) (defcustom antlr-ask-about-save t "If not nil, \\[antlr-run-tool] asks which buffers to save. Otherwise, it saves all modified buffers before running without asking." - :group 'antlr :type 'boolean) (defcustom antlr-makefile-specification @@ -604,7 +506,6 @@ Then, GEN-VAR is a string with the name of the variable which contains the file names of all makefile rules. GEN-VAR-FORMAT is a format string producing the variable of each target with substitution COUNT/%d where COUNT starts with 1. GEN-SEP is used to separate long variable values." - :group 'antlr :type '(list (string :tag "Rule separator") (choice (const :tag "Direct targets" nil) @@ -683,7 +584,6 @@ DIRECTORY is the name of the current directory.") "Non-nil, if a \"Index\" menu should be added to the menubar. If it is a string, it is used instead \"Index\". Requires package imenu." - :group 'antlr :type '(choice (const :tag "No menu" nil) (const :tag "Index menu" t) (string :tag "Other menu name"))) @@ -719,9 +619,7 @@ imenu." (easy-menu-define antlr-mode-menu antlr-mode-map "Major mode menu." `("Antlr" - ,@(if (cond-emacs-xemacs - :EMACS antlr-options-use-submenus - :XEMACS antlr-options-use-submenus) + ,@(if antlr-options-use-submenus `(("Insert File Option" :filter ,(lambda (x) (antlr-options-menu-filter 1 x))) ("Insert Grammar Option" @@ -780,7 +678,6 @@ bound to `antlr-language'. For example, with value ((java-mode . 2) (c++-mode . 0)) Java actions are fontified with level 2 and C++ actions are not fontified at all." - :group 'antlr :type '(choice (const :tag "None" none) (const :tag "Inherit" inherit) (const :tag "Default" nil) @@ -824,62 +721,49 @@ in the grammar's actions and semantic predicates, see (defface antlr-default '((t nil)) "Face to prevent strings from language dependent highlighting. -Do not change." - :group 'antlr) +Do not change.") (defface antlr-keyword - (cond-emacs-xemacs - '((((class color) (background light)) - (:foreground "black" :EMACS :weight bold :XEMACS :bold t)) - (t :inherit font-lock-keyword-face))) - "ANTLR keywords." - :group 'antlr) + '((((class color) (background light)) + (:foreground "black" :weight bold)) + (t :inherit font-lock-keyword-face)) + "ANTLR keywords.") (defface antlr-syntax - (cond-emacs-xemacs - '((((class color) (background light)) - (:foreground "black" :EMACS :weight bold :XEMACS :bold t)) - (t :inherit font-lock-constant-face))) - "ANTLR syntax symbols like :, |, (, ), ...." - :group 'antlr) + '((((class color) (background light)) + (:foreground "black" :weight bold)) + (t :inherit font-lock-constant-face)) + "ANTLR syntax symbols like :, |, (, ), ....") (defface antlr-ruledef - (cond-emacs-xemacs - '((((class color) (background light)) - (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)) - (t :inherit font-lock-function-name-face))) - "ANTLR rule references (definition)." - :group 'antlr) + '((((class color) (background light)) + (:foreground "blue" :weight bold)) + (t :inherit font-lock-function-name-face)) + "ANTLR rule references (definition).") (defface antlr-tokendef - (cond-emacs-xemacs - '((((class color) (background light)) - (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)) - (t :inherit font-lock-function-name-face))) - "ANTLR token references (definition)." - :group 'antlr) + '((((class color) (background light)) + (:foreground "blue" :weight bold)) + (t :inherit font-lock-function-name-face)) + "ANTLR token references (definition).") (defface antlr-ruleref '((((class color) (background light)) (:foreground "blue4")) (t :inherit font-lock-type-face)) - "ANTLR rule references (usage)." - :group 'antlr) + "ANTLR rule references (usage).") (defface antlr-tokenref '((((class color) (background light)) (:foreground "orange4")) (t :inherit font-lock-type-face)) - "ANTLR token references (usage)." - :group 'antlr) + "ANTLR token references (usage).") (defface antlr-literal - (cond-emacs-xemacs - '((((class color) (background light)) - (:foreground "brown4" :EMACS :weight bold :XEMACS :bold t)) - (t :inherit font-lock-string-face))) + '((((class color) (background light)) + (:foreground "brown4" :weight bold)) + (t :inherit font-lock-string-face)) "ANTLR special literal tokens. It is used to highlight strings matched by the first regexp group of -`antlr-font-lock-literal-regexp'." - :group 'antlr) +`antlr-font-lock-literal-regexp'.") (defcustom antlr-font-lock-literal-regexp "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" "Regexp matching literals with special syntax highlighting, or nil. @@ -887,7 +771,6 @@ If nil, there is no special syntax highlighting for some literals. Otherwise, it should be a regular expression which must contain a regexp group. The string matched by the first group is highlighted with `antlr-font-lock-literal-face'." - :group 'antlr :type '(choice (const :tag "None" nil) regexp)) (defvar antlr-class-header-regexp @@ -895,50 +778,48 @@ group. The string matched by the first group is highlighted with "Regexp matching class headers.") (defvar antlr-font-lock-additional-keywords - (cond-emacs-xemacs - `((antlr-invalidate-context-cache) - ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))" - (1 'antlr-tokendef)) - ("\\$\\sw+" (0 'antlr-keyword)) - ;; the tokens are already fontified as string/docstrings: - (,(lambda (limit) - (if antlr-font-lock-literal-regexp - (antlr-re-search-forward antlr-font-lock-literal-regexp limit))) - (1 'antlr-literal t) - :XEMACS (0 nil)) ; XEmacs bug workaround - (,(lambda (limit) - (antlr-re-search-forward antlr-class-header-regexp limit)) - (1 'antlr-keyword) - (2 'antlr-ruledef) - (3 'antlr-keyword) - (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser")) - 'antlr-keyword - 'font-lock-type-face))) - (,(lambda (limit) - (antlr-re-search-forward - "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>" - limit)) + `((antlr-invalidate-context-cache) + ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))" + (1 'antlr-tokendef)) + ("\\$\\sw+" (0 'antlr-keyword)) + ;; the tokens are already fontified as string/docstrings: + (,(lambda (limit) + (if antlr-font-lock-literal-regexp + (antlr-re-search-forward antlr-font-lock-literal-regexp limit))) + (1 'antlr-literal t)) + (,(lambda (limit) + (antlr-re-search-forward antlr-class-header-regexp limit)) + (1 'antlr-keyword) + (2 'antlr-ruledef) + (3 'antlr-keyword) + (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser")) + 'antlr-keyword + 'font-lock-type-face))) + (,(lambda (limit) + (antlr-re-search-forward + "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>" + limit)) (1 'antlr-keyword)) - (,(lambda (limit) - (antlr-re-search-forward - "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?" - limit)) - (1 'font-lock-type-face) ; not XEmacs's java level-3 fruit salad + (,(lambda (limit) + (antlr-re-search-forward + "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?" + limit)) + (1 'font-lock-type-face) ; not XEmacs's java level-3 fruit salad (3 (if (antlr-upcase-p (char-after (match-beginning 3))) 'antlr-tokendef 'antlr-ruledef) nil t) (4 'antlr-syntax nil t)) - (,(lambda (limit) - (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit)) + (,(lambda (limit) + (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit)) (1 (if (antlr-upcase-p (char-after (match-beginning 0))) 'antlr-tokendef 'antlr-ruledef) nil t) (2 'antlr-syntax nil t)) - (,(lambda (limit) - ;; v:ruleref and v:"literal" is allowed... - (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit)) + (,(lambda (limit) + ;; v:ruleref and v:"literal" is allowed... + (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit)) (1 (if (match-beginning 2) (if (eq (char-after (match-beginning 2)) ?=) 'antlr-default @@ -947,9 +828,9 @@ group. The string matched by the first group is highlighted with 'antlr-tokenref 'antlr-ruleref))) (2 'antlr-default nil t)) - (,(lambda (limit) - (antlr-re-search-forward "[|&:;(~]\\|)\\([*+?]\\|=>\\)?" limit)) - (0 'antlr-syntax)))) + (,(lambda (limit) + (antlr-re-search-forward "[|&:;(~]\\|)\\([*+?]\\|=>\\)?" limit)) + (0 'antlr-syntax))) "Font-lock keywords for ANTLR's normal grammar code. See `antlr-font-lock-keywords-alist' for the keywords of actions.") @@ -1015,35 +896,6 @@ Used for `antlr-slow-syntactic-context'.") ;;; Syntax functions -- Emacs vs XEmacs dependent, part 1 ;;;=========================================================================== -;; From help.el (XEmacs-21.1), without `copy-syntax-table' -(defmacro antlr-with-syntax-table (syntab &rest body) - "Evaluate BODY with the syntax table SYNTAB." - `(let ((stab (syntax-table))) - (unwind-protect - (progn (set-syntax-table ,syntab) ,@body) - (set-syntax-table stab)))) -(put 'antlr-with-syntax-table 'lisp-indent-function 1) -(put 'antlr-with-syntax-table 'edebug-form-spec '(form body)) - -(defunx antlr-default-directory () - :xemacs-and-try default-directory - "Return `default-directory'." - default-directory) - -;; Check Emacs-21.1 simple.el, `shell-command'. -(defunx antlr-read-shell-command (prompt &optional initial-input history) - :xemacs-and-try read-shell-command - "Read a string from the minibuffer, using `shell-command-history'." - (read-from-minibuffer prompt initial-input nil nil - (or history 'shell-command-history))) - -(defunx antlr-with-displaying-help-buffer (thunk &optional _name) - :xemacs-and-try with-displaying-help-buffer - "Make a help buffer and call `thunk' there." - (with-output-to-temp-buffer "*Help*" - (save-excursion (funcall thunk)))) - - ;;;=========================================================================== ;;; Context cache ;;;=========================================================================== @@ -1056,26 +908,18 @@ Used for `antlr-slow-syntactic-context'.") ;;;(defvar antlr-statistics-cache 0) ;;;(defvar antlr-statistics-inval 0) -(defunx antlr-invalidate-context-cache (&rest _dummies) +(defun antlr-invalidate-context-cache (&rest _dummies) ;; checkdoc-params: (dummies) "Invalidate context cache for syntactical context information." - :XEMACS ; XEmacs bug workaround - (with-current-buffer (get-buffer-create " ANTLR XEmacs bug workaround") - (buffer-syntactic-context-depth) - nil) - :EMACS ;;; (cl-incf antlr-statistics-inval) (setq antlr-slow-context-cache nil)) -(defunx antlr-syntactic-context () +(defun antlr-syntactic-context () "Return some syntactic context information. Return `string' if point is within a string, `block-comment' or `comment' is point is within a comment or the depth within all parenthesis-syntax delimiters at point otherwise. WARNING: this may alter `match-data'." - :XEMACS - (or (buffer-syntactic-context) (buffer-syntactic-context-depth)) - :EMACS (let ((orig (point)) diff state ;; Arg, Emacs's (buffer-modified-tick) changes with font-lock. Use ;; hack that `loudly' is bound during font-locking => cache use will @@ -1094,9 +938,9 @@ WARNING: this may alter `match-data'." (if (>= orig antlr-slow-cache-diff-threshold) (beginning-of-defun) (goto-char (point-min))) -;;; (cond ((and diff (< diff 0)) (cl-incf antlr-statistics-full-neg)) -;;; ((and diff (>= diff 3000)) (cl-incf antlr-statistics-full-diff)) -;;; (t (cl-incf antlr-statistics-full-other))) + ;; (cond ((and diff (< diff 0)) (cl-incf antlr-statistics-full-neg)) + ;; ((and diff (>= diff 3000)) (cl-incf antlr-statistics-full-diff)) + ;; (t (cl-incf antlr-statistics-full-other))) (setq state (parse-partial-sexp (point) orig))) (goto-char orig) (if antlr-slow-context-cache @@ -1108,52 +952,52 @@ WARNING: this may alter `match-data'." ((nth 4 state) 'comment) ; block-comment? -- we don't care (t (car state))))) -;;; (cl-incf (aref antlr-statistics 2)) -;;; (unless (and (eq (current-buffer) -;;; (caar antlr-slow-context-cache)) -;;; (eq (buffer-modified-tick) -;;; (cdar antlr-slow-context-cache))) -;;; (cl-incf (aref antlr-statistics 1)) -;;; (setq antlr-slow-context-cache nil)) -;;; (let* ((orig (point)) -;;; (base (cadr antlr-slow-context-cache)) -;;; (curr (cddr antlr-slow-context-cache)) -;;; (state (cond ((eq orig (car curr)) (cdr curr)) -;;; ((eq orig (car base)) (cdr base)))) -;;; diff diff2) -;;; (unless state -;;; (cl-incf (aref antlr-statistics 3)) -;;; (when curr -;;; (if (< (setq diff (abs (- orig (car curr)))) -;;; (setq diff2 (abs (- orig (car base))))) -;;; (setq state curr) -;;; (setq state base -;;; diff diff2)) -;;; (if (or (>= (1+ diff) (point)) (>= diff 3000)) -;;; (setq state nil))) ; start from bod/bob -;;; (if state -;;; (setq state -;;; (parse-partial-sexp (car state) orig nil nil (cdr state))) -;;; (if (>= orig 3000) (beginning-of-defun) (goto-char (point-min))) -;;; (cl-incf (aref antlr-statistics 4)) -;;; (setq cw (list orig (point) base curr)) -;;; (setq state (parse-partial-sexp (point) orig))) -;;; (goto-char orig) -;;; (if antlr-slow-context-cache -;;; (setcdr (cdr antlr-slow-context-cache) (cons orig state)) -;;; (setq antlr-slow-context-cache -;;; (cons (cons (current-buffer) (buffer-modified-tick)) -;;; (cons (cons orig state) (cons orig state)))))) -;;; (cond ((nth 3 state) 'string) -;;; ((nth 4 state) 'comment) ; block-comment? -- we don't care -;;; (t (car state))))) - -;;; (beginning-of-defun) -;;; (let ((state (parse-partial-sexp (point) orig))) -;;; (goto-char orig) -;;; (cond ((nth 3 state) 'string) -;;; ((nth 4 state) 'comment) ; block-comment? -- we don't care -;;; (t (car state)))))) +;; (cl-incf (aref antlr-statistics 2)) +;; (unless (and (eq (current-buffer) +;; (caar antlr-slow-context-cache)) +;; (eq (buffer-modified-tick) +;; (cdar antlr-slow-context-cache))) +;; (cl-incf (aref antlr-statistics 1)) +;; (setq antlr-slow-context-cache nil)) +;; (let* ((orig (point)) +;; (base (cadr antlr-slow-context-cache)) +;; (curr (cddr antlr-slow-context-cache)) +;; (state (cond ((eq orig (car curr)) (cdr curr)) +;; ((eq orig (car base)) (cdr base)))) +;; diff diff2) +;; (unless state +;; (cl-incf (aref antlr-statistics 3)) +;; (when curr +;; (if (< (setq diff (abs (- orig (car curr)))) +;; (setq diff2 (abs (- orig (car base))))) +;; (setq state curr) +;; (setq state base +;; diff diff2)) +;; (if (or (>= (1+ diff) (point)) (>= diff 3000)) +;; (setq state nil))) ; start from bod/bob +;; (if state +;; (setq state +;; (parse-partial-sexp (car state) orig nil nil (cdr state))) +;; (if (>= orig 3000) (beginning-of-defun) (goto-char (point-min))) +;; (cl-incf (aref antlr-statistics 4)) +;; (setq cw (list orig (point) base curr)) +;; (setq state (parse-partial-sexp (point) orig))) +;; (goto-char orig) +;; (if antlr-slow-context-cache +;; (setcdr (cdr antlr-slow-context-cache) (cons orig state)) +;; (setq antlr-slow-context-cache +;; (cons (cons (current-buffer) (buffer-modified-tick)) +;; (cons (cons orig state) (cons orig state)))))) +;; (cond ((nth 3 state) 'string) +;; ((nth 4 state) 'comment) ; block-comment? -- we don't care +;; (t (car state))))) + +;; (beginning-of-defun) +;; (let ((state (parse-partial-sexp (point) orig))) +;; (goto-char orig) +;; (cond ((nth 3 state) 'string) +;; ((nth 4 state) 'comment) ; block-comment? -- we don't care +;; (t (car state)))))) ;;;=========================================================================== @@ -1207,7 +1051,7 @@ strings and actions/semantic predicates." (defsubst antlr-skip-sexps (count) "Skip the next COUNT balanced expressions and the comments after it. Return position before the comments after the last expression." - (goto-char (or (ignore-errors-x (scan-sexps (point) count)) (point-max))) + (goto-char (or (ignore-errors (scan-sexps (point) count)) (point-max))) (prog1 (point) (antlr-c-forward-sws))) @@ -1229,7 +1073,8 @@ See `antlr-font-lock-additional-keywords', `antlr-language' and antlr-font-lock-keywords-alist)) (if (eq antlr-font-lock-maximum-decoration 'inherit) font-lock-maximum-decoration - antlr-font-lock-maximum-decoration))))))) + antlr-font-lock-maximum-decoration))) + t)))) ;;;=========================================================================== @@ -1248,7 +1093,7 @@ IF TOKENREFS-ONLY is non-nil, just return alist with tokenref names." (continue t)) ;; The generic imenu function searches backward, which is slower ;; and more likely not to work during editing. - (antlr-with-syntax-table antlr-action-syntax-table + (with-syntax-table antlr-action-syntax-table (antlr-invalidate-context-cache) (goto-char (point-min)) (antlr-skip-file-prelude t) @@ -1392,37 +1237,37 @@ Move to the beginning of the current rule if point is inside a rule." A grammar class header and the file prelude are also considered as a rule." (save-excursion - (antlr-with-syntax-table antlr-action-syntax-table + (with-syntax-table antlr-action-syntax-table (not (antlr-outside-rule-p))))) -(defunx antlr-end-of-rule (&optional arg) +(defun antlr-end-of-rule (&optional arg) "Move forward to next end of rule. Do it ARG [default: 1] many times. A grammar class header and the file prelude are also considered as a rule. Negative argument ARG means move back to ARGth preceding end of rule. If ARG is zero, run `antlr-end-of-body'." - (interactive "_p") + (interactive "^p") (if (zerop arg) (antlr-end-of-body) - (antlr-with-syntax-table antlr-action-syntax-table + (with-syntax-table antlr-action-syntax-table (antlr-next-rule arg nil)))) -(defunx antlr-beginning-of-rule (&optional arg) +(defun antlr-beginning-of-rule (&optional arg) "Move backward to preceding beginning of rule. Do it ARG many times. A grammar class header and the file prelude are also considered as a rule. Negative argument ARG means move forward to ARGth next beginning of rule. If ARG is zero, run `antlr-beginning-of-body'." - (interactive "_p") + (interactive "^p") (if (zerop arg) (antlr-beginning-of-body) - (antlr-with-syntax-table antlr-action-syntax-table + (with-syntax-table antlr-action-syntax-table (antlr-next-rule (- arg) t)))) -(defunx antlr-end-of-body (&optional msg) +(defun antlr-end-of-body (&optional msg) "Move to position after the `;' of the current rule. A grammar class header is also considered as a rule. With optional prefix arg MSG, move to `:'." - (interactive "_") - (antlr-with-syntax-table antlr-action-syntax-table + (interactive "^") + (with-syntax-table antlr-action-syntax-table (let ((orig (point))) (if (antlr-outside-rule-p) (error "Outside an ANTLR rule")) @@ -1440,9 +1285,9 @@ prefix arg MSG, move to `:'." (error msg)) (antlr-c-forward-sws)))))) -(defunx antlr-beginning-of-body () +(defun antlr-beginning-of-body () "Move to the first element after the `:' of the current rule." - (interactive "_") + (interactive "^") (antlr-end-of-body "Class headers and the file prelude are without `:'")) @@ -1458,7 +1303,7 @@ If non-nil, TRANSFORM is used on literals instead of `downcase-region'." (let ((literals 0)) (save-excursion (goto-char (point-min)) - (antlr-with-syntax-table antlr-action-syntax-table + (with-syntax-table antlr-action-syntax-table (antlr-invalidate-context-cache) (while (antlr-re-search-forward "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" nil) (funcall transform (match-beginning 0) (match-end 0)) @@ -1487,10 +1332,10 @@ Display a message unless optional argument SILENT is non-nil." (antlr-hide-actions 0 t) (save-excursion (goto-char (point-min)) - (antlr-with-syntax-table antlr-action-syntax-table + (with-syntax-table antlr-action-syntax-table (antlr-invalidate-context-cache) (while (antlr-re-search-forward regexp nil) - (let ((beg (ignore-errors-x (scan-sexps (point) -1)))) + (let ((beg (ignore-errors (scan-sexps (point) -1)))) (when beg (if diff ; braces are visible (if (> (point) (+ beg diff)) @@ -1683,7 +1528,7 @@ like \(AREA . PLACE), see `antlr-option-location'." (cond ((null pos) 'error) ((looking-at "options[ \t\n]*{") (goto-char (match-end 0)) - (setq pos (ignore-errors-x (scan-lists (point) 1 1))) + (setq pos (ignore-errors (scan-lists (point) 1 1))) (antlr-option-location orig min0 max0 (point) (if pos (1- pos) (point-max)) @@ -1708,7 +1553,7 @@ is undefined." (widen) (if (eq requested 1) 1 - (antlr-with-syntax-table antlr-action-syntax-table + (with-syntax-table antlr-action-syntax-table (antlr-invalidate-context-cache) (let* ((orig (point)) (outsidep (antlr-outside-rule-p)) @@ -2086,7 +1931,7 @@ its export vocabulary is used as an import vocabulary." (unless buffer-file-name (error "Grammar buffer does not visit a file")) (let (classes export-vocabs import-vocabs superclasses default-vocab) - (antlr-with-syntax-table antlr-action-syntax-table + (with-syntax-table antlr-action-syntax-table (goto-char (point-min)) (while (antlr-re-search-forward antlr-class-header-regexp nil) ;; parse class definition -------------------------------------------- @@ -2239,9 +2084,9 @@ Use prefix argument ARG to return \(COMMAND FILE SAVED)." (setq glibs (car (antlr-superclasses-glibs supers (car (antlr-directory-dependencies - (antlr-default-directory))))))) - (list (antlr-read-shell-command "Run Antlr on current file with: " - (concat antlr-tool-command glibs " ")) + default-directory)))))) + (list (read-shell-command "Run Antlr on current file with: " + (concat antlr-tool-command glibs " ")) buffer-file-name supers))) @@ -2263,7 +2108,7 @@ Also insert strings PRE and POST before and after the variable." "Insert Makefile rules in the current buffer at point. IN-MAKEFILE is non-nil, if the current buffer is the Makefile. See command `antlr-show-makefile-rules' for detail." - (let* ((dirname (antlr-default-directory)) + (let* ((dirname default-directory) (deps0 (antlr-directory-dependencies dirname)) (classes (car deps0)) ; CLASS -> (FILE . EVOCAB) ... (deps (cdr deps0)) ; FILE -> (c . s) (ev . iv) . LANGUAGE @@ -2342,7 +2187,9 @@ commentary with value `antlr-help-unknown-file-text' is added. The *Help* buffer always starts with the text in `antlr-help-rules-intro'." (interactive) (if (null (derived-mode-p 'makefile-mode)) - (antlr-with-displaying-help-buffer 'antlr-insert-makefile-rules) + (with-output-to-temp-buffer "*Help*" + (save-excursion + (antlr-insert-makefile-rules))) (push-mark) (antlr-insert-makefile-rules t))) @@ -2385,7 +2232,7 @@ to a lesser extent, `antlr-tab-offset-alist'." (skip-chars-forward " \t") (setq boi (point)) ;; check syntax at beginning of indentation ---------------------------- - (antlr-with-syntax-table antlr-action-syntax-table + (with-syntax-table antlr-action-syntax-table (antlr-invalidate-context-cache) (setq syntax (antlr-syntactic-context)) (cond ((symbolp syntax) @@ -2481,7 +2328,7 @@ ANTLR's syntax and influences the auto indentation, see (interactive "*P") (if (or arg (save-excursion (skip-chars-backward " \t") (not (bolp))) - (antlr-with-syntax-table antlr-action-syntax-table + (with-syntax-table antlr-action-syntax-table (antlr-invalidate-context-cache) (let ((context (antlr-syntactic-context))) (not (and (numberp context) @@ -2524,7 +2371,7 @@ ANTLR's syntax and influences the auto indentation, see (while settings (when (boundp (car settings)) (ignore-errors - (set (car settings) (eval (cadr settings))))) + (set (car settings) (eval (cadr settings) t)))) (setq settings (cddr settings))))) (defun antlr-language-option (search) @@ -2571,20 +2418,11 @@ the default language." (cadr (assq antlr-language antlr-language-alist))))) ;; indentation, for the C engine ------------------------------------------- (setq c-buffer-is-cc-mode antlr-language) - (cond ((fboundp 'c-init-language-vars-for) ; cc-mode 5.30.5+ - (c-init-language-vars-for antlr-language)) - ((fboundp 'c-init-c-language-vars) ; cc-mode 5.30 to 5.30.4 - (c-init-c-language-vars) ; not perfect, but OK - (setq c-recognize-knr-p nil)) - ((fboundp 'c-init-language-vars) ; cc-mode 5.29 - (let ((init-fn 'c-init-language-vars)) - (funcall init-fn))) ; is a function in v5.29 - (t ; cc-mode upto 5.28 - (antlr-c-init-language-vars))) ; do it myself + (c-init-language-vars-for antlr-language) (c-basic-common-init antlr-language (or antlr-indent-style "gnu")) (set (make-local-variable 'outline-regexp) "[^#\n\^M]") - (set (make-local-variable 'outline-level) 'c-outline-level) ;TODO: define own - (set (make-local-variable 'indent-line-function) 'antlr-indent-line) + (set (make-local-variable 'outline-level) #'c-outline-level) ;TODO: define own + (set (make-local-variable 'indent-line-function) #'antlr-indent-line) (set (make-local-variable 'indent-region-function) nil) ; too lazy (setq comment-start "// " comment-end "" @@ -2594,7 +2432,7 @@ the default language." (when (featurep 'xemacs) (easy-menu-add antlr-mode-menu)) (set (make-local-variable 'imenu-create-index-function) - 'antlr-imenu-create-index-function) + #'antlr-imenu-create-index-function) (set (make-local-variable 'imenu-generic-expression) t) ; fool stupid test (and antlr-imenu-name ; there should be a global variable... (fboundp 'imenu-add-to-menubar) @@ -2624,6 +2462,6 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'." (provide 'antlr-mode) -;;; Local IspellPersDict: .ispell_antlr +;; Local IspellPersDict: .ispell_antlr ;;; antlr-mode.el ends here diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 9038c7bd95a..4cf7af843b7 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -4319,38 +4319,29 @@ mhtml-mode." (setq c-state-nonlit-pos-cache-limit (1- here))) (c-truncate-lit-pos-cache here) - ;; `c-state-cache': - ;; Case 1: if `here' is in a literal containing point-min, everything - ;; becomes (or is already) nil. - (if (or (null c-state-cache-good-pos) - (< here (c-state-get-min-scan-pos))) - (setq c-state-cache nil - c-state-cache-good-pos nil - c-state-min-scan-pos nil) - - ;; Truncate `c-state-cache' and set `c-state-cache-good-pos' to a value - ;; below `here'. To maintain its consistency, we may need to insert a new - ;; brace pair. - (let ((here-bol (c-point 'bol here)) - too-high-pa ; recorded {/(/[ next above or just below here, or nil. - dropped-cons) ; was the last removed element a brace pair? - ;; The easy bit - knock over-the-top bits off `c-state-cache'. - (while (and c-state-cache - (>= (c-state-cache-top-paren) here)) - (setq dropped-cons (consp (car c-state-cache)) - too-high-pa (c-state-cache-top-lparen) - c-state-cache (cdr c-state-cache))) - - ;; Do we need to add in an earlier brace pair, having lopped one off? - (if (and dropped-cons - (<= too-high-pa here)) - (c-append-lower-brace-pair-to-state-cache too-high-pa here here-bol)) - (if (and c-state-cache-good-pos (< here c-state-cache-good-pos)) - (setq c-state-cache-good-pos - (or (save-excursion - (goto-char here) - (c-literal-start)) - here))))) + (cond + ;; `c-state-cache': + ;; Case 1: if `here' is in a literal containing point-min, everything + ;; becomes (or is already) nil. + ((or (null c-state-cache-good-pos) + (< here (c-state-get-min-scan-pos))) + (setq c-state-cache nil + c-state-cache-good-pos nil + c-state-min-scan-pos nil)) + + ;; Case 2: `here' is below `c-state-cache-good-pos', so we need to amend + ;; the entire `c-state-cache' data. + ((< here c-state-cache-good-pos) + (let* ((res (c-remove-stale-state-cache-backwards here)) + (good-pos (car res)) + (scan-backward-pos (cadr res)) + (scan-forward-p (car (cddr res)))) + (if scan-backward-pos + (c-append-lower-brace-pair-to-state-cache scan-backward-pos here)) + (setq c-state-cache-good-pos + (if scan-forward-p + (c-append-to-state-cache good-pos here) + good-pos))))) ;; The brace-pair desert marker: (when (car c-state-brace-pair-desert) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index db142c0dc3e..6b22228397c 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1044,166 +1044,161 @@ versions of Emacs." map) "Keymap used in CPerl mode.") -(defvar cperl-menu) (defvar cperl-lazy-installed) (defvar cperl-old-style nil) -(condition-case nil - (progn - (require 'easymenu) - (easy-menu-define - cperl-menu cperl-mode-map "Menu for CPerl mode" - '("Perl" - ["Beginning of function" beginning-of-defun t] - ["End of function" end-of-defun t] - ["Mark function" mark-defun t] - ["Indent expression" cperl-indent-exp t] - ["Fill paragraph/comment" fill-paragraph t] - "----" - ["Line up a construction" cperl-lineup (use-region-p)] - ["Invert if/unless/while etc" cperl-invert-if-unless t] - ("Regexp" - ["Beautify" cperl-beautify-regexp - cperl-use-syntax-table-text-property] - ["Beautify one level deep" (cperl-beautify-regexp 1) - cperl-use-syntax-table-text-property] - ["Beautify a group" cperl-beautify-level - cperl-use-syntax-table-text-property] - ["Beautify a group one level deep" (cperl-beautify-level 1) - cperl-use-syntax-table-text-property] - ["Contract a group" cperl-contract-level - cperl-use-syntax-table-text-property] - ["Contract groups" cperl-contract-levels - cperl-use-syntax-table-text-property] - "----" - ["Find next interpolated" cperl-next-interpolated-REx - (next-single-property-change (point-min) 'REx-interpolated)] - ["Find next interpolated (no //o)" - cperl-next-interpolated-REx-0 - (or (text-property-any (point-min) (point-max) 'REx-interpolated t) - (text-property-any (point-min) (point-max) 'REx-interpolated 1))] - ["Find next interpolated (neither //o nor whole-REx)" - cperl-next-interpolated-REx-1 - (text-property-any (point-min) (point-max) 'REx-interpolated t)]) - ["Insert spaces if needed to fix style" cperl-find-bad-style t] - ["Refresh \"hard\" constructions" cperl-find-pods-heres t] - "----" - ["Indent region" cperl-indent-region (use-region-p)] - ["Comment region" cperl-comment-region (use-region-p)] - ["Uncomment region" cperl-uncomment-region (use-region-p)] - "----" - ["Run" mode-compile (fboundp 'mode-compile)] - ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill) - (get-buffer "*compilation*"))] - ["Next error" next-error (get-buffer "*compilation*")] - ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)] - "----" - ["Debugger" cperl-db t] - "----" - ("Tools" - ["Imenu" imenu (fboundp 'imenu)] - ["Imenu on Perl Info" cperl-imenu-on-info (featurep 'imenu)] - "----" - ["Ispell PODs" cperl-pod-spell - ;; Better not to update syntaxification here: - ;; debugging syntaxification can be broken by this??? - (or - (get-text-property (point-min) 'in-pod) - (< (progn - (and cperl-syntaxify-for-menu - (cperl-update-syntaxification (point-max))) - (next-single-property-change (point-min) 'in-pod nil (point-max))) - (point-max)))] - ["Ispell HERE-DOCs" cperl-here-doc-spell - (< (progn - (and cperl-syntaxify-for-menu - (cperl-update-syntaxification (point-max))) - (next-single-property-change (point-min) 'here-doc-group nil (point-max))) - (point-max))] - ["Narrow to this HERE-DOC" cperl-narrow-to-here-doc - (eq 'here-doc (progn - (and cperl-syntaxify-for-menu - (cperl-update-syntaxification (point))) - (get-text-property (point) 'syntax-type)))] - ["Select this HERE-DOC or POD section" - cperl-select-this-pod-or-here-doc - (memq (progn - (and cperl-syntaxify-for-menu - (cperl-update-syntaxification (point))) - (get-text-property (point) 'syntax-type)) - '(here-doc pod))] - "----" - ["CPerl pretty print (experimental)" cperl-ps-print - (fboundp 'ps-extend-face-list)] - "----" - ["Syntaxify region" cperl-find-pods-heres-region - (use-region-p)] - ["Profile syntaxification" cperl-time-fontification t] - ["Debug errors in delayed fontification" cperl-emulate-lazy-lock t] - ["Debug unwind for syntactic scan" cperl-toggle-set-debug-unwind t] - ["Debug backtrace on syntactic scan (BEWARE!!!)" - (cperl-toggle-set-debug-unwind nil t) t] - "----" - ["Class Hierarchy from TAGS" cperl-tags-hier-init t] - ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] - ("Tags" - ;; ["Create tags for current file" cperl-etags t] - ;; ["Add tags for current file" (cperl-etags t) t] - ;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] - ;; ["Add tags for Perl files in directory" (cperl-etags t t) t] - ;; ["Create tags for Perl files in (sub)directories" - ;; (cperl-etags nil 'recursive) t] - ;; ["Add tags for Perl files in (sub)directories" - ;; (cperl-etags t 'recursive) t]) - ;; ;;? cperl-write-tags (&optional file erase recurse dir inbuffer) - ["Create tags for current file" (cperl-write-tags nil t) t] - ["Add tags for current file" (cperl-write-tags) t] - ["Create tags for Perl files in directory" - (cperl-write-tags nil t nil t) t] - ["Add tags for Perl files in directory" - (cperl-write-tags nil nil nil t) t] - ["Create tags for Perl files in (sub)directories" - (cperl-write-tags nil t t t) t] - ["Add tags for Perl files in (sub)directories" - (cperl-write-tags nil nil t t) t])) - ("Perl docs" - ["Define word at point" imenu-go-find-at-position - (fboundp 'imenu-go-find-at-position)] - ["Help on function" cperl-info-on-command t] - ["Help on function at point" cperl-info-on-current-command t] - ["Help on symbol at point" cperl-get-help t] - ["Perldoc" cperl-perldoc t] - ["Perldoc on word at point" cperl-perldoc-at-point t] - ["View manpage of POD in this file" cperl-build-manpage t] - ["Auto-help on" cperl-lazy-install - (not cperl-lazy-installed)] - ["Auto-help off" cperl-lazy-unstall - cperl-lazy-installed]) - ("Toggle..." - ["Auto newline" cperl-toggle-auto-newline t] - ["Electric parens" cperl-toggle-electric t] - ["Electric keywords" cperl-toggle-abbrev t] - ["Fix whitespace on indent" cperl-toggle-construct-fix t] - ["Auto-help on Perl constructs" cperl-toggle-autohelp t] - ["Auto fill" auto-fill-mode t]) - ("Indent styles..." - ["CPerl" (cperl-set-style "CPerl") t] - ["PBP" (cperl-set-style "PBP") t] - ["PerlStyle" (cperl-set-style "PerlStyle") t] - ["GNU" (cperl-set-style "GNU") t] - ["C++" (cperl-set-style "C++") t] - ["K&R" (cperl-set-style "K&R") t] - ["BSD" (cperl-set-style "BSD") t] - ["Whitesmith" (cperl-set-style "Whitesmith") t] - ["Memorize Current" (cperl-set-style "Current") t] - ["Memorized" (cperl-set-style-back) cperl-old-style]) - ("Micro-docs" - ["Tips" (describe-variable 'cperl-tips) t] - ["Problems" (describe-variable 'cperl-problems) t] - ["Speed" (describe-variable 'cperl-speed) t] - ["Praise" (describe-variable 'cperl-praise) t] - ["Faces" (describe-variable 'cperl-tips-faces) t] - ["CPerl mode" (describe-function 'cperl-mode) t])))) - (error nil)) +(easy-menu-define cperl-menu cperl-mode-map + "Menu for CPerl mode." + '("Perl" + ["Beginning of function" beginning-of-defun t] + ["End of function" end-of-defun t] + ["Mark function" mark-defun t] + ["Indent expression" cperl-indent-exp t] + ["Fill paragraph/comment" fill-paragraph t] + "----" + ["Line up a construction" cperl-lineup (use-region-p)] + ["Invert if/unless/while etc" cperl-invert-if-unless t] + ("Regexp" + ["Beautify" cperl-beautify-regexp + cperl-use-syntax-table-text-property] + ["Beautify one level deep" (cperl-beautify-regexp 1) + cperl-use-syntax-table-text-property] + ["Beautify a group" cperl-beautify-level + cperl-use-syntax-table-text-property] + ["Beautify a group one level deep" (cperl-beautify-level 1) + cperl-use-syntax-table-text-property] + ["Contract a group" cperl-contract-level + cperl-use-syntax-table-text-property] + ["Contract groups" cperl-contract-levels + cperl-use-syntax-table-text-property] + "----" + ["Find next interpolated" cperl-next-interpolated-REx + (next-single-property-change (point-min) 'REx-interpolated)] + ["Find next interpolated (no //o)" + cperl-next-interpolated-REx-0 + (or (text-property-any (point-min) (point-max) 'REx-interpolated t) + (text-property-any (point-min) (point-max) 'REx-interpolated 1))] + ["Find next interpolated (neither //o nor whole-REx)" + cperl-next-interpolated-REx-1 + (text-property-any (point-min) (point-max) 'REx-interpolated t)]) + ["Insert spaces if needed to fix style" cperl-find-bad-style t] + ["Refresh \"hard\" constructions" cperl-find-pods-heres t] + "----" + ["Indent region" cperl-indent-region (use-region-p)] + ["Comment region" cperl-comment-region (use-region-p)] + ["Uncomment region" cperl-uncomment-region (use-region-p)] + "----" + ["Run" mode-compile (fboundp 'mode-compile)] + ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill) + (get-buffer "*compilation*"))] + ["Next error" next-error (get-buffer "*compilation*")] + ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)] + "----" + ["Debugger" cperl-db t] + "----" + ("Tools" + ["Imenu" imenu (fboundp 'imenu)] + ["Imenu on Perl Info" cperl-imenu-on-info (featurep 'imenu)] + "----" + ["Ispell PODs" cperl-pod-spell + ;; Better not to update syntaxification here: + ;; debugging syntaxification can be broken by this??? + (or + (get-text-property (point-min) 'in-pod) + (< (progn + (and cperl-syntaxify-for-menu + (cperl-update-syntaxification (point-max))) + (next-single-property-change (point-min) 'in-pod nil (point-max))) + (point-max)))] + ["Ispell HERE-DOCs" cperl-here-doc-spell + (< (progn + (and cperl-syntaxify-for-menu + (cperl-update-syntaxification (point-max))) + (next-single-property-change (point-min) 'here-doc-group nil (point-max))) + (point-max))] + ["Narrow to this HERE-DOC" cperl-narrow-to-here-doc + (eq 'here-doc (progn + (and cperl-syntaxify-for-menu + (cperl-update-syntaxification (point))) + (get-text-property (point) 'syntax-type)))] + ["Select this HERE-DOC or POD section" + cperl-select-this-pod-or-here-doc + (memq (progn + (and cperl-syntaxify-for-menu + (cperl-update-syntaxification (point))) + (get-text-property (point) 'syntax-type)) + '(here-doc pod))] + "----" + ["CPerl pretty print (experimental)" cperl-ps-print + (fboundp 'ps-extend-face-list)] + "----" + ["Syntaxify region" cperl-find-pods-heres-region + (use-region-p)] + ["Profile syntaxification" cperl-time-fontification t] + ["Debug errors in delayed fontification" cperl-emulate-lazy-lock t] + ["Debug unwind for syntactic scan" cperl-toggle-set-debug-unwind t] + ["Debug backtrace on syntactic scan (BEWARE!!!)" + (cperl-toggle-set-debug-unwind nil t) t] + "----" + ["Class Hierarchy from TAGS" cperl-tags-hier-init t] + ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] + ("Tags" + ;; ["Create tags for current file" cperl-etags t] + ;; ["Add tags for current file" (cperl-etags t) t] + ;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] + ;; ["Add tags for Perl files in directory" (cperl-etags t t) t] + ;; ["Create tags for Perl files in (sub)directories" + ;; (cperl-etags nil 'recursive) t] + ;; ["Add tags for Perl files in (sub)directories" + ;; (cperl-etags t 'recursive) t]) + ;; ;;? cperl-write-tags (&optional file erase recurse dir inbuffer) + ["Create tags for current file" (cperl-write-tags nil t) t] + ["Add tags for current file" (cperl-write-tags) t] + ["Create tags for Perl files in directory" + (cperl-write-tags nil t nil t) t] + ["Add tags for Perl files in directory" + (cperl-write-tags nil nil nil t) t] + ["Create tags for Perl files in (sub)directories" + (cperl-write-tags nil t t t) t] + ["Add tags for Perl files in (sub)directories" + (cperl-write-tags nil nil t t) t])) + ("Perl docs" + ["Define word at point" imenu-go-find-at-position + (fboundp 'imenu-go-find-at-position)] + ["Help on function" cperl-info-on-command t] + ["Help on function at point" cperl-info-on-current-command t] + ["Help on symbol at point" cperl-get-help t] + ["Perldoc" cperl-perldoc t] + ["Perldoc on word at point" cperl-perldoc-at-point t] + ["View manpage of POD in this file" cperl-build-manpage t] + ["Auto-help on" cperl-lazy-install + (not cperl-lazy-installed)] + ["Auto-help off" cperl-lazy-unstall + cperl-lazy-installed]) + ("Toggle..." + ["Auto newline" cperl-toggle-auto-newline t] + ["Electric parens" cperl-toggle-electric t] + ["Electric keywords" cperl-toggle-abbrev t] + ["Fix whitespace on indent" cperl-toggle-construct-fix t] + ["Auto-help on Perl constructs" cperl-toggle-autohelp t] + ["Auto fill" auto-fill-mode t]) + ("Indent styles..." + ["CPerl" (cperl-set-style "CPerl") t] + ["PBP" (cperl-set-style "PBP") t] + ["PerlStyle" (cperl-set-style "PerlStyle") t] + ["GNU" (cperl-set-style "GNU") t] + ["C++" (cperl-set-style "C++") t] + ["K&R" (cperl-set-style "K&R") t] + ["BSD" (cperl-set-style "BSD") t] + ["Whitesmith" (cperl-set-style "Whitesmith") t] + ["Memorize Current" (cperl-set-style "Current") t] + ["Memorized" (cperl-set-style-back) cperl-old-style]) + ("Micro-docs" + ["Tips" (describe-variable 'cperl-tips) t] + ["Problems" (describe-variable 'cperl-problems) t] + ["Speed" (describe-variable 'cperl-speed) t] + ["Praise" (describe-variable 'cperl-praise) t] + ["Faces" (describe-variable 'cperl-tips-faces) t] + ["CPerl mode" (describe-function 'cperl-mode) t]))) (autoload 'c-macro-expand "cmacexp" "Display the result of expanding all C macros occurring in the region. diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el index 4a8a20a2969..14eefdca1e6 100644 --- a/lisp/progmodes/dcl-mode.el +++ b/lisp/progmodes/dcl-mode.el @@ -93,10 +93,10 @@ Presently this includes some syntax, .OP.erators, and \"f$\" lexicals.") (defcustom dcl-basic-offset 4 "Number of columns to indent a block in DCL. A block is the commands between THEN-ELSE-ENDIF and between the commands -dcl-block-begin-regexp and dcl-block-end-regexp. +`dcl-block-begin-regexp' and `dcl-block-end-regexp'. The meaning of this variable may be changed if -dcl-calc-command-indent-function is set to a function." +`dcl-calc-command-indent-function' is set to a function." :type 'integer) @@ -105,7 +105,7 @@ dcl-calc-command-indent-function is set to a function." A continuation line is a line that follows a line ending with `-'. The meaning of this variable may be changed if -dcl-calc-cont-indent-function is set to a function." +`dcl-calc-cont-indent-function' is set to a function." :type 'integer) @@ -121,7 +121,7 @@ A command line is a line that starts with `$'." (defcustom dcl-margin-label-offset 2 "Number of columns to indent a margin label in DCL. A margin label is a label that doesn't begin or end a block, i.e. it -doesn't match dcl-block-begin-regexp or dcl-block-end-regexp." +doesn't match `dcl-block-begin-regexp' or `dcl-block-end-regexp'." :type 'integer) @@ -169,8 +169,8 @@ If this variable is nil, the indentation is calculated as CUR-INDENT + EXTRA-INDENT. This package includes two functions suitable for this: - dcl-calc-command-indent-multiple - dcl-calc-command-indent-hang" + `dcl-calc-command-indent-multiple' + `dcl-calc-command-indent-hang'" :type '(choice (const nil) function)) @@ -187,7 +187,7 @@ If this variable is nil, the indentation is calculated as CUR-INDENT + EXTRA-INDENT. This package includes one function suitable for this: - dcl-calc-cont-indent-relative" + `dcl-calc-cont-indent-relative'" :type 'function) @@ -286,49 +286,30 @@ See `imenu-generic-expression' for details." (define-key map "\C-c\C-o" 'dcl-set-option) (define-key map "\C-c\C-f" 'tempo-forward-mark) (define-key map "\C-c\C-b" 'tempo-backward-mark) - - (define-key map [menu-bar] (make-sparse-keymap)) - (define-key map [menu-bar dcl] - (cons "DCL" (make-sparse-keymap "DCL"))) - - ;; Define these in bottom-up order - (define-key map [menu-bar dcl tempo-backward-mark] - '("Previous template mark" . tempo-backward-mark)) - (define-key map [menu-bar dcl tempo-forward-mark] - '("Next template mark" . tempo-forward-mark)) - (define-key map [menu-bar dcl tempo-complete-tag] - '("Complete template tag" . tempo-complete-tag)) - (define-key map [menu-bar dcl dcl-separator-tempo] - '("--")) - (define-key map [menu-bar dcl dcl-save-all-options] - '("Save all options" . dcl-save-all-options)) - (define-key map [menu-bar dcl dcl-save-nondefault-options] - '("Save changed options" . dcl-save-nondefault-options)) - (define-key map [menu-bar dcl dcl-set-option] - '("Set option" . dcl-set-option)) - (define-key map [menu-bar dcl dcl-separator-option] - '("--")) - (define-key map [menu-bar dcl dcl-delete-indentation] - '("Delete indentation" . dcl-delete-indentation)) - (define-key map [menu-bar dcl dcl-split-line] - '("Split line" . dcl-split-line)) - (define-key map [menu-bar dcl dcl-indent-command] - '("Indent command" . dcl-indent-command)) - (define-key map [menu-bar dcl dcl-tab] - '("Indent line/insert tab" . dcl-tab)) - (define-key map [menu-bar dcl dcl-back-to-indentation] - '("Back to indentation" . dcl-back-to-indentation)) - (define-key map [menu-bar dcl dcl-forward-command] - '("End of statement" . dcl-forward-command)) - (define-key map [menu-bar dcl dcl-backward-command] - '("Beginning of statement" . dcl-backward-command)) - (define-key map [menu-bar dcl dcl-separator-movement] - '("--")) - (define-key map [menu-bar dcl imenu] - '("Buffer index menu" . imenu)) map) "Keymap used in DCL-mode buffers.") +(easy-menu-define dcl-mode-menu dcl-mode-map + "Menu for DCL-mode buffers." + '("DCL" + ["Buffer index menu" imenu] + "---" + ["Beginning of statement" dcl-backward-command] + ["End of statement" dcl-forward-command] + ["Back to indentation" dcl-back-to-indentation] + ["Indent line/insert tab" dcl-tab] + ["Indent command" dcl-indent-command] + ["Split line" dcl-split-line] + ["Delete indentation" dcl-delete-indentation] + "---" + ["Set option" dcl-set-option] + ["Save changed options" dcl-save-nondefault-options] + ["Save all options" dcl-save-all-options] + "---" + ["Complete template tag" tempo-complete-tag] + ["Next template mark" tempo-forward-mark] + ["Previous template mark" tempo-backward-mark])) + (defcustom dcl-ws-r "\\([ \t]*-[ \t]*\\(!.*\\)*\n\\)*[ \t]*" "Regular expression describing white space in a DCL command line. @@ -368,10 +349,10 @@ optionally followed by a comment, followed by a newline." (list "endif" "else" dcl-label-r) "Regexps that can trigger an electric reindent. A list of regexps that will trigger a reindent if the last letter -is defined as dcl-electric-character. +is defined as `dcl-electric-character'. E.g.: if this list contains `endif', the key `f' is defined as -dcl-electric-character and you have just typed the `f' in +`dcl-electric-character' and you have just typed the `f' in `endif', the line will be reindented." :type '(repeat regexp)) @@ -395,7 +376,7 @@ dcl-electric-character and you have just typed the `f' in (comment-start curval) (comment-start-skip curval) ) - "Options and default values for dcl-set-option. + "Options and default values for `dcl-set-option'. An alist with option variables and functions or keywords to get a default value for the option. @@ -409,8 +390,8 @@ toggle the opposite of the current value (for t/nil)") (mapcar (lambda (option-assoc) (format "%s" (car option-assoc))) dcl-option-alist) - "The history list for dcl-set-option. -Preloaded with all known option names from dcl-option-alist") + "The history list for `dcl-set-option'. +Preloaded with all known option names from `dcl-option-alist'") ;; Must be defined after dcl-cmd-r @@ -874,7 +855,7 @@ Returns one of the following symbols: ;;;--------------------------------------------------------------------------- (defun dcl-show-line-type () - "Test dcl-get-line-type." + "Test `dcl-get-line-type'." (interactive) (let ((type (dcl-get-line-type))) (cond @@ -919,8 +900,7 @@ $ if cond $ then $ if cond $ then -$ ! etc -" +$ ! etc" ;; calculate indentation if it's an interesting indent-type, ;; otherwise return nil to get the default indentation (let ((indent)) @@ -949,8 +929,7 @@ $ xxx If you use this function you will probably want to add \"then\" to dcl-electric-reindent-regexps and define the key \"n\" as -dcl-electric-character. -" +dcl-electric-character." (let ((case-fold-search t)) (save-excursion (cond @@ -993,17 +972,17 @@ see if the current lines should be indented. Analyze the current line to see if it should be `outdented'. Calculate the indentation of the current line, either with the default -method or by calling dcl-calc-command-indent-function if it is +method or by calling `dcl-calc-command-indent-function' if it is non-nil. If the current line should be outdented, calculate its indentation, either with the default method or by calling -dcl-calc-command-indent-function if it is non-nil. +`dcl-calc-command-indent-function' if it is non-nil. Rules for default indentation: -If it is the first line in the buffer, indent dcl-margin-offset. +If it is the first line in the buffer, indent `dcl-margin-offset'. Go to the previous command line with a command on it. Find out how much it is indented (cur-indent). @@ -1011,7 +990,7 @@ Look at the first word on the line to see if the indentation should be adjusted. Skip margin-label, continuations and comments while looking for the first word. Save this buffer position as `last-point'. If the first word after a label is SUBROUTINE, set extra-indent to -dcl-margin-offset. +`dcl-margin-offset'. First word extra-indent THEN +dcl-basic-offset @@ -1168,8 +1147,7 @@ Indented lines will align with either: * the innermost nonclosed parenthesis $ if ((a.eq.b .and. - d.eq.c .or. f$function(xxxx, - - yyy))) -" + yyy)))" (let ((case-fold-search t) indent) (save-excursion @@ -1349,7 +1327,7 @@ Adjusts indentation on the current line. Data lines are not indented." ;;;------------------------------------------------------------------------- (defun dcl-indent-command () - "Indents the complete command line that point is on. + "Indent the complete command line that point is on. This includes continuation lines." (interactive "*") (let ((type (dcl-get-line-type))) @@ -1396,7 +1374,7 @@ the lines indentation; otherwise insert a tab." ;;;------------------------------------------------------------------------- (defun dcl-electric-character (arg) - "Inserts a character and indents if necessary. + "Insert a character and indent if necessary. Insert a character if the user gave a numeric argument or the flag `dcl-electric-characters' is not set. If an argument was given, insert that many characters. @@ -1810,8 +1788,8 @@ Set or update the value of VAR in the current buffers ;;;------------------------------------------------------------------------- (defun dcl-save-all-options () - "Save all dcl-mode options for this buffer. -Saves or updates all dcl-mode related options in a `Local Variables:' + "Save all `dcl-mode' options for this buffer. +Saves or updates all `dcl-mode' related options in a `Local Variables:' section at the end of the current buffer." (interactive "*") (mapcar (lambda (option-assoc) diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index a174d4851e5..40bdaad574f 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -35,7 +35,6 @@ (require 'cl-lib) (require 'seq) -(require 'easymenu) (require 'view) (require 'ebuff-menu) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 2dd2702acb7..408da8a9628 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -182,7 +182,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") (defun emacs-lisp-byte-compile () "Byte compile the file containing the current buffer." - (interactive) + (interactive nil emacs-lisp-mode) (if buffer-file-name (byte-compile-file buffer-file-name) (error "The buffer must be saved in a file first"))) @@ -198,7 +198,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") (defun emacs-lisp-byte-compile-and-load () "Byte-compile the current file (if it has changed), then load compiled code." - (interactive) + (interactive nil emacs-lisp-mode) (emacs-lisp--before-compile-buffer) (require 'bytecomp) (byte-recompile-file buffer-file-name nil 0) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 869529ab2db..023c90cca5b 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1604,11 +1604,11 @@ that do nothing." ;; This might be a neat idea, but it's too hairy at the moment. ;;(defmacro tags-with-syntax (&rest body) +;; (declare (debug t)) ;; `(with-syntax-table ;; (with-current-buffer (find-file-noselect (file-of-tag)) ;; (syntax-table)) ;; ,@body)) -;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form)) ;; exact file name match, i.e. searched tag must match complete file ;; name including directories parts if there are some. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index d01803282aa..bd308e02203 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -287,8 +287,7 @@ LEVEL is passed to `display-warning', which is used to display the warning. If this form is included in a byte-compiled file, the generated warning contains an indication of the file that generated it." - (let* ((compile-file (and (boundp 'byte-compile-current-file) - (symbol-value 'byte-compile-current-file))) + (let* ((compile-file (macroexp-file-name)) (sublog (if (and compile-file (not load-file-name)) diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el index a36f020439d..d81fe1c753b 100644 --- a/lisp/progmodes/icon.el +++ b/lisp/progmodes/icon.el @@ -31,53 +31,48 @@ "Abbrev table in use in Icon-mode buffers.") (define-abbrev-table 'icon-mode-abbrev-table ()) -(defvar icon-mode-map () - "Keymap used in Icon mode.") -(if icon-mode-map - () +(defvar icon-mode-map (let ((map (make-sparse-keymap "Icon"))) - (setq icon-mode-map (make-sparse-keymap)) - (define-key icon-mode-map "{" 'electric-icon-brace) - (define-key icon-mode-map "}" 'electric-icon-brace) - (define-key icon-mode-map "\e\C-h" 'mark-icon-function) - (define-key icon-mode-map "\e\C-a" 'beginning-of-icon-defun) - (define-key icon-mode-map "\e\C-e" 'end-of-icon-defun) - (define-key icon-mode-map "\e\C-q" 'indent-icon-exp) - (define-key icon-mode-map "\177" 'backward-delete-char-untabify) - - (define-key icon-mode-map [menu-bar] (make-sparse-keymap "Icon")) - (define-key icon-mode-map [menu-bar icon] - (cons "Icon" map)) - (define-key map [beginning-of-icon-defun] '("Beginning of function" . beginning-of-icon-defun)) - (define-key map [end-of-icon-defun] '("End of function" . end-of-icon-defun)) - (define-key map [comment-region] '("Comment Out Region" . comment-region)) - (define-key map [indent-region] '("Indent Region" . indent-region)) - (define-key map [indent-line] '("Indent Line" . icon-indent-command)) - (put 'eval-region 'menu-enable 'mark-active) - (put 'comment-region 'menu-enable 'mark-active) - (put 'indent-region 'menu-enable 'mark-active))) - -(defvar icon-mode-syntax-table nil - "Syntax table in use in Icon-mode buffers.") + (define-key map "{" 'electric-icon-brace) + (define-key map "}" 'electric-icon-brace) + (define-key map "\e\C-h" 'mark-icon-function) + (define-key map "\e\C-a" 'beginning-of-icon-defun) + (define-key map "\e\C-e" 'end-of-icon-defun) + (define-key map "\e\C-q" 'indent-icon-exp) + (define-key map "\177" 'backward-delete-char-untabify) + map) + "Keymap used in Icon mode.") -(if icon-mode-syntax-table - () - (setq icon-mode-syntax-table (make-syntax-table)) - (modify-syntax-entry ?\\ "\\" icon-mode-syntax-table) - (modify-syntax-entry ?# "<" icon-mode-syntax-table) - (modify-syntax-entry ?\n ">" icon-mode-syntax-table) - (modify-syntax-entry ?$ "." icon-mode-syntax-table) - (modify-syntax-entry ?/ "." icon-mode-syntax-table) - (modify-syntax-entry ?* "." icon-mode-syntax-table) - (modify-syntax-entry ?+ "." icon-mode-syntax-table) - (modify-syntax-entry ?- "." icon-mode-syntax-table) - (modify-syntax-entry ?= "." icon-mode-syntax-table) - (modify-syntax-entry ?% "." icon-mode-syntax-table) - (modify-syntax-entry ?< "." icon-mode-syntax-table) - (modify-syntax-entry ?> "." icon-mode-syntax-table) - (modify-syntax-entry ?& "." icon-mode-syntax-table) - (modify-syntax-entry ?| "." icon-mode-syntax-table) - (modify-syntax-entry ?\' "\"" icon-mode-syntax-table)) +(easy-menu-define icon-mode-menu icon-mode-map + "Menu for Icon mode." + '("Icon" + ["Beginning of function" beginning-of-icon-defun] + ["Comment Out Region" comment-region + :enable mark-active] + ["End of function" end-of-icon-defun] + ["Indent Line" icon-indent-command] + ["Indent Region" indent-region + :enable mark-active])) + +(defvar icon-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?# "<" table) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?$ "." table) + (modify-syntax-entry ?/ "." table) + (modify-syntax-entry ?* "." table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?% "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?\' "\"" table) + table) + "Syntax table in use in Icon-mode buffers.") (defgroup icon nil "Mode for editing Icon code." diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 46b0949c133..a59014827e8 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -88,8 +88,6 @@ ;;; Code: -(require 'easymenu) - (defgroup meta-font nil "Major mode for editing Metafont or MetaPost sources." :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 9f5f9ed6d3d..29cce51e222 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -267,7 +267,6 @@ (require 'shell) ) -(require 'easymenu) (require 'align) (defgroup prolog nil diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index 15fd2e84393..598f748f5b3 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -39,7 +39,6 @@ "Peter Kleiweg <p.c.j.kleiweg@rug.nl>, bug-gnu-emacs@gnu.org") (require 'comint) -(require 'easymenu) (require 'smie) ;; Define core `PostScript' group. diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index a899de7e594..72ac2d95a21 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -162,25 +162,26 @@ (defvar scheme-mode-line-process "") (defvar scheme-mode-map - (let ((smap (make-sparse-keymap)) - (map (make-sparse-keymap "Scheme"))) - (set-keymap-parent smap lisp-mode-shared-map) - (define-key smap [menu-bar scheme] (cons "Scheme" map)) - (define-key map [run-scheme] '("Run Inferior Scheme" . run-scheme)) - (define-key map [uncomment-region] - '("Uncomment Out Region" . (lambda (beg end) - (interactive "r") - (comment-region beg end '(4))))) - (define-key map [comment-region] '("Comment Out Region" . comment-region)) - (define-key map [indent-region] '("Indent Region" . indent-region)) - (define-key map [indent-line] '("Indent Line" . lisp-indent-line)) - (put 'comment-region 'menu-enable 'mark-active) - (put 'uncomment-region 'menu-enable 'mark-active) - (put 'indent-region 'menu-enable 'mark-active) - smap) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map lisp-mode-shared-map) + map) "Keymap for Scheme mode. All commands in `lisp-mode-shared-map' are inherited by this map.") +(easy-menu-define scheme-mode-menu scheme-mode-map + "Menu for Scheme mode." + '("Scheme" + ["Indent Line" lisp-indent-line] + ["Indent Region" indent-region + :enable mark-active] + ["Comment Out Region" comment-region + :enable mark-active] + ["Uncomment Out Region" (lambda (beg end) + (interactive "r") + (comment-region beg end '(4))) + :enable mark-active] + ["Run Inferior Scheme" run-scheme])) + ;; Used by cmuscheme (defun scheme-mode-commands (map) ;;(define-key map "\t" 'indent-for-tab-command) ; default diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index fab600f83f4..ef157ce4ab7 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -270,48 +270,25 @@ for SIMULA mode to function correctly." (define-key map ":" 'simula-electric-label) (define-key map "\e\C-q" 'simula-indent-exp) (define-key map "\t" 'simula-indent-command) - - (define-key map [menu-bar simula] - (cons "SIMULA" (make-sparse-keymap "SIMULA"))) - (define-key map [menu-bar simula indent-exp] - '("Indent Expression" . simula-indent-exp)) - (define-key map [menu-bar simula indent-line] - '("Indent Line" . simula-indent-command)) - (define-key map [menu-bar simula separator-navigate] - '("--")) - (define-key map [menu-bar simula backward-stmt] - '("Previous Statement" . simula-previous-statement)) - (define-key map [menu-bar simula forward-stmt] - '("Next Statement" . simula-next-statement)) - (define-key map [menu-bar simula backward-up] - '("Backward Up Level" . simula-backward-up-level)) - (define-key map [menu-bar simula forward-down] - '("Forward Down Statement" . simula-forward-down-level)) - - (put 'simula-next-statement 'menu-enable '(not (eobp))) - (put 'simula-previous-statement 'menu-enable '(not (bobp))) - (put 'simula-forward-down-level 'menu-enable '(not (eobp))) - (put 'simula-backward-up-level 'menu-enable '(not (bobp))) - (put 'simula-indent-command 'menu-enable '(not buffer-read-only)) - (put 'simula-indent-exp 'menu-enable '(not buffer-read-only)) - - ;; RMS: mouse-3 should not select this menu. mouse-3's global - ;; definition is useful in SIMULA mode and we should not interfere - ;; with that. The menu is mainly for beginners, and for them, - ;; the menubar requires less memory than a special click. - ;; in Lucid Emacs, we want the menu to popup when the 3rd button is - ;; hit. In 19.10 and beyond this is done automatically if we put - ;; the menu on mode-popup-menu variable, see c-common-init [cc-mode.el] - ;;(if (not (boundp 'mode-popup-menu)) - ;; (define-key simula-mode-map 'button3 'simula-popup-menu)) map) "Keymap used in `simula-mode'.") -;; menus for Lucid -(defun simula-popup-menu (_e) - "Pops up the SIMULA menu." - (interactive "@e") - (popup-menu (cons (concat mode-name " Mode Commands") simula-mode-menu))) +(easy-menu-define simula-mode-menu simula-mode-map + "Menu for `simula-mode'." + '("SIMULA" + ["Forward Down Statement" simula-forward-down-level + :enable (not (eobp))] + ["Backward Up Level" simula-backward-up-level + :enable (not (bobp))] + ["Next Statement" simula-next-statement + :enable (not (eobp))] + ["Previous Statement" simula-previous-statement + :enable (not (bobp))] + "---" + ["Indent Line" simula-indent-command + :enable (not buffer-read-only)] + ["Indent Expression" simula-indent-exp + :enable (not buffer-read-only)])) ;;;###autoload (define-derived-mode simula-mode prog-mode "Simula" @@ -1600,7 +1577,7 @@ If not nil and not t, move to limit of search and return nil." ("!\\|\\<COMMENT\\>" ";" comment)) nil 'case-insensitive))) -;; defuns for submitting bug reports +;; obsolete (defconst simula-mode-help-address "bug-gnu-emacs@gnu.org" "Address accepting submission of `simula-mode' bug reports.") @@ -1611,6 +1588,12 @@ If not nil and not t, move to limit of search and return nil." (define-obsolete-function-alias 'simula-submit-bug-report 'report-emacs-bug "24.4") +(defun simula-popup-menu (_e) + "Pops up the SIMULA menu." + (declare (obsolete simula-mode-menu "28.1")) + (interactive "@e") + (popup-menu (cons (concat mode-name " Mode Commands") simula-mode-menu))) + (provide 'simula) ;;; simula.el ends here diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index c2e1719d54a..036b2f447bf 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -119,8 +119,6 @@ If nil, TAB always indents current line." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Menu -(require 'easymenu) - (easy-menu-define vera-mode-menu vera-mode-map "Menu keymap for Vera Mode." '("Vera" diff --git a/lisp/simple.el b/lisp/simple.el index 26710e6d53d..403861351c9 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1980,7 +1980,9 @@ This function uses the `read-extended-command-predicate' user option." ;; but actually a prompt other than "M-x" would be confusing, ;; because "M-x" is a well-known prompt to read a command ;; and it serves as a shorthand for "Extended command: ". - "M-x ") + (if (memq 'shift (event-modifiers last-command-event)) + "M-X " + "M-x ")) (lambda (string pred action) (if (and suggest-key-bindings (eq action 'metadata)) '(metadata @@ -4668,7 +4670,7 @@ see other processes running on the system, use `list-system-processes'." (setq prefix-command--last-echo (let ((strs nil)) (run-hook-wrapped 'prefix-command-echo-keystrokes-functions - (lambda (fun) (push (funcall fun) strs))) + (lambda (fun) (push (funcall fun) strs) nil)) (setq strs (delq nil strs)) (when strs (mapconcat #'identity strs " ")))))) diff --git a/lisp/subr.el b/lisp/subr.el index 0c7085827b5..9579c9a395e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -380,7 +380,7 @@ PREFIX is a string, and defaults to \"g\"." "Do nothing and return nil. This function accepts any number of ARGUMENTS, but ignores them. Also see `always'." - (declare (completion #'ignore)) + (declare (completion ignore)) (interactive) nil) @@ -928,7 +928,7 @@ For an approximate inverse of this, see `key-description'." (defun undefined () "Beep to tell the user this binding is undefined." - (declare (completion #'ignore)) + (declare (completion ignore)) (interactive) (ding) (if defining-kbd-macro @@ -2102,7 +2102,7 @@ can do the job." ,(if append `(setq ,sym (append ,sym (list ,x))) `(push ,x ,sym)))))) - (if (not (macroexp--compiling-p)) + (if (not (macroexp-compiling-p)) code `(progn (macroexp--funcall-if-compiled ',warnfun) @@ -3340,7 +3340,7 @@ to `accept-change-group' or `cancel-change-group'." ;; insertions are ever merged/combined, so we use such a "boundary" ;; only when the last change was an insertion and we use the position ;; of the last insertion. - (when (numberp (caar buffer-undo-list)) + (when (numberp (car-safe (car buffer-undo-list))) (push (cons (caar buffer-undo-list) (caar buffer-undo-list)) buffer-undo-list)))))) @@ -5050,14 +5050,10 @@ This function is called directly from the C code." obarray)) (msg (format "Package %s is deprecated" package)) (fun (lambda (msg) (message "%s" msg)))) - ;; Cribbed from cl--compiling-file. (when (or (not (fboundp 'byte-compile-warning-enabled-p)) (byte-compile-warning-enabled-p 'obsolete package)) (cond - ((and (boundp 'byte-compile--outbuffer) - (bufferp (symbol-value 'byte-compile--outbuffer)) - (equal (buffer-name (symbol-value 'byte-compile--outbuffer)) - " *Compiler Output*")) + ((bound-and-true-p byte-compile-current-file) ;; Don't warn about obsolete files using other obsolete files. (unless (and (stringp byte-compile-current-file) (string-match-p "/obsolete/[^/]*\\'" diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index dba79fbd81c..c95559a1b7d 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -100,11 +100,13 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and "Install key bindings for switching between tabs if the user has configured them." (when tab-bar-select-tab-modifiers (global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0))) - 'tab-bar-switch-to-recent-tab) - (dotimes (i 9) + 'tab-recent) + (dotimes (i 8) (global-set-key (vector (append tab-bar-select-tab-modifiers (list (+ i 1 ?0)))) - 'tab-bar-select-tab))) + 'tab-bar-select-tab)) + (global-set-key (vector (append tab-bar-select-tab-modifiers (list ?9))) + 'tab-last)) ;; Don't override user customized key bindings (unless (global-key-binding [(control tab)]) (global-set-key [(control tab)] 'tab-next)) @@ -113,6 +115,15 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and (unless (global-key-binding [(control shift iso-lefttab)]) (global-set-key [(control shift iso-lefttab)] 'tab-previous))) +(defun tab-bar--undefine-keys () + "Uninstall key bindings previously bound by `tab-bar--define-keys'." + (when (eq (global-key-binding [(control tab)]) 'tab-next) + (global-unset-key [(control tab)])) + (when (eq (global-key-binding [(control shift tab)]) 'tab-previous) + (global-unset-key [(control shift tab)])) + (when (eq (global-key-binding [(control shift iso-lefttab)]) 'tab-previous) + (global-unset-key [(control shift iso-lefttab)]))) + (defun tab-bar--load-buttons () "Load the icons for the tab buttons." (when (and tab-bar-new-button @@ -181,13 +192,7 @@ update." (tab-bar--load-buttons)) (if tab-bar-mode (tab-bar--define-keys) - ;; Unset only keys bound by tab-bar - (when (eq (global-key-binding [(control tab)]) 'tab-next) - (global-unset-key [(control tab)])) - (when (eq (global-key-binding [(control shift tab)]) 'tab-previous) - (global-unset-key [(control shift tab)])) - (when (eq (global-key-binding [(control shift iso-lefttab)]) 'tab-previous) - (global-unset-key [(control shift iso-lefttab)])))) + (tab-bar--undefine-keys))) (defun tab-bar-handle-mouse (event) "Text-mode emulation of switching tabs on the tab bar. @@ -374,6 +379,9 @@ and `tab-bar-select-tab-modifiers'." (defvar tab-bar-separator nil "String that delimits tabs.") +(defun tab-bar-separator () + (or tab-bar-separator (if window-system " " "|"))) + (defcustom tab-bar-tab-name-function #'tab-bar-tab-name-current "Function to get a tab name. @@ -497,9 +505,9 @@ the formatted tab name to display in the tab bar." (defun tab-bar-make-keymap-1 () "Generate an actual keymap from `tab-bar-map', without caching." - (let* ((separator (or tab-bar-separator (if window-system " " "|"))) - (i 0) - (tabs (funcall tab-bar-tabs-function))) + (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) @@ -717,6 +725,12 @@ ARG counts from 1." (setq arg 1)) (tab-bar-switch-to-next-tab (- arg))) +(defun tab-bar-switch-to-last-tab (&optional arg) + "Switch to the last tab or ARGth tab from the end of the tab bar." + (interactive "p") + (tab-bar-select-tab (- (length (funcall tab-bar-tabs-function)) + (1- (or arg 1))))) + (defun tab-bar-switch-to-recent-tab (&optional arg) "Switch to ARGth most recently visited tab." (interactive "p") @@ -731,7 +745,8 @@ ARG counts from 1." "Switch to the tab by NAME. Default values are tab names sorted by recency, so you can use \ \\<minibuffer-local-map>\\[next-history-element] -to get the name of the last visited tab, the second last, and so on." +to get the name of the most recently visited tab, the second +most recent, and so on." (interactive (let* ((recent-tabs (mapcar (lambda (tab) (alist-get 'name tab)) @@ -747,12 +762,17 @@ to get the name of the last visited tab, the second last, and so on." (defun tab-bar-move-tab-to (to-index &optional from-index) "Move tab from FROM-INDEX position to new position at TO-INDEX. FROM-INDEX defaults to the current tab index. -FROM-INDEX and TO-INDEX count from 1." +FROM-INDEX and TO-INDEX count from 1. +Negative TO-INDEX counts tabs from the end of the tab bar. +Argument addressing is absolute in contrast to `tab-bar-move-tab' +where argument addressing is relative." (interactive "P") (let* ((tabs (funcall tab-bar-tabs-function)) (from-index (or from-index (1+ (tab-bar--current-tab-index tabs)))) (from-tab (nth (1- from-index) tabs)) - (to-index (max 0 (min (1- (or to-index 1)) (1- (length tabs)))))) + (to-index (if to-index (prefix-numeric-value to-index) 1)) + (to-index (if (< to-index 0) (+ (length tabs) (1+ to-index)) to-index)) + (to-index (max 0 (min (1- to-index) (1- (length tabs)))))) (setq tabs (delq from-tab tabs)) (cl-pushnew from-tab (nthcdr to-index tabs)) (set-frame-parameter nil 'tabs tabs) @@ -760,7 +780,9 @@ FROM-INDEX and TO-INDEX count from 1." (defun tab-bar-move-tab (&optional arg) "Move the current tab ARG positions to the right. -If a negative ARG, move the current tab ARG positions to the left." +If a negative ARG, move the current tab ARG positions to the left. +Argument addressing is relative in contrast to `tab-bar-move-tab-to' +where argument addressing is absolute." (interactive "p") (let* ((tabs (funcall tab-bar-tabs-function)) (from-index (or (tab-bar--current-tab-index tabs) 0)) @@ -828,7 +850,9 @@ called." "Add a new tab at the absolute position TO-INDEX. TO-INDEX counts from 1. If no TO-INDEX is specified, then add a new tab at the position specified by `tab-bar-new-tab-to'. - +Negative TO-INDEX counts tabs from the end of the tab bar. +Argument addressing is absolute in contrast to `tab-bar-new-tab' +where argument addressing is relative. After the tab is created, the hooks in `tab-bar-tab-post-open-functions' are run." (interactive "P") @@ -855,15 +879,19 @@ After the tab is created, the hooks in (when from-index (setf (nth from-index tabs) from-tab)) - (let ((to-tab (tab-bar--current-tab)) - (to-index (or (if to-index (1- to-index)) - (pcase tab-bar-new-tab-to - ('leftmost 0) - ('rightmost (length tabs)) - ('left (or from-index 1)) - ('right (1+ (or from-index 0))) - ((pred functionp) - (funcall tab-bar-new-tab-to)))))) + (let* ((to-tab (tab-bar--current-tab)) + (to-index (and to-index (prefix-numeric-value to-index))) + (to-index (or (if to-index + (if (< to-index 0) + (+ (length tabs) (1+ to-index)) + (1- to-index))) + (pcase tab-bar-new-tab-to + ('leftmost 0) + ('rightmost (length tabs)) + ('left (or from-index 1)) + ('right (1+ (or from-index 0))) + ((pred functionp) + (funcall tab-bar-new-tab-to)))))) (setq to-index (max 0 (min (or to-index 0) (length tabs)))) (cl-pushnew to-tab (nthcdr to-index tabs)) @@ -888,7 +916,11 @@ After the tab is created, the hooks in (defun tab-bar-new-tab (&optional arg) "Create a new tab ARG positions to the right. If a negative ARG, create a new tab ARG positions to the left. -If ARG is zero, create a new tab in place of the current tab." +If ARG is zero, create a new tab in place of the current tab. +If no ARG is specified, then add a new tab at the position +specified by `tab-bar-new-tab-to'. +Argument addressing is relative in contrast to `tab-bar-new-tab-to' +where argument addressing is absolute." (interactive "P") (if arg (let* ((tabs (funcall tab-bar-tabs-function)) @@ -1067,7 +1099,7 @@ for the last tab on a frame is determined by (message "Deleted all other tabs"))))) (defun tab-bar-undo-close-tab () - "Restore the last closed tab." + "Restore the most recently closed tab." (interactive) ;; Pop out closed tabs that were on already deleted frames (while (and tab-bar-closed-tabs @@ -1247,24 +1279,6 @@ and can restore them." (remove-hook 'window-configuration-change-hook 'tab-bar--history-change))) -;;; Short aliases - -(defalias 'tab-new 'tab-bar-new-tab) -(defalias 'tab-new-to 'tab-bar-new-tab-to) -(defalias 'tab-duplicate 'tab-bar-duplicate-tab) -(defalias 'tab-close 'tab-bar-close-tab) -(defalias 'tab-close-other 'tab-bar-close-other-tabs) -(defalias 'tab-undo 'tab-bar-undo-close-tab) -(defalias 'tab-select 'tab-bar-select-tab) -(defalias 'tab-next 'tab-bar-switch-to-next-tab) -(defalias 'tab-previous 'tab-bar-switch-to-prev-tab) -(defalias 'tab-recent 'tab-bar-switch-to-recent-tab) -(defalias 'tab-move 'tab-bar-move-tab) -(defalias 'tab-move-to 'tab-bar-move-tab-to) -(defalias 'tab-rename 'tab-bar-rename-tab) -(defalias 'tab-list 'tab-switcher) - - ;;; Non-graphical access to frame-local tabs (named window configurations) (defun tab-switcher () @@ -1669,13 +1683,37 @@ When `switch-to-buffer-obey-display-actions' is non-nil, nil "[other-tab]") (message "Display next command buffer in a new tab...")) + +;;; Short aliases and keybindings + +(defalias 'tab-new 'tab-bar-new-tab) +(defalias 'tab-new-to 'tab-bar-new-tab-to) +(defalias 'tab-duplicate 'tab-bar-duplicate-tab) +(defalias 'tab-close 'tab-bar-close-tab) +(defalias 'tab-close-other 'tab-bar-close-other-tabs) +(defalias 'tab-undo 'tab-bar-undo-close-tab) +(defalias 'tab-select 'tab-bar-select-tab) +(defalias 'tab-switch 'tab-bar-switch-to-tab) +(defalias 'tab-next 'tab-bar-switch-to-next-tab) +(defalias 'tab-previous 'tab-bar-switch-to-prev-tab) +(defalias 'tab-last 'tab-bar-switch-to-last-tab) +(defalias 'tab-recent 'tab-bar-switch-to-recent-tab) +(defalias 'tab-move 'tab-bar-move-tab) +(defalias 'tab-move-to 'tab-bar-move-tab-to) +(defalias 'tab-rename 'tab-bar-rename-tab) +(defalias 'tab-list 'tab-switcher) + +(define-key tab-prefix-map "n" 'tab-duplicate) +(define-key tab-prefix-map "N" 'tab-new-to) (define-key tab-prefix-map "2" 'tab-new) (define-key tab-prefix-map "1" 'tab-close-other) (define-key tab-prefix-map "0" 'tab-close) (define-key tab-prefix-map "o" 'tab-next) +(define-key tab-prefix-map "O" 'tab-previous) (define-key tab-prefix-map "m" 'tab-move) +(define-key tab-prefix-map "M" 'tab-move-to) (define-key tab-prefix-map "r" 'tab-rename) -(define-key tab-prefix-map "\r" 'tab-bar-select-tab-by-name) +(define-key tab-prefix-map "\r" 'tab-switch) (define-key tab-prefix-map "b" 'switch-to-buffer-other-tab) (define-key tab-prefix-map "f" 'find-file-other-tab) (define-key tab-prefix-map "\C-f" 'find-file-other-tab) diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 1bdddc2c83e..903862a3e83 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -430,42 +430,56 @@ variable `tab-line-tabs-function'." next-buffers))) +(defcustom tab-line-tab-name-format-function #'tab-line-tab-name-format-default + "Function to format a tab name. +Function gets two arguments: the tab and a list of all tabs, and +should return the formatted tab name to display in the tab line." + :type 'function + :initialize 'custom-initialize-default + :set (lambda (sym val) + (set-default sym val) + (force-mode-line-update)) + :group 'tab-line + :version "28.1") + +(defun tab-line-tab-name-format-default (tab tabs) + (let* ((buffer-p (bufferp tab)) + (selected-p (if buffer-p + (eq tab (window-buffer)) + (cdr (assq 'selected tab)))) + (name (if buffer-p + (funcall tab-line-tab-name-function tab tabs) + (cdr (assq 'name tab)))) + (face (if selected-p + (if (eq (selected-window) (old-selected-window)) + 'tab-line-tab-current + 'tab-line-tab) + 'tab-line-tab-inactive))) + (dolist (fn tab-line-tab-face-functions) + (setf face (funcall fn tab tabs face buffer-p selected-p))) + (apply 'propertize + (concat (propertize name 'keymap tab-line-tab-map) + (or (and (or buffer-p (assq 'buffer tab) (assq 'close tab)) + tab-line-close-button-show + (not (eq tab-line-close-button-show + (if selected-p 'non-selected 'selected))) + tab-line-close-button) + "")) + `( + tab ,tab + ,@(if selected-p '(selected t)) + face ,face + mouse-face tab-line-highlight)))) + (defun tab-line-format-template (tabs) "Template for displaying tab line for selected window." - (let* ((selected-buffer (window-buffer)) - (separator (or tab-line-separator (if window-system " " "|"))) + (let* ((separator (or tab-line-separator (if window-system " " "|"))) (hscroll (window-parameter nil 'tab-line-hscroll)) (strings (mapcar (lambda (tab) - (let* ((buffer-p (bufferp tab)) - (selected-p (if buffer-p - (eq tab selected-buffer) - (cdr (assq 'selected tab)))) - (name (if buffer-p - (funcall tab-line-tab-name-function tab tabs) - (cdr (assq 'name tab)))) - (face (if selected-p - (if (eq (selected-window) (old-selected-window)) - 'tab-line-tab-current - 'tab-line-tab) - 'tab-line-tab-inactive))) - (dolist (fn tab-line-tab-face-functions) - (setf face (funcall fn tab tabs face buffer-p selected-p))) - (concat - separator - (apply 'propertize - (concat (propertize name 'keymap tab-line-tab-map) - (or (and (or buffer-p (assq 'buffer tab) (assq 'close tab)) - tab-line-close-button-show - (not (eq tab-line-close-button-show - (if selected-p 'non-selected 'selected))) - tab-line-close-button) "")) - `( - tab ,tab - ,@(if selected-p '(selected t)) - face ,face - mouse-face tab-line-highlight))))) + (concat separator + (funcall tab-line-tab-name-format-function tab tabs))) tabs)) (hscroll-data (tab-line-auto-hscroll strings hscroll))) (setq hscroll (nth 1 hscroll-data)) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 89a71ac2b87..59f7c87e99b 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -635,54 +635,38 @@ For instance, if mode is #o700, then it produces `rwx------'." ;; Let mouse-1 follow the link. (define-key map [follow-link] 'mouse-face) - ;; Make menu bar items. - ;; Get rid of the Edit menu bar item to save space. (define-key map [menu-bar edit] 'undefined) - (define-key map [menu-bar immediate] - (cons "Immediate" (make-sparse-keymap "Immediate"))) - - (define-key map [menu-bar immediate woman] - '("Read Man Page (WoMan)" . woman-tar-extract-file)) - (define-key map [menu-bar immediate view] - '("View This File" . tar-view)) - (define-key map [menu-bar immediate display] - '("Display in Other Window" . tar-display-other-window)) - (define-key map [menu-bar immediate find-file-other-window] - '("Find in Other Window" . tar-extract-other-window)) - (define-key map [menu-bar immediate find-file] - '("Find This File" . tar-extract)) - - (define-key map [menu-bar mark] - (cons "Mark" (make-sparse-keymap "Mark"))) - - (define-key map [menu-bar mark unmark-all] - '("Unmark All" . tar-clear-modification-flags)) - (define-key map [menu-bar mark deletion] - '("Flag" . tar-flag-deleted)) - (define-key map [menu-bar mark unmark] - '("Unflag" . tar-unflag)) - - (define-key map [menu-bar operate] - (cons "Operate" (make-sparse-keymap "Operate"))) - - (define-key map [menu-bar operate chown] - '("Change Owner..." . tar-chown-entry)) - (define-key map [menu-bar operate chgrp] - '("Change Group..." . tar-chgrp-entry)) - (define-key map [menu-bar operate chmod] - '("Change Mode..." . tar-chmod-entry)) - (define-key map [menu-bar operate rename] - '("Rename to..." . tar-rename-entry)) - (define-key map [menu-bar operate copy] - '("Copy to..." . tar-copy)) - (define-key map [menu-bar operate expunge] - '("Expunge Marked Files" . tar-expunge)) - map) "Local keymap for Tar mode listings.") +(easy-menu-define tar-mode-immediate-menu tar-mode-map + "Immediate menu for Tar mode." + '("Immediate" + ["Find This File" tar-extract] + ["Find in Other Window" tar-extract-other-window] + ["Display in Other Window" tar-display-other-window] + ["View This File" tar-view] + ["Read Man Page (WoMan)" woman-tar-extract-file])) + +(easy-menu-define tar-mode-mark-menu tar-mode-map + "Mark menu for Tar mode." + '("Mark" + ["Unflag" tar-unflag] + ["Flag" tar-flag-deleted] + ["Unmark All" tar-clear-modification-flags])) + +(easy-menu-define tar-mode-operate-menu tar-mode-map + "Operate menu for Tar mode." + '("Operate" + ["Expunge Marked Files" tar-expunge] + ["Copy to..." tar-copy] + ["Rename to..." tar-rename-entry] + ["Change Mode..." tar-chmod-entry] + ["Change Group..." tar-chgrp-entry] + ["Change Owner..." tar-chown-entry])) + ;; tar mode is suitable only for specially formatted data. (put 'tar-mode 'mode-class 'special) diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index e66adb43e75..9a886d23971 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -481,50 +481,6 @@ This variable is initialized by the `artist-make-prev-next-op-alist' function.") (defvar artist-arrow-point-1 nil) (defvar artist-arrow-point-2 nil) -(defvar artist-menu-map - (let ((map (make-sparse-keymap))) - (define-key map [spray-chars] - '(menu-item "Characters for Spray" artist-select-spray-chars - :help "Choose characters for sprayed by the spray-can")) - (define-key map [borders] - '(menu-item "Draw Shape Borders" artist-toggle-borderless-shapes - :help "Toggle whether shapes are drawn with borders" - :button (:toggle . (not artist-borderless-shapes)))) - (define-key map [trimming] - '(menu-item "Trim Line Endings" artist-toggle-trim-line-endings - :help "Toggle trimming of line-endings" - :button (:toggle . artist-trim-line-endings))) - (define-key map [rubber-band] - '(menu-item "Rubber-banding" artist-toggle-rubber-banding - :help "Toggle rubber-banding" - :button (:toggle . artist-rubber-banding))) - (define-key map [set-erase] - '(menu-item "Character to Erase..." artist-select-erase-char - :help "Choose a specific character to erase")) - (define-key map [set-line] - '(menu-item "Character for Line..." artist-select-line-char - :help "Choose the character to insert when drawing lines")) - (define-key map [set-fill] - '(menu-item "Character for Fill..." artist-select-fill-char - :help "Choose the character to insert when filling in shapes")) - (define-key map [artist-separator] '(menu-item "--")) - (dolist (op '(("Vaporize" artist-select-op-vaporize-lines vaporize-lines) - ("Erase" artist-select-op-erase-rectangle erase-rect) - ("Spray-can" artist-select-op-spray-set-size spray-get-size) - ("Text" artist-select-op-text-overwrite text-ovwrt) - ("Ellipse" artist-select-op-circle circle) - ("Poly-line" artist-select-op-straight-poly-line spolyline) - ("Square" artist-select-op-square square) - ("Rectangle" artist-select-op-rectangle rectangle) - ("Line" artist-select-op-straight-line s-line) - ("Pen" artist-select-op-pen-line pen-line))) - (define-key map (vector (nth 2 op)) - `(menu-item ,(nth 0 op) - ,(nth 1 op) - :help ,(format "Draw using the %s style" (nth 0 op)) - :button (:radio . (eq artist-curr-go ',(nth 2 op)))))) - map)) - (defvar artist-mode-map (let ((map (make-sparse-keymap))) (setq artist-mode-map (make-sparse-keymap)) @@ -577,10 +533,50 @@ This variable is initialized by the `artist-make-prev-next-op-alist' function.") (define-key map "\C-c\C-a\C-y" 'artist-select-op-paste) (define-key map "\C-c\C-af" 'artist-select-op-flood-fill) (define-key map "\C-c\C-a\C-b" 'artist-submit-bug-report) - (define-key map [menu-bar artist] (cons "Artist" artist-menu-map)) map) "Keymap for `artist-mode'.") +(easy-menu-define artist-menu-map artist-mode-map + "Menu for `artist-mode'." + `("Artist" + ,@(mapcar + (lambda (op) + `[,(nth 0 op) ,(nth 1 op) + :help ,(format "Draw using the %s style" (nth 0 op)) + :style radio + :selected (eq artist-curr-go ',(nth 2 op))]) + '(("Vaporize" artist-select-op-vaporize-lines vaporize-lines) + ("Erase" artist-select-op-erase-rectangle erase-rect) + ("Spray-can" artist-select-op-spray-set-size spray-get-size) + ("Text" artist-select-op-text-overwrite text-ovwrt) + ("Ellipse" artist-select-op-circle circle) + ("Poly-line" artist-select-op-straight-poly-line spolyline) + ("Square" artist-select-op-square square) + ("Rectangle" artist-select-op-rectangle rectangle) + ("Line" artist-select-op-straight-line s-line) + ("Pen" artist-select-op-pen-line pen-line))) + "---" + ["Character for Fill..." artist-select-fill-char + :help "Choose the character to insert when filling in shapes"] + ["Character for Line..." artist-select-line-char + :help "Choose the character to insert when drawing lines"] + ["Character to Erase..." artist-select-erase-char + :help "Choose a specific character to erase"] + ["Rubber-banding" artist-toggle-rubber-banding + :help "Toggle rubber-banding" + :style toggle + :selected artist-rubber-banding] + ["Trim Line Endings" artist-toggle-trim-line-endings + :help "Toggle trimming of line-endings" + :style toggle + :selected artist-trim-line-endings] + ["Draw Shape Borders" artist-toggle-borderless-shapes + :help "Toggle whether shapes are drawn with borders" + :style toggle + :selected (not artist-borderless-shapes)] + ["Characters for Spray" artist-select-spray-chars + :help "Choose characters for sprayed by the spray-can"])) + (defvar artist-replacement-table (make-vector 256 0) "Replacement table for `artist-replace-char'.") diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index d88964aa4f0..5f34ae152d1 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -63,8 +63,7 @@ not align (only setting space according to `conf-assignment-space')." :type 'boolean) (defvar conf-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap))) + (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-u" 'conf-unix-mode) (define-key map "\C-c\C-w" 'conf-windows-mode) (define-key map "\C-c\C-j" 'conf-javaprop-mode) @@ -78,52 +77,46 @@ not align (only setting space according to `conf-assignment-space')." (define-key map "\C-c\"" 'conf-quote-normal) (define-key map "\C-c'" 'conf-quote-normal) (define-key map "\C-c\C-a" 'conf-align-assignments) - (define-key map [menu-bar sh-script] (cons "Conf" menu-map)) - (define-key menu-map [conf-windows-mode] - '(menu-item "Windows mode" - conf-windows-mode - :help "Conf Mode starter for Windows style Conf files" - :button (:radio . (eq major-mode 'conf-windows-mode)))) - (define-key menu-map [conf-javaprop-mode] - '(menu-item "Java properties mode" - conf-javaprop-mode - :help "Conf Mode starter for Java properties files" - :button (:radio . (eq major-mode 'conf-javaprop-mode)))) - (define-key menu-map [conf-space-keywords] - '(menu-item "Space keywords mode..." - conf-space-keywords - :help "Enter Conf Space mode using regexp KEYWORDS to match the keywords" - :button (:radio . (eq major-mode 'conf-space-keywords)))) - (define-key menu-map [conf-ppd-mode] - '(menu-item "PPD mode" - conf-ppd-mode - :help "Conf Mode starter for Adobe/CUPS PPD files" - :button (:radio . (eq major-mode 'conf-ppd-mode)))) - (define-key menu-map [conf-colon-mode] - '(menu-item "Colon mode" - conf-colon-mode - :help "Conf Mode starter for Colon files" - :button (:radio . (eq major-mode 'conf-colon-mode)))) - (define-key menu-map [conf-unix-mode] - '(menu-item "Unix mode" - conf-unix-mode - :help "Conf Mode starter for Unix style Conf files" - :button (:radio . (eq major-mode 'conf-unix-mode)))) - (define-key menu-map [conf-xdefaults-mode] - '(menu-item "Xdefaults mode" - conf-xdefaults-mode - :help "Conf Mode starter for Xdefaults files" - :button (:radio . (eq major-mode 'conf-xdefaults-mode)))) - (define-key menu-map [c-s0] '("--")) - (define-key menu-map [conf-quote-normal] - '(menu-item "Set quote syntax normal" conf-quote-normal - :help "Set the syntax of \\=' and \" to punctuation")) - (define-key menu-map [conf-align-assignments] - '(menu-item "Align assignments" conf-align-assignments - :help "Align assignments")) map) "Local keymap for `conf-mode' buffers.") +(easy-menu-define conf-mode-menu conf-mode-map + "Menu for `conf-mode'." + '("Conf" + ["Align assignments" conf-align-assignments + :help "Align assignments"] + ["Set quote syntax normal" conf-quote-normal + :help "Set the syntax of \\=' and \" to punctuation"] + "---" + ["Xdefaults mode" conf-xdefaults-mode + :help "Conf Mode starter for Xdefaults files" + :style radio + :selected (eq major-mode 'conf-xdefaults-mode)] + ["Unix mode" conf-unix-mode + :help "Conf Mode starter for Unix style Conf files" + :style radio + :selected (eq major-mode 'conf-unix-mode)] + ["Colon mode" conf-colon-mode + :help "Conf Mode starter for Colon files" + :style radio + :selected (eq major-mode 'conf-colon-mode)] + ["PPD mode" conf-ppd-mode + :help "Conf Mode starter for Adobe/CUPS PPD files" + :style radio + :selected (eq major-mode 'conf-ppd-mode)] + ["Space keywords mode..." conf-space-keywords + :help "Enter Conf Space mode using regexp KEYWORDS to match the keywords" + :style radio + :selected (eq major-mode 'conf-space-keywords)] + ["Java properties mode" conf-javaprop-mode + :help "Conf Mode starter for Java properties files" + :style radio + :selected (eq major-mode 'conf-javaprop-mode)] + ["Windows mode" conf-windows-mode + :help "Conf Mode starter for Windows style Conf files" + :style radio + :selected (eq major-mode 'conf-windows-mode)])) + (defvar conf-mode-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?= "." table) diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el index e7d852be3c8..7d9b414bf0c 100644 --- a/lisp/textmodes/nroff-mode.el +++ b/lisp/textmodes/nroff-mode.el @@ -46,38 +46,34 @@ :type 'boolean) (defvar nroff-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap))) + (let ((map (make-sparse-keymap))) (define-key map "\t" 'tab-to-tab-stop) (define-key map "\e?" 'nroff-count-text-lines) (define-key map "\n" 'nroff-electric-newline) (define-key map "\en" 'nroff-forward-text-line) (define-key map "\ep" 'nroff-backward-text-line) (define-key map "\C-c\C-c" 'nroff-view) - (define-key map [menu-bar nroff-mode] (cons "Nroff" menu-map)) - (define-key menu-map [nn] - '(menu-item "Newline" nroff-electric-newline - :help "Insert newline for nroff mode; special if nroff-electric mode")) - (define-key menu-map [nc] - '(menu-item "Count text lines" nroff-count-text-lines - :help "Count lines in region, except for nroff request lines.")) - (define-key menu-map [nf] - '(menu-item "Forward text line" nroff-forward-text-line - :help "Go forward one nroff text line, skipping lines of nroff requests")) - (define-key menu-map [nb] - '(menu-item "Backward text line" nroff-backward-text-line - :help "Go backward one nroff text line, skipping lines of nroff requests")) - (define-key menu-map [ne] - '(menu-item "Electric newline mode" - nroff-electric-mode - :help "Auto insert closing requests if necessary" - :button (:toggle . nroff-electric-mode))) - (define-key menu-map [npm] - '(menu-item "Preview as man page" nroff-view - :help "Run man on this file.")) map) "Major mode keymap for `nroff-mode'.") +(easy-menu-define nroff-mode-menu nroff-mode-map + "Menu for `nroff-mode'." + '("Nroff" + ["Preview as man page" nroff-view + :help "Run man on this file."] + ["Electric newline mode" nroff-electric-mode + :help "Auto insert closing requests if necessary" + :style toggle + :selected nroff-electric-mode] + ["Backward text line" nroff-backward-text-line + :help "Go backward one nroff text line, skipping lines of nroff requests"] + ["Forward text line" nroff-forward-text-line + :help "Go forward one nroff text line, skipping lines of nroff requests"] + ["Count text lines" nroff-count-text-lines + :help "Count lines in region, except for nroff request lines."] + ["Newline" nroff-electric-newline + :help "Insert newline for nroff mode; special if nroff-electric mode"])) + (defvar nroff-mode-syntax-table (let ((st (copy-syntax-table text-mode-syntax-table))) ;; " isn't given string quote syntax in text-mode but it diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 7051f520b90..876347bc81e 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -117,8 +117,7 @@ definitions. So we normally turn it off.") This takes effect when first loading the `sgml-mode' library.") (defvar sgml-mode-map - (let ((map (make-keymap)) ;`sparse' doesn't allow binding to charsets. - (menu-map (make-sparse-keymap "SGML"))) + (let ((map (make-keymap))) ;`sparse' doesn't allow binding to charsets. (define-key map "\C-c\C-i" 'sgml-tags-invisible) (define-key map "/" 'sgml-slash) (define-key map "\C-c\C-n" 'sgml-name-char) @@ -153,26 +152,24 @@ This takes effect when first loading the `sgml-mode' library.") (map (nth 1 map))) (while (< (setq c (1+ c)) 256) (aset map c 'sgml-maybe-name-self))) - (define-key map [menu-bar sgml] (cons "SGML" menu-map)) - (define-key menu-map [sgml-validate] '("Validate" . sgml-validate)) - (define-key menu-map [sgml-name-8bit-mode] - '("Toggle 8 Bit Insertion" . sgml-name-8bit-mode)) - (define-key menu-map [sgml-tags-invisible] - '("Toggle Tag Visibility" . sgml-tags-invisible)) - (define-key menu-map [sgml-tag-help] - '("Describe Tag" . sgml-tag-help)) - (define-key menu-map [sgml-delete-tag] - '("Delete Tag" . sgml-delete-tag)) - (define-key menu-map [sgml-skip-tag-forward] - '("Forward Tag" . sgml-skip-tag-forward)) - (define-key menu-map [sgml-skip-tag-backward] - '("Backward Tag" . sgml-skip-tag-backward)) - (define-key menu-map [sgml-attributes] - '("Insert Attributes" . sgml-attributes)) - (define-key menu-map [sgml-tag] '("Insert Tag" . sgml-tag)) map) "Keymap for SGML mode. See also `sgml-specials'.") +(easy-menu-define sgml-mode-menu sgml-mode-map + "Menu for SGML mode." + '("SGML" + ["Insert Tag" sgml-tag] + ["Insert Attributes" sgml-attributes] + ["Backward Tag" sgml-skip-tag-backward] + ["Forward Tag" sgml-skip-tag-forward] + ["Delete Tag" sgml-delete-tag] + ["Describe Tag" sgml-tag-help] + "---" + ["Toggle Tag Visibility" sgml-tags-invisible] + ["Toggle 8 Bit Insertion" sgml-name-8bit-mode] + "---" + ["Validate" sgml-validate])) + (defun sgml-make-syntax-table (specials) (let ((table (make-syntax-table text-mode-syntax-table))) (modify-syntax-entry ?< "(>" table) @@ -1788,8 +1785,7 @@ This defaults to `sgml-quick-keys'. This takes effect when first loading the library.") (defvar html-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap "HTML"))) + (let ((map (make-sparse-keymap))) (set-keymap-parent map sgml-mode-map) (define-key map "\C-c6" 'html-headline-6) (define-key map "\C-c5" 'html-headline-5) @@ -1826,34 +1822,35 @@ This takes effect when first loading the library.") (define-key map "\C-cs" 'html-span)) (define-key map "\C-c\C-s" 'html-autoview-mode) (define-key map "\C-c\C-v" 'browse-url-of-buffer) - (define-key map [menu-bar html] (cons "HTML" menu-map)) - (define-key menu-map [html-autoview-mode] - '("Toggle Autoviewing" . html-autoview-mode)) - (define-key menu-map [browse-url-of-buffer] - '("View Buffer Contents" . browse-url-of-buffer)) - (define-key menu-map [nil] '("--")) - ;;(define-key menu-map "6" '("Heading 6" . html-headline-6)) - ;;(define-key menu-map "5" '("Heading 5" . html-headline-5)) - ;;(define-key menu-map "4" '("Heading 4" . html-headline-4)) - (define-key menu-map "3" '("Heading 3" . html-headline-3)) - (define-key menu-map "2" '("Heading 2" . html-headline-2)) - (define-key menu-map "1" '("Heading 1" . html-headline-1)) - (define-key menu-map "l" '("Radio Buttons" . html-radio-buttons)) - (define-key menu-map "c" '("Checkboxes" . html-checkboxes)) - (define-key menu-map "l" '("List Item" . html-list-item)) - (define-key menu-map "u" '("Unordered List" . html-unordered-list)) - (define-key menu-map "o" '("Ordered List" . html-ordered-list)) - (define-key menu-map "-" '("Horizontal Rule" . html-horizontal-rule)) - (define-key menu-map "\n" '("Line Break" . html-line)) - (define-key menu-map "\r" '("Paragraph" . html-paragraph)) - (define-key menu-map "i" '("Image" . html-image)) - (define-key menu-map "h" '("Href Anchor URL" . html-href-anchor)) - (define-key menu-map "f" '("Href Anchor File" . html-href-anchor-file)) - (define-key menu-map "n" '("Name Anchor" . html-name-anchor)) - (define-key menu-map "#" '("ID Anchor" . html-id-anchor)) map) "Keymap for commands for use in HTML mode.") +(easy-menu-define html-mode-menu html-mode-map + "Menu for HTML mode." + '("HTML" + ["ID Anchor" html-id-anchor] + ["Name Anchor" html-name-anchor] + ["Href Anchor File" html-href-anchor-file] + ["Href Anchor URL" html-href-anchor] + ["Image" html-image] + ["Paragraph" html-paragraph] + ["Line Break" html-line] + ["Horizontal Rule" html-horizontal-rule] + ["Ordered List" html-ordered-list] + ["Unordered List" html-unordered-list] + ["List Item" html-list-item] + ["Checkboxes" html-checkboxes] + ["Radio Buttons" html-radio-buttons] + ["Heading 1" html-headline-1] + ["Heading 2" html-headline-2] + ["Heading 3" html-headline-3] + ;; ["Heading 4" html-headline-4] + ;; ["Heading 5" html-headline-5] + ;; ["Heading 6" html-headline-6] + "---" + ["View Buffer Contents" browse-url-of-buffer] + ["Toggle Autoviewing" html-autoview-mode])) + (defvar html-face-tag-alist '((bold . "strong") (italic . "em") diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index a416474e16d..46fbf448616 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -56,39 +56,48 @@ See `run-hooks'." (defface vc-dir-header '((t :inherit font-lock-type-face)) "Face for headers in VC-dir buffers." - :group 'vc) + :group 'vc + :version "28.1") (defface vc-dir-header-value '((t :inherit font-lock-variable-name-face)) "Face for header values in VC-dir buffers." - :group 'vc) + :group 'vc + :version "28.1") (defface vc-dir-directory '((t :inherit font-lock-comment-delimiter-face)) "Face for directories in VC-dir buffers." - :group 'vc) + :group 'vc + :version "28.1") (defface vc-dir-file '((t :inherit font-lock-function-name-face)) "Face for files in VC-dir buffers." - :group 'vc) + :group 'vc + :version "28.1") (defface vc-dir-mark-indicator '((t :inherit font-lock-type-face)) "Face for mark indicators in VC-dir buffers." - :group 'vc) + :group 'vc + :version "28.1") (defface vc-dir-status-warning '((t :inherit font-lock-warning-face)) "Face for warning status in VC-dir buffers." - :group 'vc) + :group 'vc + :version "28.1") (defface vc-dir-status-edited '((t :inherit font-lock-variable-name-face)) "Face for edited status in VC-dir buffers." - :group 'vc) + :group 'vc + :version "28.1") (defface vc-dir-status-up-to-date '((t :inherit font-lock-builtin-face)) "Face for up-to-date status in VC-dir buffers." - :group 'vc) + :group 'vc + :version "28.1") (defface vc-dir-status-ignored '((t :inherit shadow)) "Face for ignored or empty values in VC-dir buffers." - :group 'vc) + :group 'vc + :version "28.1") ;; Used to store information for the files displayed in the directory buffer. ;; Each item displayed corresponds to one of these defstructs. diff --git a/lisp/wdired.el b/lisp/wdired.el index 3829ff1f977..c495d8de341 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -176,26 +176,21 @@ nonexistent directory will fail." (define-key map "\C-p" 'wdired-previous-line) (define-key map [down] 'wdired-next-line) (define-key map "\C-n" 'wdired-next-line) - - (define-key map [menu-bar wdired] - (cons "WDired" (make-sparse-keymap "WDired"))) - (define-key map [menu-bar wdired wdired-customize] - '("Options" . wdired-customize)) - (define-key map [menu-bar wdired dashes] - '("--")) - (define-key map [menu-bar wdired wdired-abort-changes] - '(menu-item "Abort Changes" wdired-abort-changes - :help "Abort changes and return to dired mode")) - (define-key map [menu-bar wdired wdired-finish-edit] - '("Commit Changes" . wdired-finish-edit)) - (define-key map [remap upcase-word] 'wdired-upcase-word) (define-key map [remap capitalize-word] 'wdired-capitalize-word) (define-key map [remap downcase-word] 'wdired-downcase-word) - map) "Keymap used in `wdired-mode'.") +(easy-menu-define wdired-mode-menu wdired-mode-map + "Menu for `wdired-mode'." + '("WDired" + ["Commit Changes" wdired-finish-edit] + ["Abort Changes" wdired-abort-changes + :help "Abort changes and return to Dired mode"] + "---" + ["Options" wdired-customize])) + (defvar wdired-mode-hook nil "Hooks run when changing to WDired mode.") diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el index 124cb04486c..39b32217628 100644 --- a/lisp/wid-browse.el +++ b/lisp/wid-browse.el @@ -27,7 +27,6 @@ ;;; Code: -(require 'easymenu) (require 'wid-edit) (defgroup widget-browse nil |