diff options
Diffstat (limited to 'lisp')
102 files changed, 901 insertions, 795 deletions
diff --git a/lisp/array.el b/lisp/array.el index 08c5ff45ddd..aed93ffb65b 100644 --- a/lisp/array.el +++ b/lisp/array.el @@ -103,7 +103,7 @@ Set them to the optional arguments A-ROW and A-COLUMN if those are supplied." (defun array-update-buffer-position () "Set `array-buffer-line' and `array-buffer-column' to their current values." - (setq array-buffer-line (current-line) + (setq array-buffer-line (array-current-line) array-buffer-column (current-column))) @@ -113,7 +113,7 @@ Set them to the optional arguments A-ROW and A-COLUMN if those are supplied." (defun array-what-position () "Display the row and column in which the cursor is positioned." (interactive) - (let ((array-buffer-line (current-line)) + (let ((array-buffer-line (array-current-line)) (array-buffer-column (current-column))) (message "Array row: %s Array column: %s" (prin1-to-string (array-current-row)) @@ -147,13 +147,13 @@ Set them to the optional arguments A-ROW and A-COLUMN if those are supplied." ;;; Internal movement functions. (defun array-beginning-of-field (&optional go-there) - "Return the column of the beginning of the current field. + "Return the column of the beginning of the current field. Optional argument GO-THERE, if non-nil, means go there too." - ;; Requires that array-buffer-column be current. - (let ((goal-column (- array-buffer-column (% array-buffer-column array-field-width)))) - (if go-there - (move-to-column-untabify goal-column) - goal-column))) + ;; Requires that array-buffer-column be current. + (let ((goal-column (- array-buffer-column (% array-buffer-column array-field-width)))) + (if go-there + (array-move-to-column-untabify goal-column) + goal-column))) (defun array-end-of-field (&optional go-there) "Return the column of the end of the current array field. @@ -162,7 +162,7 @@ If optional argument GO-THERE is non-nil, go there too." (let ((goal-column (+ (- array-buffer-column (% array-buffer-column array-field-width)) array-field-width))) (if go-there - (move-to-column-untabify goal-column) + (array-move-to-column-untabify goal-column) goal-column))) (defun array-move-to-cell (a-row a-column) @@ -174,7 +174,7 @@ Leave point at the beginning of the field and return the new buffer column." (goal-column (* array-field-width (% (1- a-column) array-columns-per-line)))) (goto-char (point-min)) (forward-line goal-line) - (move-to-column-untabify goal-column))) + (array-move-to-column-untabify goal-column))) (defun array-move-to-row (a-row) "Move to array row A-ROW preserving the current array column. @@ -184,7 +184,7 @@ Leave point at the beginning of the field and return the new array row." (% array-buffer-line array-lines-per-row))) (goal-column (- array-buffer-column (% array-buffer-column array-field-width)))) (forward-line (- goal-line array-buffer-line)) - (move-to-column-untabify goal-column) + (array-move-to-column-untabify goal-column) a-row)) (defun array-move-to-column (a-column) @@ -196,7 +196,7 @@ Leave point at the beginning of the field and return the new array column." (floor (1- a-column) array-columns-per-line))) (goal-column (* array-field-width (% (1- a-column) array-columns-per-line)))) (forward-line (- goal-line array-buffer-line)) - (move-to-column-untabify goal-column) + (array-move-to-column-untabify goal-column) a-column)) (defun array-move-one-row (sign) @@ -214,7 +214,7 @@ If requested to move beyond the array bounds, signal an error." (t (progn (forward-line (* sign array-lines-per-row)) - (move-to-column-untabify goal-column) + (array-move-to-column-untabify goal-column) (+ array-row sign)))))) (defun array-move-one-column (sign) @@ -233,15 +233,15 @@ If requested to move beyond the array bounds, signal an error." ;; Going backward from first column on the line. ((and (= sign -1) (= 1 (% array-column array-columns-per-line))) (forward-line -1) - (move-to-column-untabify + (array-move-to-column-untabify (* array-field-width (1- array-columns-per-line)))) ;; Going forward from last column on the line. ((and (= sign 1) (zerop (% array-column array-columns-per-line))) (forward-line 1)) ;; Somewhere in the middle of the line. (t - (move-to-column-untabify (+ (array-beginning-of-field) - (* array-field-width sign))))) + (array-move-to-column-untabify (+ (array-beginning-of-field) + (* array-field-width sign))))) (+ array-column sign))))) (defun array-normalize-cursor () @@ -281,15 +281,15 @@ If necessary, scroll horizontally to keep the cursor in view." "Move down one array row, staying in the current array column. If optional ARG is given, move down ARG array rows." (interactive "p") - (let ((array-buffer-line (current-line)) + (let ((array-buffer-line (array-current-line)) (array-buffer-column (current-column))) (if (= (abs arg) 1) (array-move-one-row arg) (array-move-to-row - (limit-index (+ (or (array-current-row) - (error "Cursor is not in an array cell")) - arg) - array-max-row)))) + (array--limit-index (+ (or (array-current-row) + (error "Cursor is not in an array cell")) + arg) + array-max-row)))) (array-normalize-cursor)) (defun array-previous-row (&optional arg) @@ -303,15 +303,15 @@ If optional ARG is given, move up ARG array rows." If optional ARG is given, move forward ARG array columns. If necessary, keep the cursor in the window by scrolling right or left." (interactive "p") - (let ((array-buffer-line (current-line)) + (let ((array-buffer-line (array-current-line)) (array-buffer-column (current-column))) (if (= (abs arg) 1) (array-move-one-column arg) (array-move-to-column - (limit-index (+ (or (array-current-column) - (error "Cursor is not in an array cell")) - arg) - array-max-column)))) + (array--limit-index (+ (or (array-current-column) + (error "Cursor is not in an array cell")) + arg) + array-max-column)))) (array-normalize-cursor)) (defun array-backward-column (&optional arg) @@ -325,8 +325,8 @@ If necessary, keep the cursor in the window by scrolling right or left." "Go to array row A-ROW and array column A-COLUMN." (interactive "nArray row: \nnArray column: ") (array-move-to-cell - (limit-index a-row array-max-row) - (limit-index a-column array-max-column)) + (array--limit-index a-row array-max-row) + (array--limit-index a-column array-max-column)) (array-normalize-cursor)) @@ -417,7 +417,7 @@ Leave point at the beginning of the field." "Copy the current field one array row down. If optional ARG is given, copy down through ARG array rows." (interactive "p") - (let* ((array-buffer-line (current-line)) + (let* ((array-buffer-line (array-current-line)) (array-buffer-column (current-column)) (array-row (or (array-current-row) (error "Cursor is not in a valid array cell"))) @@ -425,7 +425,7 @@ If optional ARG is given, copy down through ARG array rows." (if (= (abs arg) 1) (array-copy-once-vertically arg) (array-copy-to-row - (limit-index (+ array-row arg) array-max-row)))) + (array--limit-index (+ array-row arg) array-max-row)))) (array-normalize-cursor)) (defun array-copy-up (&optional arg) @@ -438,7 +438,7 @@ If optional ARG is given, copy up through ARG array rows." "Copy the current field one array column to the right. If optional ARG is given, copy through ARG array columns to the right." (interactive "p") - (let* ((array-buffer-line (current-line)) + (let* ((array-buffer-line (array-current-line)) (array-buffer-column (current-column)) (array-column (or (array-current-column) (error "Cursor is not in a valid array cell"))) @@ -446,7 +446,7 @@ If optional ARG is given, copy through ARG array columns to the right." (if (= (abs arg) 1) (array-copy-once-horizontally arg) (array-copy-to-column - (limit-index (+ array-column arg) array-max-column)))) + (array--limit-index (+ array-column arg) array-max-column)))) (array-normalize-cursor)) (defun array-copy-backward (&optional arg) @@ -473,7 +473,7 @@ If optional ARG is given, copy through ARG array columns to the right." (if (= (abs arg) 1) (array-copy-once-horizontally arg) (array-copy-to-column - (limit-index (+ array-column arg) array-max-column)))))) + (array--limit-index (+ array-column arg) array-max-column)))))) (message "Working...done") (array-move-to-row array-row) (array-normalize-cursor)) @@ -506,7 +506,7 @@ If optional ARG is given, copy through ARG rows down." (forward-line 1) (point)))) (this-row array-row) - (goal-row (limit-index (+ this-row arg) array-max-row)) + (goal-row (array--limit-index (+ this-row arg) array-max-row)) (num (- goal-row this-row)) (count (abs num)) (sign (if (not (zerop count)) (/ num count)))) @@ -700,13 +700,13 @@ of `array-rows-numbered'." (floor (1- temp-max-column) new-columns-per-line)) (newlines-added 0)) (while (< newlines-removed newlines-to-be-removed) - (move-to-column-untabify + (array-move-to-column-untabify (* (1+ newlines-removed) old-line-length)) (kill-line 1) (setq newlines-removed (1+ newlines-removed))) (beginning-of-line) (while (< newlines-added newlines-to-be-added) - (move-to-column-untabify (* old-field-width new-columns-per-line)) + (array-move-to-column-untabify (* old-field-width new-columns-per-line)) (newline) (setq newlines-added (1+ newlines-added))) (forward-line 1)))) @@ -735,16 +735,16 @@ of `array-rows-numbered'." ;;; Utilities. -(defun limit-index (index limit) +(defun array--limit-index (index limit) (cond ((< index 1) 1) ((> index limit) limit) (t index))) -(defun current-line () +(defun array-current-line () "Return the current buffer line at point. The first line is 0." (count-lines (point-min) (line-beginning-position))) -(defun move-to-column-untabify (column) +(defun array-move-to-column-untabify (column) "Move to COLUMN on the current line, untabifying if necessary. Return COLUMN." (or (and (= column (move-to-column column)) @@ -753,10 +753,10 @@ Return COLUMN." (if array-respect-tabs (error "There is a TAB character in the way") (progn - (untabify-backward) + (array--untabify-backward) (move-to-column column))))) -(defun untabify-backward () +(defun array--untabify-backward () "Untabify the preceding TAB." (save-excursion (let ((start (point))) @@ -885,7 +885,10 @@ Entering array mode calls the function `array-mode-hook'." (setq-local truncate-lines t) (setq overwrite-mode 'overwrite-mode-textual)) - +(define-obsolete-function-alias 'limit-index #'array--limit-index "29.1") +(define-obsolete-function-alias 'current-line #'array-current-line "29.1") +(define-obsolete-function-alias 'move-to-column-untabify #'array-move-to-column-untabify "29.1") +(define-obsolete-function-alias 'untabify-backward #'array--untabify-backward "29.1") (provide 'array) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 30a03e0431e..d0893e932b4 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -966,7 +966,7 @@ it removes only the first instance of a bookmark with that name from the list of bookmarks.)" (interactive (list nil current-prefix-arg)) (let ((prompt - (if no-overwrite "Append bookmark named" "Set bookmark named"))) + (if no-overwrite "Add bookmark named" "Set bookmark named"))) (bookmark-set-internal prompt name (if no-overwrite 'push 'overwrite)))) ;;;###autoload diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index 3b8629b797d..8d99f62a9ba 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el @@ -647,9 +647,7 @@ (defun calcFunc-rhead (vec) (if (and (Math-vectorp vec) (cdr vec)) - (let ((vec (copy-sequence vec))) - (setcdr (nthcdr (- (length vec) 2) vec) nil) - vec) + (butlast vec) (calc-record-why 'vectorp vec) (list 'calcFunc-rhead vec))) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 254c703ee22..6c21430b1b3 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1959,12 +1959,8 @@ See calc-keypad for details." (or n (setq n 1)) (or m (setq m 1)) (calc-check-stack (+ n m -1)) - (and (> n 0) - (let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1) - calc-stack)))) - (setcdr (nthcdr (1- n) top) nil) - (nreverse - (mapcar (lambda (x) (calc-get-stack-element x sel-mode)) top))))) + (nreverse (mapcar (lambda (x) (calc-get-stack-element x sel-mode)) + (take n (nthcdr (+ m calc-stack-top -1) calc-stack))))) (defun calc-top-list-n (&optional n m sel-mode) (mapcar #'math-check-complete @@ -2291,9 +2287,7 @@ the United States." ((and (null n) (eq (car-safe top) 'incomplete) (> (length top) (if (eq (nth 1 top) 'intv) 3 2))) - (calc-pop-push-list 1 (let ((tt (copy-sequence top))) - (setcdr (nthcdr (- (length tt) 2) tt) nil) - (list tt)))) + (calc-pop-push-list 1 (list (butlast top)))) ((< nn 0) (if (and calc-any-selections (calc-top-selected 1 (- nn))) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 7e911d814dc..bbdcaa4db4e 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -171,13 +171,13 @@ If DATE lacks timezone information, GMT is assumed." (error "Invalid date: %s" date))))))))) ;;;###autoload -(defalias 'time-to-seconds 'float-time) +(defalias 'time-to-seconds #'float-time) ;;;###autoload -(defun seconds-to-time (seconds &rest form) - "Convert SECONDS to a proper time, like `current-time' would. -FORM means the same as in `time-convert'." - (time-convert seconds form)) +(defun seconds-to-time (seconds) + "Convert SECONDS to a proper time, like `current-time' would." + ;; FIXME: Should we (declare (obsolete time-convert "27.1")) ? + (time-convert seconds 'list)) ;;;###autoload (defun days-to-time (days) @@ -202,7 +202,7 @@ TIME should be either a time value or a date-time string." (time-subtract nil time)) ;;;###autoload -(define-obsolete-function-alias 'subtract-time 'time-subtract "26.1") +(define-obsolete-function-alias 'subtract-time #'time-subtract "26.1") ;;;###autoload (defun date-to-day (date) diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el index e6befb10e91..c33ac850722 100644 --- a/lisp/cedet/cedet.el +++ b/lisp/cedet/cedet.el @@ -25,15 +25,12 @@ ;;; Commentary: ;;; Code: -;; -;; This file depends on the major components of CEDET, so that you can -;; load them all by doing (require 'cedet). This is mostly for -;; compatibility with the upstream, stand-alone CEDET distribution. (declare-function inversion-find-version "inversion") (defconst cedet-version "2.0" "Current version of CEDET.") +(make-obsolete-variable 'cedet-version 'emacs-version "29.1") (defconst cedet-packages `( @@ -45,6 +42,7 @@ (ede "1.2" nil "ede" ) ) "Table of CEDET packages to install.") +(make-obsolete-variable 'cedet-packages 'package-built-in-p "29.1") (defvar cedet-menu-map ;(make-sparse-keymap "CEDET menu") (let ((map (make-sparse-keymap "CEDET menu"))) diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index 4ea14e33c5d..e6bfd0b1e85 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -1,10 +1,10 @@ ;;; ede.el --- Emacs Development Environment gloss -*- lexical-binding: t; -*- -;; Copyright (C) 1998-2005, 2007-2022 Free Software Foundation, Inc. +;; Copyright (C) 1998-2022 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make -;; Version: 1.2 +;; Version: 2.0 ;; This file is part of GNU Emacs. @@ -39,6 +39,8 @@ ;; ;; (global-ede-mode t) +;;; Code: + (require 'cedet) (require 'cl-lib) (require 'eieio) @@ -66,10 +68,11 @@ (defconst ede-version "2.0" "Current version of the Emacs EDE.") +(make-obsolete-variable 'ede-version 'emacs-version "29.1") -;;; Code: (defun ede-version () "Display the current running version of EDE." + (declare (obsolete emacs-version "29.1")) (interactive) (message "EDE %s" ede-version)) (defgroup ede nil diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el index cbe766cedb6..c83e6873679 100644 --- a/lisp/cedet/ede/emacs.el +++ b/lisp/cedet/ede/emacs.el @@ -80,7 +80,6 @@ ROOTPROJ is nil, since there is only one project." ;; Doesn't already exist, so let's make one. (let* ((vertuple (ede-emacs-version dir))) (ede-emacs-project - (car vertuple) :name (car vertuple) :version (cdr vertuple) :directory (file-name-as-directory dir) diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 78002dd8abc..3166279de40 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -34,6 +34,8 @@ ;; menu). To enable it at startup, put (semantic-mode 1) in your init ;; file. +;;; Code: + (require 'cedet) (require 'semantic/tag) (require 'semantic/lex) @@ -41,6 +43,7 @@ (defvar semantic-version "2.2" "Current version of Semantic.") +(make-obsolete-variable 'semantic-version 'emacs-version "29.1") (declare-function inversion-test "inversion") (declare-function semanticdb-load-ebrowse-caches "semantic/db-ebrowse") @@ -73,9 +76,6 @@ introduced." (require 'semantic/fw) -;;; Code: -;; - ;;; Variables and Configuration ;; (defvar-local semantic--parse-table nil diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el index 1e52b1f8504..a6cf8d89a4f 100644 --- a/lisp/cedet/semantic/bovine.el +++ b/lisp/cedet/semantic/bovine.el @@ -143,14 +143,14 @@ list of semantic tokens found." cvl nil ;re-init the collected value list. lte (car matchlist) ;Get the local matchlist entry. ) - (if (or (byte-code-function-p (car lte)) + (if (or (compiled-function-p (car lte)) (listp (car lte))) ;; In this case, we have an EMPTY match! Make ;; stuff up. (setq cvl (list nil)))) (while (and lte - (not (byte-code-function-p (car lte))) + (not (compiled-function-p (car lte))) (not (listp (car lte)))) ;; GRAMMAR SOURCE DEBUGGING! diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index d00ab47ce69..e2c9d618ba2 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -29,7 +29,7 @@ (require 'cedet-files) (require 'data-debug) -(defvar semanticdb-file-version semantic-version +(defvar semanticdb-file-version "2.2" "Version of semanticdb we are writing files to disk with.") (defvar semanticdb-file-incompatible-version "1.4" "Version of semanticdb we are not reverse compatible with.") diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 17cd3b1d59a..e24f6128a68 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -38,7 +38,7 @@ ;;; Code: (require 'semantic/wisent) (eval-when-compile (require 'cl-lib)) -(eval-when-compile (require 'subr-x)) ; `string-pad' +(require 'subr-x) ; `string-pad' ;;;; ------------------- ;;;; Misc. useful things diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el index 7c054d4c100..9691f906a4c 100644 --- a/lisp/cedet/srecode.el +++ b/lisp/cedet/srecode.el @@ -37,14 +37,16 @@ ;; ;; See the srecode manual for specific details. +;;; Code: + (require 'eieio) (require 'mode-local) (load "srecode/loaddefs" nil 'nomessage) (defvar srecode-version "1.2" "Current version of the Semantic Recoder.") +(make-obsolete-variable 'srecode-version 'emacs-version "29.1") -;;; Code: (defgroup srecode nil "Semantic Recoder." :group 'extensions diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 16971aa6611..7fad031add6 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -655,7 +655,9 @@ The character information includes: ("file code" ,@(if multibyte-p (let* ((coding buffer-file-coding-system) - (encoded (encode-coding-char char coding charset))) + (encoded + (and coding + (encode-coding-char char coding charset)))) (if encoded (list (encoded-string-description encoded coding) (format "(encoded by coding system %S)" diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 2a2bcca7007..d383650f4e5 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1054,9 +1054,9 @@ ;; (print "Let's clean up now!")) ;; foo ;; -;; Now `foo's advice is byte-compiled: +;; Now `foo's advice is compiled: ;; -;; (byte-code-function-p 'ad-Advice-foo) +;; (compiled-function-p 'ad-Advice-foo) ;; t ;; ;; (foo 3) @@ -1298,7 +1298,7 @@ ;; constructed during preactivation was used, even though we did not specify ;; the `compile' flag: ;; -;; (byte-code-function-p 'ad-Advice-fum) +;; (compiled-function-p 'ad-Advice-fum) ;; t ;; ;; (fum 2) @@ -1329,7 +1329,7 @@ ;; ;; A new uncompiled advised definition got constructed: ;; -;; (byte-code-function-p 'ad-Advice-fum) +;; (compiled-function-p 'ad-Advice-fum) ;; nil ;; ;; (fum 2) @@ -1580,8 +1580,6 @@ :link '(custom-manual "(elisp)Advising Functions") :group 'lisp) -(defconst ad-version "2.14") - ;;;###autoload (defcustom ad-redefinition-action 'warn "Defines what to do with redefinitions during Advice de/activation. @@ -2118,9 +2116,9 @@ the cache-id will clear the cache." (defsubst ad-compiled-p (definition) "Return non-nil if DEFINITION is a compiled byte-code object." - (or (byte-code-function-p definition) - (and (macrop definition) - (byte-code-function-p (ad-lambdafy definition))))) + (or (compiled-function-p definition) + (and (macrop definition) + (compiled-function-p (ad-lambdafy definition))))) (defsubst ad-compiled-code (compiled-definition) "Return the byte-code object of a COMPILED-DEFINITION." @@ -3250,6 +3248,9 @@ Use only in REAL emergencies." (message "Oops! Left over advised function %S" function) (ad-pop-advised-function function))) +(defconst ad-version "2.14") +(make-obsolete-variable 'ad-version 'emacs-version "29.1") + (provide 'advice) ;;; advice.el ends here diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 7a4bbf2e8af..52e00952846 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1207,25 +1207,26 @@ See Info node `(elisp) Integer Basics'." form))) (defun byte-optimize-apply (form) - ;; If the last arg is a literal constant, turn this into a funcall. - ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...). - (if (= (length form) 2) - ;; single-argument `apply' is not worth optimizing (bug#40968) - form - (let ((fn (nth 1 form)) - (last (nth (1- (length form)) form))) ; I think this really is fastest - (or (if (or (null last) - (eq (car-safe last) 'quote)) - (if (listp (nth 1 last)) - (let ((butlast (nreverse (cdr (reverse (cdr (cdr form))))))) - (nconc (list 'funcall fn) butlast - (mapcar (lambda (x) (list 'quote x)) (nth 1 last)))) + (let ((len (length form))) + (if (>= len 2) + (let ((fn (nth 1 form)) + (last (nth (1- len) form))) + (cond + ;; (apply F ... '(X Y ...)) -> (funcall F ... 'X 'Y ...) + ((or (null last) + (eq (car-safe last) 'quote)) + (let ((last-value (nth 1 last))) + (if (listp last-value) + `(funcall ,fn ,@(butlast (cddr form)) + ,@(mapcar (lambda (x) (list 'quote x)) last-value)) (byte-compile-warn-x - last - "last arg to apply can't be a literal atom: `%s'" - last) - nil)) - form)))) + last "last arg to apply can't be a literal atom: `%s'" last) + nil))) + ;; (apply F ... (list X Y ...)) -> (funcall F ... X Y ...) + ((eq (car-safe last) 'list) + `(funcall ,fn ,@(butlast (cddr form)) ,@(cdr last))) + (t form))) + form))) (put 'funcall 'byte-optimizer #'byte-optimize-funcall) (put 'apply 'byte-optimizer #'byte-optimize-apply) @@ -1747,10 +1748,10 @@ See Info node `(elisp) Integer Basics'." byte-goto-if-not-nil-else-pop)) (defconst byte-after-unbind-ops - '(byte-constant byte-dup + '(byte-constant byte-dup byte-stack-ref byte-stack-set byte-discard byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp byte-eq byte-not - byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4 + byte-cons byte-list1 byte-list2 byte-list3 byte-list4 byte-listN byte-interactive-p) ;; How about other side-effect-free-ops? Is it safe to move an ;; error invocation (such as from nth) out of an unwind-protect? @@ -1762,7 +1763,8 @@ See Info node `(elisp) Integer Basics'." (defconst byte-compile-side-effect-and-error-free-ops '(byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe - byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max + byte-cdr-safe byte-cons byte-list1 byte-list2 byte-list3 byte-list4 + byte-listN byte-point byte-point-max byte-point-min byte-following-char byte-preceding-char byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp byte-current-buffer byte-stack-ref)) @@ -2113,13 +2115,15 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (setcar (cdr rest) lap0) (setq keep-going t)) ;; - ;; varbind-X unbind-N --> discard unbind-(N-1) - ;; save-excursion unbind-N --> unbind-(N-1) - ;; save-restriction unbind-N --> unbind-(N-1) + ;; varbind-X unbind-N --> discard unbind-(N-1) + ;; save-excursion unbind-N --> unbind-(N-1) + ;; save-restriction unbind-N --> unbind-(N-1) + ;; save-current-buffer unbind-N --> unbind-(N-1) ;; ((and (eq 'byte-unbind (car lap1)) (memq (car lap0) '(byte-varbind byte-save-excursion - byte-save-restriction)) + byte-save-restriction + byte-save-current-buffer)) (< 0 (cdr lap1))) (if (zerop (setcdr lap1 (1- (cdr lap1)))) (delq lap1 rest)) @@ -2475,8 +2479,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; itself, compile some of its most used recursive functions (at load time). ;; (eval-when-compile - (or (byte-code-function-p (symbol-function 'byte-optimize-form)) - (subr-native-elisp-p (symbol-function 'byte-optimize-form)) + (or (compiled-function-p (symbol-function 'byte-optimize-form)) (assq 'byte-code (symbol-function 'byte-optimize-form)) (let ((byte-optimize nil) (byte-compile-warnings nil)) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 9d5f6682b5a..907015eb48e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1395,7 +1395,7 @@ when printing the error message." (or (symbolp (symbol-function fn)) (consp (symbol-function fn)) (and (not macro-p) - (byte-code-function-p (symbol-function fn))))) + (compiled-function-p (symbol-function fn))))) (setq fn (symbol-function fn))) (let ((advertised (gethash (if (and (symbolp fn) (fboundp fn)) ;; Could be a subr. @@ -1407,7 +1407,7 @@ when printing the error message." (if macro-p `(macro lambda ,advertised) `(lambda ,advertised))) - ((and (not macro-p) (byte-code-function-p fn)) fn) + ((and (not macro-p) (compiled-function-p fn)) fn) ((not (consp fn)) nil) ((eq 'macro (car fn)) (cdr fn)) (macro-p nil) @@ -2946,11 +2946,11 @@ If FORM is a lambda or a macro, byte-compile it as a function." (setq fun (cdr fun))) (prog1 (cond - ;; Up until Emacs-24.1, byte-compile silently did nothing when asked to - ;; compile something invalid. So let's tune down the complaint from an - ;; error to a simple message for the known case where signaling an error - ;; causes problems. - ((byte-code-function-p fun) + ;; Up until Emacs-24.1, byte-compile silently did nothing + ;; when asked to compile something invalid. So let's tone + ;; down the complaint from an error to a simple message for + ;; the known case where signaling an error causes problems. + ((compiled-function-p fun) (message "Function %s is already compiled" (if (symbolp form) form "provided")) fun) @@ -3527,7 +3527,7 @@ lambda-expression." (byte-compile-out-tag endtag))) (defun byte-compile-unfold-bcf (form) - "Inline call to byte-code-functions." + "Inline call to byte-code function." (let* ((byte-compile-bound-variables byte-compile-bound-variables) (fun (car form)) (fargs (aref fun 0)) @@ -5254,11 +5254,13 @@ invoked interactively." ((not (consp f)) "<malformed function>") ((eq 'macro (car f)) - (if (or (byte-code-function-p (cdr f)) + (if (or (compiled-function-p (cdr f)) + ;; FIXME: Can this still happen? (assq 'byte-code (cdr (cdr (cdr f))))) " <compiled macro>" " <macro>")) ((assq 'byte-code (cdr (cdr f))) + ;; FIXME: Can this still happen? "<compiled lambda>") ((eq 'lambda (car f)) "<function>") @@ -5507,9 +5509,7 @@ and corresponding effects." ;; itself, compile some of its most used recursive functions (at load time). ;; (eval-when-compile - (or (byte-code-function-p (symbol-function 'byte-compile-form)) - (subr-native-elisp-p (symbol-function 'byte-compile-form)) - (assq 'byte-code (symbol-function 'byte-compile-form)) + (or (compiled-function-p (symbol-function 'byte-compile-form)) (let ((byte-optimize nil) ; do it fast (byte-compile-warnings nil)) (mapc (lambda (x) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index ac589b82f83..04ead562f2f 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1,6 +1,6 @@ ;;; checkdoc.el --- check documentation strings for style requirements -*- lexical-binding:t -*- -;; Copyright (C) 1997-1998, 2001-2022 Free Software Foundation, Inc. +;; Copyright (C) 1997-2022 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Old-Version: 0.6.2 @@ -1357,23 +1357,6 @@ checking of documentation strings. checkdoc-common-verbs-wrong-voice "\\|") "\\)\\>")))) -;; Profiler says this is not yet faster than just calling assoc -;;(defun checkdoc-word-in-alist-vector (word vector) -;; "Check to see if WORD is in the car of an element of VECTOR. -;;VECTOR must be sorted. The CDR should be a replacement. Since the -;;word list is getting bigger, it is time for a quick bisecting search." -;; (let ((max (length vector)) (min 0) i -;; (found nil) (fw nil)) -;; (setq i (/ max 2)) -;; (while (and (not found) (/= min max)) -;; (setq fw (car (aref vector i))) -;; (cond ((string= word fw) (setq found (cdr (aref vector i)))) -;; ((string< word fw) (setq max i)) -;; (t (setq min i))) -;; (setq i (/ (+ max min) 2)) -;; ) -;; found)) - ;;; Checking engines ;; (defun checkdoc-this-string-valid (&optional take-notes) @@ -2860,8 +2843,6 @@ function called to create the messages." (custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode) -;; Obsolete - (define-obsolete-function-alias 'checkdoc-run-hooks #'run-hook-with-args-until-success "28.1") (defvar checkdoc-version "0.6.2" diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index eefaa36b911..80ca43c902a 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3411,7 +3411,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (character . natnump) (char-table . char-table-p) (command . commandp) - (compiled-function . byte-code-function-p) + (compiled-function . compiled-function-p) (hash-table . hash-table-p) (cons . consp) (fixnum . fixnump) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index c8ff6b68144..047b0069bb9 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1813,8 +1813,7 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ (unless (or (null tests) (zerop high)) (message "\nLONG-RUNNING TESTS") (message "------------------") - (setq tests (sort tests (lambda (x y) (> (car x) (car y))))) - (when (< high (length tests)) (setcdr (nthcdr (1- high) tests) nil)) + (setq tests (ntake high (sort tests (lambda (x y) (> (car x) (car y)))))) (message "%s" (mapconcat #'cdr tests "\n"))) ;; More details on hydra and emba, where the logs are harder to get to. (when (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el index 654dbbc5fef..10bb2973253 100644 --- a/lisp/emacs-lisp/helper.el +++ b/lisp/emacs-lisp/helper.el @@ -131,7 +131,6 @@ (defun Helper-describe-bindings () "Describe local key bindings of current mode." (interactive) - (message "Making binding list...") (save-window-excursion (describe-bindings)) (Helper-help-scroller)) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 3b329357ad9..31e1514193f 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -519,15 +519,21 @@ binds `generated-autoload-file' as a file-local variable, write its autoloads into the specified file instead. The function does NOT recursively descend into subdirectories of the -directory or directories specified. +directory or directories specified by DIRS. -If EXTRA-DATA, include this string at the start of the generated -file. This will also force generation of OUTPUT-FILE even if -there are no autoloads to put into the file. +Optional argument EXCLUDED-FILES, if non-nil, should be a list of +files, such as preloaded files, whose autoloads should not be written +to OUTPUT-FILE. -If INCLUDE-PACKAGE-VERSION, include package version data. +If EXTRA-DATA is non-nil, it should be a string; include that string +at the beginning of the generated file. This will also force the +generation of OUTPUT-FILE even if there are no autoloads to put into +that file. -If GENERATE-FULL, don't update, but regenerate all the loaddefs files." +If INCLUDE-PACKAGE-VERSION is non-nil, include package version data. + +If GENERATE-FULL is non-nil, regenerate all the loaddefs files anew, +instead of just updating them with the new/changed autoloads." (let* ((files-re (let ((tmp nil)) (dolist (suf (get-load-suffixes)) ;; We don't use module-file-suffix below because @@ -545,6 +551,11 @@ If GENERATE-FULL, don't update, but regenerate all the loaddefs files." (updating (and (file-exists-p output-file) (not generate-full))) (defs nil)) + ;; Allow the excluded files to be relative. + (setq excluded-files + (mapcar (lambda (file) (expand-file-name file dir)) + excluded-files)) + ;; Collect all the autoload data. (let ((progress (make-progress-reporter (byte-compile-info @@ -583,7 +594,8 @@ If GENERATE-FULL, don't update, but regenerate all the loaddefs files." ;; We have some data, so generate the loaddef files. First ;; group per output file. (dolist (fdefs (seq-group-by #'car defs)) - (let ((loaddefs-file (car fdefs))) + (let ((loaddefs-file (car fdefs)) + hash) (with-temp-buffer (if (and updating (file-exists-p loaddefs-file)) (insert-file-contents loaddefs-file) @@ -593,6 +605,7 @@ If GENERATE-FULL, don't update, but regenerate all the loaddefs files." (when extra-data (insert extra-data) (ensure-empty-lines 1))) + (setq hash (buffer-hash)) ;; Then group by source file (and sort alphabetically). (dolist (section (sort (seq-group-by #'cadr (cdr fdefs)) (lambda (e1 e2) @@ -629,9 +642,11 @@ If GENERATE-FULL, don't update, but regenerate all the loaddefs files." (loaddefs-generate--print-form def)) (unless (bolp) (insert "\n"))))) - (write-region (point-min) (point-max) loaddefs-file nil 'silent) - (byte-compile-info (file-relative-name loaddefs-file lisp-directory) - t "GEN"))))))) + ;; Only write the file if we actually made a change. + (unless (equal (buffer-hash) hash) + (write-region (point-min) (point-max) loaddefs-file nil 'silent) + (byte-compile-info + (file-relative-name loaddefs-file lisp-directory) t "GEN")))))))) (defun loaddefs-generate--print-form (def) "Print DEF in a format that makes sense for version control." diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 6a193a56d2d..5ae9d8368f0 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -823,7 +823,7 @@ test of free variables in the following ways: (eval-when-compile (add-hook 'emacs-startup-hook (lambda () - (and (not (byte-code-function-p + (and (not (compiled-function-p (symbol-function 'macroexpand-all))) (locate-library "macroexp.elc") (load "macroexp.elc"))))) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 2d5a1b5e77b..a9a20ab5abf 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -167,31 +167,31 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.") (defun advice--interactive-form (function) "Like `interactive-form' but tries to avoid autoloading functions." - (when (commandp function) - (if (not (and (symbolp function) (autoloadp (indirect-function function)))) - (interactive-form function) + (if (not (and (symbolp function) (autoloadp (indirect-function function)))) + (interactive-form function) + (when (commandp function) `(interactive (advice-eval-interactive-spec (cadr (interactive-form ',function))))))) -(defun advice--make-interactive-form (function main) +(defun advice--make-interactive-form (iff ifm) ;; TODO: make it so that interactive spec can be a constant which ;; dynamically checks the advice--car/cdr to do its job. ;; For that, advice-eval-interactive-spec needs to be more faithful. - (let* ((iff (advice--interactive-form function)) - (ifm (advice--interactive-form main)) - (fspec (cadr iff))) + (let* ((fspec (cadr iff))) (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda? - (setq fspec (nth 1 fspec))) + (setq fspec (eval fspec t))) (if (functionp fspec) `(funcall ',fspec ',(cadr ifm)) (cadr (or iff ifm))))) (cl-defmethod oclosure-interactive-form ((ad advice) &optional _) - (let ((car (advice--car ad)) - (cdr (advice--cdr ad))) - (when (or (commandp car) (commandp cdr)) - `(interactive ,(advice--make-interactive-form car cdr))))) + (let* ((car (advice--car ad)) + (cdr (advice--cdr ad)) + (ifa (advice--interactive-form car)) + (ifd (advice--interactive-form cdr))) + (when (or ifa ifd) + `(interactive ,(advice--make-interactive-form ifa ifd))))) (cl-defmethod cl-print-object ((object advice) stream) (cl-assert (advice--p object)) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index d2959f7728c..ed23ee5f221 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3530,7 +3530,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (let ((place (cdr desc)) (out (copy-sequence (car desc)))) (add-text-properties place (1+ place) - '(face (bold font-lock-warning-face)) + '(face help-key-binding) out) out)) (package--prettify-quick-help-key (cons desc 0)))) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 07443dabfef..10bd4bc6886 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -607,31 +607,38 @@ recording whether the var has been referenced by earlier parts of the match." (symbolp . vectorp) (symbolp . stringp) (symbolp . byte-code-function-p) + (symbolp . compiled-function-p) (symbolp . recordp) (integerp . consp) (integerp . arrayp) (integerp . vectorp) (integerp . stringp) (integerp . byte-code-function-p) + (integerp . compiled-function-p) (integerp . recordp) (numberp . consp) (numberp . arrayp) (numberp . vectorp) (numberp . stringp) (numberp . byte-code-function-p) + (numberp . compiled-function-p) (numberp . recordp) (consp . arrayp) (consp . atom) (consp . vectorp) (consp . stringp) (consp . byte-code-function-p) + (consp . compiled-function-p) (consp . recordp) (arrayp . byte-code-function-p) + (arrayp . compiled-function-p) (vectorp . byte-code-function-p) + (vectorp . compiled-function-p) (vectorp . recordp) (stringp . vectorp) (stringp . recordp) - (stringp . byte-code-function-p))) + (stringp . byte-code-function-p) + (stringp . compiled-function-p))) (defun pcase--mutually-exclusive-p (pred1 pred2) (or (member (cons pred1 pred2) @@ -771,8 +778,8 @@ A and B can be one of: ((consp (cadr pat)) #'consp) ((stringp (cadr pat)) #'stringp) ((vectorp (cadr pat)) #'vectorp) - ((byte-code-function-p (cadr pat)) - #'byte-code-function-p)))) + ((compiled-function-p (cadr pat)) + #'compiled-function-p)))) (pcase--mutually-exclusive-p (cadr upat) otherpred)) '(:pcase--fail . nil)) ;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c)))) diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el index 2b2039f9d15..e8b92a532fa 100644 --- a/lisp/emacs-lisp/ring.el +++ b/lisp/emacs-lisp/ring.el @@ -42,6 +42,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + ;;; User Functions: ;;;###autoload @@ -51,6 +53,8 @@ (consp (cdr x)) (integerp (cadr x)) (vectorp (cddr x)))) +(cl-deftype ring () '(satisfies ring-p)) + ;;;###autoload (defun make-ring (size) "Make a ring that can contain SIZE elements." diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 6ddd8de6e8d..b6f0f66e5b1 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -458,11 +458,21 @@ TESTFN is used to compare elements, or `equal' if TESTFN is nil." (cl-defmethod seq-uniq ((sequence list) &optional testfn) (let ((result nil)) (if (not testfn) - ;; Fast path. - (while sequence - (unless (member (car sequence) result) - (push (car sequence) result)) - (pop sequence)) + ;; Fast path. If the list is long, use a hash table to speed + ;; things up even more. + (let ((l (length sequence))) + (if (> l 100) + (let ((hash (make-hash-table :test #'equal :size l))) + (while sequence + (unless (gethash (car sequence) hash) + (setf (gethash (car sequence) hash) t) + (push (car sequence) result)) + (setq sequence (cdr sequence)))) + ;; Short list. + (while sequence + (unless (member (car sequence) result) + (push (car sequence) result)) + (pop sequence)))) ;; Slower path. (while sequence (unless (seq-find (lambda (elem) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index b7083bfe7cc..bd7c3c82f97 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -254,13 +254,9 @@ the string." (unless (natnump length) (signal 'wrong-type-argument (list 'natnump length))) (let ((pad-length (- length (length string)))) - (if (< pad-length 0) - string - (concat (and start - (make-string pad-length (or padding ?\s))) - string - (and (not start) - (make-string pad-length (or padding ?\s))))))) + (cond ((<= pad-length 0) string) + (start (concat (make-string pad-length (or padding ?\s)) string)) + (t (concat string (make-string pad-length (or padding ?\s))))))) (defun string-chop-newline (string) "Remove the final newline (if any) from STRING." @@ -471,6 +467,18 @@ be marked unmodified, effectively ignoring those changes." (equal ,hash (buffer-hash))) (restore-buffer-modified-p nil)))))))) +(defun emacs-etc--hide-local-variables () + "Hide local variables. +Used by `emacs-authors-mode' and `emacs-news-mode'." + (narrow-to-region (point-min) + (save-excursion + (goto-char (point-max)) + ;; Obfuscate to avoid this being interpreted + ;; as a local variable section itself. + (if (re-search-backward "^Local\sVariables:$" nil t) + (progn (forward-line -1) (point)) + (point-max))))) + (provide 'subr-x) ;;; subr-x.el ends here diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index d1634c64ad3..d1c8b5ff2dd 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -7,7 +7,7 @@ ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; Keywords: emulations -;; Version: 3.14.1 +;; Version: 3.14.2 ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this ;; file on 20/3/2008, and the maintainer agreed that when a bug is diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el index 5d3aaf7c81c..9ad218d5988 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -206,7 +206,7 @@ file named by `eshell-aliases-file'.") (let ((eshell-current-handles (eshell-create-handles eshell-aliases-file 'overwrite))) (eshell/alias) - (eshell-close-handles 0)))) + (eshell-close-handles 0 'nil)))) (defsubst eshell-lookup-alias (name) "Check whether NAME is aliased. Return the alias if there is one." diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 775e4c1057e..62c95056fd2 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -133,6 +133,10 @@ There are several different kinds of commands, however." Such arguments will be passed to `read', and then evaluated." :type 'regexp) +(defcustom eshell-lisp-form-nil-is-failure t + "If non-nil, Lisp forms like (COMMAND ARGS) treat a nil result as failure." + :type 'boolean) + (defcustom eshell-pre-command-hook nil "A hook run before each interactive command is invoked." :type 'hook) @@ -541,9 +545,7 @@ implemented via rewriting, rather than as a function." ,(eshell-invokify-arg body t))) (setcar for-items (cadr for-items)) (setcdr for-items (cddr for-items))) - (eshell-close-handles - eshell-last-command-status - (list 'quote eshell-last-command-result)))))) + (eshell-close-handles))))) (defun eshell-structure-basic-command (func names keyword test body &optional else) @@ -551,10 +553,11 @@ implemented via rewriting, rather than as a function." The first of NAMES should be the positive form, and the second the negative. It's not likely that users should ever need to call this function." - ;; If the test form begins with `eshell-convert', it means - ;; something data-wise will be returned, and we should let - ;; that determine the truth of the statement. - (unless (eq (car test) 'eshell-convert) + ;; If the test form begins with `eshell-convert' or + ;; `eshell-escape-arg', it means something data-wise will be + ;; returned, and we should let that determine the truth of the + ;; statement. + (unless (memq (car test) '(eshell-convert eshell-escape-arg)) (setq test `(progn ,test (eshell-exit-success-p)))) @@ -574,9 +577,7 @@ function." `(let ((eshell-command-body '(nil)) (eshell-test-body '(nil))) (,func ,test ,body ,else) - (eshell-close-handles - eshell-last-command-status - (list 'quote eshell-last-command-result)))) + (eshell-close-handles))) (defun eshell-rewrite-while-command (terms) "Rewrite a `while' command into its equivalent Eshell command form. @@ -1415,43 +1416,53 @@ via `eshell-errorn'." (defun eshell-lisp-command (object &optional args) "Insert Lisp OBJECT, using ARGS if a function." (catch 'eshell-external ; deferred to an external command + (setq eshell-last-command-status 0 + eshell-last-arguments args) (let* ((eshell-ensure-newline-p (eshell-interactive-output-p)) + (command-form-p (functionp object)) (result - (if (functionp object) - (progn - (setq eshell-last-arguments args - eshell-last-command-name + (if command-form-p + (let ((numeric (not (get object + 'eshell-no-numeric-conversions))) + (fname-args (get object 'eshell-filename-arguments))) + (when (or numeric fname-args) + (while args + (let ((arg (car args))) + (cond + ((and numeric (stringp arg) (> (length arg) 0) + (text-property-any 0 (length arg) + 'number t arg)) + ;; If any of the arguments are flagged as + ;; numbers waiting for conversion, convert + ;; them now. + (setcar args (string-to-number arg))) + ((and fname-args (stringp arg) + (string-equal arg "~")) + ;; If any of the arguments match "~", + ;; prepend "./" to treat it as a regular + ;; file name. + (setcar args (concat "./" arg))))) + (setq args (cdr args)))) + (setq eshell-last-command-name (concat "#<function " (symbol-name object) ">")) - (let ((numeric (not (get object - 'eshell-no-numeric-conversions))) - (fname-args (get object 'eshell-filename-arguments))) - (when (or numeric fname-args) - (while args - (let ((arg (car args))) - (cond ((and numeric (stringp arg) (> (length arg) 0) - (text-property-any 0 (length arg) - 'number t arg)) - ;; If any of the arguments are - ;; flagged as numbers waiting for - ;; conversion, convert them now. - (setcar args (string-to-number arg))) - ((and fname-args (stringp arg) - (string-equal arg "~")) - ;; If any of the arguments match "~", - ;; prepend "./" to treat it as a - ;; regular file name. - (setcar args (concat "./" arg))))) - (setq args (cdr args))))) (eshell-apply object eshell-last-arguments)) - (setq eshell-last-arguments args - eshell-last-command-name "#<Lisp object>") + (setq eshell-last-command-name "#<Lisp object>") (eshell-eval object)))) (if (and eshell-ensure-newline-p (save-excursion (goto-char eshell-last-output-end) (not (bolp)))) (eshell-print "\n")) - (eshell-close-handles 0 (list 'quote result))))) + (eshell-close-handles + ;; If `eshell-lisp-form-nil-is-failure' is non-nil, Lisp forms + ;; that succeeded but have a nil result should have an exit + ;; status of 2. + (when (and eshell-lisp-form-nil-is-failure + (not command-form-p) + (= eshell-last-command-status 0) + (not result)) + 2) + (list 'quote result))))) (defalias 'eshell-lisp-command* #'eshell-lisp-command) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 68e52a2c9c8..27703976f6d 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -254,6 +254,30 @@ a nil value of mode defaults to `insert'." (setq idx (1+ idx)))) handles) +(defun eshell-close-handles (&optional exit-code result handles) + "Close all of the current HANDLES, taking refcounts into account. +If HANDLES is nil, use `eshell-current-handles'. + +EXIT-CODE is the process exit code (zero, if the command +completed successfully). If nil, then use the exit code already +set in `eshell-last-command-status'. + +RESULT is the quoted value of the last command. If nil, then use +the value already set in `eshell-last-command-result'." + (when exit-code + (setq eshell-last-command-status exit-code)) + (when result + (cl-assert (eq (car result) 'quote)) + (setq eshell-last-command-result (cadr result))) + (let ((handles (or handles eshell-current-handles))) + (dotimes (idx eshell-number-of-handles) + (when-let ((handle (aref handles idx))) + (setcdr handle (1- (cdr handle))) + (when (= (cdr handle) 0) + (dolist (target (ensure-list (car (aref handles idx)))) + (eshell-close-target target (= eshell-last-command-status 0))) + (setcar handle nil)))))) + (defun eshell-close-target (target status) "Close an output TARGET, passing STATUS as the result. STATUS should be non-nil on successful termination of the output." @@ -305,32 +329,6 @@ STATUS should be non-nil on successful termination of the output." ((consp target) (apply (car target) status (cdr target))))) -(defun eshell-close-handles (exit-code &optional result handles) - "Close all of the current handles, taking refcounts into account. -EXIT-CODE is the process exit code; mainly, it is zero, if the command -completed successfully. RESULT is the quoted value of the last -command. If nil, then the meta variables for keeping track of the -last execution result should not be changed." - (let ((idx 0)) - (cl-assert (or (not result) (eq (car result) 'quote))) - (setq eshell-last-command-status exit-code - eshell-last-command-result (cadr result)) - (while (< idx eshell-number-of-handles) - (let ((handles (or handles eshell-current-handles))) - (when (aref handles idx) - (setcdr (aref handles idx) - (1- (cdr (aref handles idx)))) - (when (= (cdr (aref handles idx)) 0) - (let ((target (car (aref handles idx)))) - (if (not (listp target)) - (eshell-close-target target (= exit-code 0)) - (while target - (eshell-close-target (car target) (= exit-code 0)) - (setq target (cdr target))))) - (setcar (aref handles idx) nil)))) - (setq idx (1+ idx))) - nil)) - (defun eshell-kill-append (string) "Call `kill-append' with STRING, if it is indeed a string." (if (stringp string) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 99b43661f2c..c367b5cd643 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -346,7 +346,9 @@ Used only on systems which do not support async subprocesses.") (defvar eshell-last-output-end) ;Defined in esh-mode.el. (eshell-update-markers eshell-last-output-end) ;; Simulate the effect of eshell-sentinel. - (eshell-close-handles (if (numberp exit-status) exit-status -1)) + (eshell-close-handles + (if (numberp exit-status) exit-status -1) + (list 'quote (and (numberp exit-status) (= exit-status 0)))) (eshell-kill-process-function command exit-status) (or (bound-and-true-p eshell-in-pipeline-p) (setq eshell-last-sync-output-start nil)) @@ -398,40 +400,36 @@ PROC is the process that's exiting. STRING is the exit message." (when (buffer-live-p (process-buffer proc)) (with-current-buffer (process-buffer proc) (unwind-protect - (let ((entry (assq proc eshell-process-list))) -; (if (not entry) -; (error "Sentinel called for unowned process `%s'" -; (process-name proc)) - (when entry - (unwind-protect - (progn - (unless (string= string "run") - ;; Write the exit message if the status is - ;; abnormal and the process is already writing - ;; to the terminal. - (when (and (eq proc (eshell-tail-process)) - (not (string-match "^\\(finished\\|exited\\)" - string))) - (funcall (process-filter proc) proc string)) - (let ((handles (nth 1 entry)) - (str (prog1 (nth 3 entry) - (setf (nth 3 entry) nil))) - (status (process-exit-status proc))) - ;; If we're in the middle of handling output - ;; from this process then schedule the EOF for - ;; later. - (letrec ((finish-io - (lambda () - (if (nth 4 entry) - (run-at-time 0 nil finish-io) - (when str - (ignore-error 'eshell-pipe-broken - (eshell-output-object - str nil handles))) - (eshell-close-handles - status 'nil handles))))) - (funcall finish-io))))) - (eshell-remove-process-entry entry)))) + (when-let ((entry (assq proc eshell-process-list))) + (unwind-protect + (unless (string= string "run") + ;; Write the exit message if the status is + ;; abnormal and the process is already writing + ;; to the terminal. + (when (and (eq proc (eshell-tail-process)) + (not (string-match "^\\(finished\\|exited\\)" + string))) + (funcall (process-filter proc) proc string)) + (let ((handles (nth 1 entry)) + (str (prog1 (nth 3 entry) + (setf (nth 3 entry) nil))) + (status (process-exit-status proc))) + ;; If we're in the middle of handling output + ;; from this process then schedule the EOF for + ;; later. + (letrec ((finish-io + (lambda () + (if (nth 4 entry) + (run-at-time 0 nil finish-io) + (when str + (ignore-error 'eshell-pipe-broken + (eshell-output-object + str nil handles))) + (eshell-close-handles + status (list 'quote (= status 0)) + handles))))) + (funcall finish-io)))) + (eshell-remove-process-entry entry))) (eshell-kill-process-function proc string))))) (defun eshell-process-interact (func &optional all query) diff --git a/lisp/faces.el b/lisp/faces.el index c7acbf57587..390ddbf606a 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2046,18 +2046,29 @@ as backgrounds." (when msg (message "Color: `%s'" color)) color)) -(defun face-at-point (&optional thing multiple) - "Return the face of the character after point. -If it has more than one face, return the first one. -If THING is non-nil try first to get a face name from the buffer. -IF MULTIPLE is non-nil, return a list of all faces. -Return nil if there is no face." +(defun face-at-point (&optional text multiple) + "Return a face name from point in the current buffer. +This function is meant to be used as a conveniency function for +providing defaults when prompting the user for a face name. + +If TEXT is non-nil, return the text at point if it names an +existing face. + +Otherwise, look at the faces in effect at point as text +properties or overlay properties, and return one of these face +names. + +IF MULTIPLE is non-nil, return a list of faces. + +Return nil if there is no face at point. + +This function is not meant for handling faces programatically; to +do that, use `get-text-property' and `get-char-property'." (let (faces) - (if thing - ;; Try to get a face name from the buffer. - (let ((face (intern-soft (thing-at-point 'symbol)))) - (if (facep face) - (push face faces)))) + (when text + ;; Try to get a face name from the buffer. + (when-let ((face (thing-at-point 'face))) + (push face faces))) ;; Add the named faces that the `read-face-name' or `face' property uses. (let ((faceprop (or (get-char-property (point) 'read-face-name) (get-char-property (point) 'face)))) diff --git a/lisp/finder.el b/lisp/finder.el index 73072c0cd48..08d20963b46 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -77,6 +77,7 @@ Each element has the form (KEYWORD . DESCRIPTION).") (defvar-keymap finder-mode-map :doc "Keymap used in `finder-mode'." + :parent special-mode-map "SPC" #'finder-select "f" #'finder-select "<follow-link>" 'mouse-face @@ -420,15 +421,14 @@ FILE should be in a form suitable for passing to `locate-library'." (interactive) (finder-list-keywords)) -(define-derived-mode finder-mode nil "Finder" +(define-derived-mode finder-mode special-mode "Finder" "Major mode for browsing package documentation. \\<finder-mode-map> \\[finder-select] more help for the item on the current line -\\[finder-exit] exit Finder mode and kill the Finder buffer." - :syntax-table finder-mode-syntax-table +\\[finder-exit] exit Finder mode and kill the Finder buffer. + +\\{finder-mode-map}" :interactive nil - (setq buffer-read-only t - buffer-undo-list t) (setq-local finder-headmark nil)) (defun finder-summary () @@ -436,9 +436,9 @@ FILE should be in a form suitable for passing to `locate-library'." (interactive nil finder-mode) (message "%s" (substitute-command-keys - "\\<finder-mode-map>\\[finder-select] = select, \ -\\[finder-mouse-select] = select, \\[finder-list-keywords] = to \ -finder directory, \\[finder-exit] = quit, \\[finder-summary] = help"))) + "\\<finder-mode-map>\\[finder-select] select, \ +\\[finder-mouse-select] select, \\[finder-list-keywords] go to \ +finder directory, \\[finder-exit] quit, \\[finder-summary] help"))) (defun finder-exit () "Exit Finder mode. diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index 732c6062b8b..41fc2d83ac3 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -223,6 +223,7 @@ (defconst gnus-outlook-deuglify-version "1.5 Gnus version" "Version of gnus-outlook-deuglify.") +(make-obsolete-variable 'gnus-outlook-deuglify-version 'emacs-version "29.1") ;;; User Customizable Variables: diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index cd2b53064b9..6028d4fcb2f 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -65,8 +65,9 @@ There are currently two built-in format functions: (const :tag "french" gnus-diary-delay-format-french) (symbol :tag "other"))) -(defconst gnus-diary-version nndiary-version +(defconst gnus-diary-version "0.2-b14" "Current Diary back end version.") +(make-obsolete-variable 'gnus-diary-version 'emacs-version "29.1") ;; Compatibility functions ================================================== @@ -377,8 +378,9 @@ If ARG (or prefix) is non-nil, force prompting for all fields." (defun gnus-diary-version () "Current Diary back end version." + (declare (obsolete emacs-version "29.1")) (interactive) - (message "NNDiary version %s" nndiary-version)) + (message "NNDiary version %s" gnus-diary-version)) (provide 'gnus-diary) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index d1ad5bd7b2d..4c93814e0dc 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -40,17 +40,14 @@ (defcustom gnus-completing-read-function 'gnus-emacs-completing-read "Function use to do completing read." - :version "24.1" + :version "29.1" :group 'gnus-meta :type '(radio (function-item :doc "Use Emacs standard `completing-read' function." gnus-emacs-completing-read) (function-item :doc "Use `ido-completing-read' function." - gnus-ido-completing-read) - (function-item - :doc "Use iswitchb based completing-read function." - gnus-iswitchb-completing-read))) + gnus-ido-completing-read))) (defcustom gnus-completion-styles (append (when (and (assq 'substring completion-styles-alist) @@ -1202,6 +1199,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (defun gnus-iswitchb-completing-read (prompt collection &optional require-match initial-input history def) "`iswitchb' based completing-read function." + (declare (obsolete nil "29.1")) ;; Make sure iswitchb is loaded before we let-bind its variables. ;; If it is loaded inside the let, variables can become unbound afterwards. (require 'iswitchb) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 6990d8ee778..ee6cab365f3 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -260,9 +260,10 @@ Default is t." "Non-nil means that files will be viewed with metamail. The gnus-uu viewing functions will be ignored and gnus-uu will try to guess at a content-type based on file name suffixes. Default -it nil." +is nil." :group 'gnus-extract :type 'boolean) +(make-obsolete-variable 'gnus-uu-view-with-metamail "don't use it." "29.1") (defcustom gnus-uu-unmark-articles-not-decoded nil "If non-nil, gnus-uu will mark unsuccessfully decoded articles as unread. diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index b036978efa8..0afd873a5df 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -4166,8 +4166,7 @@ prompt the user for the name of an NNTP server to use." ;; file. (unless (string-match "^Gnus" gnus-version) (load "gnus-load" nil t)) - (unless (or (byte-code-function-p (symbol-function 'gnus)) - (subr-native-elisp-p (symbol-function 'gnus))) + (unless (compiled-function-p (symbol-function 'gnus)) (message "You should compile Gnus") (sit-for 2)) (let ((gnus-action-message-log (list nil))) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 00a27fb5f51..8a3967f3461 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2086,6 +2086,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (defun message-mark-active-p () "Non-nil means the mark and region are currently active in this buffer." + (declare (obsolete mark-active "29.1")) mark-active) (defun message-unquote-tokens (elems) @@ -2953,12 +2954,12 @@ Consider adding this function to `message-header-setup-hook'" ["Fill Yanked Message" message-fill-yanked-message t] ["Insert Signature" message-insert-signature t] ["Caesar (rot13) Message" message-caesar-buffer-body t] - ["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)] + ["Caesar (rot13) Region" message-caesar-region mark-active] ["Elide Region" message-elide-region - :active (message-mark-active-p) + :active mark-active :help "Replace text in region with an ellipsis"] ["Delete Outside Region" message-delete-not-region - :active (message-mark-active-p) + :active mark-active :help "Delete all quoted text outside region"] ["Kill To Signature" message-kill-to-signature t] ["Newline and Reformat" message-newline-and-reformat t] @@ -2966,7 +2967,7 @@ Consider adding this function to `message-header-setup-hook'" ["Spellcheck" ispell-message :help "Spellcheck this message"] "----" ["Insert Region Marked" message-mark-inserted-region - :active (message-mark-active-p) :help "Mark region with enclosing tags"] + :active mark-active :help "Mark region with enclosing tags"] ["Insert File Marked..." message-mark-insert-file :help "Insert file at point marked with enclosing tags"] ["Attach File..." mml-attach-file t] diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 79217d34001..1417ecdccc8 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -117,8 +117,7 @@ (cond ((fboundp 'libxml-parse-html-region) 'shr) ((executable-find "w3m") 'gnus-w3m) ((executable-find "links") 'links) - ((executable-find "lynx") 'lynx) - ((locate-library "html2text") 'html2text)) + ((executable-find "lynx") 'lynx)) "Render of HTML contents. It is one of defined renderer types, or a rendering function. The defined renderer types are: @@ -127,16 +126,14 @@ The defined renderer types are: `w3m': use emacs-w3m; `w3m-standalone': use plain w3m; `links': use links; -`lynx': use lynx; -`html2text': use html2text." - :version "27.1" +`lynx': use lynx." + :version "29.1" :type '(choice (const shr) (const gnus-w3m) (const w3m :tag "emacs-w3m") (const w3m-standalone :tag "standalone w3m" ) (const links) (const lynx) - (const html2text) (function)) :group 'mime-display) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 5cd57d2f801..e8291cfe6f7 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -35,7 +35,6 @@ (declare-function gnus-setup-posting-charset "gnus-msg" (group)) (autoload 'gnus-completing-read "gnus-util") (autoload 'message-fetch-field "message") -(autoload 'message-mark-active-p "message") (autoload 'message-info "message") (autoload 'fill-flowed-encode "flow-fill") (autoload 'message-posting-charset "message") @@ -1236,7 +1235,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ;; ;;["Narrow" mml-narrow-to-part t] ["Quote MML in region" mml-quote-region - :active (message-mark-active-p) + :active mark-active :help "Quote MML tags in region"] ["Validate MML" mml-validate t] ["Preview" mml-preview t] diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el index 60140a46411..d7e32e45809 100644 --- a/lisp/gnus/nnagent.el +++ b/lisp/gnus/nnagent.el @@ -35,6 +35,7 @@ (defconst nnagent-version "nnagent 1.0") +(make-obsolete-variable 'nnagent-version 'emacs-version "29.1") (defvoo nnagent-directory nil "Internal variable." diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index ff0dea8ecdd..5f9903a5b06 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -55,6 +55,7 @@ (defconst nnbabyl-version "nnbabyl 1.0" "nnbabyl version.") +(make-obsolete-variable 'nnbabyl-version 'emacs-version "29.1") (defvoo nnbabyl-mbox-buffer nil) (defvoo nnbabyl-current-group nil) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index bd60c43f59d..14540ac7e87 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -234,9 +234,11 @@ all. This may very well take some time.") (defconst nndiary-version "0.2-b14" "Current Diary back end version.") +(make-obsolete-variable 'nndiary-version 'emacs-version "29.1") (defun nndiary-version () "Current Diary back end version." + (declare (obsolete emacs-version "29.1")) (interactive) (message "NNDiary version %s" nndiary-version)) diff --git a/lisp/gnus/nndir.el b/lisp/gnus/nndir.el index 2ca25534ce1..75a6ace107a 100644 --- a/lisp/gnus/nndir.el +++ b/lisp/gnus/nndir.el @@ -48,6 +48,7 @@ (defvoo nndir-status-string "" nil nnmh-status-string) (defconst nndir-version "nndir 1.0") +(make-obsolete-variable 'nndir-version 'emacs-version "29.1") diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 19ccce47b50..cdff7c9accf 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -218,6 +218,7 @@ from the document.") (defconst nndoc-version "nndoc 1.0" "nndoc version.") +(make-obsolete-variable 'nndoc-version 'emacs-version "29.1") diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index fa88b8a87e0..f21e4faf559 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -56,6 +56,7 @@ are generated if and only if they are also in `message-draft-headers'." (defvoo nndraft-current-directory nil nil nnmh-current-directory) (defconst nndraft-version "nndraft 1.0") +(make-obsolete-variable 'nndraft-version 'emacs-version "29.1") (defvoo nndraft-status-string "" nil nnmh-status-string) diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index 0c565a8230c..ff72842a2ee 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -57,6 +57,7 @@ included.") (defconst nneething-version "nneething 1.0" "nneething version.") +(make-obsolete-variable 'nneething-version 'emacs-version "29.1") (defvoo nneething-current-directory nil "Current news group directory.") diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index c3f7073a7b8..a2b461c15f0 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -91,6 +91,7 @@ message, a huge time saver for large mailboxes.") (defconst nnfolder-version "nnfolder 2.0" "nnfolder version.") +(make-obsolete-variable 'nnfolder-version 'emacs-version "29.1") (defconst nnfolder-article-marker "X-Gnus-Article-Number: " "String used to demarcate what the article number for a message is.") diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 3dc74c95fb3..4d1ecbf8642 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -62,6 +62,7 @@ (require 'subr-x)) (defconst nnmaildir-version "Gnus") +(make-obsolete-variable 'nnmaildir-version 'emacs-version "29.1") (defconst nnmaildir-flag-mark-mapping '((?F . tick) diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el index 96ecc34e156..5735c97805e 100644 --- a/lisp/gnus/nnmbox.el +++ b/lisp/gnus/nnmbox.el @@ -52,6 +52,7 @@ (defconst nnmbox-version "nnmbox 1.0" "nnmbox version.") +(make-obsolete-variable 'nnmbox-version 'emacs-version "29.1") (defvoo nnmbox-current-group nil "Current nnmbox news group directory.") diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index 3902af7d2f6..bced527d03f 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -55,6 +55,7 @@ as unread by Gnus.") (defconst nnmh-version "nnmh 1.0" "nnmh version.") +(make-obsolete-variable 'nnmh-version 'emacs-version "29.1") (defvoo nnmh-current-directory nil "Current news group directory.") diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 7fe2b516cce..ae726ba0f7b 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -89,6 +89,7 @@ non-nil.") (defconst nnml-version "nnml 1.0" "nnml version.") +(make-obsolete-variable 'nnml-version 'emacs-version "29.1") (defvoo nnml-nov-file-name ".overview") diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 8c96d3e0678..99e7b2a6f3f 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -71,6 +71,7 @@ this variable to the list of fields to be ignored.") (defvoo nnrss-status-string "") (defconst nnrss-version "nnrss 1.0") +(make-obsolete-variable 'nnrss-version 'emacs-version "29.1") (defvar nnrss-group-alist '() "List of RSS addresses.") diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index 39b89abb88a..e5eb4b81604 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -114,6 +114,7 @@ there.") (defconst nnspool-version "nnspool 2.0" "Version numbers of this version of NNSPOOL.") +(make-obsolete-variable 'nnspool-version 'emacs-version "29.1") (defvoo nnspool-current-directory nil "Current news group directory.") diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 29570fa8c9f..6fa424a1555 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -259,6 +259,7 @@ update their active files often, this can help.") (defvoo nntp-connection-alist nil) (defvoo nntp-status-string "") (defconst nntp-version "nntp 5.0") +(make-obsolete-variable 'nntp-version 'emacs-version "29.1") (defvoo nntp-inhibit-erase nil) (defvoo nntp-inhibit-output nil) diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index ae4265de7fb..7b192aa1d2e 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -57,6 +57,7 @@ component group will show up when you enter the virtual group.") (defconst nnvirtual-version "nnvirtual 1.1") +(make-obsolete-variable 'nnvirtual-version 'emacs-version "29.1") (defvoo nnvirtual-current-group nil) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 59a509b2215..74e18285e64 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1005,9 +1005,9 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." (help-fns--analyze-function function)) (file-name (find-lisp-object-file-name function (if aliased 'defun def))) - (beg (if (and (or (byte-code-function-p def) + (beg (if (and (or (functionp def) (keymapp def) - (memq (car-safe def) '(macro lambda closure))) + (eq (car-safe def) 'macro)) (stringp file-name) (help-fns--autoloaded-p function)) (concat @@ -1040,7 +1040,7 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." (t "Lisp function")))) ((or (eq (car-safe def) 'macro) ;; For advised macros, def is a lambda - ;; expression or a byte-code-function-p, so we + ;; expression or a compiled-function-p, so we ;; need to check macros before functions. (macrop function)) (concat beg "Lisp macro")) @@ -1534,8 +1534,8 @@ This cancels value editing without updating the value." (when safe-var (princ " This variable is safe as a file local variable ") (princ "if its value\n satisfies the predicate ") - (princ (if (byte-code-function-p safe-var) - "which is a byte-compiled expression.\n" + (princ (if (compiled-function-p safe-var) + "which is a compiled expression.\n" (format-message "`%s'.\n" safe-var)))))) (add-hook 'help-fns-describe-variable-functions #'help-fns--var-risky) diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index dbcc152c15d..bf7446f151a 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -81,11 +81,9 @@ (eval-when-compile (require 'cl-lib)) (require 'cus-edit) -(defconst htmlfontify-version 0.21) - (defconst hfy-meta-tags - (format "<meta name=\"generator\" content=\"emacs %s; htmlfontify %0.2f\" />" - emacs-version htmlfontify-version) + (format "<meta name=\"generator\" content=\"emacs %s; htmlfontify\" />" + emacs-version) "The generator meta tag for this version of htmlfontify.") (defconst htmlfontify-manual "Htmlfontify Manual" @@ -2392,13 +2390,14 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'." (let ((file (hfy-initfile))) (load file 'NOERROR nil nil) )) -;; Obsolete. - (defun hfy-interq (set-a set-b) "Return the intersection (using `eq') of two lists SET-A and SET-B." (declare (obsolete seq-intersection "28.1")) (nreverse (seq-intersection set-a set-b #'eq))) +(defconst htmlfontify-version 0.21) +(make-obsolete-variable 'htmlfontify-version 'emacs-version "29.1") + (define-obsolete-function-alias 'hfy-prop-invisible-p #'invisible-p "29.1") (provide 'htmlfontify) diff --git a/lisp/international/characters.el b/lisp/international/characters.el index ca28222c815..d6e83c81e74 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -1525,6 +1525,17 @@ Setup `char-width-table' appropriate for non-CJK language environment." (aset char-acronym-table (+ #xE0021 i) (format " %c TAG" (+ 33 i)))) (aset char-acronym-table #xE007F "->|TAG") ; CANCEL TAG +(dotimes (i 256) + (let* ((vs-number (1+ i)) + (codepoint (if (< i 16) + (+ #xfe00 i) + (+ #xe0100 i -16))) + (delimiter (cond ((<= vs-number 9) "0") + ((<= vs-number 99) "") + (t " ")))) + (aset char-acronym-table codepoint + (format "VS%s%s" delimiter vs-number)))) + ;; We can't use the \N{name} things here, because this file is used ;; too early in the build process. (defvar bidi-control-characters @@ -1574,7 +1585,9 @@ option `glyphless-char-display'." #x80 #x9F method)) ((eq target 'variation-selectors) (glyphless-set-char-table-range glyphless-char-display - #xFE00 #xFE0F method)) + #xFE00 #xFE0F method) + (glyphless-set-char-table-range glyphless-char-display + #xE0100 #xE01EF method)) ((or (eq target 'format-control) (eq target 'bidi-control)) (when unicode-category-table @@ -1647,10 +1660,10 @@ GROUP must be one of these symbols: that are relevant for bidirectional formatting control, like U+2069 (PDI) and U+202B (RLE). `variation-selectors': - Characters in the range U+FE00..U+FE0F, used for - selecting alternate glyph presentations, such as - Emoji vs Text presentation, of the preceding - character(s). + Characters in the range U+FE00..U+FE0F and + U+E0100..U+E01EF, used for selecting alternate glyph + presentations, such as Emoji vs Text presentation, of + the preceding character(s). `no-font': For GUI frames, characters for which no suitable font is found; for text-mode frames, characters that cannot be encoded by `terminal-coding-system'. diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index e652f108dde..431d8369c1e 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -702,7 +702,7 @@ is." ;; Probhat Input Method (quail-define-package "bengali-probhat" "Bengali" "BngPB" t - "Probhat keyboard for Bengali/Bangla" nil t nil nil nil nil nil nil nil nil t) + "Probhat keyboard for Bengali/Bangla" nil t nil t t nil nil nil nil nil t) (quail-define-rules ("!" ?!) diff --git a/lisp/loadup.el b/lisp/loadup.el index 8dad382ac0d..17e82cc0c49 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -154,8 +154,7 @@ ;; Load-time macro-expansion can only take effect after setting ;; load-source-file-function because of where it is called in lread.c. (load "emacs-lisp/macroexp") -(if (or (byte-code-function-p (symbol-function 'macroexpand-all)) - (subr-native-elisp-p (symbol-function 'macroexpand-all))) +(if (compiled-function-p (symbol-function 'macroexpand-all)) nil ;; Since loaddefs is not yet loaded, macroexp's uses of pcase will simply ;; fail until pcase is explicitly loaded. This also means that we have to diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 93af525e39d..a61620b2761 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -388,11 +388,11 @@ gnus-version) (insert "MH-E " mh-version "\n\n") ;; MH-E compilation details. (insert "MH-E compilation details:\n") - (let* ((compiled-mhe (byte-code-function-p (symbol-function 'mh-version))) + (let* ((compiled-mhe (compiled-function-p (symbol-function 'mh-version))) (gnus-compiled-version (if compiled-mhe (mh-macro-expansion-time-gnus-version) "N/A"))) - (insert " Byte compiled:\t\t" (if compiled-mhe "yes" "no") "\n" + (insert " Compiled:\t\t" (if compiled-mhe "yes" "no") "\n" " Gnus (compile-time):\t" gnus-compiled-version "\n" " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n")) ;; Emacs version. diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index 637f53e6550..e98767ae7c7 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -361,7 +361,8 @@ AGES is the list of ages that are to be shown." (mapc (lambda (feed) (let ((feed-name-symbol (intern (car feed)))) (mapc (lambda (item) - (when (memq (newsticker--age item) ages) + (when (or (memq 'all ages) + (memq (newsticker--age item) ages)) (newsticker--treeview-list-add-item item feed-name-symbol t))) (newsticker--treeview-list-sort-items @@ -1218,11 +1219,11 @@ Note: does not update the layout." (newsticker--treeview-list-update t) (newsticker--treeview-item-update) (newsticker--treeview-tree-update-tags) - (cond (newsticker--treeview-current-feed - (newsticker--treeview-list-items newsticker--treeview-current-feed)) - (newsticker--treeview-current-vfeed + (cond (newsticker--treeview-current-vfeed (newsticker--treeview-list-items-with-age - (intern newsticker--treeview-current-vfeed)))) + (intern newsticker--treeview-current-vfeed))) + (newsticker--treeview-current-feed + (newsticker--treeview-list-items newsticker--treeview-current-feed))) (newsticker--treeview-tree-update-highlight) (newsticker--treeview-list-update-highlight) (let ((cur-feed (or newsticker--treeview-current-feed diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index d033667e87f..170583f608c 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -324,7 +324,7 @@ arguments to pass to the OPERATION." (tramp-compat-file-name-concat localname ".")) (tramp-shell-quote-argument (tramp-compat-file-name-concat localname "..")))) - (replace-regexp-in-region + (tramp-compat-replace-regexp-in-region (regexp-quote (tramp-compat-file-name-unquote (file-name-as-directory localname))) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index fda1441615e..548999ca1d2 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -325,7 +325,7 @@ arguments to pass to the OPERATION." ;; Starting with Emacs 29, `tramp-archive-file-name-handler' is ;; autoloaded. But it must still be in tramp-loaddefs.el for older ;; Emacsen. -;;;###autoload(autoload 'tramp-archive-file-name-handler "tramp-archine") +;;;###autoload(autoload 'tramp-archive-file-name-handler "tramp-archive") ;;;###tramp-autoload (defun tramp-archive-file-name-handler (operation &rest args) "Invoke the file archive related OPERATION. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index b83f9f0724e..203d3ede98f 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -330,6 +330,29 @@ CONDITION can also be a list of error conditions." (autoload 'netrc-parse "netrc") (netrc-parse file)))) +;; Function `replace-regexp-in-region' is new in Emacs 28.1. +(defalias 'tramp-compat-replace-regexp-in-region + (if (fboundp 'replace-regexp-in-region) + #'replace-regexp-in-region + (lambda (regexp replacement &optional start end) + (if start + (when (< start (point-min)) + (error "Start before start of buffer")) + (setq start (point))) + (if end + (when (> end (point-max)) + (error "End after end of buffer")) + (setq end (point-max))) + (save-excursion + (let ((matches 0) + (case-fold-search nil)) + (goto-char start) + (while (re-search-forward regexp end t) + (replace-match replacement t) + (setq matches (1+ matches))) + (and (not (zerop matches)) + matches)))))) + (dolist (elt (all-completions "tramp-compat-" obarray 'functionp)) (put (intern elt) 'tramp-suppress-trace t)) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 7f385292626..27b359d439b 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -426,7 +426,7 @@ Otherwise, return NAME." (if (directory-name-p name) #'file-name-as-directory #'identity) (concat dir - (unless (string-equal localname "/") + (unless (string-match-p (rx (seq bos (opt "/") eos)) localname) (with-tramp-file-property crypt-vec localname (concat (symbol-name op) "-file-name") (unless (tramp-crypt-send-command diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 0b40ff867f2..ca5e959bea5 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1055,9 +1055,10 @@ file names." ;; code in case of direct copy/move. Apply ;; sanity checks. (or (not equal-remote) - (tramp-gvfs-info newname) - (eq op 'copy) - (not (tramp-gvfs-info filename)))) + (and + (tramp-gvfs-info newname) + (or (eq op 'copy) + (not (tramp-gvfs-info filename)))))) (if (or (not equal-remote) (and equal-remote diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index a2b675cf885..f2e3c48235a 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4205,14 +4205,17 @@ file exists and nonzero exit status otherwise." ;; by some sh implementations (eg, bash when called as sh) on ;; startup; this way, we avoid the startup file clobbering $PS1. ;; $PROMPT_COMMAND is another way to set the prompt in /bin/bash, - ;; it must be discarded as well. $HISTFILE is set according to - ;; `tramp-histfile-override'. $TERM and $INSIDE_EMACS set here to - ;; ensure they have the correct values when the shell starts, not - ;; just processes run within the shell. (Which processes include - ;; our initial probes to ensure the remote shell is usable.) - ;; For the time being, we assume that all shells interpret -i as - ;; interactive shell. Must be the last argument, because (for - ;; example) bash expects long options first. + ;; it must be discarded as well. Some ssh daemons (for example, + ;; on Android devices) do not acknowledge the $PS1 setting in + ;; that call, so we make a further sanity check. (Bug#57044) + ;; $HISTFILE is set according to `tramp-histfile-override'. $TERM + ;; and $INSIDE_EMACS set here to ensure they have the correct + ;; values when the shell starts, not just processes run within the + ;; shell. (Which processes include our initial probes to ensure + ;; the remote shell is usable.) For the time being, we assume + ;; that all shells interpret -i as interactive shell. Must be the + ;; last argument, because (for example) bash expects long options + ;; first. (tramp-send-command vec (format (concat @@ -4228,7 +4231,21 @@ file exists and nonzero exit status otherwise." "")) (tramp-shell-quote-argument tramp-end-of-output) shell (or (tramp-get-sh-extra-args shell) "")) - t) + t t) + + ;; Sanity check. + (tramp-barf-if-no-shell-prompt + (tramp-get-connection-process vec) 10 + "Couldn't find remote shell prompt for %s" shell) + (unless + (tramp-check-for-regexp + (tramp-get-connection-process vec) (regexp-quote tramp-end-of-output)) + (tramp-message vec 5 "Setting shell prompt") + (tramp-send-command + vec (format "PS1=%s PS2='' PS3='' PROMPT_COMMAND=''" + (tramp-shell-quote-argument tramp-end-of-output)) + t)) + ;; Check proper HISTFILE setting. We give up when not working. (when (and (stringp tramp-histfile-override) (file-name-directory tramp-histfile-override)) @@ -5524,10 +5541,14 @@ Nonexistent directories are removed from spec." ;; "--color=never" argument (for example on FreeBSD). (when (tramp-send-command-and-check vec (format "%s -lnd /" result)) - (when (tramp-send-command-and-check - vec (format - "%s --color=never -al %s" - result (tramp-get-remote-null-device vec))) + (when (and (tramp-send-command-and-check + vec (format + "%s --color=never -al %s" + result (tramp-get-remote-null-device vec))) + (not (string-match-p + (regexp-quote "\e") + (tramp-get-buffer-string + (tramp-get-buffer vec))))) (setq result (concat result " --color=never"))) (throw 'ls-found result)) (setq dl (cdr dl)))))) diff --git a/lisp/org/org.el b/lisp/org/org.el index 68f522b060a..df708a2159d 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -3807,10 +3807,6 @@ This is needed for font-lock setup.") (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) -(declare-function iswitchb-read-buffer - "iswitchb" - (prompt &optional - default require-match _predicate start matches-set)) (declare-function org-agenda-change-all-lines "org-agenda" (newhead hdmarker &optional fixface just-this)) @@ -3844,7 +3840,6 @@ This is needed for font-lock setup.") (defvar calc-embedded-open-formula) (defvar calc-embedded-open-mode) (defvar font-lock-unfontify-region-function) -(defvar iswitchb-temp-buflist) (defvar org-agenda-tags-todo-honor-ignore-options) (defvar remember-data-file) (defvar texmathp-why) diff --git a/lisp/outline.el b/lisp/outline.el index 35524a79a90..3250b62f1e7 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -281,7 +281,7 @@ This option is only in effect when `outline-minor-mode-cycle' is non-nil." [outline-1 outline-2 outline-3 outline-4 outline-5 outline-6 outline-7 outline-8]) -(defcustom outline-minor-mode-use-buttons '(derived-mode . special-mode) +(defcustom outline-minor-mode-use-buttons '(derived-mode . help-mode) "Whether to display clickable buttons on the headings. The value should be a `buffer-match-p' condition. @@ -294,16 +294,16 @@ buffers (yet) -- that will be amended in a future version." :version "29.1") (define-icon outline-open button - '((emoji "▶️") - (symbol " ⯈ ") + '((emoji "🔽") + (symbol " ▼ ") (text " open ")) "Icon used for buttons for opening a section in outline buffers." :version "29.1" :help-echo "Open this section") (define-icon outline-close button - '((emoji "🔽") - (symbol " ⯆ ") + '((emoji "▶️") + (symbol " ▶ ") (text " close ")) "Icon used for buttons for closing a section in outline buffers." :version "29.1" diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 8fe72ddf593..fb944f4d76a 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -82,13 +82,6 @@ ;; Non-customize variables. -(defmacro 5x5-defvar-local (var value doc) - "Define VAR to VALUE with documentation DOC and make it buffer local." - (declare (obsolete defvar-local "28.1")) - `(progn - (defvar ,var ,value ,doc) - (make-variable-buffer-local (quote ,var)))) - (defvar-local 5x5-grid nil "5x5 grid contents.") @@ -930,14 +923,15 @@ lest." ;; Support functions -(define-obsolete-function-alias '5x5-xor 'xor "27.1") - (defun 5x5-y-or-n-p (prompt) "5x5 wrapper for `y-or-n-p' which respects the `5x5-hassle-me' setting." (if 5x5-hassle-me (y-or-n-p prompt) t)) +(define-obsolete-function-alias '5x5-xor #'xor "27.1") +(define-obsolete-function-alias '5x5-defvar-local #'defvar-local "28.1") + (provide '5x5) ;;; 5x5.el ends here diff --git a/lisp/printing.el b/lisp/printing.el index 83c9ffc9cbd..534b45c772b 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -4,16 +4,9 @@ ;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, print, PostScript -;; Version: 6.9.3 +;; Old-Version: 6.9.3 ;; URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre -(defconst pr-version "6.9.3" - "printing.el, v 6.9.3 <2007/12/09 vinicius> - -Please send all bug fixes and enhancements to - bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> -") - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -63,10 +56,6 @@ Please send all bug fixes and enhancements to ;; spool and to despool PostScript buffer. So, `printing' provides an ;; interface to ps-print package and it also provides some extra stuff. ;; -;; To download the latest ps-print package see -;; `https://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'. -;; Please, see README file for ps-print installation instructions. -;; ;; `printing' was inspired by: ;; ;; print-nt.el Frederic Corne <frederic.corne@erli.fr> @@ -942,11 +931,6 @@ Please send all bug fixes and enhancements to ;; ;; Below are some URL where you can find good utilities. ;; -;; * For `printing' package: -;; -;; printing `https://www.emacswiki.org/cgi-bin/emacs/download/printing.el' -;; ps-print `https://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage' -;; ;; * For GNU or Unix system: ;; ;; gs, gv `https://www.gnu.org/software/ghostscript/ghostscript.html' @@ -1015,10 +999,6 @@ Please send all bug fixes and enhancements to (require 'lpr) (require 'ps-print) -(and (string< ps-print-version "6.6.4") - (error "`printing' requires `ps-print' package version 6.6.4 or later")) - - (defconst pr-cygwin-system (and lpr-windows-system (getenv "OSTYPE") (string-match "cygwin" (getenv "OSTYPE")))) @@ -3007,9 +2987,7 @@ Calls `pr-update-menus' to adjust menus." (defconst pr-help-message - (concat "printing.el version " pr-version - " ps-print.el version " ps-print-version - "\n\n + "\ Menu Layout ----------- @@ -3215,14 +3193,12 @@ VI. Customization: 23. Show current settings for `printing', `ps-print' or `lpr'. 24. Quick help for printing menu layout. -") +" "Printing help message.") (defconst pr-interface-help-message - (concat "printing.el version " pr-version - " ps-print.el version " ps-print-version - "\n\n + "\ The printing interface buffer has the same functionality as the printing menu. The major difference is that the states (like sending PostScript generated to a file, n-up printing, etc.) are set and saved between printing buffer @@ -3449,7 +3425,7 @@ The printing interface buffer has the following sections: Quick help for printing interface buffer and printing menu layout. You can also quit the printing interface buffer or kill all printing help buffer. -") +" "Printing buffer interface help message.") @@ -4402,7 +4378,6 @@ Or choose the menu option Printing/Show Settings/printing." (mapconcat #'ps-print-quote (list - (concat "\n;;; printing.el version " pr-version "\n") ";; internal vars" (ps-comment-string "emacs-version " emacs-version) (ps-comment-string "pr-txt-command " pr-txt-command) @@ -5597,9 +5572,6 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (switch-to-buffer (get-buffer-create pr-buffer-name)) ;; header - (let ((versions (concat "printing v" pr-version - " ps-print v" ps-print-version))) - (widget-insert (make-string (- 79 (length versions)) ?\ ) versions)) (pr-insert-italic "\nCurrent Directory : " 1) (pr-insert-italic default-directory) @@ -6213,6 +6185,12 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defconst pr-version "6.9.3" + "printing.el, v 6.9.3 <2007/12/09 vinicius> + +Please send all bug fixes and enhancements to + bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>") +(make-obsolete-variable 'pr-version 'emacs-version "29.1") (provide 'printing) diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index e19726a7eab..6e42da2d54f 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -4,7 +4,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript -;; Version: 4.4 +;; Old-Version: 4.4 ;; URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre ;; This file is part of GNU Emacs. @@ -22,16 +22,6 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -(defconst ebnf-version "4.4" - "ebnf2ps.el, v 4.4 <2007/02/12 vinicius> - -Vinicius's last change version. When reporting bugs, please also -report the version of Emacs, if any, that ebnf2ps was running with. - -Please send all bug fixes and enhancements to - Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>.") - - ;;; Commentary: ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -45,20 +35,12 @@ Please send all bug fixes and enhancements to ;; ;; (require 'ebnf2ps) ;; -;; ebnf2ps uses ps-print package (version 5.2.3 or later), so see ps-print to +;; ebnf2ps uses ps-print package (bundled with Emacs), so see ps-print to ;; know how to set options like landscape printing, page headings, margins, ;; etc. ;; -;; NOTE: ps-print zebra stripes and line number options doesn't have effect on -;; ebnf2ps, they behave as it's turned off. -;; -;; For good performance, be sure to byte-compile ebnf2ps.el, e.g. -;; -;; M-x byte-compile-file <give the path to ebnf2ps.el when prompted> -;; -;; This will generate ebnf2ps.elc, which will be loaded instead of ebnf2ps.el. -;; -;; ebnf2ps was tested with GNU Emacs 20.4.1. +;; NOTE: ps-print zebra stripes and line number options don't have an +;; effect on ebnf2ps, they behave as if it's turned off. ;; ;; ;; Using ebnf2ps @@ -1154,9 +1136,6 @@ Please send all bug fixes and enhancements to (require 'ps-print) (eval-when-compile (require 'cl-lib)) -(and (string< ps-print-version "5.2.3") - (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later")) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User Variables: @@ -2455,8 +2434,6 @@ See also `ebnf-syntax-buffer'." "Return the current ebnf2ps setup." (format " -;;; ebnf2ps.el version %s - ;;; Emacs version %S \(setq ebnf-special-show-delimiter %S @@ -2525,7 +2502,6 @@ See also `ebnf-syntax-buffer'." ;;; ebnf2ps.el - end of settings " - ebnf-version emacs-version ebnf-special-show-delimiter (ps-print-quote ebnf-special-font) @@ -2958,7 +2934,7 @@ See section \"Actions in Comments\" in ebnf2ps documentation.") (defvar ebnf-eps-file-alist nil -"Alist associating file name with EPS header and footer. + "Alist associating file name with EPS header and footer. Each element has the following form: @@ -5242,11 +5218,7 @@ killed after process termination." (not (search-forward "& ebnf2ps v" (line-end-position) t)) - (progn - ;; adjust creator comment - (end-of-line) - ;; (backward-char) - (insert " & ebnf2ps v" ebnf-version) + (progn ;; insert ebnf settings & engine (goto-char (point-max)) (search-backward "\n%%EndProlog\n") @@ -5272,7 +5244,7 @@ killed after process termination." (format "%d %d" (1+ ebnf-eps-upper-x) (1+ ebnf-eps-upper-y)) "\n%%Title: " filename "\n%%CreationDate: " (format-time-string "%T %b %d %Y") - "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")" + "\n%%Creator: " (user-full-name) " (using GNU Emacs " emacs-version ")" "\n%%DocumentNeededResources: font " (or ebnf-fonts-required (setq ebnf-fonts-required @@ -6350,6 +6322,15 @@ killed after process termination." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defconst ebnf-version "4.4" + "ebnf2ps.el, v 4.4 <2007/02/12 vinicius> + +Vinicius's last change version. When reporting bugs, please also +report the version of Emacs, if any, that ebnf2ps was running with. + +Please send all bug fixes and enhancements to + bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>.") +(make-obsolete-variable 'ebnf-version 'emacs-version "29.1") (provide 'ebnf2ps) diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index dcd74f0369c..443281c4f07 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -116,12 +116,11 @@ ;; non-nil, the line numbers are never touched. ;; 2) Multi-; statements like "do i=1,20 ; j=j+i ; end do" are not handled ;; correctly, but I imagine them to be rare. -;; 3) Regexps for hilit19 are no longer supported. -;; 4) For FIXED FORMAT code, use fortran mode. -;; 5) Preprocessor directives, i.e., lines starting with # are left-justified +;; 3) For FIXED FORMAT code, use fortran mode. +;; 4) Preprocessor directives, i.e., lines starting with # are left-justified ;; and are untouched by all case-changing commands. There is, at present, no ;; mechanism for treating multi-line directives (continued by \ ). -;; 6) f77 do-loops do 10 i=.. ; ; 10 continue are not correctly indented. +;; 5) f77 do-loops do 10 i=.. ; ; 10 continue are not correctly indented. ;; You are urged to use f90-do loops (with labels if you wish). ;; List of user commands diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 9c2c6405253..c256198b3c1 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -92,6 +92,7 @@ (require 'cl-seq) (require 'bindat) (eval-when-compile (require 'pcase)) +(require 'subr-x) ; `string-pad' (declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) @@ -2511,9 +2512,8 @@ means to decode using the coding-system set for the GDB process." ;; Record transactions if logging is enabled. (when gdb-enable-debug (push (cons 'recv string) gdb-debug-log) - (if (and gdb-debug-log-max - (> (length gdb-debug-log) gdb-debug-log-max)) - (setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil))) + (when gdb-debug-log-max + (setq gdb-debug-log (ntake gdb-debug-log-max gdb-debug-log)))) ;; Recall the left over gud-marker-acc from last time. (setq gud-marker-acc (concat gud-marker-acc string)) @@ -2943,7 +2943,8 @@ Return position where LINE begins." start-posn))) (defun gdb-pad-string (string padding) - (format (concat "%" (number-to-string padding) "s") string)) + (declare (obsolete string-pad "29.1")) + (string-pad string padding nil t)) ;; gdb-table struct is a way to programmatically construct simple ;; tables. It help to reliably align columns of data in GDB buffers @@ -2985,13 +2986,13 @@ calling `gdb-table-string'." "Return TABLE as a string with columns separated with SEP." (let ((column-sizes (gdb-table-column-sizes table))) (mapconcat - 'identity + #'identity (cl-mapcar (lambda (row properties) - (apply 'propertize - (mapconcat 'identity - (cl-mapcar (lambda (s x) (gdb-pad-string s x)) - row column-sizes) + (apply #'propertize + (mapconcat #'identity + (cl-mapcar (lambda (s x) (string-pad s x nil t)) + row column-sizes) sep) properties)) (gdb-table-rows table) @@ -3688,10 +3689,11 @@ in `gdb-memory-format'." (dolist (row memory) (insert (concat (gdb-mi--field row 'addr) ":")) (dolist (column (gdb-mi--field row 'data)) - (insert (gdb-pad-string column - (+ 2 (gdb-memory-column-width - gdb-memory-unit - gdb-memory-format))))) + (insert (string-pad column + (+ 2 (gdb-memory-column-width + gdb-memory-unit + gdb-memory-format)) + nil t))) (newline))) ;; Show last page instead of empty buffer when out of bounds (when gdb-memory-last-address diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index be43effed7d..ccc57205757 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -1577,16 +1577,17 @@ into one that invokes an Emacs-enabled debugging session. (seen-e nil) (shift (lambda () (push (pop args) new-args)))) - ;; Pass all switches and -e scripts through. + ;; Pass all switches and -E/-e scripts through. (while (and args (string-match "^-" (car args)) (not (equal "-" (car args))) (not (equal "--" (car args)))) - (when (equal "-e" (car args)) + (when (or (equal "-E" (car args)) (equal "-e" (car args))) ;; -e goes with the next arg, so shift one extra. - (or (funcall shift) - ;; -e as the last arg is an error in Perl. - (error "No code specified for -e")) + (funcall shift) + (or args + ;; -E (or -e) as the last arg is an error in Perl. + (error "No code specified for %s" (car new-args))) (setq seen-e t)) (funcall shift)) @@ -1697,7 +1698,7 @@ The directory containing the perl program becomes the initial working directory and source-file directory for your debugger." (interactive (list (gud-query-cmdline 'perldb - (concat (or (buffer-file-name) "-e 0") " ")))) + (concat (or (buffer-file-name) "-E 0") " ")))) (gud-common-init command-line 'gud-perldb-massage-args 'gud-perldb-marker-filter) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index d2c24a75810..efad3b52aa9 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3490,9 +3490,10 @@ This function is intended for use in `after-change-functions'." ;;;###autoload (define-derived-mode js-json-mode js-mode "JSON" - ;; JSON files can be big. Speed up syntax-ppss. - (setq-local syntax-propertize-function nil) - (setq-local js-enabled-frameworks nil)) + (setq-local js-enabled-frameworks nil) + ;; Speed up `syntax-ppss': JSON files can be big but can't hold + ;; regexp matchers nor #! thingies (and `js-enabled-frameworks' is nil). + (setq-local syntax-propertize-function #'ignore)) ;; Since we made JSX support available and automatically-enabled in ;; the base `js-mode' (for ease of use), now `js-jsx-mode' simply diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index 7c9aee2b2a8..89482d86ce2 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -34,7 +34,6 @@ ;;; Code: -(defconst ps-mode-version "1.1i, 17 May 2008") (defconst ps-mode-maintainer-address "Peter Kleiweg <p.c.j.kleiweg@rug.nl>, bug-gnu-emacs@gnu.org") @@ -519,7 +518,7 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number (defun ps-mode-show-version () "Show current version of PostScript mode." (interactive) - (message " *** PostScript Mode (ps-mode) Version %s *** " ps-mode-version)) + (message " *** PostScript Mode (ps-mode) in GNU Emacs %s *** " emacs-version)) ;; From reporter.el (defvar reporter-prompt-for-summary-p) @@ -534,7 +533,7 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number ps-run-font-lock-keywords-2))) (reporter-submit-bug-report ps-mode-maintainer-address - (format "ps-mode.el %s [%s]" ps-mode-version system-type) + (format "ps-mode.el %s [%s]" emacs-version system-type) '(ps-mode-tab ps-mode-paper-size ps-mode-print-function @@ -1094,6 +1093,9 @@ Use line numbers if `ps-run-error-line-numbers' is not nil." ;; (add-hook 'kill-emacs-hook #'ps-run-cleanup) +(defconst ps-mode-version "1.1i, 17 May 2008") +(make-obsolete-variable 'ps-mode-version 'emacs-version "29.1") + (provide 'ps-mode) ;;; ps-mode.el ends here diff --git a/lisp/ps-print.el b/lisp/ps-print.el index dad4c8ffbac..d67c34e11ab 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -8,21 +8,9 @@ ;; Kenichi Handa <handa@gnu.org> (multi-byte characters) ;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, print, PostScript -;; Version: 7.3.5 +;; Old-Version: 7.3.5 ;; URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre -(eval-when-compile (require 'cl-lib)) - -(defconst ps-print-version "7.3.5" - "ps-print.el, v 7.3.5 <2009/12/23 vinicius> - -Vinicius's last change version -- this file may have been edited as part of -Emacs without changes to the version number. When reporting bugs, please also -report the version of Emacs, if any, that ps-print was distributed with. - -Please send all bug fixes and enhancements to - bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>.") - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -1320,11 +1308,11 @@ Please send all bug fixes and enhancements to ;; Known bugs and limitations of ps-print ;; -------------------------------------- ;; -;; Automatic font-attribute detection doesn't work well, especially with -;; hilit19 and older versions of get-create-face. Users having problems with -;; auto-font detection should use the lists `ps-italic-faces', `ps-bold-faces' -;; and `ps-underlined-faces' and/or turn off automatic detection by setting -;; `ps-auto-font-detect' to nil. +;; Automatic font-attribute detection doesn't work well. Users having +;; problems with auto-font detection should use the lists +;; `ps-italic-faces', `ps-bold-faces' and `ps-underlined-faces' and/or +;; turn off automatic detection by setting `ps-auto-font-detect' to +;; nil. ;; ;; Still too slow; could use some hand-optimization. ;; @@ -1451,6 +1439,7 @@ Please send all bug fixes and enhancements to ;;; Code: (require 'lpr) +(eval-when-compile (require 'cl-lib)) ;; autoloads for secondary file (require 'ps-print-loaddefs) @@ -3596,7 +3585,6 @@ The table depends on the current ps-print setup." (mapconcat #'ps-print-quote (list - (concat "\n;;; (Emacs) ps-print version " ps-print-version "\n") ";; internal vars" (ps-comment-string "emacs-version " emacs-version) (ps-comment-string "lpr-windows-system" lpr-windows-system) @@ -5347,7 +5335,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") ps-adobe-tag "%%Title: " (buffer-name) ; Take job name from name of ; first buffer printed - "\n%%Creator: ps-print v" ps-print-version + "\n%%Creator: GNU Emacs " emacs-version "\n%%For: " (user-full-name) ;FIXME: may need encoding! "\n%%CreationDate: " (format-time-string "%T %b %d %Y") ;FIXME: encoding! "\n%%Orientation: " @@ -6548,6 +6536,17 @@ If FACE is not a valid face name, use default face." (unless noninteractive (add-hook 'kill-emacs-query-functions #'ps-kill-emacs-check)) +(defconst ps-print-version "7.3.5" + "ps-print.el, v 7.3.5 <2009/12/23 vinicius> + +Vinicius's last change version -- this file may have been edited as part of +Emacs without changes to the version number. When reporting bugs, please also +report the version of Emacs, if any, that ps-print was distributed with. + +Please send all bug fixes and enhancements to + bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>.") +(make-obsolete-variable 'ps-print-version 'emacs-version "29.1") + (define-obsolete-function-alias 'ps-print-ensure-fontified #'font-lock-ensure "29.1") (provide 'ps-print) diff --git a/lisp/select.el b/lisp/select.el index e407c224367..5b9cca80a38 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -673,9 +673,12 @@ two markers or an overlay. Otherwise, it is nil." (let ((str (cond ((stringp value) value) ((setq value (xselect--selection-bounds value)) (with-current-buffer (nth 2 value) - (buffer-substring (nth 0 value) - (nth 1 value))))))) - (xselect--encode-string type str t))) + (when (and (>= (nth 0 value) (point-min)) + (<= (nth 1 value) (point-max))) + (buffer-substring (nth 0 value) + (nth 1 value)))))))) + (when str + (xselect--encode-string type str t)))) (defun xselect-convert-to-length (_selection _type value) (let ((len (cond ((stringp value) diff --git a/lisp/simple.el b/lisp/simple.el index a4ea345ca5f..1e6e5e11e00 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6731,7 +6731,8 @@ If Transient Mark mode is disabled, this function normally does nothing; but if FORCE is non-nil, it deactivates the mark anyway. Deactivating the mark sets `mark-active' to nil, updates the -primary selection according to `select-active-regions', and runs +primary selection according to `select-active-regions' (unless +`deactivate-mark' is `dont-save'), and runs `deactivate-mark-hook'. If Transient Mark mode was temporarily enabled, reset the value @@ -6742,6 +6743,7 @@ run `deactivate-mark-hook'." (when (and (if (eq select-active-regions 'only) (eq (car-safe transient-mark-mode) 'only) select-active-regions) + (not (eq deactivate-mark 'dont-save)) (region-active-p) (display-selections-p)) ;; The var `saved-region-selection', if non-nil, is the text in @@ -7690,11 +7692,33 @@ not vscroll." ;; But don't vscroll in a keyboard macro. (not defining-kbd-macro) (not executing-kbd-macro) + ;; Lines are not truncated... + (not + (and + (or truncate-lines + (and (integerp truncate-partial-width-windows) + (< (window-total-width) + truncate-partial-width-windows)) + (and truncate-partial-width-windows + (not (integerp truncate-partial-width-windows)) + (not (window-full-width-p)))) + ;; ...or if lines are truncated, this buffer + ;; doesn't have very long lines. + (long-line-optimizations-p))) (line-move-partial arg noerror)) (set-window-vscroll nil 0 t) (if (and line-move-visual ;; Display-based column are incompatible with goal-column. (not goal-column) + ;; Lines aren't truncated. + (not + (or truncate-lines + (and (integerp truncate-partial-width-windows) + (< (window-width) + truncate-partial-width-windows)) + (and truncate-partial-width-windows + (not (integerp truncate-partial-width-windows)) + (not (window-full-width-p))))) ;; When the text in the window is scrolled to the left, ;; display-based motion doesn't make sense (because each ;; logical line occupies exactly one screen line). @@ -8131,10 +8155,11 @@ For motion by visual lines, see `beginning-of-visual-line'." (line-move (1- arg) t))) ;; Move to beginning-of-line, ignoring fields and invisible text. - (skip-chars-backward "^\n") - (while (and (not (bobp)) (invisible-p (1- (point)))) - (goto-char (previous-char-property-change (point))) - (skip-chars-backward "^\n")) + (let ((inhibit-field-text-motion t)) + (goto-char (line-beginning-position)) + (while (and (not (bobp)) (invisible-p (1- (point)))) + (goto-char (previous-char-property-change (point))) + (goto-char (line-beginning-position)))) ;; Now find first visible char in the line. (while (and (< (point) orig) (invisible-p (point))) diff --git a/lisp/subr.el b/lisp/subr.el index 4b1fc832da1..42ce9148a90 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4077,6 +4077,12 @@ Otherwise, return nil." (or (eq 'macro (car def)) (and (autoloadp def) (memq (nth 4 def) '(macro t))))))) +(defun compiled-function-p (object) + "Return non-nil if OBJECT is a function that has been compiled. +Does not distinguish between functions implemented in machine code +or byte-code." + (or (subrp object) (byte-code-function-p object))) + (defun field-at-pos (pos) "Return the field at position POS, taking stickiness etc into account." (let ((raw-field (get-char-property (field-beginning pos) 'field))) diff --git a/lisp/textmodes/emacs-authors-mode.el b/lisp/textmodes/emacs-authors-mode.el new file mode 100644 index 00000000000..af78ab605e9 --- /dev/null +++ b/lisp/textmodes/emacs-authors-mode.el @@ -0,0 +1,145 @@ +;;; emacs-authors-mode.el --- font-locking for etc/AUTHORS -*- lexical-binding: t -*- + +;; Copyright (C) 2021-2022 Free Software Foundation, Inc. + +;; Author: Stefan Kangas <stefan@marxist.se> +;; Keywords: internal + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Major mode to display the etc/AUTHORS file from the Emacs +;; distribution. Provides some basic font locking and not much else. + +;;; Code: + +(require 'subr-x) ; `emacs-etc--hide-local-variables' + +(defgroup emacs-authors-mode nil + "Display the \"etc/AUTHORS\" file from the Emacs distribution." + :version "29.1" + :group 'internal) + +(defface emacs-authors-default + '((t :inherit variable-pitch)) + "Default face used to display the \"etc/AUTHORS\" file. +See also `emacs-authors-mode'." + :version "29.1") + +(defface emacs-authors-author + '((((class color) (min-colors 88) (background light)) + :foreground "midnight blue" + :weight bold :height 1.05 + :inherit variable-pitch) + (((class color) (min-colors 88) (background dark)) + :foreground "cyan" + :weight bold :height 1.05 + :inherit variable-pitch) + (((supports :weight bold) (supports :height 1.05)) + :weight bold :height 1.05 + :inherit variable-pitch) + (((supports :weight bold)) + :weight bold :inherit variable-pitch) + (t :inherit variable-pitch)) + "Face used for the author in the \"etc/AUTHORS\" file. +See also `emacs-authors-mode'." + :version "29.1") + +(defface emacs-authors-descriptor + '((((class color) (min-colors 88) (background light)) + :foreground "sienna" :inherit variable-pitch) + (((class color) (min-colors 88) (background dark)) + :foreground "peru" :inherit variable-pitch) + (t :inherit variable-pitch)) + "Face used for the description text in the \"etc/AUTHORS\" file. +See also `emacs-authors-mode'." + :version "29.1") + +(defface emacs-authors-other-files + '((t :inherit emacs-authors-descriptor)) + "Face used for the \"other files\" text in the \"etc/AUTHORS\" file. +See also `emacs-authors-mode'." + :version "29.1") + +(defconst emacs-authors--author-re + (rx bol (group (not (any blank "\n")) (+? (not (any ":" "\n")))) ":") + "Regexp matching an author in \"etc/AUTHORS\".") + +(defvar emacs-authors-mode-font-lock-keywords + `((,emacs-authors--author-re + 1 'emacs-authors-author) + (,(rx (or "wrote" + (seq (? "and ") (or "co-wrote" "changed")))) + 0 'emacs-authors-descriptor) + (,(rx "and " (+ digit) " other files") + 0 'emacs-authors-other-files) + (,(rx bol (not space) (+ not-newline) eol) + 0 'emacs-authors-default))) + +(defun emacs-authors-next-author (&optional arg) + "Move point to the next author in \"etc/AUTHORS\". +With a prefix arg ARG, move point that many authors forward." + (interactive "p" emacs-authors-mode) + (if (< 0 arg) + (progn + (when (looking-at emacs-authors--author-re) + (forward-line 1)) + (re-search-forward emacs-authors--author-re nil t arg)) + (when (looking-at emacs-authors--author-re) + (forward-line -1)) + (re-search-backward emacs-authors--author-re nil t (abs arg))) + (goto-char (line-beginning-position))) + +(defun emacs-authors-prev-author (&optional arg) + "Move point to the previous author in \"etc/AUTHORS\". +With a prefix arg ARG, move point that many authors backward." + (interactive "p" emacs-authors-mode) + (emacs-authors-next-author (- arg))) + +(defvar emacs-authors-imenu-generic-expression + `((nil ,(rx bol (group (+ (not ":"))) ": " + (or "wrote" "co-wrote" "changed") + " ") + 1))) + +(define-obsolete-variable-alias 'etc-authors-mode-map 'emacs-authors-mode-map "29.1") +(defvar-keymap emacs-authors-mode-map + :doc "Keymap for `emacs-authors-mode'." + "n" #'emacs-authors-next-author + "p" #'emacs-authors-prev-author) + +;;;###autoload +(define-derived-mode emacs-authors-mode special-mode "Authors View" + "Major mode for viewing \"etc/AUTHORS\" from the Emacs distribution. +Provides some basic font locking and not much else." + (setq-local font-lock-defaults + '(emacs-authors-mode-font-lock-keywords nil nil ((?_ . "w")))) + (setq font-lock-multiline nil) + (setq imenu-generic-expression emacs-authors-imenu-generic-expression) + (emacs-etc--hide-local-variables)) + +(define-obsolete-face-alias 'etc-authors-default 'emacs-authors-default "29.1") +(define-obsolete-face-alias 'etc-authors-author 'emacs-authors-author "29.1") +(define-obsolete-face-alias 'etc-authors-descriptor 'emacs-authors-descriptor "29.1") +(define-obsolete-face-alias 'etc-authors-other-files 'emacs-authors-other-files "29.1") +(define-obsolete-function-alias 'etc-authors-next-author #'emacs-authors-next-author "29.1") +(define-obsolete-function-alias 'etc-authors-prev-author #'emacs-authors-prev-author "29.1") +;;;###autoload +(define-obsolete-function-alias 'etc-authors-mode #'emacs-authors-mode "29.1") + +(provide 'emacs-authors-mode) +;;; emacs-authors-mode.el ends here diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el index e6e1f037284..022e17c9343 100644 --- a/lisp/textmodes/emacs-news-mode.el +++ b/lisp/textmodes/emacs-news-mode.el @@ -25,6 +25,7 @@ (eval-when-compile (require 'cl-lib)) (require 'outline) +(require 'subr-x) ; `emacs-etc--hide-local-variables' (defgroup emacs-news-mode nil "Major mode for editing and viewing the Emacs NEWS file." @@ -59,9 +60,12 @@ "C-x C-q" #'emacs-news-view-mode "<remap> <open-line>" #'emacs-news-open-line) -(defvar-keymap emacs-news-view-mode-map - :parent emacs-news-common-map - "C-x C-q" #'emacs-news-mode) +(defvar emacs-news-view-mode-map + ;; This is defined this way instead of inheriting because we're + ;; deriving the mode from `special-mode' and want the keys from there. + (let ((map (copy-keymap emacs-news-common-map))) + (keymap-set map "C-x C-q" #'emacs-news-mode) + map)) (defvar emacs-news-mode-font-lock-keywords `(("^---$" 0 'emacs-news-does-not-need-documentation) @@ -73,7 +77,8 @@ outline-minor-mode-cycle t outline-level (lambda () (length (match-string 2))) outline-minor-mode-highlight 'append) - (outline-minor-mode)) + (outline-minor-mode) + (emacs-etc--hide-local-variables)) ;;;###autoload (define-derived-mode emacs-news-mode text-mode "NEWS" diff --git a/lisp/textmodes/etc-authors-mode.el b/lisp/textmodes/etc-authors-mode.el deleted file mode 100644 index 7eabdd4c2b8..00000000000 --- a/lisp/textmodes/etc-authors-mode.el +++ /dev/null @@ -1,133 +0,0 @@ -;;; etc-authors-mode.el --- font-locking for etc/AUTHORS -*- lexical-binding: t -*- - -;; Copyright (C) 2021-2022 Free Software Foundation, Inc. - -;; Author: Stefan Kangas <stefan@marxist.se> -;; Keywords: internal - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Major mode to display the etc/AUTHORS file from the Emacs -;; distribution. Provides some basic font locking and not much else. - -;;; Code: - -(defgroup etc-authors-mode nil - "Display the \"etc/AUTHORS\" file from the Emacs distribution." - :version "28.1" - :group 'internal) - -(defface etc-authors-default '((t :inherit variable-pitch)) - "Default face used to display the \"etc/AUTHORS\" file. -See also `etc-authors-mode'." - :version "28.1") - -(defface etc-authors-author '((((class color) (min-colors 88) (background light)) - :foreground "midnight blue" - :weight bold :height 1.05 - :inherit variable-pitch) - (((class color) (min-colors 88) (background dark)) - :foreground "cyan" - :weight bold :height 1.05 - :inherit variable-pitch) - (((supports :weight bold) (supports :height 1.05)) - :weight bold :height 1.05 - :inherit variable-pitch) - (((supports :weight bold)) - :weight bold :inherit variable-pitch) - (t :inherit variable-pitch)) - "Face used for the author in the \"etc/AUTHORS\" file. -See also `etc-authors-mode'." - :version "28.1") - -(defface etc-authors-descriptor '((((class color) (min-colors 88) (background light)) - :foreground "sienna" :inherit variable-pitch) - (((class color) (min-colors 88) (background dark)) - :foreground "peru" :inherit variable-pitch) - (t :inherit variable-pitch)) - "Face used for the description text in the \"etc/AUTHORS\" file. -See also `etc-authors-mode'." - :version "28.1") - -(defface etc-authors-other-files '((t :inherit etc-authors-descriptor)) - "Face used for the \"other files\" text in the \"etc/AUTHORS\" file. -See also `etc-authors-mode'." - :version "28.1") - -(defconst etc-authors--author-re - (rx bol (group (not (any blank "\n")) (+? (not (any ":" "\n")))) ":") - "Regexp matching an author in \"etc/AUTHORS\".") - -(defvar etc-authors-mode-font-lock-keywords - `((,etc-authors--author-re - 1 'etc-authors-author) - (,(rx (or "wrote" - (seq (? "and ") (or "co-wrote" "changed")))) - 0 'etc-authors-descriptor) - (,(rx "and " (+ digit) " other files") - 0 'etc-authors-other-files) - (,(rx bol (not space) (+ not-newline) eol) - 0 'etc-authors-default))) - -(defun etc-authors-mode--hide-local-variables () - "Hide local variables in \"etc/AUTHORS\". Used by `etc-authors-mode'." - (narrow-to-region (point-min) - (save-excursion - (goto-char (point-min)) - ;; Obfuscate to avoid this being interpreted - ;; as a local variable section itself. - (if (re-search-forward "^Local\sVariables:$" nil t) - (progn (forward-line -1) (point)) - (point-max))))) - -(defun etc-authors-next-author (&optional arg) - "Move point to the next author in \"etc/AUTHORS\". -With a prefix arg ARG, move point that many authors forward." - (interactive "p" etc-authors-mode) - (if (< 0 arg) - (progn - (when (looking-at etc-authors--author-re) - (forward-line 1)) - (re-search-forward etc-authors--author-re nil t arg)) - (when (looking-at etc-authors--author-re) - (forward-line -1)) - (re-search-backward etc-authors--author-re nil t (abs arg))) - (goto-char (line-beginning-position))) - -(defun etc-authors-prev-author (&optional arg) - "Move point to the previous author in \"etc/AUTHORS\". -With a prefix arg ARG, move point that many authors backward." - (interactive "p" etc-authors-mode) - (etc-authors-next-author (- arg))) - -(defvar-keymap etc-authors-mode-map - :doc "Keymap for `etc-authors-mode'." - "n" #'etc-authors-next-author - "p" #'etc-authors-prev-author) - -;;;###autoload -(define-derived-mode etc-authors-mode special-mode "Authors View" - "Major mode for viewing \"etc/AUTHORS\" from the Emacs distribution. -Provides some basic font locking and not much else." - (setq-local font-lock-defaults - '(etc-authors-mode-font-lock-keywords nil nil ((?_ . "w")))) - (setq font-lock-multiline nil) - (etc-authors-mode--hide-local-variables)) - -(provide 'etc-authors-mode) -;;; etc-authors-mode.el ends here diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index a7c86fb24f0..462f87d3c1a 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -74,7 +74,7 @@ question. \"things\" include `symbol', `list', `sexp', `defun', `filename', `existing-filename', `url', `email', `uuid', `word', `sentence', -`whitespace', `line', and `page'.") +`whitespace', `line', `face' and `page'.") ;; Basic movement @@ -166,7 +166,7 @@ positions of the thing found." THING should be a symbol specifying a type of syntactic entity. Possibilities include `symbol', `list', `sexp', `defun', `filename', `existing-filename', `url', `email', `uuid', `word', -`sentence', `whitespace', `line', `number', and `page'. +`sentence', `whitespace', `line', `number', `face' and `page'. When the optional argument NO-PROPERTIES is non-nil, strip text properties from the return value. @@ -361,6 +361,15 @@ E.g.: (put 'existing-filename 'thing-at-point 'thing-at-point-file-at-point) +;; Faces + +(defun thing-at-point-face-at-point (&optional _lax _bounds) + "Return the name of the face at point as a symbol." + (when-let ((face (thing-at-point 'symbol))) + (and (facep face) (intern face)))) + +(put 'face 'thing-at-point 'thing-at-point-face-at-point) + ;; URIs (defvar thing-at-point-beginning-of-url-regexp nil diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index e02d84f1f56..d710578ffff 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -568,14 +568,12 @@ Compatibility function for \\[next-error] invocations." ;; Select window displaying source file. (select-window change-log-find-window))))) -(defvar change-log-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [?\C-c ?\C-p] #'add-log-edit-prev-comment) - (define-key map [?\C-c ?\C-n] #'add-log-edit-next-comment) - (define-key map [?\C-c ?\C-f] #'change-log-find-file) - (define-key map [?\C-c ?\C-c] #'change-log-goto-source) - map) - "Keymap for Change Log major mode.") +(defvar-keymap change-log-mode-map + :doc "Keymap for Change Log major mode." + "C-c C-p" #'add-log-edit-prev-comment + "C-c C-n" #'add-log-edit-next-comment + "C-c C-f" #'change-log-find-file + "C-c C-c" #'change-log-goto-source) (easy-menu-define change-log-mode-menu change-log-mode-map "Menu for Change Log major mode." diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index aa426446d73..e4a1996c1bb 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -27,8 +27,8 @@ ;; to the corresponding source file. ;; Inspired by Pavel Machek's patch-mode.el (<pavel@@atrey.karlin.mff.cuni.cz>) -;; Some efforts were spent to have it somewhat compatible with XEmacs's -;; diff-mode as well as with compilation-minor-mode +;; Some efforts were spent to have it somewhat compatible with +;; `compilation-minor-mode'. ;; Bugs: diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index 7e15060f8c4..52e356d8e9b 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -144,20 +144,18 @@ Useful commands (type ? to hide them and free up screen): (ediff-defvar-local ediff-meta-buffer-map nil "The keymap for the meta buffer.") -(defvar ediff-dir-diffs-buffer-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" #'ediff-bury-dir-diffs-buffer) - (define-key map " " #'next-line) - (define-key map "n" #'next-line) - (define-key map "\C-?" #'previous-line) - (define-key map "p" #'previous-line) - (define-key map "C" #'ediff-dir-diff-copy-file) - (define-key map [mouse-2] #'ediff-dir-diff-copy-file) - (define-key map [delete] #'previous-line) - (define-key map [backspace] #'previous-line) - map) - "Keymap for buffer showing differences between directories.") +(defvar-keymap ediff-dir-diffs-buffer-map + :doc "Keymap for buffer showing differences between directories." + :suppress t + "q" #'ediff-bury-dir-diffs-buffer + "SPC" #'next-line + "n" #'next-line + "DEL" #'previous-line + "p" #'previous-line + "C" #'ediff-dir-diff-copy-file + "<mouse-2>" #'ediff-dir-diff-copy-file + "<delete>" #'previous-line + "<backspace>" #'previous-line) ;; Variable specifying the action to take when the use invokes ediff in the ;; meta buffer. This is usually ediff-registry-action or ediff-filegroup-action diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index 84ad5cef90f..94e3fc6d7fe 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -89,12 +89,11 @@ ;; underlining. However, if the region is already underlined by some other ;; overlays, there is no simple way to temporarily remove that residual ;; underlining. This problem occurs when a buffer is highlighted with -;; hilit19.el or font-lock.el packages. If this residual highlighting gets -;; in the way, you can do the following. Both font-lock.el and hilit19.el -;; provide commands for unhighlighting buffers. You can either place these -;; commands in `ediff-prepare-buffer-hook' (which will unhighlight every -;; buffer used by Ediff) or you can execute them interactively, at any time -;; and on any buffer. +;; font-lock.el packages. If this residual highlighting gets in the way, you +;; can do the following. font-lock.el provides commands for unhighlighting +;; buffers. You can either place these commands in `ediff-prepare-buffer-hook' +;; (which will unhighlight every buffer used by Ediff) or you can execute +;; them interactively, at any time and in any buffer. ;;; Acknowledgments: diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el index 422ed5c0a4d..de09be80e7c 100644 --- a/lisp/vc/emerge.el +++ b/lisp/vc/emerge.el @@ -2942,6 +2942,7 @@ If some prefix of KEY has a non-prefix definition, it is redefined." ;; Define a key if it (or a prefix) is not already defined in the map. (defun emerge-define-key-if-possible (keymap key definition) + (declare (obsolete keymap-set "29.1")) ;; look up the present definition of the key (let ((present (lookup-key keymap key))) (if (integerp present) @@ -2959,6 +2960,7 @@ If some prefix of KEY has a non-prefix definition, it is redefined." If the name won't fit on one line, the minibuffer is expanded to hold it, and the command waits for a keystroke from the user. If the keystroke is SPC, it is ignored; if it is anything else, it is processed as a command." + (declare (obsolete nil "29.1")) (interactive) (let ((name (buffer-file-name))) (or name diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index 1f19c4cfe26..a15cf417de3 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -162,22 +162,20 @@ List of factors, used to expand/compress the time scale. See `vc-annotate'." :type '(repeat number) :group 'vc) -(defvar vc-annotate-mode-map - (let ((m (make-sparse-keymap))) - (define-key m "a" #'vc-annotate-revision-previous-to-line) - (define-key m "d" #'vc-annotate-show-diff-revision-at-line) - (define-key m "=" #'vc-annotate-show-diff-revision-at-line) - (define-key m "D" #'vc-annotate-show-changeset-diff-revision-at-line) - (define-key m "f" #'vc-annotate-find-revision-at-line) - (define-key m "j" #'vc-annotate-revision-at-line) - (define-key m "l" #'vc-annotate-show-log-revision-at-line) - (define-key m "n" #'vc-annotate-next-revision) - (define-key m "p" #'vc-annotate-prev-revision) - (define-key m "w" #'vc-annotate-working-revision) - (define-key m "v" #'vc-annotate-toggle-annotation-visibility) - (define-key m "\C-m" #'vc-annotate-goto-line) - m) - "Local keymap used for VC-Annotate mode.") +(defvar-keymap vc-annotate-mode-map + :doc "Local keymap used for VC-Annotate mode." + "a" #'vc-annotate-revision-previous-to-line + "d" #'vc-annotate-show-diff-revision-at-line + "=" #'vc-annotate-show-diff-revision-at-line + "D" #'vc-annotate-show-changeset-diff-revision-at-line + "f" #'vc-annotate-find-revision-at-line + "j" #'vc-annotate-revision-at-line + "l" #'vc-annotate-show-log-revision-at-line + "n" #'vc-annotate-next-revision + "p" #'vc-annotate-prev-revision + "w" #'vc-annotate-working-revision + "v" #'vc-annotate-toggle-annotation-visibility + "RET" #'vc-annotate-goto-line) ;;; Annotate functionality diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 072bd72b441..f6b17d4ce09 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -1008,19 +1008,17 @@ stream. Standard error output is discarded." ;; frob the results accordingly. (file-relative-name dir (vc-bzr-root dir))))) -(defvar vc-bzr-shelve-map - (let ((map (make-sparse-keymap))) - ;; Turn off vc-dir marking - (define-key map [mouse-2] #'ignore) - - (define-key map [down-mouse-3] #'vc-bzr-shelve-menu) - (define-key map "\C-k" #'vc-bzr-shelve-delete-at-point) - (define-key map "=" #'vc-bzr-shelve-show-at-point) - (define-key map "\C-m" #'vc-bzr-shelve-show-at-point) - (define-key map "A" #'vc-bzr-shelve-apply-and-keep-at-point) - (define-key map "P" #'vc-bzr-shelve-apply-at-point) - (define-key map "S" #'vc-bzr-shelve-snapshot) - map)) +(defvar-keymap vc-bzr-shelve-map + ;; Turn off vc-dir marking + "<mouse-2>" #'ignore + + "<down-mouse-3>" #'vc-bzr-shelve-menu + "C-k" #'vc-bzr-shelve-delete-at-point + "=" #'vc-bzr-shelve-show-at-point + "RET" #'vc-bzr-shelve-show-at-point + "A" #'vc-bzr-shelve-apply-and-keep-at-point + "P" #'vc-bzr-shelve-apply-at-point + "S" #'vc-bzr-shelve-snapshot) (defvar vc-bzr-shelve-menu-map (let ((map (make-sparse-keymap "Bzr Shelve"))) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 9335da10065..068a66b25b8 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -1467,17 +1467,13 @@ These are the commands available for use in the file status buffer: (propertize "Please add backend specific headers here. It's easy!" 'face 'vc-dir-status-warning))) -(defvar vc-dir-status-mouse-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] #'vc-dir-toggle-mark) - map) - "Local keymap for toggling mark.") +(defvar-keymap vc-dir-status-mouse-map + :doc "Local keymap for toggling mark." + "<mouse-2>" #'vc-dir-toggle-mark) -(defvar vc-dir-filename-mouse-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] #'vc-dir-find-file-other-window) - map) - "Local keymap for visiting a file.") +(defvar-keymap vc-dir-filename-mouse-map + :doc "Local keymap for visiting a file." + "<mouse-2>" #'vc-dir-find-file-other-window) (defun vc-default-dir-printer (_backend fileentry) "Pretty print FILEENTRY." diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 8937454d111..46a486a46c3 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -664,32 +664,26 @@ or an empty string if none." :files files :update-function update-function))) -(defvar vc-git-stash-shared-map - (let ((map (make-sparse-keymap))) - (define-key map "S" #'vc-git-stash-snapshot) - (define-key map "C" #'vc-git-stash) - map)) - -(defvar vc-git-stash-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map vc-git-stash-shared-map) - ;; Turn off vc-dir marking - (define-key map [mouse-2] #'ignore) - - (define-key map [down-mouse-3] #'vc-git-stash-menu) - (define-key map "\C-k" #'vc-git-stash-delete-at-point) - (define-key map "=" #'vc-git-stash-show-at-point) - (define-key map "\C-m" #'vc-git-stash-show-at-point) - (define-key map "A" #'vc-git-stash-apply-at-point) - (define-key map "P" #'vc-git-stash-pop-at-point) - map)) - -(defvar vc-git-stash-button-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map vc-git-stash-shared-map) - (define-key map [mouse-2] #'push-button) - (define-key map "\C-m" #'push-button) - map)) +(defvar-keymap vc-git-stash-shared-map + "S" #'vc-git-stash-snapshot + "C" #'vc-git-stash) + +(defvar-keymap vc-git-stash-map + :parent vc-git-stash-shared-map + ;; Turn off vc-dir marking + "<mouse-2>" #'ignore + + "<down-mouse-3>" #'vc-git-stash-menu + "C-k" #'vc-git-stash-delete-at-point + "=" #'vc-git-stash-show-at-point + "RET" #'vc-git-stash-show-at-point + "A" #'vc-git-stash-apply-at-point + "P" #'vc-git-stash-pop-at-point) + +(defvar-keymap vc-git-stash-button-map + :parent vc-git-stash-shared-map + "<mouse-2>" #'push-button + "RET" #'push-button) (defconst vc-git-stash-shared-help "\\<vc-git-stash-shared-map>\\[vc-git-stash]: Create named stash\n\\[vc-git-stash-snapshot]: Snapshot stash") @@ -910,12 +904,11 @@ If toggling on, also insert its message into the buffer." standard-output 1 nil "log" "--max-count=1" "--pretty=format:%B" "HEAD"))))) -(defvar vc-git-log-edit-mode-map - (let ((map (make-sparse-keymap "Git-Log-Edit"))) - (define-key map "\C-c\C-s" #'vc-git-log-edit-toggle-signoff) - (define-key map "\C-c\C-n" #'vc-git-log-edit-toggle-no-verify) - (define-key map "\C-c\C-e" #'vc-git-log-edit-toggle-amend) - map)) +(defvar-keymap vc-git-log-edit-mode-map + :name "Git-Log-Edit" + "C-c C-s" #'vc-git-log-edit-toggle-signoff + "C-c C-n" #'vc-git-log-edit-toggle-no-verify + "C-c C-e" #'vc-git-log-edit-toggle-amend) (define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git" "Major mode for editing Git log messages. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 5fba2b3908a..61976288e35 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1177,10 +1177,9 @@ If toggling on, also insert its message into the buffer." standard-output 1 nil "log" "--limit=1" "--template" "{desc}"))))) -(defvar vc-hg-log-edit-mode-map - (let ((map (make-sparse-keymap "Hg-Log-Edit"))) - (define-key map "\C-c\C-e" #'vc-hg-log-edit-toggle-amend) - map)) +(defvar-keymap vc-hg-log-edit-mode-map + :name "Hg-Log-Edit" + "C-c C-e" #'vc-hg-log-edit-toggle-amend) (define-derived-mode vc-hg-log-edit-mode log-edit-mode "Log-Edit/hg" "Major mode for editing Hg log messages. @@ -1262,9 +1261,7 @@ REV is the revision to check out into WORKFILE." ;;; Hg specific functionality. -(defvar vc-hg-extra-menu-map - (let ((map (make-sparse-keymap))) - map)) +(defvar-keymap vc-hg-extra-menu-map) (defun vc-hg-extra-menu () vc-hg-extra-menu-map) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 405c9bc2ca4..1f0eeb7e18a 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -855,38 +855,37 @@ In the latter case, VC mode is deactivated for this buffer." ;; Autoloading works fine, but it prevents shortcuts from appearing ;; in the menu because they don't exist yet when the menu is built. ;; (autoload 'vc-prefix-map "vc" nil nil 'keymap) -(defvar vc-prefix-map - (let ((map (make-sparse-keymap))) - (define-key map "a" #'vc-update-change-log) - (with-suppressed-warnings ((obsolete vc-switch-backend)) - (define-key map "b" #'vc-switch-backend)) - (define-key map "d" #'vc-dir) - (define-key map "g" #'vc-annotate) - (define-key map "G" #'vc-ignore) - (define-key map "h" #'vc-region-history) - (define-key map "i" #'vc-register) - (define-key map "l" #'vc-print-log) - (define-key map "L" #'vc-print-root-log) - (define-key map "I" #'vc-log-incoming) - (define-key map "O" #'vc-log-outgoing) - (define-key map "ML" #'vc-log-mergebase) - (define-key map "MD" #'vc-diff-mergebase) - (define-key map "m" #'vc-merge) - (define-key map "r" #'vc-retrieve-tag) - (define-key map "s" #'vc-create-tag) - (define-key map "u" #'vc-revert) - (define-key map "v" #'vc-next-action) - (define-key map "+" #'vc-update) - ;; I'd prefer some kind of symmetry with vc-update: - (define-key map "P" #'vc-push) - (define-key map "=" #'vc-diff) - (define-key map "D" #'vc-root-diff) - (define-key map "~" #'vc-revision-other-window) - (define-key map "x" #'vc-delete-file) - map)) +(defvar-keymap vc-prefix-map + "a" #'vc-update-change-log + "d" #'vc-dir + "g" #'vc-annotate + "G" #'vc-ignore + "h" #'vc-region-history + "i" #'vc-register + "l" #'vc-print-log + "L" #'vc-print-root-log + "I" #'vc-log-incoming + "O" #'vc-log-outgoing + "M L" #'vc-log-mergebase + "M D" #'vc-diff-mergebase + "m" #'vc-merge + "r" #'vc-retrieve-tag + "s" #'vc-create-tag + "u" #'vc-revert + "v" #'vc-next-action + "+" #'vc-update + ;; I'd prefer some kind of symmetry with vc-update: + "P" #'vc-push + "=" #'vc-diff + "D" #'vc-root-diff + "~" #'vc-revision-other-window + "x" #'vc-delete-file) (fset 'vc-prefix-map vc-prefix-map) (define-key ctl-x-map "v" 'vc-prefix-map) +(with-suppressed-warnings ((obsolete vc-switch-backend)) + (keymap-set vc-prefix-map "b" #'vc-switch-backend)) + (defvar vc-menu-map (let ((map (make-sparse-keymap "Version Control"))) ;;(define-key map [show-files] |