diff options
Diffstat (limited to 'lisp')
131 files changed, 1306 insertions, 1669 deletions
diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 9bcceceb0ee..164e4a01f59 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -302,7 +302,7 @@ endif # subdirectories, to make sure require's and load's in the files being # compiled find the right files. -.SUFFIXES: .eln .elc .el +.SUFFIXES: .elc .el # An old-fashioned suffix rule, which, according to the GNU Make manual, # cannot have prerequisites. @@ -357,13 +357,6 @@ compile-main: gen-lisp compile-clean TARGETS="$$chunk"; \ done -.PHONY: native-compile-clean -native-compile-clean: -# Erase all eln output compilation folders. -ifeq ($(HAVE_NATIVE_COMP),yes) - find $(lisp) -regex ".*/eln-.*-[0-9a-z]+\\'" -type d | xargs rm -rf -endif - .PHONY: compile-clean # Erase left-over .elc files that do not have a corresponding .el file. compile-clean: @@ -400,7 +393,7 @@ compile: $(LOADDEFS) autoloads compile-first # Compile all Lisp files. This is like 'compile' but compiles files # unconditionally. Some files don't actually get compiled because they # set the local variable no-byte-compile. -compile-always: native-compile-clean +compile-always: find $(lisp) -name '*.elc' $(FIND_DELETE) $(MAKE) compile @@ -490,7 +483,7 @@ $(CAL_DIR)/hol-loaddefs.el: $(CAL_SRC) $(CAL_DIR)/diary-loaddefs.el .PHONY: bootstrap-clean distclean maintainer-clean extraclean -bootstrap-clean: native-compile-clean +bootstrap-clean: find $(lisp) -name '*.elc' $(FIND_DELETE) rm -f $(AUTOGENEL) diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 2d61a96010e..468b0d995b3 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -517,14 +517,6 @@ It is nil if the abbrev has already been unexpanded.") ;; "Local (mode-specific) abbrev table of current buffer.") ;; (make-variable-buffer-local 'local-abbrev-table) -(defcustom pre-abbrev-expand-hook nil - "Function or functions to be called before abbrev expansion is done. -This is the first thing that `expand-abbrev' does, and so this may change -the current abbrev table before abbrev lookup happens." - :type 'hook - :group 'abbrev-mode) -(make-obsolete-variable 'pre-abbrev-expand-hook 'abbrev-expand-function "23.1") - (defun clear-abbrev-table (table) "Undefine all abbrevs in abbrev table TABLE, leaving it empty." (setq abbrevs-changed t) @@ -836,12 +828,10 @@ Takes no argument and should return the abbrev symbol if expansion took place.") (defun expand-abbrev () "Expand the abbrev before point, if there is an abbrev there. Effective when explicitly called even when `abbrev-mode' is nil. -Before doing anything else, runs `pre-abbrev-expand-hook'. Calls the value of `abbrev-expand-function' with no argument to do the work, and returns whatever it does. (That return value should be the abbrev symbol if expansion occurred, else nil.)" (interactive) - (run-hooks 'pre-abbrev-expand-hook) (funcall abbrev-expand-function)) (defun abbrev--default-expand () diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 36a361c3f4b..8a3bcf8e59d 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -923,8 +923,6 @@ annotations." "# Date: " (current-time-string) "\n")) -(define-obsolete-variable-alias 'bookmark-read-annotation-text-func - 'bookmark-edit-annotation-text-func "23.1") (defvar bookmark-edit-annotation-text-func 'bookmark-default-annotation-text "Function to return default text to use for a bookmark annotation. It takes one argument, the name of the bookmark, as a string.") @@ -1143,17 +1141,6 @@ DISPLAY-FUNC would be `switch-to-buffer-other-window'." (let ((pop-up-frames t)) (bookmark-jump-other-window bookmark))) -(defun bookmark-jump-noselect (bookmark) - "Return the location pointed to by BOOKMARK (see `bookmark-jump'). -The return value has the form (BUFFER . POINT). - -Note: this function is deprecated and is present for Emacs 22 -compatibility only." - (declare (obsolete bookmark-handle-bookmark "23.1")) - (save-excursion - (bookmark-handle-bookmark bookmark) - (cons (current-buffer) (point)))) - (defun bookmark-handle-bookmark (bookmark-name-or-record) "Call BOOKMARK-NAME-OR-RECORD's handler or `bookmark-default-handler' if it has none. This changes current buffer and point and returns nil, diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index aa5c47ca7f4..d06ba287879 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -229,9 +229,6 @@ commands.") map) "Local keymap for `Buffer-menu-mode' buffers.") -(define-obsolete-variable-alias 'buffer-menu-mode-hook - 'Buffer-menu-mode-hook "23.1") - (define-derived-mode Buffer-menu-mode tabulated-list-mode "Buffer Menu" "Major mode for Buffer Menu buffers. The Buffer Menu is invoked by the commands \\[list-buffers], diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el index ecce3e7105b..140e7387a68 100644 --- a/lisp/cedet/ede/make.el +++ b/lisp/cedet/ede/make.el @@ -32,29 +32,15 @@ (declare-function inversion-check-version "inversion") -(if (fboundp 'locate-file) - (defsubst ede--find-executable (exec) - "Return an expanded file name for a program EXEC on the exec path." - (locate-file exec exec-path)) - - ;; Else, older version of Emacs. - - (defsubst ede--find-executable (exec) - "Return an expanded file name for a program EXEC on the exec path." - (let ((p exec-path) - (found nil)) - (while (and p (not found)) - (let ((f (expand-file-name exec (car p)))) - (if (file-exists-p f) - (setq found f))) - (setq p (cdr p))) - found)) - ) +(defsubst ede--find-executable (exec) + "Return an expanded file name for a program EXEC on the exec path." + (declare (obsolete locate-file "28.1")) + (locate-file exec exec-path)) (defvar ede-make-min-version "3.0" "Minimum version of GNU make required.") -(defcustom ede-make-command (cond ((ede--find-executable "gmake") +(defcustom ede-make-command (cond ((executable-find "gmake") "gmake") (t "make")) ;; What to do? "The MAKE command to use for EDE when compiling. diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 358829a4568..3649d1c2f1f 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -46,27 +46,10 @@ (declare-function c-forward-conditional "cc-cmds") (declare-function ede-system-include-path "ede") -;;; Compatibility -;; (eval-when-compile (require 'cc-mode)) -(if (fboundp 'c-end-of-macro) - (eval-and-compile - (defalias 'semantic-c-end-of-macro 'c-end-of-macro)) - ;; From cc-mode 5.30 - (defun semantic-c-end-of-macro () - "Go to the end of a preprocessor directive. -More accurately, move point to the end of the closest following line -that doesn't end with a line continuation backslash. - -This function does not do any hidden buffer changes." - (while (progn - (end-of-line) - (when (and (eq (char-before) ?\\) - (not (eobp))) - (forward-char) - t)))) - ) +(define-obsolete-function-alias 'semantic-c-end-of-macro + #'c-end-of-macro "28.1") ;;; Code: (with-suppressed-warnings ((obsolete define-child-mode)) @@ -266,7 +249,7 @@ Return the defined symbol as a special spp lex token." (semantic-lex-analyzer #'semantic-cpp-lexer) (raw-stream (semantic-lex-spp-stream-for-macro (save-excursion - (semantic-c-end-of-macro) + (c-end-of-macro) ;; HACK - If there's a C comment after ;; the macro, do not parse it. (if (looking-back "/\\*.*" beginning-of-define) @@ -590,7 +573,7 @@ case, we must skip it since it is the ELSE part." (define-lex-regex-analyzer semantic-lex-c-macrobits "Ignore various forms of #if/#else/#endif conditionals." "^\\s-*#\\s-*\\(if\\(n?def\\)?\\|endif\\|elif\\|else\\)" - (semantic-c-end-of-macro) + (c-end-of-macro) (setq semantic-lex-end-point (point)) nil) diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el index 47afa25dd74..60ab6033aec 100644 --- a/lisp/cedet/semantic/dep.el +++ b/lisp/cedet/semantic/dep.el @@ -183,16 +183,8 @@ macro `defcustom-mode-local-semantic-dependency-system-include-path'." ;; ;; methods for finding files on a provided path. (defmacro semantic--dependency-find-file-on-path (file path) - (if (fboundp 'locate-file) - `(locate-file ,file ,path) - `(let ((p ,path) - (found nil)) - (while (and p (not found)) - (let ((f (expand-file-name ,file (car p)))) - (if (file-exists-p f) - (setq found f))) - (setq p (cdr p))) - found))) + (declare (obsolete locate-file "28.1")) + `(locate-file ,file ,path)) (defvar ede-minor-mode) (defvar ede-object) @@ -216,11 +208,11 @@ provided mode, not from the current major mode." (when (file-exists-p file) (setq found file)) (when (and (not found) (not systemp)) - (setq found (semantic--dependency-find-file-on-path file locp))) + (setq found (locate-file file locp))) (when (and (not found) edesys) - (setq found (semantic--dependency-find-file-on-path file edesys))) + (setq found (locate-file file edesys))) (when (not found) - (setq found (semantic--dependency-find-file-on-path file sysp))) + (setq found (locate-file file sysp))) (if found (expand-file-name found)))) diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index b8812de05b6..e6e124eb812 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -70,7 +70,7 @@ (require 'semantic) (require 'semantic/lex) -(declare-function semantic-c-end-of-macro "semantic/bovine/c") +(declare-function c-end-of-macro "cc-engine") ;;; Code: (defvar semantic-lex-spp-macro-symbol-obarray nil @@ -946,7 +946,7 @@ by another macro." (save-excursion (let ((start (match-beginning 0)) (end (match-end 0)) - (peom (save-excursion (semantic-c-end-of-macro) (point)))) + (peom (save-excursion (c-end-of-macro) (point)))) (condition-case nil (progn ;; This will throw an error if no closing paren can be found. diff --git a/lisp/comint.el b/lisp/comint.el index c3cb439d8b8..092902d865e 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -223,6 +223,13 @@ This variable is buffer-local." (other :tag "on" t)) :group 'comint) +(defcustom comint-highlight-input t + "If non-nil, highlight input with `comint-highlight-input' face. +Otherwise keep the original highlighting untouched." + :version "28.1" + :type 'boolean + :group 'comint) + (defface comint-highlight-input '((t (:weight bold))) "Face to use to highlight user input." :group 'comint) @@ -1897,9 +1904,10 @@ Similarly for Soar, Scheme, etc." (end (if no-newline (point) (1- (point))))) (with-silent-modifications (when (> end beg) - (add-text-properties beg end - '(front-sticky t - font-lock-face comint-highlight-input)) + (when comint-highlight-input + (add-text-properties beg end + '( font-lock-face comint-highlight-input + front-sticky t ))) (unless comint-use-prompt-regexp ;; Give old user input a field property of `input', to ;; distinguish it from both process output and unsent @@ -3852,7 +3860,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." (set-buffer output-buffer) (goto-char (point-min)) ;; Skip past the command, if it was echoed - (and (looking-at command) + (and (looking-at (regexp-quote command)) (forward-line)) (while (and (not (eobp)) (re-search-forward regexp nil t)) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 16695967dfa..23ceb3a857a 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -801,16 +801,19 @@ has been executed, nil otherwise." If a setting was edited and set before, this saves it. If a setting was merely edited before, this sets it then saves it." (interactive) - (when (custom-command-apply - (lambda (child) - (when (memq (widget-get child :custom-state) - '(modified set changed rogue)) - (widget-apply child :custom-mark-to-save))) - "Save all settings in this buffer? " t) - ;; Save changes to buffer and redraw. - (custom-save-all) - (dolist (child custom-options) - (widget-apply child :custom-state-set-and-redraw)))) + (let (edited-widgets) + (when (custom-command-apply + (lambda (child) + (when (memq (widget-get child :custom-state) + '(modified set changed rogue)) + (push child edited-widgets) + (widget-apply child :custom-mark-to-save))) + "Save all settings in this buffer? " t) + ;; Save changes to buffer. + (custom-save-all) + ;; Redraw and recalculate the state when necessary. + (dolist (widget edited-widgets) + (widget-apply widget :custom-state-set-and-redraw))))) (defun custom-reset (_widget &optional event) "Select item from reset menu." @@ -4868,8 +4871,6 @@ If several parents are listed, go to the first of them." (parent (downcase (widget-get button :tag)))) (customize-group parent))))) -(define-obsolete-variable-alias 'custom-mode-hook 'Custom-mode-hook "23.1") - (defcustom Custom-mode-hook nil "Hook called when entering Custom mode." :type 'hook @@ -4940,8 +4941,6 @@ if that value is non-nil." (put 'Custom-mode 'mode-class 'special) -(define-obsolete-function-alias 'custom-mode 'Custom-mode "23.1") - ;;; The End. (provide 'cus-edit) diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 55f0b7dcb40..d6da4280630 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -141,8 +141,7 @@ otherwise." (wid-field (get-char-property pos 'field)) (wid-button (get-char-property pos 'button)) (wid-doc (get-char-property pos 'widget-doc)) - ;; If button.el is not loaded, we have no buttons in the text. - (button (and (fboundp 'button-at) (button-at pos))) + (button (button-at pos)) (button-type (and button (button-type button))) (button-label (and button (button-label button))) (widget (or wid-field wid-button wid-doc))) diff --git a/lisp/desktop.el b/lisp/desktop.el index 7fe5f73b879..7a7f1d07c93 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -1037,7 +1037,7 @@ file. To upgrade a version 206 file to version 208, call this command explicitly with a prefix argument: \\[universal-argument] \\[desktop-save]. -If you are upgrading from Emacs 24 or older, we recommed to do +If you are upgrading from Emacs 24 or older, we recommend to do this once you decide you no longer need compatibility with versions of Emacs before 25.1. diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el index 3a0bbd2c9c2..ad0c18d1b38 100644 --- a/lisp/dirtrack.el +++ b/lisp/dirtrack.el @@ -196,9 +196,6 @@ directory." (remove-hook 'comint-preoutput-filter-functions 'dirtrack t))) -(define-obsolete-function-alias 'dirtrack-debug-toggle 'dirtrack-debug-mode - "23.1") -(define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1") (define-minor-mode dirtrack-debug-mode "Toggle Dirtrack debugging." nil nil nil diff --git a/lisp/doc-view.el b/lisp/doc-view.el index de342f1519e..77c06a8eaf9 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -435,6 +435,9 @@ Typically \"page-%s.png\".") (define-key map (kbd "c m") 'doc-view-set-slice-using-mouse) (define-key map (kbd "c b") 'doc-view-set-slice-from-bounding-box) (define-key map (kbd "c r") 'doc-view-reset-slice) + ;; Centering the image + (define-key map (kbd "c h") 'doc-view-center-page-horizontally) + (define-key map (kbd "c v") 'doc-view-center-page-vertically) ;; Searching (define-key map (kbd "C-s") 'doc-view-search) (define-key map (kbd "<find>") 'doc-view-search) @@ -740,8 +743,7 @@ It's a subdirectory of `doc-view-cache-directory'." Document types are symbols like `dvi', `ps', `pdf', or `odf' (any OpenDocument format)." (and (display-graphic-p) - (or (image-type-available-p 'imagemagick) - (image-type-available-p 'png)) + (image-type-available-p 'png) (cond ((eq type 'dvi) (and (doc-view-mode-p 'pdf) @@ -769,10 +771,7 @@ OpenDocument format)." (defun doc-view-enlarge (factor) "Enlarge the document by FACTOR." (interactive (list doc-view-shrink-factor)) - (if (and doc-view-scale-internally - (eq (plist-get (cdr (doc-view-current-image)) :type) - 'imagemagick)) - ;; ImageMagick supports on-the-fly-rescaling. + (if doc-view-scale-internally (let ((new (ceiling (* factor doc-view-image-width)))) (unless (equal new doc-view-image-width) (setq-local doc-view-image-width new) @@ -792,9 +791,7 @@ OpenDocument format)." (defun doc-view-scale-reset () "Reset the document size/zoom level to the initial one." (interactive) - (if (and doc-view-scale-internally - (eq (plist-get (cdr (doc-view-current-image)) :type) - 'imagemagick)) + (if doc-view-scale-internally (progn (kill-local-variable 'doc-view-image-width) (doc-view-insert-image @@ -927,6 +924,32 @@ Resize the containing frame if needed." (when new-frame-params (modify-frame-parameters (selected-frame) new-frame-params)))) +(defun doc-view-center-page-horizontally () + "Center page horizontally when page is wider than window." + (interactive) + (let ((page-width (car (image-size (doc-view-current-image) 'pixel))) + (window-width (window-body-width nil 'pixel)) + ;; How much do we scroll in order to center the page? + (pixel-hscroll 0) + ;; How many pixels are there in a column? + (col-in-pixel (/ (window-body-width nil 'pixel) + (window-body-width nil)))) + (when (> page-width window-width) + (setq pixel-hscroll (/ (- page-width window-width) 2)) + (set-window-hscroll (selected-window) + (/ pixel-hscroll col-in-pixel))))) + +(defun doc-view-center-page-vertically () + "Center page vertically when page is wider than window." + (interactive) + (let ((page-height (cdr (image-size (doc-view-current-image) 'pixel))) + (window-height (window-body-height nil 'pixel)) + ;; How much do we scroll in order to center the page? + (pixel-scroll 0)) + (when (> page-height window-height) + (setq pixel-scroll (/ (- page-height window-height) 2)) + (set-window-vscroll (selected-window) pixel-scroll 'pixel)))) + (defun doc-view-reconvert-doc () "Reconvert the current document. Should be invoked when the cached images aren't up-to-date." @@ -1393,12 +1416,11 @@ ARGS is a list of image descriptors." ;; Only insert the image if the buffer is visible. (when (window-live-p (overlay-get ol 'window)) (let* ((image (if (and file (file-readable-p file)) - (if (not (and doc-view-scale-internally - (fboundp 'imagemagick-types))) + (if (not doc-view-scale-internally) (apply #'create-image file doc-view--image-type nil args) (unless (member :width args) (setq args `(,@args :width ,doc-view-image-width))) - (apply #'create-image file 'imagemagick nil args)))) + (apply #'create-image file doc-view--image-type nil args)))) (slice (doc-view-current-slice)) (img-width (and image (car (image-size image)))) (displayed-img-width (if (and image slice) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 20a481a8a1c..507cfe76ffa 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2041,7 +2041,8 @@ The value is non-nil if there were no errors, nil if errors." (with-current-buffer output-buffer (goto-char (point-max)) (insert "\n") ; aaah, unix. - (if (file-writable-p target-file) + (if (or (file-writable-p target-file) + byte-native-compiling) ;; We must disable any code conversion here. (progn (let* ((coding-system-for-write 'no-conversion) @@ -2050,7 +2051,8 @@ The value is non-nil if there were no errors, nil if errors." ;; parallel bootstrap), it does not risk getting a ;; half-finished file. (Bug#4196) (tempfile - (make-temp-file (expand-file-name target-file))) + (make-temp-file (when (file-writable-p target-file) + (expand-file-name target-file)))) (default-modes (default-file-modes)) (temp-modes (logand default-modes #o600)) (desired-modes (logand default-modes #o666)) diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 2321ac1ed50..964836a32ac 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -105,9 +105,7 @@ Useful if new Emacs is used on B&W display.") (car cl) "white")) (set-face-foreground nf "black") - (if (and chart-face-use-pixmaps - pl - (fboundp 'set-face-background-pixmap)) + (if (and chart-face-use-pixmaps pl) (condition-case nil (set-face-background-pixmap nf (car pl)) (error (message "Cannot set background pixmap %s" (car pl))))) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a92392f63ac..3176351b37d 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -36,18 +36,12 @@ (require 'gv) (require 'rx) (require 'subr-x) +(require 'warnings) (defgroup comp nil "Emacs Lisp native compiler." :group 'lisp) -(defcustom comp-deferred-compilation nil - "If non-nil compile asyncronously all .elc files being loaded. -Once compilation happened each function definition is updated to -the native compiled one." - :type 'boolean - :group 'comp) - (defcustom comp-speed 2 "Compiler optimization level. From -1 to 3. - -1 functions are kept in bytecode form and no native compilation is performed. @@ -143,6 +137,9 @@ before compilation. Usable to modify the compiler environment." (defvar comp-dry-run nil "When non nil run everything but the C back-end.") +(defconst comp-valid-source-re (rx ".el" (? ".gz") eos) + "Regexp to match filename of valid input source files.") + (defconst comp-log-buffer-name "*Native-compile-Log*" "Name of the native-compiler log buffer.") @@ -569,28 +566,6 @@ VERBOSITY is a number between 0 and 3." -(defun comp-output-directory (src) - "Return the compilation direcotry for source SRC." - (let* ((src (if (symbolp src) (symbol-name src) src)) - (expanded-filename (expand-file-name src))) - (file-name-as-directory - (concat (file-name-directory expanded-filename) - comp-native-path-postfix)))) - -(defun comp-output-base-filename (src) - "Output filename sans extention for SRC file being native compiled." - (let* ((src (if (symbolp src) (symbol-name src) src)) - (expanded-filename (expand-file-name src)) - (output-dir (comp-output-directory src)) - (output-filename - (file-name-sans-extension - (file-name-nondirectory expanded-filename)))) - (expand-file-name output-filename output-dir))) - -(defun comp-output-filename (src) - "Output filename for SRC file being native compiled." - (concat (comp-output-base-filename src) ".eln")) - (defmacro comp-loop-insn-in-block (basic-block &rest body) "Loop over all insns in BASIC-BLOCK executning BODY. Inside BODY `insn' can be used to read or set the current @@ -2486,7 +2461,7 @@ Prepare every function for final compilation and drive the C back-end." (unless (file-exists-p dir) ;; In case it's created in the meanwhile. (ignore-error 'file-already-exists - (make-directory dir))) + (make-directory dir t))) (unless comp-dry-run (comp--compile-ctxt-to-file name)))) @@ -2592,17 +2567,20 @@ display a message." (cl-loop for (source-file . load) = (pop comp-files-queue) while source-file - do (cl-assert (string-match-p (rx ".el" eos) source-file) nil + do (cl-assert (string-match-p comp-valid-source-re source-file) nil "`comp-files-queue' should be \".el\" files: %s" source-file) when (or comp-always-compile + load ; Always compile when the compilation is + ; commanded for late load. (file-newer-than-file-p source-file - (comp-output-filename source-file))) + (comp-el-to-eln-filename source-file))) do (let* ((expr `(progn (require 'comp) (setf comp-speed ,comp-speed comp-debug ,comp-debug comp-verbose ,comp-verbose + comp-eln-load-path ',comp-eln-load-path load-path ',load-path) ,comp-async-env-modifier-form (message "Compiling %s..." ,source-file) @@ -2636,7 +2614,7 @@ display a message." (when (and load1 (zerop (process-exit-status process))) (native-elisp-load - (comp-output-filename source-file1) + (comp-el-to-eln-filename source-file1) (eq load1 'late))) (comp-run-async-workers))))) (puthash source-file process comp-async-compilations)) @@ -2676,7 +2654,11 @@ Return the compilation unit file name." (byte-compile-debug t) (comp-ctxt (make-comp-ctxt - :output (comp-output-base-filename function-or-file) + :output (comp-el-to-eln-filename (if (symbolp function-or-file) + (symbol-name function-or-file) + function-or-file) + (when byte-native-for-bootstrap + (car (last comp-eln-load-path)))) :with-late-load with-late-load))) (comp-log "\n \n" 1) (condition-case err @@ -2746,8 +2728,8 @@ LOAD can be nil t or 'late." (dolist (path paths) (cond ((file-directory-p path) (dolist (file (if recursively - (directory-files-recursively path (rx ".el" eos)) - (directory-files path t (rx ".el" eos)))) + (directory-files-recursively path comp-valid-source-re) + (directory-files path t comp-valid-source-re))) (push file files))) ((file-exists-p path) (push path files)) (t (signal 'native-compiler-error @@ -2770,11 +2752,11 @@ queued with LOAD %" (and (eq load 'late) (cl-some (lambda (re) (string-match re file)) comp-deferred-compilation-black-list))) - (let ((out-dir (comp-output-directory file)) - (out-filename (comp-output-filename file))) - (if (or (file-writable-p out-filename) - (and (not (file-exists-p out-dir)) - (file-writable-p (substring out-dir 0 -1)))) + (let* ((out-filename (comp-el-to-eln-filename file)) + (out-dir (file-name-directory out-filename))) + (unless (file-exists-p out-dir) + (make-directory out-dir t)) + (if (file-writable-p out-filename) (setf comp-files-queue (append comp-files-queue `((,file . ,load)))) (display-warning 'comp diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index 65483d0813a..89d106ee489 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -270,12 +270,6 @@ with empty strings removed." (remove-hook 'choose-completion-string-functions 'crm--choose-completion-string))) -(define-obsolete-function-alias 'crm-minibuffer-complete 'crm-complete "23.1") -(define-obsolete-function-alias - 'crm-minibuffer-completion-help 'crm-completion-help "23.1") -(define-obsolete-function-alias - 'crm-minibuffer-complete-and-exit 'crm-complete-and-exit "23.1") - ;; testing and debugging ;; (defun crm-init-test-environ () ;; "Set up some variables for testing." diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 3eafad177dd..6a11f1c3949 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -364,6 +364,7 @@ which more-or-less shadow%s %s's corresponding table%s." (defsubst derived-mode-setup-function-name (mode) "Construct a setup-function name based on a MODE name." + (declare (obsolete nil "28.1")) (intern (concat (symbol-name mode) "-setup"))) diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 6ba8b997f84..73dabef3fa5 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -29,16 +29,6 @@ ;;; Code: -(defvar easy-menu-precalculate-equivalent-keybindings nil - "Determine when equivalent key bindings are computed for easy-menu menus. -It can take some time to calculate the equivalent key bindings that are shown -in a menu. If the variable is on, then this calculation gives a (maybe -noticeable) delay when a mode is first entered. If the variable is off, then -this delay will come when a menu is displayed the first time. If you never use -menus, turn this variable off, otherwise it is probably better to keep it on.") -(make-obsolete-variable - 'easy-menu-precalculate-equivalent-keybindings nil "23.1") - (defsubst easy-menu-intern (s) (if (stringp s) (intern s) s)) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 764354b03b7..241eece05b6 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -515,7 +515,14 @@ Returns nil if they are." `(cdr ,cdr-x) (cl-assert (equal a b) t) nil)))))))) - ((pred arrayp) + ((pred cl-struct-p) + (cl-loop for slot in (cl-struct-slot-info (type-of a)) + for ai across a + for bi across b + for xf = (ert--explain-equal-rec ai bi) + do (when xf (cl-return `(struct-field ,(car slot) ,xf))) + finally (cl-assert (equal a b) t))) + ((or (pred arrayp) (pred recordp)) ;; For mixed unibyte/multibyte string comparisons, make both multibyte. (when (and (stringp a) (xor (multibyte-string-p a) (multibyte-string-p b))) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index efbcfb3a722..60b16257a3e 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -188,11 +188,7 @@ LIBRARY should be a string (the name of the library)." ((string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library) (setq library (replace-match "" t t library))) ((string-match "\\.eln\\'" library) - ;; From help-fns.el. - (setq library (expand-file-name (concat (file-name-base library) - ".el") - (concat (file-name-directory library) - ".."))))) + (setq library (gethash (file-name-nondirectory library) comp-eln-to-el-h)))) (or (locate-file library (or find-function-source-path load-path) @@ -300,12 +296,13 @@ if non-nil)." (find-library-suffixes) "\\|")) (table (cl-loop for dir in (or find-function-source-path load-path) - when (file-readable-p dir) + for dir-or-default = (or dir default-directory) + when (file-readable-p dir-or-default) append (mapcar (lambda (file) (replace-regexp-in-string suffix-regexp "" file)) - (directory-files dir nil + (directory-files dir-or-default nil suffix-regexp)))) (def (if (eq (function-called-at-point) 'require) ;; `function-called-at-point' may return 'require diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 1311d94cb01..584ed8c6f90 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -200,7 +200,9 @@ (save-excursion (ignore-errors (goto-char pos) - (or (eql (char-before) ?\') + ;; '(lambda ..) is not a funcall position, but #'(lambda ...) is. + (or (and (eql (char-before) ?\') + (not (eql (char-before (1- (point))) ?#))) (let* ((ppss (syntax-ppss)) (paren-posns (nth 9 ppss)) (parent @@ -785,8 +787,6 @@ or to switch back to an existing one." nil))) (comment-indent-default))) -(define-obsolete-function-alias 'lisp-mode-auto-fill 'do-auto-fill "23.1") - (defcustom lisp-indent-offset nil "If non-nil, indent second line of expressions that many more columns." :group 'lisp diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 88bb0a8bd6c..8d8d071031c 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -255,9 +255,9 @@ Left-fold the list L, starting with X, by the binary function F." x) (defun rx--normalise-or-arg (form) - "Normalise the `or' argument FORM. + "Normalize the `or' argument FORM. Characters become strings, user-definitions and `eval' forms are expanded, -and `or' forms are normalised recursively." +and `or' forms are normalized recursively." (cond ((characterp form) (char-to-string form)) ((and (consp form) (memq (car form) '(or |))) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 77f1b291043..dd7648c2b77 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -694,7 +694,7 @@ ARG is used as the prefix value for the executed command. If EVENTS is a list of events, which become the beginning of the command." (interactive "P") - (if (viper= (viper-last-command-char) ?\\) + (if (viper= last-command-event ?\\) (message "Switched to EMACS state for the next command...")) (viper-escape-to-state arg events 'emacs-state)) @@ -1149,7 +1149,7 @@ as a Meta key and any number of multiple escapes are allowed." "Begin numeric argument for the next command." (interactive "P") (viper-prefix-arg-value - (viper-last-command-char) (if (consp arg) (cdr arg) nil))) + last-command-event (if (consp arg) (cdr arg) nil))) (defun viper-command-argument (arg) "Accept a motion command as an argument." @@ -1157,7 +1157,7 @@ as a Meta key and any number of multiple escapes are allowed." (let ((viper-intermediate-command 'viper-command-argument)) (condition-case nil (viper-prefix-arg-com - (viper-last-command-char) + last-command-event (cond ((null arg) nil) ((consp arg) (car arg)) ((integerp arg) arg) @@ -1564,7 +1564,7 @@ invokes the command before that, etc." ;; Hook used in viper-undo (defun viper-after-change-undo-hook (beg end _len) - (if (and (boundp 'undo-in-progress) undo-in-progress) + (if undo-in-progress (setq undo-beg-posn beg undo-end-posn (or end beg)) ;; some other hooks may be changing various text properties in @@ -1598,9 +1598,9 @@ invokes the command before that, etc." (pos-visible-in-window-p before-undo-pt)) (progn (push-mark (point-marker) t) - (viper-sit-for-short 300) + (sit-for 0.3) (goto-char undo-end-posn) - (viper-sit-for-short 300) + (sit-for 0.3) (if (pos-visible-in-window-p undo-beg-posn) (goto-char before-undo-pt) (goto-char undo-beg-posn))) @@ -1886,15 +1886,11 @@ Undo previous insertion and inserts new." (or unread-command-events executing-kbd-macro (sit-for 840)) - (if (fboundp 'minibuffer-prompt-end) - (delete-region (minibuffer-prompt-end) (point-max)) - (erase-buffer)) + (delete-region (minibuffer-prompt-end) (point-max)) (insert viper-initial))) (defsubst viper-minibuffer-real-start () - (if (fboundp 'minibuffer-prompt-end) - (minibuffer-prompt-end) - (point-min))) + (minibuffer-prompt-end)) (defun viper-minibuffer-post-command-hook() (when (active-minibuffer-window) @@ -1908,7 +1904,7 @@ Undo previous insertion and inserts new." "Exit minibuffer Viper way." (interactive) (let (command) - (setq command (local-key-binding (char-to-string (viper-last-command-char)))) + (setq command (local-key-binding (char-to-string last-command-event))) (run-hooks 'viper-minibuffer-exit-hook) (if command (command-execute command) @@ -2883,7 +2879,7 @@ If point is on a widget or a button, simulate clicking on that widget/button." (and (consp widget) (get (widget-type widget) 'widget-type)))) (widget-button-press (point)) - (if (and (fboundp 'button-at) (fboundp 'push-button) (button-at (point))) + (if (button-at (point)) (push-button) ;; not a widget or a button (save-excursion @@ -4738,8 +4734,7 @@ Please, specify your level now: ")) (viper-color-display-p (if (viper-window-display-p) (viper-color-display-p) 'non-x)) - (viper-frame-parameters (if (fboundp 'frame-parameters) - (frame-parameters (selected-frame)))) + (viper-frame-parameters (frame-parameters (selected-frame))) (viper-minibuffer-emacs-face (if (viper-has-face-support-p) (facep viper-minibuffer-emacs-face) diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index 6ecfec548cb..928a3ef00ee 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -98,7 +98,7 @@ considered related." ;;; Code (defsubst viper-multiclick-p () - (not (viper-sit-for-short viper-multiclick-timeout t))) + (not (sit-for (/ viper-multiclick-timeout 1000.0) t))) ;; Returns window where click occurs (defun viper-mouse-click-window (click) diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 1561204151d..83e45e1cd0c 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -786,14 +786,11 @@ Otherwise return the normal value." (defun viper-check-minibuffer-overlay () (if (overlayp viper-minibuffer-overlay) (move-overlay - viper-minibuffer-overlay - (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) - (1+ (buffer-size))) + viper-minibuffer-overlay (minibuffer-prompt-end) (1+ (buffer-size))) (setq viper-minibuffer-overlay ;; make overlay open-ended (make-overlay - (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) - (1+ (buffer-size)) + (minibuffer-prompt-end) (1+ (buffer-size)) (current-buffer) nil 'rear-advance)))) @@ -808,9 +805,8 @@ Otherwise return the normal value." (define-obsolete-function-alias 'viper-abbreviate-file-name 'abbreviate-file-name "27.1") -;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg -;; in sit-for, so this function smooths out the differences. (defsubst viper-sit-for-short (val &optional nodisp) + (declare (obsolete nil "28.1")) (sit-for (/ val 1000.0) nodisp)) ;; EVENT may be a single event of a sequence of events @@ -868,11 +864,10 @@ Otherwise return the normal value." ;; Uses different timeouts for ESC-sequences and others (defun viper-fast-keysequence-p () - (not (viper-sit-for-short - (if (viper-ESC-event-p last-input-event) - (viper-ESC-keyseq-timeout) - viper-fast-keyseq-timeout) - t))) + (not (sit-for (/ (if (viper-ESC-event-p last-input-event) + (viper-ESC-keyseq-timeout) + viper-fast-keyseq-timeout) 1000.0) + t))) (define-obsolete-function-alias 'viper-read-event-convert-to-char 'read-event "27.1") @@ -920,6 +915,7 @@ Otherwise return the normal value." basis))) (defun viper-last-command-char () + (declare (obsolete nil "28.1")) last-command-event) (defun viper-key-to-emacs-key (key) diff --git a/lisp/epa.el b/lisp/epa.el index d190824293f..5140d3f0a69 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -666,10 +666,6 @@ If SECRET is non-nil, list secret keys instead of public keys." (goto-char (point-min))) (display-buffer buffer))))) -(defun epa-display-verify-result (verify-result) - (declare (obsolete epa-display-info "23.1")) - (epa-display-info (epg-verify-result-to-string verify-result))) - (defun epa-passphrase-callback-function (context key-id handback) (if (eq key-id 'SYM) (read-passwd diff --git a/lisp/epg.el b/lisp/epg.el index 96af3ad4bca..920b85398f3 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -190,6 +190,7 @@ (string nil :read-only t)) ;;;; Context Struct +(declare-function epa-passphrase-callback-function "epa.el") (cl-defstruct (epg-context (:constructor nil) @@ -215,7 +216,7 @@ cipher-algorithm digest-algorithm compress-algorithm - (passphrase-callback (list #'epg-passphrase-callback-function)) + (passphrase-callback (list #'epa-passphrase-callback-function)) progress-callback edit-callback signers @@ -1246,19 +1247,6 @@ callback data (if any)." ;;; Functions -(defun epg-passphrase-callback-function (context key-id _handback) - (declare (obsolete epa-passphrase-callback-function "23.1")) - (if (eq key-id 'SYM) - (read-passwd "Passphrase for symmetric encryption: " - (eq (epg-context-operation context) 'encrypt)) - (read-passwd - (if (eq key-id 'PIN) - "Passphrase for PIN: " - (let ((entry (assoc key-id epg-user-id-alist))) - (if entry - (format "Passphrase for %s %s: " key-id (cdr entry)) - (format "Passphrase for %s: " key-id))))))) - (defun epg--list-keys-1 (context name mode) (let ((args (append (if (epg-context-home-directory context) (list "--homedir" diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 4f3d85ba3c8..1cf0bb49217 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -98,7 +98,6 @@ ;;; Code: -(require 'erc-compat) (eval-when-compile (require 'cl-lib)) ;; There's a fairly strong mutual dependency between erc.el and erc-backend.el. ;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the @@ -782,7 +781,7 @@ value of `erc-server-coding-system'." (pop precedence)) (when precedence (setq coding (car precedence))))) - (erc-decode-coding-string str coding))) + (decode-coding-string str coding t))) ;; proposed name, not used by anything yet (defun erc-send-line (text display-fn) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index bf98eb818f3..477f148197b 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -419,7 +419,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." (pcomplete-here (pcase (intern (downcase (pcomplete-arg 1))) ('chat (mapcar (lambda (elt) (plist-get elt :nick)) - (erc-remove-if-not + (cl-remove-if-not #'(lambda (elt) (eq (plist-get elt :type) 'CHAT)) erc-dcc-list))) @@ -427,7 +427,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) erc-dcc-list))) ('get (mapcar #'erc-dcc-nick - (erc-remove-if-not + (cl-remove-if-not #'(lambda (elt) (eq (plist-get elt :type) 'GET)) erc-dcc-list))) @@ -435,7 +435,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." (pcomplete-here (pcase (intern (downcase (pcomplete-arg 2))) ('get (mapcar (lambda (elt) (plist-get elt :file)) - (erc-remove-if-not + (cl-remove-if-not #'(lambda (elt) (and (eq (plist-get elt :type) 'GET) (erc-nick-equal-p (erc-extract-nick @@ -443,7 +443,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." (pcomplete-arg 1)))) erc-dcc-list))) ('close (mapcar #'erc-dcc-nick - (erc-remove-if-not + (cl-remove-if-not #'(lambda (elt) (eq (plist-get elt :type) (intern (upcase (pcomplete-arg 1))))) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 39a8be5e0cf..d09caf7aa12 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -38,7 +38,7 @@ :group 'erc) ;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t) -(erc-define-minor-mode erc-fill-mode +(define-minor-mode erc-fill-mode "Toggle ERC fill mode. With a prefix argument ARG, enable ERC fill mode if ARG is positive, and disable it otherwise. If called from Lisp, enable diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index ff7a77f1265..a475f0a1770 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -399,8 +399,7 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." (start (match-beginning 0)) (end (+ (match-beginning 0) (length (match-string 5 s))))) - (setq s (erc-replace-match-subexpression-in-string - "" s control 1 start)) + (setq s (replace-match "" nil nil s 1)) (cond ((and erc-interpret-mirc-color (or fg-color bg-color)) (setq fg fg-color) (setq bg bg-color)) diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index e2c066da9b1..2166123e674 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -267,7 +267,7 @@ The current buffer is given by BUFFER." (with-current-buffer buffer (auto-save-mode -1) (setq buffer-file-name nil) - (erc-set-write-file-functions '(erc-save-buffer-in-logs)) + (set (make-local-variable 'write-file-functions) '(erc-save-buffer-in-logs)) (when erc-log-insert-log-on-open (ignore-errors (save-excursion diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 6e87a183fc1..b3145674f29 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -94,7 +94,9 @@ The following values are allowed: `nick-or-keyword' - highlight the nick of the user who typed your nickname, or all instances of the current nickname if there was no sending user - `all' - highlight the entire message where current nickname occurs + `message' - highlight the entire message where current nickname occurs + `all' - highlight the entire message (including the nick) where + current nickname occurs Any other value disables highlighting of current nickname altogether." :group 'erc-match @@ -102,6 +104,7 @@ Any other value disables highlighting of current nickname altogether." (const nick) (const keyword) (const nick-or-keyword) + (const message) (const all))) (defcustom erc-pal-highlight-type 'nick @@ -110,14 +113,17 @@ See `erc-pals'. The following values are allowed: - nil - do not highlight the message at all - `nick' - highlight pal's nickname only - `all' - highlight the entire message from pal + nil - do not highlight the message at all + `nick' - highlight pal's nickname only + `message' - highlight the entire message from pal + `all' - highlight the entire message (including the nick) + from pal Any other value disables pal highlighting altogether." :group 'erc-match :type '(choice (const nil) (const nick) + (const message) (const all))) (defcustom erc-fool-highlight-type 'nick @@ -126,14 +132,17 @@ See `erc-fools'. The following values are allowed: - nil - do not highlight the message at all - `nick' - highlight fool's nickname only - `all' - highlight the entire message from fool + nil - do not highlight the message at all + `nick' - highlight fool's nickname only + `message' - highlight the entire message from fool + `all' - highlight the entire message (including the nick) + from fool Any other value disables fool highlighting altogether." :group 'erc-match :type '(choice (const nil) (const nick) + (const message) (const all))) (defcustom erc-keyword-highlight-type 'keyword @@ -143,12 +152,15 @@ See variable `erc-keywords'. The following values are allowed: `keyword' - highlight keyword only - `all' - highlight the entire message containing keyword + `message' - highlight the entire message containing keyword + `all' - highlight the entire message (including the nick) + containing keyword Any other value disables keyword highlighting altogether." :group 'erc-match :type '(choice (const nil) (const keyword) + (const message) (const all))) (defcustom erc-dangerous-host-highlight-type 'nick @@ -157,13 +169,16 @@ See `erc-dangerous-hosts'. The following values are allowed: - `nick' - highlight nick from dangerous-host only - `all' - highlight the entire message from dangerous-host + `nick' - highlight nick from dangerous-host only + `message' - highlight the entire message from dangerous-host + `all' - highlight the entire message (including the nick) + from dangerous-host Any other value disables dangerous-host highlighting altogether." :group 'erc-match :type '(choice (const nil) (const nick) + (const message) (const all))) @@ -449,19 +464,18 @@ Use this defun with `erc-insert-modify-hook'." (match-beginning 0))) (nick-end (when nick-beg (match-end 0))) - (message (buffer-substring - (if (and nick-end - (<= (+ 2 nick-end) (point-max))) - ;; Message starts 2 characters after the nick - ;; except for CTCP ACTION messages. Nick - ;; surrounded by angle brackets only in normal - ;; messages. - (+ nick-end - (if (eq ?> (char-after nick-end)) - 2 - 1)) - (point-min)) - (point-max)))) + (message-beg (if (and nick-end + (<= (+ 2 nick-end) (point-max))) + ;; Message starts 2 characters after the + ;; nick except for CTCP ACTION messages. + ;; Nick surrounded by angle brackets only in + ;; normal messages. + (+ nick-end + (if (eq ?> (char-after nick-end)) + 2 + 1)) + (point-min))) + (message (buffer-substring message-beg (point-max)))) (when (and vector (not (and erc-match-exclude-server-buffer (erc-server-buffer-p)))) @@ -498,7 +512,12 @@ Use this defun with `erc-insert-modify-hook'." (while (re-search-forward match-regex nil t) (erc-put-text-property (match-beginning 0) (match-end 0) 'font-lock-face match-face)))) - ;; Highlight the whole message + ;; Highlight the whole message (not including the nick) + ((eq match-htype 'message) + (erc-put-text-property + message-beg (point-max) + 'font-lock-face match-face (current-buffer))) + ;; Highlight the whole message (including the nick) ((eq match-htype 'all) (erc-put-text-property (point-min) (point-max) diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index 1b092c8a6a9..144a981f832 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -181,7 +181,7 @@ nick from `erc-last-ison' to prevent any further notifications." (let ((nick (erc-extract-nick (erc-response.sender parsed)))) (when (and (erc-member-ignore-case nick erc-notify-list) (erc-member-ignore-case nick erc-last-ison)) - (setq erc-last-ison (erc-delete-if + (setq erc-last-ison (cl-delete-if (let ((nick-down (erc-downcase nick))) (lambda (el) (string= nick-down (erc-downcase el)))) diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index 7643fa85b96..f8b7e13be02 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -41,7 +41,6 @@ (require 'pcomplete) (require 'erc) -(require 'erc-compat) (require 'time-date) (defgroup erc-pcomplete nil diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index cbab2f9da2b..08970f2d70e 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -35,7 +35,6 @@ ;;; Code: (require 'erc) -(require 'erc-compat) (defgroup erc-stamp nil "For long conversation on IRC it is sometimes quite diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 41d8fc1a98f..3398c8b9d0c 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -36,7 +36,6 @@ (eval-when-compile (require 'cl-lib)) (require 'erc) -(require 'erc-compat) (require 'erc-match) ;;; Code: @@ -329,9 +328,8 @@ important." (defun erc-track-remove-from-mode-line () "Remove `erc-track-modified-channels' from the mode-line." - (when (boundp 'mode-line-modes) - (setq mode-line-modes - (remove '(t erc-modified-channels-object) mode-line-modes))) + (setq mode-line-modes + (remove '(t erc-modified-channels-object) mode-line-modes)) (when (consp global-mode-string) (setq global-mode-string (delq 'erc-modified-channels-object global-mode-string)))) @@ -341,12 +339,10 @@ important." See `erc-track-position-in-mode-line' for possible values." ;; CVS Emacs has a new format string, and global-mode-string ;; is very far to the right. - (cond ((and (eq position 'before-modes) - (boundp 'mode-line-modes)) + (cond ((eq position 'before-modes) (add-to-list 'mode-line-modes '(t erc-modified-channels-object))) - ((and (eq position 'after-modes) - (boundp 'mode-line-modes)) + ((eq position 'after-modes) (add-to-list 'mode-line-modes '(t erc-modified-channels-object) t)) ((eq position t) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 41d7516fbb4..8712113790b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -57,12 +57,12 @@ (load "erc-loaddefs" nil t) -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'font-lock) +(require 'format-spec) (require 'pp) (require 'thingatpt) (require 'auth-source) -(require 'erc-compat) (require 'time-date) (require 'iso8601) (eval-when-compile (require 'subr-x)) @@ -877,8 +877,8 @@ See `erc-server-flood-margin' for other flood-related parameters.") ;; Script parameters (defcustom erc-startup-file-list - (list (concat erc-user-emacs-directory ".ercrc.el") - (concat erc-user-emacs-directory ".ercrc") + (list (concat user-emacs-directory ".ercrc.el") + (concat user-emacs-directory ".ercrc") "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc") "List of files to try for a startup script. The first existent and readable one will get executed. @@ -1306,7 +1306,7 @@ Example: (enable (intern (format "erc-%s-enable" (downcase sn)))) (disable (intern (format "erc-%s-disable" (downcase sn))))) `(progn - (erc-define-minor-mode + (define-minor-mode ,mode ,(format "Toggle ERC %S mode. With a prefix argument ARG, enable %s if ARG is positive, @@ -1489,8 +1489,7 @@ Defaults to the server buffer." (define-derived-mode erc-mode fundamental-mode "ERC" "Major mode for Emacs IRC." (setq local-abbrev-table erc-mode-abbrev-table) - (when (boundp 'next-line-add-newlines) - (set (make-local-variable 'next-line-add-newlines) nil)) + (set (make-local-variable 'next-line-add-newlines) nil) (setq line-move-ignore-invisible t) (set (make-local-variable 'paragraph-separate) (concat "\C-l\\|\\(^" (regexp-quote (erc-prompt)) "\\)")) @@ -2688,7 +2687,7 @@ displayed hostnames." otherwise `erc-server-announced-name'. SERVER is matched against `erc-common-server-suffixes'." (when server - (or (cdar (erc-remove-if-not + (or (cdar (cl-remove-if-not (lambda (net) (string-match (car net) server)) erc-common-server-suffixes)) erc-server-announced-name))) @@ -3725,8 +3724,9 @@ the message given by REASON." x-toolkit-scroll-bars))) "") (if (featurep 'multi-tty) ", multi-tty" "")) - (if erc-emacs-build-time - (concat " of " erc-emacs-build-time) + (if emacs-build-time + (concat " of " (format-time-string + "%Y-%m-%d" emacs-build-time)) ""))) t) @@ -4573,7 +4573,7 @@ See also: `erc-echo-notice-in-user-buffers', ((string-match "^-" mode) ;; Remove the unbanned masks from the ban list (setq erc-channel-banlist - (erc-delete-if + (cl-delete-if #'(lambda (y) (member (upcase (cdr y)) (mapcar #'upcase @@ -4594,7 +4594,7 @@ See also: `erc-echo-notice-in-user-buffers', "Group LIST into sublists of length N." (cond ((null list) nil) ((null (nthcdr n list)) (list list)) - (t (cons (erc-subseq list 0 n) (erc-group-list (nthcdr n list) n))))) + (t (cons (cl-subseq list 0 n) (erc-group-list (nthcdr n list) n))))) ;;; MOTD numreplies @@ -6183,8 +6183,7 @@ non-nil value is found. output (apply #'format format-args)) ;; Change all "1 units" to "1 unit". (while (string-match "\\([^0-9]\\|^\\)1 \\S-+\\(s\\)" output) - (setq output (erc-replace-match-subexpression-in-string - "" output (match-string 2 output) 2 (match-beginning 2)))) + (setq output (replace-match "" nil nil output 2))) output)) diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el index bf5a4bf1afe..7991c631772 100644 --- a/lisp/eshell/em-rebind.el +++ b/lisp/eshell/em-rebind.el @@ -114,7 +114,6 @@ This is default behavior of shells like bash." backward-list forward-page backward-page - forward-point forward-paragraph backward-paragraph backward-prefix-chars diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 0aa4ec4d16c..b4154861908 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -382,12 +382,7 @@ it defaults to `insert'." "Set handle INDEX, using MODE, to point to TARGET." (when target (if (and (stringp target) - (or (cond - ((boundp 'null-device) - (string= target null-device)) - ((boundp 'grep-null-device) - (string= target grep-null-device)) - (t nil)) + (or (string= target null-device) (string= target "/dev/null"))) (aset eshell-current-handles index nil) (let ((where (eshell-get-target target mode)) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index d0147b345aa..8799007c596 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -690,46 +690,47 @@ newline." "Send the output from PROCESS (STRING) to the interactive display. This is done after all necessary filtering has been done." (let ((oprocbuf (if process (process-buffer process) - (current-buffer))) - (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t)) - (let ((functions eshell-preoutput-filter-functions)) - (while (and functions string) - (setq string (funcall (car functions) string)) - (setq functions (cdr functions)))) - (if (and string oprocbuf (buffer-name oprocbuf)) - (let (opoint obeg oend) - (with-current-buffer oprocbuf - (setq opoint (point)) - (setq obeg (point-min)) - (setq oend (point-max)) - (let ((buffer-read-only nil) - (nchars (length string)) - (ostart nil)) - (widen) - (goto-char eshell-last-output-end) - (setq ostart (point)) - (if (<= (point) opoint) - (setq opoint (+ opoint nchars))) - (if (< (point) obeg) - (setq obeg (+ obeg nchars))) - (if (<= (point) oend) - (setq oend (+ oend nchars))) + (current-buffer))) + (inhibit-point-motion-hooks t) + (inhibit-modification-hooks t)) + (when (and string oprocbuf (buffer-name oprocbuf)) + (with-current-buffer oprocbuf + (let ((functions eshell-preoutput-filter-functions)) + (while (and functions string) + (setq string (funcall (car functions) string)) + (setq functions (cdr functions)))) + (when string + (let (opoint obeg oend) + (setq opoint (point)) + (setq obeg (point-min)) + (setq oend (point-max)) + (let ((buffer-read-only nil) + (nchars (length string)) + (ostart nil)) + (widen) + (goto-char eshell-last-output-end) + (setq ostart (point)) + (if (<= (point) opoint) + (setq opoint (+ opoint nchars))) + (if (< (point) obeg) + (setq obeg (+ obeg nchars))) + (if (<= (point) oend) + (setq oend (+ oend nchars))) ;; Let the ansi-color overlay hooks run. (let ((inhibit-modification-hooks nil)) (insert-before-markers string)) - (if (= (window-start) (point)) - (set-window-start (selected-window) - (- (point) nchars))) - (if (= (point) eshell-last-input-end) - (set-marker eshell-last-input-end - (- eshell-last-input-end nchars))) - (set-marker eshell-last-output-start ostart) - (set-marker eshell-last-output-end (point)) - (force-mode-line-update)) - (narrow-to-region obeg oend) - (goto-char opoint) - (eshell-run-output-filters)))))) + (if (= (window-start) (point)) + (set-window-start (selected-window) + (- (point) nchars))) + (if (= (point) eshell-last-input-end) + (set-marker eshell-last-input-end + (- eshell-last-input-end nchars))) + (set-marker eshell-last-output-start ostart) + (set-marker eshell-last-output-end (point)) + (force-mode-line-update)) + (narrow-to-region obeg oend) + (goto-char opoint) + (eshell-run-output-filters))))))) (defun eshell-run-output-filters () "Run the `eshell-output-filter-functions' on the current output." diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index 5ffb159b575..6698ca45de4 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -384,15 +384,6 @@ corresponding to a successful execution." (set status-var eshell-last-command-status)) (cadr result)))))) -;;;_* Reporting bugs -;; -;; If you do encounter a bug, on any system, please report -;; it -- in addition to any particular oddities in your configuration -;; -- so that the problem may be corrected for the benefit of others. - -;;;###autoload -(define-obsolete-function-alias 'eshell-report-bug 'report-emacs-bug "23.1") - ;;; Code: (defun eshell-unload-all-modules () diff --git a/lisp/ffap.el b/lisp/ffap.el index ceba9d26223..28f566dd93a 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1109,6 +1109,121 @@ The arguments CHARS, BEG and END are handled as described in ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95. "Last string returned by the function `ffap-string-at-point'.") +(defcustom ffap-file-name-with-spaces nil + "If non-nil, enable looking for paths with spaces in `ffap-string-at-point'. +Enabling this variable may lead to `find-file-at-point' guessing +wrong more often when trying to find a file name intermingled +with normal text, but can be useful when working on systems that +normally use spaces in file names (like Microsoft Windows and the +like)." + :type 'boolean + :version "28.1") + +(defun ffap-search-backward-file-end (&optional dir-separator end) + "Search backward position point where file would probably end. +Optional DIR-SEPARATOR defaults to \"/\". The search maximum is +`line-end-position' or optional END point. + +Suppose the cursor is somewhere that might be near end of file, +the guessing would position point before punctuation (like comma) +after the file extension: + + C:\temp\file.log, which contain .... + =============================== (before) + ---------------- (after) + + + C:\temp\file.log on Windows or /tmp/file.log on Unix + =============================== (before) + ---------------- (after) + +The strategy is to search backward until DIR-SEPARATOR which defaults to +\"/\" and then take educated guesses. + +Move point and return point if an adjustment was done." + (unless dir-separator + (setq dir-separator "/")) + (let ((opoint (point)) + point punct end whitespace-p) + (when (re-search-backward + (regexp-quote dir-separator) (line-beginning-position) t) + ;; Move to the beginning of the match.. + (forward-char 1) + ;; ... until typical punctuation. + (when (re-search-forward "\\([][<>()\"'`,.:;]\\)" + (or end + (line-end-position)) + t) + (setq end (match-end 0)) + (setq punct (match-string 1)) + (setq whitespace-p (looking-at "[ \t\r\n]\\|$")) + (goto-char end) + (cond + ((and (string-equal punct ".") + whitespace-p) ;end of sentence + (setq point (1- (point)))) + ((and (string-equal punct ".") + (looking-at "[a-zA-Z0-9.]+")) ;possibly file extension + (setq point (match-end 0))) + (t + (setq point (point))))) + (goto-char opoint) + (when point + (goto-char point) + point)))) + +(defun ffap-search-forward-file-end (&optional dir-separator) + "Search DIR-SEPARATOR and position point at file's maximum ending. +This includes spaces. +Optional DIR-SEPARATOR defaults to \"/\". +Call `ffap-search-backward-file-end' to refine the ending point." + (unless dir-separator + (setq dir-separator "/")) + (let* ((chars ;expected chars in file name + (concat "[^][^<>()\"'`;,#*|" + ;; exclude the opposite as we know the separator + (if (string-equal dir-separator "/") + "\\\\" + "/") + "\t\r\n]")) + (re (concat + chars "*" + (if dir-separator + (regexp-quote dir-separator) + "/") + chars "*"))) + (when (looking-at re) + (goto-char (match-end 0))))) + +(defun ffap-dir-separator-near-point () + "Search backward and forward for closest slash or backlash in line. +Return string slash or backslash. Point is moved to closest position." + (let ((point (point)) + str pos) + (when (looking-at ".*?/") + (setq str "/" + pos (match-end 0))) + (when (and (looking-at ".*?\\\\") + (or (null pos) + (< (match-end 0) pos))) + (setq str "\\" + pos (match-end 0))) + (goto-char point) + (when (and (re-search-backward "/" (line-beginning-position) t) + (or (null pos) + (< (- point (point)) (- pos point)))) + (setq str "/" + pos (1+ (point)))) ;1+ to keep cursor at the end of char + (goto-char point) + (when (and (re-search-backward "\\\\" (line-beginning-position) t) + (or (null pos) + (< (- point (point)) (- pos point)))) + (setq str "\\" + pos (1+ (point)))) + (when pos + (goto-char pos)) + str)) + (defun ffap-string-at-point (&optional mode) "Return a string of characters from around point. @@ -1128,7 +1243,8 @@ Set the variables `ffap-string-at-point' and When the region is active and larger than `ffap-max-region-length', return an empty string, and set `ffap-string-at-point-region' to '(1 1)." - (let* ((args + (let* (dir-separator + (args (cdr (or (assq (or mode major-mode) ffap-string-at-point-mode-alist) (assq 'file ffap-string-at-point-mode-alist)))) @@ -1137,14 +1253,25 @@ return an empty string, and set `ffap-string-at-point-region' to '(1 1)." (beg (if region-selected (region-beginning) (save-excursion - (skip-chars-backward (car args)) - (skip-chars-forward (nth 1 args) pt) + (if (and ffap-file-name-with-spaces + (memq mode '(nil file))) + (when (setq dir-separator (ffap-dir-separator-near-point)) + (while (re-search-backward + (regexp-quote dir-separator) + (line-beginning-position) t) + (goto-char (match-beginning 0)))) + (skip-chars-backward (car args)) + (skip-chars-forward (nth 1 args) pt)) (point)))) (end (if region-selected (region-end) (save-excursion (skip-chars-forward (car args)) (skip-chars-backward (nth 2 args) pt) + (when (and ffap-file-name-with-spaces + (memq mode '(nil file))) + (ffap-search-forward-file-end dir-separator) + (ffap-search-backward-file-end dir-separator)) (point)))) (region-len (- (max beg end) (min beg end)))) @@ -1825,12 +1952,6 @@ Only intended for interactive use." (defalias 'find-file-literally-at-point 'ffap-literally) -;;; Bug Reporter: - -(define-obsolete-function-alias 'ffap-bug 'report-emacs-bug "23.1") -(define-obsolete-function-alias 'ffap-submit-bug 'report-emacs-bug "23.1") - - ;;; Hooks for Gnus, VM, Rmail: ;; ;; If you do not like these bindings, write versions with whatever diff --git a/lisp/files.el b/lisp/files.el index 9270f334afa..975f78e8527 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -926,7 +926,10 @@ one or more of those symbols." (logior (if (memq 'executable predicate) 1 0) (if (memq 'writable predicate) 2 0) (if (memq 'readable predicate) 4 0)))) - (locate-file-internal filename path suffixes predicate)) + (let ((file (locate-file-internal filename path suffixes predicate))) + (if (and file (string-match "\\.eln\\'" file)) + (gethash (file-name-nondirectory file) comp-eln-to-el-h) + file))) (defun locate-file-completion-table (dirs suffixes string pred action) "Do completion for file names passed to `locate-file'." @@ -985,14 +988,6 @@ one or more of those symbols." (completion-table-with-context string-dir names string-file pred action))))) -(defun locate-file-completion (string path-and-suffixes action) - "Do completion for file names passed to `locate-file'. -PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." - (declare (obsolete locate-file-completion-table "23.1")) - (locate-file-completion-table (car path-and-suffixes) - (cdr path-and-suffixes) - string nil action)) - (defvar locate-dominating-stop-dir-regexp (purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'") "Regexp of directory names that stop the search in `locate-dominating-file'. diff --git a/lisp/forms.el b/lisp/forms.el index fcb6075f94b..83daabdcd6e 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -504,12 +504,9 @@ Commands: Equivalent keys in read-only mode: (setq forms-new-record-filter nil) (setq forms-modified-record-filter nil) - ;; If running Emacs 19 under X, setup faces to show read-only and - ;; read-write fields. - (if (fboundp 'make-face) - (progn - (make-local-variable 'forms-ro-face) - (make-local-variable 'forms-rw-face))) + ;; Setup faces to show read-only and read-write fields. + (make-local-variable 'forms-ro-face) + (make-local-variable 'forms-rw-face) ;; eval the buffer, should set variables ;;(message "forms: processing control file...") @@ -609,16 +606,14 @@ Commands: Equivalent keys in read-only mode: (setq forms--mode-setup t) ;; Copy desired faces to the actual variables used by the forms formatter. - (if (fboundp 'make-face) + (make-local-variable 'forms--ro-face) + (make-local-variable 'forms--rw-face) + (if forms-read-only (progn - (make-local-variable 'forms--ro-face) - (make-local-variable 'forms--rw-face) - (if forms-read-only - (progn - (setq forms--ro-face forms-ro-face) - (setq forms--rw-face forms-ro-face)) - (setq forms--ro-face forms-ro-face) - (setq forms--rw-face forms-rw-face)))) + (setq forms--ro-face forms-ro-face) + (setq forms--rw-face forms-ro-face)) + (setq forms--ro-face forms-ro-face) + (setq forms--rw-face forms-rw-face)) ;; Make more local variables. (make-local-variable 'forms--file-buffer) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 4363860eac8..c53f81fe026 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1913,7 +1913,8 @@ increase the score of each group you read." "," gnus-summary-best-unread-article "[" gnus-summary-prev-unseen-article "]" gnus-summary-next-unseen-article - "\M-s" gnus-summary-search-article-forward + "\M-s\M-s" gnus-summary-search-article-forward + "\M-s\M-r" gnus-summary-search-article-backward "\M-r" gnus-summary-search-article-backward "\M-S" gnus-summary-repeat-search-article-forward "\M-R" gnus-summary-repeat-search-article-backward diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index ab625be9e37..07ff4890385 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2751,16 +2751,17 @@ OpenPGP header will be left out. If all the values are nil, or `message-openpgp-header' is itself nil, the OpenPGP header will not be inserted." :type '(choice - (const nil :tag "Don't add OpenPGP header") - (list (choice (string :tag "ID") - (const nil :tag "No ID")) + (const :tag "Don't add OpenPGP header" nil) + (list :tag "Use OpenPGP header" + (choice (string :tag "ID") + (const :tag "No ID" nil)) (choice (string :tag "Key") - (const nil :tag "No Key")) - (choice (other nil :tag "None") - (const "unprotected" :tag "Unprotected") - (const "sign" :tag "Sign") - (const "encrypt" :tag "Encrypt") - (const "signencrypt" :tag "Sign and Encrypt")))) + (const :tag "No Key" nil)) + (choice (other :tag "None" nil) + (const :tag "Unprotected" "unprotected") + (const :tag "Sign" "sign") + (const :tag "Encrypt" "encrypt") + (const :tag "Sign and Encrypt" "signencrypt")))) :version "28.1") (defun message-add-openpgp-header () @@ -2768,32 +2769,34 @@ will not be inserted." Header will be constructed as specified in `message-openpgp-header'. -Consider adding this function to `message-send-hook'." +Consider adding this function to `message-header-setup-hook'" ;; See https://tools.ietf.org/html/draft-josefsson-openpgp-mailnews-header (when (and message-openpgp-header (or (nth 0 message-openpgp-header) (nth 1 message-openpgp-header) (nth 2 message-openpgp-header))) - (with-temp-buffer - (insert "OpenPGP: ") - ;; add ID - (let (need-sep) - (when (nth 0 message-openpgp-header) - (insert "id=" (nth 0 message-openpgp-header)) - (setq need-sep t)) - ;; add URL - (when (nth 1 message-openpgp-header) - (when need-sep (insert "; ")) - (if (string-match-p ";") - (insert "url=\"" (nth 1 message-openpgp-header) "\"") - (insert "url=\"" (nth 1 message-openpgp-header) "\"")) - (setq need-sep t)) - ;; add preference - (when (nth 2 message-openpgp-header) - (when need-sep (insert "; ")) - (insert "preference=" (nth 2 message-openpgp-header)))) - ;; insert header - (message-add-header (buffer-string))))) + (message-add-header + (with-temp-buffer + (insert "OpenPGP: ") + ;; add ID + (let (need-sep) + (when (nth 0 message-openpgp-header) + (insert "id=" (nth 0 message-openpgp-header)) + (setq need-sep t)) + ;; add URL + (when (nth 1 message-openpgp-header) + (when need-sep (insert "; ")) + (if (string-match-p ";") + (insert "url=\"" (nth 1 message-openpgp-header) "\"") + (insert "url=\"" (nth 1 message-openpgp-header) "\"")) + (setq need-sep t)) + ;; add preference + (when (nth 2 message-openpgp-header) + (when need-sep (insert "; ")) + (insert "preference=" (nth 2 message-openpgp-header)))) + ;; insert header + (buffer-string))) + (message-sort-headers))) diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 4754f37a2da..acddb300339 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -329,7 +329,6 @@ Whether the passphrase is cached at all is controlled by (autoload 'epg-verify-string "epg") (autoload 'epg-sign-string "epg") (autoload 'epg-encrypt-string "epg") - (autoload 'epg-passphrase-callback-function "epg") (autoload 'epg-context-set-passphrase-callback "epg") (autoload 'epg-sub-key-fingerprint "epg") (autoload 'epg-configuration "epg-config") diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 8be1b84e52f..88864ea3579 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -242,7 +242,6 @@ Whether the passphrase is cached at all is controlled by (defvar epg-user-id-alist) (autoload 'epg-make-context "epg") -(autoload 'epg-passphrase-callback-function "epg") (autoload 'epa-select-keys "epa") (autoload 'epg-list-keys "epg") (autoload 'epg-context-set-armor "epg") diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index d1d150ad2ee..45c9bbfe905 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -712,7 +712,6 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (autoload 'epg-verify-string "epg") (autoload 'epg-sign-string "epg") (autoload 'epg-encrypt-string "epg") -(autoload 'epg-passphrase-callback-function "epg") (autoload 'epg-context-set-passphrase-callback "epg") (autoload 'epg-key-sub-key-list "epg") (autoload 'epg-sub-key-capability "epg") diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el index d41f32801ee..5504a520783 100644 --- a/lisp/gnus/smiley.el +++ b/lisp/gnus/smiley.el @@ -56,14 +56,11 @@ (defvar smiley-data-directory) -(defcustom smiley-style - (if (and (fboundp 'face-attribute) - ;; In batch mode, attributes can be unspecified. - (condition-case nil - (>= (face-attribute 'default :height) 160) - (error nil))) - 'medium - 'low-color) +;; In batch mode, attributes can be unspecified. +(defcustom smiley-style (if (ignore-errors + (>= (face-attribute 'default :height) 160)) + 'medium + 'low-color) "Smiley style." :type '(choice (const :tag "small, 3 colors" low-color) ;; 13x14 (const :tag "medium, ~10 colors" medium) ;; 16x16 diff --git a/lisp/help-fns.el b/lisp/help-fns.el index afca2cd932e..49cdb4ed5e4 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -333,10 +333,8 @@ suitable file is found, return nil." object (or (if (symbolp type) type) 'defun)))) (file-name (if (and true-name (string-match "[.]eln\\'" true-name)) - (expand-file-name (concat (file-name-base true-name) - ".el") - (concat (file-name-directory true-name) - "..")) + (gethash (file-name-nondirectory true-name) + comp-eln-to-el-h) true-name))) (cond (autoloaded diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 33ca40f8dec..0ffe77d2763 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -237,17 +237,11 @@ Instead, each hi-lock command will cycle through the faces in "Human-readable lighters for `hi-lock-interactive-patterns'.") (put 'hi-lock-interactive-lighters 'permanent-local t) -(define-obsolete-variable-alias 'hi-lock-face-history - 'hi-lock-face-defaults "23.1") (defvar hi-lock-face-defaults '("hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-salmon" "hi-aquamarine" "hi-black-b" "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb") "Default faces for hi-lock interactive functions.") -(define-obsolete-variable-alias 'hi-lock-regexp-history - 'regexp-history - "23.1") - (defvar hi-lock-file-patterns-prefix "Hi-lock" "String used to identify hi-lock patterns at the start of files.") diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index 04a5ccd8d59..ae97bb008af 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -224,9 +224,6 @@ colors then use this, if you want fancier faces then set ;; When you invoke highlight-changes-mode, should highlight-changes-visible-mode ;; be on or off? -(define-obsolete-variable-alias 'highlight-changes-initial-state - 'highlight-changes-visibility-initial-state "23.1") - (defcustom highlight-changes-visibility-initial-state t "Controls whether changes are initially visible in Highlight Changes mode. @@ -236,13 +233,7 @@ When a buffer is in Highlight Changes mode the function :type 'boolean :group 'highlight-changes) -;; highlight-changes-global-initial-state has been removed - - - ;; These are the strings displayed in the mode-line for the minor mode: -(define-obsolete-variable-alias 'highlight-changes-active-string - 'highlight-changes-visible-string "23.1") (defcustom highlight-changes-visible-string " +Chg" "The string used when in Highlight Changes mode and changes are visible. @@ -252,9 +243,6 @@ a string with a leading space." (const :tag "None" nil)) :group 'highlight-changes) -(define-obsolete-variable-alias 'highlight-changes-passive-string - 'highlight-changes-invisible-string "23.1") - (defcustom highlight-changes-invisible-string " -Chg" "The string used when in Highlight Changes mode and changes are hidden. This should be set to nil if no indication is desired, or to @@ -957,10 +945,6 @@ changes are made, so \\[highlight-changes-next-change] and (define-globalized-minor-mode global-highlight-changes-mode highlight-changes-mode highlight-changes-mode-turn-on) -(define-obsolete-function-alias - 'global-highlight-changes - 'global-highlight-changes-mode "23.1") - (defun highlight-changes-mode-turn-on () "See if Highlight Changes mode should be turned on for this buffer. This is called when `global-highlight-changes-mode' is turned on." diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 6265537e885..4d653972c95 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -556,10 +556,7 @@ If a window system is unavailable, calls `hfy-fallback-color-values'." '(1 2 3)) ;;(message ">> %s" color) (if window-system - (if (fboundp 'color-values) - (color-values color) - ;;(message "[%S]" window-system) - (x-color-values color)) + (color-values color) ;; blarg - tty colors are no good - go fetch some X colors: (hfy-fallback-color-values color)))) (define-obsolete-function-alias 'hfy-colour-vals #'hfy-color-vals "27.1") diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 3747ae3d281..8a68df876c1 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -75,7 +75,11 @@ everything preceding the ~/ is discarded so the interactive selection process starts again from the user's $HOME.") (defcustom icomplete-show-matches-on-no-input nil - "When non-nil, show completions when first prompting for input." + "When non-nil, show completions when first prompting for input. +This also means that if you traverse the list of completions with +commands like `C-.' and just hit `C-j' (enter) without typing any +characters, the match under point will be chosen instead of the +default." :type 'boolean :version "24.4") @@ -709,7 +713,10 @@ matches exist." (push comp prospects) (setq limit t)))) (setq prospects (nreverse prospects)) - ;; Decorate first of the prospects. + ;; Return the first match if the user hits enter. + (when icomplete-show-matches-on-no-input + (setq completion-content-when-empty (car prospects))) + ;; Decorate first of the prospects. (when prospects (let ((first (copy-sequence (pop prospects)))) (put-text-property 0 (length first) diff --git a/lisp/ido.el b/lisp/ido.el index e834916a6da..c83b700e656 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1523,8 +1523,10 @@ Removes badly formatted data and ignored directories." (remove-function read-file-name-function #'ido-read-file-name) (remove-function read-buffer-function #'ido-read-buffer) (when ido-everywhere - (add-function :override read-file-name-function #'ido-read-file-name) - (add-function :override read-buffer-function #'ido-read-buffer))) + (if (not ido-mode) + (ido-mode 'both) + (add-function :override read-file-name-function #'ido-read-file-name) + (add-function :override read-buffer-function #'ido-read-buffer)))) (defvar ido-minor-mode-map-entry nil) @@ -2216,7 +2218,10 @@ If cursor is not at the end of the user input, move to end of input." ((and ido-enable-virtual-buffers ido-virtual-buffers (setq filename (assoc buf ido-virtual-buffers))) - (ido-visit-buffer (find-file-noselect (cdr filename)) method t)) + (if (eq method 'kill) + (setq recentf-list + (delete (cdr filename) recentf-list)) + (ido-visit-buffer (find-file-noselect (cdr filename)) method t))) ((and (eq ido-create-new-buffer 'prompt) (null require-match) @@ -4073,6 +4078,7 @@ Record command in `command-history' if optional RECORD is non-nil." (setq buffer (buffer-name buffer))) (let (win newframe) (cond + ;; "Killing" of virtual buffers is handled in `ido-buffer-internal'. ((eq method 'kill) (if record (ido-record-command 'kill-buffer buffer)) diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el index d1091e57cb5..3543be6de91 100644 --- a/lisp/image/gravatar.el +++ b/lisp/image/gravatar.el @@ -39,6 +39,7 @@ "Whether to cache retrieved gravatars." :type 'boolean :group 'gravatar) +(make-obsolete-variable 'gravatar-automatic-caching nil "28.1") (defcustom gravatar-cache-ttl 2592000 "Time to live in seconds for gravatar cache entries. @@ -48,6 +49,7 @@ is retrieved anew. The default value is 30 days." ;; Restricted :type to number of seconds. :version "27.1" :group 'gravatar) +(make-obsolete-variable 'gravatar-cache-ttl nil "28.1") (defcustom gravatar-rating "g" "Most explicit Gravatar rating level to allow. @@ -156,18 +158,58 @@ to track whether you're reading a specific mail." (setq func (lambda (result) (cond - (result - (funcall callback (format "%s://%s/avatar" - (cdar records) result))) - ((> (length records) 1) - (pop records) + ((and + result ;there is a result + (let* ((data (mapcar (lambda (record) + (dns-get 'data (cdr record))) + (dns-get 'answers result))) + (priorities (mapcar (lambda (r) + (dns-get 'priority r)) + data)) + (max-priority (if priorities + (apply #'max priorities) + 0)) + (sum 0) top) + ;; Attempt to find all records with the same maximal + ;; priority, and calculate the sum of their weights. + (dolist (ent data) + (when (= max-priority (dns-get 'priority ent)) + (setq sum (+ sum (dns-get 'weight ent))) + (push ent top))) + ;; In case there is more than one maximal priority + ;; record, choose one at random, while taking the + ;; individual record weights into consideration. + (catch 'done + (dolist (ent top) + (when (and (or (= 0 sum) + (<= 0 (random sum) + (dns-get 'weight ent))) + ;; Ensure that port and domain data are + ;; valid. In case non of the results + ;; were valid, `catch' will evaluate to + ;; nil, and the next cond clause will be + ;; tested. + (<= 1 (dns-get 'port ent) 65535) + (string-match-p "\\`[-.0-9A-Za-z]+\\'" + (dns-get 'target ent))) + (funcall callback + (url-normalize-url + (format "%s://%s:%s/avatar" + (cdar records) + (dns-get 'target ent) + (dns-get 'port ent)))) + (throw 'done t)) + (setq sum (- sum (dns-get 'weight ent)))))))) + ((setq records (cdr records)) + ;; In case there are at least two methods. (dns-query-asynchronous (concat (caar records) "._tcp." domain) func 'SRV)) - (t + (t ;fallback (funcall callback "https://seccdn.libravatar.org/avatar"))))) (dns-query-asynchronous - (concat (caar records) "._tcp." domain) func 'SRV))))) + (concat (caar records) "._tcp." domain) + func 'SRV t))))) (defun gravatar-hash (mail-address) "Return the Gravatar hash for MAIL-ADDRESS." @@ -206,19 +248,50 @@ to track whether you're reading a specific mail." (search-forward "\n\n" nil t) (buffer-substring (point) (point-max))))) +(defvar gravatar--cache (make-hash-table :test 'equal) + "Cache for gravatars.") + ;;;###autoload (defun gravatar-retrieve (mail-address callback &optional cbargs) "Asynchronously retrieve a gravatar for MAIL-ADDRESS. When finished, call CALLBACK as (apply CALLBACK GRAVATAR CBARGS), where GRAVATAR is either an image descriptor, or the symbol `error' if the retrieval failed." - (gravatar-build-url - mail-address - (lambda (url) - (if (url-cache-expired url gravatar-cache-ttl) - (url-retrieve url #'gravatar-retrieved (list callback cbargs) t) - (with-current-buffer (url-fetch-from-cache url) - (gravatar-retrieved () callback cbargs)))))) + (let ((cached (gethash mail-address gravatar--cache))) + (gravatar--prune-cache) + (if cached + (apply callback (cdr cached) cbargs) + ;; Nothing in the cache, fetch it. + (gravatar-build-url + mail-address + (lambda (url) + (url-retrieve + url + (lambda (status) + (let* ((data (and (not (plist-get status :error)) + (gravatar-get-data))) + (image (and data (create-image data nil t)))) + ;; Store the image in the cache. + (when image + (setf (gethash mail-address gravatar--cache) + (cons (time-convert (current-time) 'integer) + image))) + (prog1 + (apply callback (if data image 'error) cbargs) + (kill-buffer)))) + nil t)))))) + +(defun gravatar--prune-cache () + (let ((expired nil) + (time (- (time-convert (current-time) 'integer) + ;; Twelve hours. + (* 12 60 60)))) + (maphash (lambda (key val) + (when (< (car val) time) + (push key expired))) + gravatar--cache) + (dolist (key expired) + (remhash key gravatar--cache)))) ;;;###autoload (defun gravatar-retrieve-synchronously (mail-address) @@ -229,10 +302,8 @@ retrieval failed." (gravatar-build-url mail-address (lambda (u) (setq url u))) (while (not url) (sleep-for 0.01)) - (with-current-buffer (if (url-cache-expired url gravatar-cache-ttl) - (url-retrieve-synchronously url t) - (url-fetch-from-cache url)) - (gravatar-retrieved () #'identity)))) + (with-current-buffer (url-retrieve-synchronously url t) + (gravatar-retrieved nil #'identity)))) (defun gravatar-retrieved (status cb &optional cbargs) "Handle Gravatar response data in current buffer. @@ -241,10 +312,6 @@ an image descriptor, or the symbol `error' on failure. This function is intended as a callback for `url-retrieve'." (let ((data (unless (plist-get status :error) (gravatar-get-data)))) - (and data ; Only cache on success. - url-current-object ; Only cache if not already cached. - gravatar-automatic-caching - (url-store-in-cache)) (prog1 (apply cb (if data (create-image data nil t) 'error) cbargs) (kill-buffer)))) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 7714a778fcb..5fe931dd9bb 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2968,11 +2968,6 @@ on encoding." ;; Doc said "obsolete" in 23.1, this statement only added in 24.1. (make-obsolete 'unify-8859-on-decoding-mode "don't use it." "23.1") -(defvar nonascii-insert-offset 0) -(make-obsolete-variable 'nonascii-insert-offset "do not use it." "23.1") -(defvar nonascii-translation-table nil) -(make-obsolete-variable 'nonascii-translation-table "do not use it." "23.1") - (defvar ucs-names nil "Hash table of cached CHAR-NAME keys to CHAR-CODE values.") diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 80e78ef7877..b13bde58ca1 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -200,10 +200,6 @@ Character sets for defining other charsets, or for backward compatibility ;;; (charset-iso-graphic-plane charset) (charset-description charset))))) -(defvar non-iso-charset-alist nil - "Obsolete.") -(make-obsolete-variable 'non-iso-charset-alist "no longer relevant." "23.1") - ;; A variable to hold charset input history. (defvar charset-history nil) diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index 5cc10b1315a..660ac58e022 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -275,15 +275,6 @@ operations such as `find-coding-systems-region'." (put 'with-coding-priority 'edebug-form-spec t) ;;;###autoload -(defmacro detect-coding-with-priority (from to priority-list) - "Detect a coding system of the text between FROM and TO with PRIORITY-LIST. -PRIORITY-LIST is an alist of coding categories vs the corresponding -coding systems ordered by priority." - (declare (obsolete with-coding-priority "23.1")) - `(with-coding-priority (mapcar #'cdr ,priority-list) - (detect-coding-region ,from ,to))) - -;;;###autoload (defun detect-coding-with-language-environment (from to lang-env) "Detect a coding system for the text between FROM and TO with LANG-ENV. The detection takes into account the coding system priorities for the diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 5fb04bc464f..958fc0d3101 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -409,16 +409,6 @@ PLIST (property list) may contain any type of information a user ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. -(defun charset-id (_charset) - "Always return 0. This is provided for backward compatibility." - (declare (obsolete nil "23.1")) - 0) - -(defmacro charset-bytes (_charset) - "Always return 0. This is provided for backward compatibility." - (declare (obsolete nil "23.1")) - 0) - (defun get-charset-property (charset propname) "Return the value of CHARSET's PROPNAME property. This is the last value stored with @@ -464,19 +454,8 @@ Return -1 if charset isn't an ISO 2022 one." "Return long name of CHARSET." (plist-get (charset-plist charset) :long-name)) -(defun charset-list () - "Return list of all charsets ever defined." - (declare (obsolete charset-list "23.1")) - charset-list) - ;;; CHARACTER -(define-obsolete-function-alias 'char-valid-p 'characterp "23.1") - -(defun generic-char-p (_char) - "Always return nil. This is provided for backward compatibility." - (declare (obsolete nil "23.1")) - nil) (defun make-char-internal (charset-id &optional code1 code2) (let ((charset (aref emacs-mule-charset-table charset-id))) @@ -1086,14 +1065,11 @@ formats (e.g. iso-latin-1-unix, koi8-r-dos)." (setq codings (cons alias codings)))))) codings)) -(defconst char-coding-system-table nil - "It exists just for backward compatibility, and the value is always nil.") -(make-obsolete-variable 'char-coding-system-table nil "23.1") - (defun transform-make-coding-system-args (name type &optional doc-string props) "For internal use only. Transform XEmacs style args for `make-coding-system' to Emacs style. Value is a list of transformed arguments." + (declare (obsolete nil "28.1")) (let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?"))) (eol-type (plist-get props 'eol-type)) properties tmp) @@ -1171,106 +1147,6 @@ Value is a list of transformed arguments." (error "unsupported XEmacs style make-coding-style arguments: %S" `(,name ,type ,doc-string ,props)))))) -(defun make-coding-system (coding-system type mnemonic doc-string - &optional - flags - properties - eol-type) - "Define a new coding system CODING-SYSTEM (symbol). -This function is provided for backward compatibility." - (declare (obsolete define-coding-system "23.1")) - ;; For compatibility with XEmacs, we check the type of TYPE. If it - ;; is a symbol, perhaps, this function is called with XEmacs-style - ;; arguments. Here, try to transform that kind of arguments to - ;; Emacs style. - (if (symbolp type) - (let ((args (transform-make-coding-system-args coding-system type - mnemonic doc-string))) - (setq coding-system (car args) - type (nth 1 args) - mnemonic (nth 2 args) - doc-string (nth 3 args) - flags (nth 4 args) - properties (nth 5 args) - eol-type (nth 6 args)))) - - (setq type - (cond ((eq type 0) 'emacs-mule) - ((eq type 1) 'shift-jis) - ((eq type 2) 'iso2022) - ((eq type 3) 'big5) - ((eq type 4) 'ccl) - ((eq type 5) 'raw-text) - (t - (error "Invalid coding system type: %s" type)))) - - (setq properties - (let ((plist nil) key) - (dolist (elt properties) - (setq key (car elt)) - (cond ((eq key 'post-read-conversion) - (setq key :post-read-conversion)) - ((eq key 'pre-write-conversion) - (setq key :pre-write-conversion)) - ((eq key 'translation-table-for-decode) - (setq key :decode-translation-table)) - ((eq key 'translation-table-for-encode) - (setq key :encode-translation-table)) - ((eq key 'safe-charsets) - (setq key :charset-list)) - ((eq key 'mime-charset) - (setq key :mime-charset)) - ((eq key 'valid-codes) - (setq key :valids))) - (setq plist (plist-put plist key (cdr elt)))) - plist)) - (setq properties (plist-put properties :mnemonic mnemonic)) - (plist-put properties :coding-type type) - (cond ((eq eol-type 0) (setq eol-type 'unix)) - ((eq eol-type 1) (setq eol-type 'dos)) - ((eq eol-type 2) (setq eol-type 'mac)) - ((vectorp eol-type) (setq eol-type nil))) - (plist-put properties :eol-type eol-type) - - (cond - ((eq type 'iso2022) - (plist-put properties :flags - (list (and (or (consp (nth 0 flags)) - (consp (nth 1 flags)) - (consp (nth 2 flags)) - (consp (nth 3 flags))) 'designation) - (or (nth 4 flags) 'long-form) - (and (nth 5 flags) 'ascii-at-eol) - (and (nth 6 flags) 'ascii-at-cntl) - (and (nth 7 flags) '7-bit) - (and (nth 8 flags) 'locking-shift) - (and (nth 9 flags) 'single-shift) - (and (nth 10 flags) 'use-roman) - (and (nth 11 flags) 'use-oldjis) - (or (nth 12 flags) 'direction) - (and (nth 13 flags) 'init-at-bol) - (and (nth 14 flags) 'designate-at-bol) - (and (nth 15 flags) 'safe) - (and (nth 16 flags) 'latin-extra))) - (plist-put properties :designation - (let ((vec (make-vector 4 nil))) - (dotimes (i 4) - (let ((spec (nth i flags))) - (if (eq spec t) - (aset vec i '(94 96)) - (if (consp spec) - (progn - (if (memq t spec) - (setq spec (append (delq t spec) '(94 96)))) - (aset vec i spec)))))) - vec))) - - ((eq type 'ccl) - (plist-put properties :ccl-decoder (car flags)) - (plist-put properties :ccl-encoder (cdr flags)))) - - (apply 'define-coding-system coding-system doc-string properties)) - (defun merge-coding-systems (first second) "Fill in any unspecified aspects of coding system FIRST from SECOND. Return the resulting coding system." @@ -1617,15 +1493,6 @@ This setting is effective for the next communication only." (setq next-selection-coding-system coding-system)) -(defun set-coding-priority (arg) - "Set priority of coding categories according to ARG. -ARG is a list of coding categories ordered by priority. - -This function is provided for backward compatibility." - (declare (obsolete set-coding-system-priority "23.1")) - (apply 'set-coding-system-priority - (mapcar #'(lambda (x) (symbol-value x)) arg))) - ;;; X selections (defvar ctext-non-standard-encodings-alist diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index ae58bfc566b..7077925602c 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -31062,7 +31062,7 @@ values), despite potential performance issues, type \\[so-long-revert]. Use \\[so-long-commentary] for more information. -Use \\[so-long-customize] to configure the behavior. +Use \\[so-long-customize] to configure the behaviour. \(fn)" t nil) @@ -31099,7 +31099,7 @@ or call the function `global-so-long-mode'.") (custom-autoload 'global-so-long-mode "so-long" nil) (autoload 'global-so-long-mode "so-long" "\ -Toggle automated performance mitigation for files with long lines. +Toggle automated performance mitigations for files with long lines. If called interactively, enable Global So-Long mode if ARG is positive, and disable it if ARG is zero or negative. If called from @@ -31118,7 +31118,7 @@ When such files are detected by `so-long-predicate', we invoke the selected Use \\[so-long-commentary] for more information. -Use \\[so-long-customize] to configure the behavior. +Use \\[so-long-customize] to configure the behaviour. \(fn &optional ARG)" t nil) diff --git a/lisp/loadup.el b/lisp/loadup.el index 31843fc24d1..aaa5888bf92 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -449,33 +449,33 @@ lost after dumping"))) ;; At this point, we're ready to resume undo recording for scratch. (buffer-enable-undo "*scratch*") -(when (native-comp-available-p) +(when (boundp 'comp-ctxt) ;; Fix the compilation unit filename to have it working when ;; when installed or if the source directory got moved. This is set to be ;; a pair in the form: (rel-path-from-install-bin . rel-path-from-local-bin). (let ((h (make-hash-table :test #'eq)) - (lisp-src-dir (expand-file-name (concat default-directory "../lisp"))) (bin-dest-dir (cadr (member "--bin-dest" command-line-args))) - (lisp-dest-dir (cadr (member "--lisp-dest" command-line-args)))) - (mapatoms (lambda (s) - (let ((f (symbol-function s))) - (when (subr-native-elisp-p f) - (puthash (subr-native-comp-unit f) nil h))))) - (maphash (lambda (cu _) - (native-comp-unit-set-file - cu - (cons - ;; Relative path from the installed binary. - (file-relative-name - (concat lisp-dest-dir - (replace-regexp-in-string - (regexp-quote lisp-src-dir) "" - (native-comp-unit-file cu))) - bin-dest-dir) - ;; Relative path from the built uninstalled binary. - (file-relative-name (native-comp-unit-file cu) - invocation-directory)))) - h))) + (eln-dest-dir (cadr (member "--eln-dest" command-line-args)))) + (when (and bin-dest-dir eln-dest-dir) + (setq eln-dest-dir + (concat eln-dest-dir "eln-cache/" comp-native-path-postfix "/")) + (mapatoms (lambda (s) + (let ((f (symbol-function s))) + (when (subr-native-elisp-p f) + (puthash (subr-native-comp-unit f) nil h))))) + (maphash (lambda (cu _) + (native-comp-unit-set-file + cu + (cons + ;; Relative path from the installed binary. + (file-relative-name (concat eln-dest-dir + (file-name-nondirectory + (native-comp-unit-file cu))) + bin-dest-dir) + ;; Relative path from the built uninstalled binary. + (file-relative-name (native-comp-unit-file cu) + invocation-directory)))) + h)))) (when (hash-table-p purify-flag) (let ((strings 0) diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el index 896f82d7bcc..2c77f88f97b 100644 --- a/lisp/mail/binhex.el +++ b/lisp/mail/binhex.el @@ -83,10 +83,8 @@ input and write the converted data to its standard output." "^[^:]...............................................................$") (defconst binhex-end-line ":$") ; unused -(defvar binhex-temporary-file-directory - (cond ((fboundp 'temp-directory) (temp-directory)) - ((boundp 'temporary-file-directory) temporary-file-directory) - ("/tmp/"))) +(make-obsolete-variable 'binhex-temporary-file-directory + 'temporary-file-directory "28.1") (defun binhex-insert-char (char &optional count ignored buffer) "Insert COUNT copies of CHARACTER into BUFFER." @@ -285,7 +283,7 @@ If HEADER-ONLY is non-nil only decode header and return filename." (file-name (expand-file-name (concat (binhex-decode-region-internal start end t) ".data") - binhex-temporary-file-directory))) + temporary-file-directory))) (save-excursion (goto-char start) (when (re-search-forward binhex-begin-line nil t) @@ -296,7 +294,7 @@ If HEADER-ONLY is non-nil only decode header and return filename." (generate-new-buffer " *binhex-work*"))) (buffer-disable-undo work-buffer) (insert-buffer-substring cbuf firstline end) - (cd binhex-temporary-file-directory) + (cd temporary-file-directory) (apply 'call-process-region (point-min) (point-max) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index efbc0668553..6b9e1db5fc6 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -324,18 +324,6 @@ usually do not have translators for other languages.\n\n"))) (let ((os (ignore-errors (report-emacs-bug--os-description)))) (if (stringp os) (insert "System Description: " os "\n\n"))) - (let ((message-buf (get-buffer "*Messages*"))) - (if message-buf - (let (beg-pos - (end-pos message-end-point)) - (with-current-buffer message-buf - (goto-char end-pos) - (forward-line -10) - (setq beg-pos (point))) - (terpri (current-buffer) t) - (insert "Recent messages:\n") - (insert-buffer-substring message-buf beg-pos end-pos)))) - (insert "\n") (when (and system-configuration-options (not (equal system-configuration-options ""))) (insert "Configured using:\n 'configure " diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el index af3b493a08a..f4b55031194 100644 --- a/lisp/mail/flow-fill.el +++ b/lisp/mail/flow-fill.el @@ -131,31 +131,37 @@ lines." (goto-char (match-end 0)) (unless (looking-at " ") (insert " ")) - (end-of-line) - (when (and (not (eobp)) - (save-excursion - (forward-line 1) - (looking-at (format "\\(%s ?\\)[^>]" prefix)))) - ;; Delete the newline and the quote at the start of the - ;; next line. - (delete-region (point) (match-end 1)) - (ignore-errors + (while (and (eq (char-before (line-end-position)) ?\s) + (not (eobp)) + (save-excursion + (forward-line 1) + (looking-at (format "\\(%s ?\\)[^>]" prefix)))) + (end-of-line) + (when (and (not (eobp)) + (save-excursion + (forward-line 1) + (looking-at (format "\\(%s ?\\)[^>]" prefix)))) + ;; Delete the newline and the quote at the start of the + ;; next line. + (delete-region (point) (match-end 1)))) + (ignore-errors (let ((fill-prefix (concat prefix " ")) adaptive-fill-mode) (fill-region (line-beginning-position) (line-end-position) - 'left 'nosqueeze)))))) - (t + 'left 'nosqueeze))))) + (t ;; Delete the newline. (when (eq (following-char) ?\s) (delete-char 1)) ;; Hack: Don't do the flowing on the signature line. (when (and (not (looking-at "-- $")) (eq (char-before (line-end-position)) ?\s)) - (end-of-line) - (when delete-space - (delete-char -1)) - (delete-char 1) + (while (eq (char-before (line-end-position)) ?\s) + (end-of-line) + (when delete-space + (delete-char -1)) + (delete-char 1)) (ignore-errors (let ((fill-prefix "")) (fill-region (line-beginning-position) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 44cde7cb5a9..312baffb901 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -521,25 +521,6 @@ still the current message in the Rmail buffer.") (defvar rmail-mmdf-delim2 "^\001\001\001\001\n" "Regexp marking the end of an mmdf message.") -;; FIXME Post-mbox, this is now unused. -;; In Emacs-22, this was called: -;; i) the very first time a message was shown. -;; ii) when toggling the headers to the normal state, every time. -;; It's not clear what it should do now, since there is nothing that -;; records when a message is shown for the first time (unseen is not -;; necessarily the same thing). -;; See https://lists.gnu.org/r/emacs-devel/2009-03/msg00013.html -(defcustom rmail-message-filter nil - "If non-nil, a filter function for new messages in RMAIL. -Called with region narrowed to the message, including headers, -before obeying `rmail-ignored-headers'." - :group 'rmail-headers - :type '(choice (const nil) function)) - -(make-obsolete-variable 'rmail-message-filter - "it is not used (try `rmail-show-message-hook')." - "23.1") - (defcustom rmail-automatic-folder-directives nil "List of directives specifying how to automatically file messages. Whenever Rmail shows a message in the folder that `rmail-file-name' diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el index ba6ebad082c..3026283a082 100644 --- a/lisp/mail/rmailedit.el +++ b/lisp/mail/rmailedit.el @@ -63,9 +63,7 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'. (use-local-map rmail-edit-map) (setq major-mode 'rmail-edit-mode) (setq mode-name "RMAIL Edit") - (if (boundp 'mode-line-modified) - (setq mode-line-modified (default-value 'mode-line-modified)) - (setq mode-line-format (default-value 'mode-line-format))) + (setq mode-line-modified (default-value 'mode-line-modified)) ;; Don't turn off auto-saving based on the size of the buffer ;; because that code does not understand buffer-swapping. (make-local-variable 'auto-save-include-big-deletions) diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el index 9423275b2e5..945bff35f79 100644 --- a/lisp/mail/uudecode.el +++ b/lisp/mail/uudecode.el @@ -61,10 +61,8 @@ input and write the converted data to its standard output." (setq str (concat str "[^a-z]"))) (concat str ".?$"))) -(defvar uudecode-temporary-file-directory - (cond ((fboundp 'temp-directory) (temp-directory)) - ((boundp 'temporary-file-directory) temporary-file-directory) - ("/tmp"))) +(make-obsolete-variable 'uudecode-temporary-file-directory + 'temporary-file-directory "28.1") ;;;###autoload (defun uudecode-decode-region-external (start end &optional file-name) @@ -86,13 +84,7 @@ used is specified by `uudecode-decoder-program'." (match-string 1))))) (setq tempfile (if file-name (expand-file-name file-name) - (if (fboundp 'make-temp-file) - (let ((temporary-file-directory - uudecode-temporary-file-directory)) - (make-temp-file "uu")) - (expand-file-name - (make-temp-name "uu") - uudecode-temporary-file-directory)))) + (make-temp-file "uu"))) (let ((cdir default-directory) (default-process-coding-system nil)) (unwind-protect diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index d2c3f9045e5..641a2e53152 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -685,13 +685,6 @@ for use at QPOS." completions) qboundary)))) -;; (defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b)) -;; (defmacro dynamic-completion-table (fun) `(completion-table-dynamic ,fun)) -(define-obsolete-function-alias - 'complete-in-turn #'completion-table-in-turn "23.1") -(define-obsolete-function-alias - 'dynamic-completion-table #'completion-table-dynamic "23.1") - ;;; Minibuffer completion (defgroup minibuffer nil @@ -1126,6 +1119,7 @@ completion candidates than this number." (defvar-local completion-all-sorted-completions nil) (defvar-local completion--all-sorted-completions-location nil) (defvar completion-cycling nil) ;Function that takes down the cycling map. +(defvar completion-content-when-empty nil) (defvar completion-fail-discreetly nil "If non-nil, stay quiet when there is no match.") @@ -1510,8 +1504,13 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', COMPLETION-FUNCTION is called if the current buffer's content does not appear to be a match." (cond - ;; Allow user to specify null string - ((= beg end) (funcall exit-function)) + ;; Allow user to specify null string. In the case that + ;; `completion-content-when-empty' is set, use that instead. + ((= beg end) + (when completion-content-when-empty + (completion--replace beg end completion-content-when-empty)) + (funcall exit-function)) + ((test-completion (buffer-substring beg end) minibuffer-completion-table minibuffer-completion-predicate) @@ -1770,9 +1769,6 @@ It also eliminates runs of equal strings." ;; Round up to a whole number of columns. (* colwidth (ceiling length colwidth)))))))))))) -(defvar completion-common-substring nil) -(make-obsolete-variable 'completion-common-substring nil "23.1") - (defvar completion-setup-hook nil "Normal hook run at the end of setting up a completion list buffer. When this hook is run, the current buffer is the one in which the @@ -1864,11 +1860,7 @@ It can find the completion buffer in `standard-output'." (insert "Possible completions are:\n") (completion--insert-strings completions)))) - ;; The hilit used to be applied via completion-setup-hook, so there - ;; may still be some code that uses completion-common-substring. - (with-no-warnings - (let ((completion-common-substring common-substring)) - (run-hooks 'completion-setup-hook))) + (run-hooks 'completion-setup-hook) nil) (defvar completion-extra-properties nil @@ -2374,8 +2366,6 @@ The completion method is determined by `completion-at-point-functions'." Gets combined either with `minibuffer-local-completion-map' or with `minibuffer-local-must-match-map'.") -(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map - 'minibuffer-local-filename-must-match-map "23.1") (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) (make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1") diff --git a/lisp/mouse.el b/lisp/mouse.el index d369545f18e..a06ca2a56ca 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -274,34 +274,6 @@ not it is actually displayed." local-menu minor-mode-menus))) -(defun mouse-major-mode-menu (event &optional prefix) - "Pop up a mode-specific menu of mouse commands. -Default to the Edit menu if the major mode doesn't define a menu." - (declare (obsolete mouse-menu-major-mode-map "23.1")) - (interactive "@e\nP") - (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) - (popup-menu (mouse-menu-major-mode-map) event prefix)) - -(defun mouse-popup-menubar (event prefix) - "Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX. -The contents are the items that would be in the menu bar whether or -not it is actually displayed." - (declare (obsolete mouse-menu-bar-map "23.1")) - (interactive "@e \nP") - (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) - (popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix)) - -(defun mouse-popup-menubar-stuff (event prefix) - "Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'. -Use the former if the menu bar is showing, otherwise the latter." - (declare (obsolete nil "23.1")) - (interactive "@e\nP") - (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) - (popup-menu - (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0)) - (mouse-menu-bar-map) - (mouse-menu-major-mode-map)) - event prefix)) ;; Commands that operate on windows. diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 317f2cd8edd..8e2039ba9d8 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -162,23 +162,18 @@ Also see `mouse-wheel-tilt-scroll'." :type 'boolean :version "26.1") -(eval-and-compile - (if (fboundp 'event-button) - (fset 'mwheel-event-button 'event-button) - (defun mwheel-event-button (event) - (let ((x (event-basic-type event))) - ;; Map mouse-wheel events to appropriate buttons - (if (eq 'mouse-wheel x) - (let ((amount (car (cdr (cdr (cdr event)))))) - (if (< amount 0) - mouse-wheel-up-event - mouse-wheel-down-event)) - x)))) - - (if (fboundp 'event-window) - (fset 'mwheel-event-window 'event-window) - (defun mwheel-event-window (event) - (posn-window (event-start event))))) +(defun mwheel-event-button (event) + (let ((x (event-basic-type event))) + ;; Map mouse-wheel events to appropriate buttons + (if (eq 'mouse-wheel x) + (let ((amount (car (cdr (cdr (cdr event)))))) + (if (< amount 0) + mouse-wheel-up-event + mouse-wheel-down-event)) + x))) + +(defun mwheel-event-window (event) + (posn-window (event-start event))) (defvar mwheel-inhibit-click-event-timer nil "Timer running while mouse wheel click event is inhibited.") diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 56ea033a963..bb6682520ae 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -1,4 +1,4 @@ -;;; eudc-bob.el --- Binary Objects Support for EUDC +;;; eudc-bob.el --- Binary Objects Support for EUDC -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. @@ -39,19 +39,41 @@ (require 'eudc) -(defvar eudc-bob-generic-keymap nil +(defvar eudc-bob-generic-keymap + (let ((map (make-sparse-keymap))) + (define-key map "s" 'eudc-bob-save-object) + (define-key map "!" 'eudc-bob-pipe-object-to-external-program) + (define-key map [down-mouse-3] 'eudc-bob-popup-menu) + map) "Keymap for multimedia objects.") -(defvar eudc-bob-image-keymap nil +(defvar eudc-bob-image-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-parent map eudc-bob-generic-keymap) + (define-key map "t" 'eudc-bob-toggle-inline-display) + map) "Keymap for inline images.") -(defvar eudc-bob-sound-keymap nil +(defvar eudc-bob-sound-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-parent map eudc-bob-generic-keymap) + (define-key map (kbd "RET") 'eudc-bob-play-sound-at-point) + (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse) + map) "Keymap for inline sounds.") -(defvar eudc-bob-url-keymap nil +(defvar eudc-bob-url-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'browse-url-at-point) + (define-key map [down-mouse-2] 'browse-url-at-mouse) + map) "Keymap for inline urls.") -(defvar eudc-bob-mail-keymap nil +(defvar eudc-bob-mail-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'goto-address-at-point) + (define-key map [down-mouse-2] 'goto-address-at-point) + map) "Keymap for inline e-mail addresses.") (defvar eudc-bob-generic-menu @@ -74,13 +96,6 @@ (fboundp 'play-sound-internal)] ,@(cdr (cdr eudc-bob-generic-menu)))) -(defun eudc-jump-to-event (event) - "Jump to the window and point where EVENT occurred." - (if (fboundp 'event-closest-point) - (goto-char (event-closest-point event)) - (set-buffer (window-buffer (posn-window (event-start event)))) - (goto-char (posn-point (event-start event))))) - (defun eudc-bob-get-overlay-prop (prop) "Get property PROP from one of the overlays around." (let ((overlays (append (overlays-at (1- (point))) @@ -205,42 +220,30 @@ display a button." "Play the sound data contained in the button where EVENT occurred." (interactive "e") (save-excursion - (eudc-jump-to-event event) + (mouse-set-point event) (eudc-bob-play-sound-at-point))) -(defun eudc-bob-save-object () +(defun eudc-bob-save-object (filename) "Save the object data of the button at point." - (interactive) + (interactive "fWrite file: ") (let ((data (eudc-bob-get-overlay-prop 'object-data)) - (buffer (generate-new-buffer "*eudc-tmp*"))) - (save-excursion - (set-buffer-file-coding-system 'binary) - (set-buffer buffer) - (set-buffer-multibyte nil) - (insert data) - (save-buffer)) - (kill-buffer buffer))) + (coding-system-for-write 'binary)) ;Inhibit EOL conversion. + (write-region data nil filename))) -(defun eudc-bob-pipe-object-to-external-program () +(defun eudc-bob-pipe-object-to-external-program (program) "Pipe the object data of the button at point to an external program." - (interactive) + (interactive (list (completing-read "Viewer: " eudc-external-viewers))) (let ((data (eudc-bob-get-overlay-prop 'object-data)) - (buffer (generate-new-buffer "*eudc-tmp*")) - program - viewer) - (condition-case nil - (save-excursion - (set-buffer-file-coding-system 'binary) - (set-buffer buffer) - (insert data) - (setq program (completing-read "Viewer: " eudc-external-viewers)) - (if (setq viewer (assoc program eudc-external-viewers)) - (call-process-region (point-min) (point-max) - (car (cdr viewer)) - (cdr (cdr viewer))) - (call-process-region (point-min) (point-max) program))) - (error - (kill-buffer buffer))))) + (viewer (assoc program eudc-external-viewers))) + (with-temp-buffer + (set-buffer-multibyte nil) + (insert data) + (let ((coding-system-for-write 'binary)) ;Inhibit EOL conversion + (if viewer + (call-process-region (point-min) (point-max) + (car (cdr viewer)) + (cdr (cdr viewer))) + (call-process-region (point-min) (point-max) program)))))) (defun eudc-bob-menu () "Retrieve the menu attached to a binary object." @@ -250,47 +253,8 @@ display a button." "Pop-up a menu of EUDC multimedia commands." (interactive "@e") (run-hooks 'activate-menubar-hook) - (eudc-jump-to-event event) - (let ((result (x-popup-menu t (eudc-bob-menu))) - command) - (if result - (progn - (setq command (lookup-key (eudc-bob-menu) - (apply 'vector result))) - (command-execute command))))) - -(setq eudc-bob-generic-keymap - (let ((map (make-sparse-keymap))) - (define-key map "s" 'eudc-bob-save-object) - (define-key map "!" 'eudc-bob-pipe-object-to-external-program) - (define-key map [down-mouse-3] 'eudc-bob-popup-menu) - map)) - -(setq eudc-bob-image-keymap - (let ((map (make-sparse-keymap))) - (define-key map "t" 'eudc-bob-toggle-inline-display) - map)) - -(setq eudc-bob-sound-keymap - (let ((map (make-sparse-keymap))) - (define-key map [return] 'eudc-bob-play-sound-at-point) - (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse) - map)) - -(setq eudc-bob-url-keymap - (let ((map (make-sparse-keymap))) - (define-key map [return] 'browse-url-at-point) - (define-key map [down-mouse-2] 'browse-url-at-mouse) - map)) - -(setq eudc-bob-mail-keymap - (let ((map (make-sparse-keymap))) - (define-key map [return] 'goto-address-at-point) - (define-key map [down-mouse-2] 'goto-address-at-point) - map)) - -(set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap) -(set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap) + (mouse-set-point event) + (popup-menu (eudc-bob-menu) event)) ;; If the first arguments can be nil here, then these 3 can be ;; defconsts once more. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index e7170b3e6d1..04deb5bee05 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -672,9 +672,30 @@ Currently this means either text/html or application/xhtml+xml." (setq header-line-format (and eww-header-line-format (let ((title (plist-get eww-data :title)) - (peer (plist-get eww-data :peer))) + (peer (plist-get eww-data :peer)) + (url (plist-get eww-data :url))) (when (zerop (length title)) (setq title "[untitled]")) + ;; Limit the length of the title so that the host name + ;; of the URL is always visible. + (when url + (let* ((parsed (url-generic-parse-url url)) + (host-length (length (format "%s://%s" + (url-type parsed) + (url-host parsed)))) + (width (window-width))) + (cond + ;; The host bit is wider than the window, so nix + ;; the title. + ((> (+ host-length 5) width) + (setq title "")) + ;; Trim the title. + ((> (+ (length title) host-length 2) width) + (setq title (concat + (substring title 0 (- width + host-length + 5)) + "...")))))) ;; This connection has is https. (when peer (setq title @@ -686,7 +707,7 @@ Currently this means either text/html or application/xhtml+xml." "%" "%%" (format-spec eww-header-line-format - `((?u . ,(or (plist-get eww-data :url) "")) + `((?u . ,(or url "")) (?t . ,title)))))))) (defun eww-tag-title (dom) diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index 1bed61f3e7d..ff8a447c7c1 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -131,14 +131,6 @@ groupcontent := feedname | groupdefinition) Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\") \"feed3\")") -(defcustom newsticker-groups-filename - nil - "Name of the newsticker groups settings file." - :version "25.1" ; changed default value to nil - :type '(choice (const nil) string) - :group 'newsticker-treeview) -(make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1") - ;; ====================================================================== ;;; internal variables ;; ====================================================================== @@ -1265,29 +1257,9 @@ Note: does not update the layout." (defun newsticker--treeview-load () "Load treeview settings." (let* ((coding-system-for-read 'utf-8) - (filename - (or (and newsticker-groups-filename - (not (string= - (expand-file-name newsticker-groups-filename) - (expand-file-name (concat newsticker-dir "/groups")))) - (file-exists-p newsticker-groups-filename) - (y-or-n-p - (format-message - (concat "Obsolete variable `newsticker-groups-filename' " - "points to existing file \"%s\".\n" - "Read it? ") - newsticker-groups-filename)) - newsticker-groups-filename) - (concat newsticker-dir "/groups"))) + (filename (concat newsticker-dir "/groups")) (buf (and (file-exists-p filename) (find-file-noselect filename)))) - (and newsticker-groups-filename - (file-exists-p newsticker-groups-filename) - (y-or-n-p (format-message - (concat "Delete the file \"%s\",\nto which the obsolete " - "variable `newsticker-groups-filename' points ? ") - newsticker-groups-filename)) - (delete-file newsticker-groups-filename)) (when buf (set-buffer buf) (goto-char (point-min)) diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index ebcd21948bf..9401430799c 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -69,7 +69,6 @@ (require 'md4) (require 'hmac-md5) -(require 'calc) (defgroup ntlm nil "NTLM (NT LanManager) authentication." @@ -133,32 +132,27 @@ is not given." domain ;buffer field )))) -(defun ntlm-compute-timestamp () - "Compute an NTLMv2 timestamp. +(defun ntlm--time-to-timestamp (time) + "Convert TIME to an NTLMv2 timestamp. Return a unibyte string representing the number of tenths of a microsecond since January 1, 1601 as a 64-bit little-endian -signed integer." - ;; FIXME: This can likely be significantly simplified using the new - ;; bignums support! - (let* ((s-to-tenths-of-us "mul(add(lsh($1,16),$2),10000000)") - (us-to-tenths-of-us "mul($3,10)") - (ps-to-tenths-of-us "idiv($4,100000)") - (tenths-of-us-since-jan-1-1601 - (apply #'calc-eval (concat "add(add(add(" - s-to-tenths-of-us "," - us-to-tenths-of-us ")," - ps-to-tenths-of-us ")," - ;; tenths of microseconds between - ;; 1601-01-01 and 1970-01-01 - "116444736000000000)") - 'rawnum (time-convert nil 'list))) - result-bytes) - (dotimes (_byte 8) - (push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601) - result-bytes) - (setq tenths-of-us-since-jan-1-1601 - (calc-eval "rsh($1,8,64)" 'rawnum tenths-of-us-since-jan-1-1601))) - (apply #'unibyte-string (nreverse result-bytes)))) +signed integer. TIME must be on the form (HIGH LOW USEC PSEC)." + (let* ((s (+ (ash (nth 0 time) 16) (nth 1 time))) + (us (nth 2 time)) + (ps (nth 3 time)) + (tenths-of-us-since-jan-1-1601 + (+ (* s 10000000) (* us 10) (/ ps 100000) + ;; tenths of microseconds between 1601-01-01 and 1970-01-01 + 116444736000000000))) + (apply #'unibyte-string + (mapcar (lambda (i) + (logand (ash tenths-of-us-since-jan-1-1601 (* i -8)) + #xff)) + (number-sequence 0 7))))) + +(defun ntlm-compute-timestamp () + "Current time as an NTLMv2 timestamp, as a unibyte string." + (ntlm--time-to-timestamp (time-convert nil 'list))) (defun ntlm-generate-nonce () "Generate a random nonce, not to be used more than once. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ca43475f453..fae15fe6a8e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4781,104 +4781,6 @@ Goes through the list `tramp-inline-compress-commands'." (tramp-message vec 2 "Couldn't find an inline transfer compress command"))))) -;;;###tramp-autoload -(defun tramp-multi-hop-p (vec) - "Whether the method of VEC is capable of multi-hops." - (and (tramp-sh-file-name-handler-p vec) - (not (tramp-get-method-parameter vec 'tramp-copy-program)))) - -(defun tramp-compute-multi-hops (vec) - "Expands VEC according to `tramp-default-proxies-alist'." - (let ((saved-tdpa tramp-default-proxies-alist) - (target-alist `(,vec)) - (hops (or (tramp-file-name-hop vec) "")) - (item vec) - choices proxy) - - ;; Ad-hoc proxy definitions. - (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit))) - (let* ((host-port (tramp-file-name-host-port item)) - (user-domain (tramp-file-name-user-domain item)) - (proxy (concat - tramp-prefix-format proxy tramp-postfix-host-format)) - (entry - (list (and (stringp host-port) - (concat "^" (regexp-quote host-port) "$")) - (and (stringp user-domain) - (concat "^" (regexp-quote user-domain) "$")) - (propertize proxy 'tramp-ad-hoc t)))) - (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry) - ;; Add the hop. - (add-to-list 'tramp-default-proxies-alist entry) - (setq item (tramp-dissect-file-name proxy)))) - ;; Save the new value. - (when (and hops tramp-save-ad-hoc-proxies) - (customize-save-variable - 'tramp-default-proxies-alist tramp-default-proxies-alist)) - - ;; Look for proxy hosts to be passed. - (setq choices tramp-default-proxies-alist) - (while choices - (setq item (pop choices) - proxy (eval (nth 2 item))) - (when (and - ;; Host. - (string-match-p - (or (eval (nth 0 item)) "") - (or (tramp-file-name-host-port (car target-alist)) "")) - ;; User. - (string-match-p - (or (eval (nth 1 item)) "") - (or (tramp-file-name-user-domain (car target-alist)) ""))) - (if (null proxy) - ;; No more hops needed. - (setq choices nil) - ;; Replace placeholders. - (setq proxy - (format-spec - proxy - (format-spec-make - ?u (or (tramp-file-name-user (car target-alist)) "") - ?h (or (tramp-file-name-host (car target-alist)) "")))) - (with-parsed-tramp-file-name proxy l - ;; Add the hop. - (push l target-alist) - ;; Start next search. - (setq choices tramp-default-proxies-alist))))) - - ;; Foreign and out-of-band methods are not supported for multi-hops. - (when (cdr target-alist) - (setq choices target-alist) - (while (setq item (pop choices)) - (unless (tramp-multi-hop-p item) - (setq tramp-default-proxies-alist saved-tdpa) - (tramp-user-error - vec "Method `%s' is not supported for multi-hops." - (tramp-file-name-method item))))) - - ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the - ;; host name in their command template. In this case, the remote - ;; file name must use either a local host name (first hop), or a - ;; host name matching the previous hop. - (let ((previous-host (or tramp-local-host-regexp ""))) - (setq choices target-alist) - (while (setq item (pop choices)) - (let ((host (tramp-file-name-host item))) - (unless - (or - ;; The host name is used for the remote shell command. - (member - '("%h") (tramp-get-method-parameter item 'tramp-login-args)) - ;; The host name must match previous hop. - (string-match-p previous-host host)) - (setq tramp-default-proxies-alist saved-tdpa) - (tramp-user-error - vec "Host name `%s' does not match `%s'" host previous-host)) - (setq previous-host (concat "^" (regexp-quote host) "$"))))) - - ;; Result. - target-alist)) - (defun tramp-ssh-controlmaster-options (vec) "Return the Control* arguments of the local ssh." (cond diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ab52bec39eb..83ade66ee14 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3634,12 +3634,109 @@ User is always nil." (delete-file local-copy))))) t))) +(defun tramp-multi-hop-p (vec) + "Whether the method of VEC is capable of multi-hops." + (and (tramp-sh-file-name-handler-p vec) + (not (tramp-get-method-parameter vec 'tramp-copy-program)))) + +(defun tramp-compute-multi-hops (vec) + "Expands VEC according to `tramp-default-proxies-alist'." + (let ((saved-tdpa tramp-default-proxies-alist) + (target-alist `(,vec)) + (hops (or (tramp-file-name-hop vec) "")) + (item vec) + choices proxy) + + ;; Ad-hoc proxy definitions. + (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit))) + (let* ((host-port (tramp-file-name-host-port item)) + (user-domain (tramp-file-name-user-domain item)) + (proxy (concat + tramp-prefix-format proxy tramp-postfix-host-format)) + (entry + (list (and (stringp host-port) + (concat "^" (regexp-quote host-port) "$")) + (and (stringp user-domain) + (concat "^" (regexp-quote user-domain) "$")) + (propertize proxy 'tramp-ad-hoc t)))) + (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry) + ;; Add the hop. + (add-to-list 'tramp-default-proxies-alist entry) + (setq item (tramp-dissect-file-name proxy)))) + ;; Save the new value. + (when (and hops tramp-save-ad-hoc-proxies) + (customize-save-variable + 'tramp-default-proxies-alist tramp-default-proxies-alist)) + + ;; Look for proxy hosts to be passed. + (setq choices tramp-default-proxies-alist) + (while choices + (setq item (pop choices) + proxy (eval (nth 2 item))) + (when (and + ;; Host. + (string-match-p + (or (eval (nth 0 item)) "") + (or (tramp-file-name-host-port (car target-alist)) "")) + ;; User. + (string-match-p + (or (eval (nth 1 item)) "") + (or (tramp-file-name-user-domain (car target-alist)) ""))) + (if (null proxy) + ;; No more hops needed. + (setq choices nil) + ;; Replace placeholders. + (setq proxy + (format-spec + proxy + (format-spec-make + ?u (or (tramp-file-name-user (car target-alist)) "") + ?h (or (tramp-file-name-host (car target-alist)) "")))) + (with-parsed-tramp-file-name proxy l + ;; Add the hop. + (push l target-alist) + ;; Start next search. + (setq choices tramp-default-proxies-alist))))) + + ;; Foreign and out-of-band methods are not supported for multi-hops. + (when (cdr target-alist) + (setq choices target-alist) + (while (setq item (pop choices)) + (unless (tramp-multi-hop-p item) + (setq tramp-default-proxies-alist saved-tdpa) + (tramp-user-error + vec "Method `%s' is not supported for multi-hops." + (tramp-file-name-method item))))) + + ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the + ;; host name in their command template. In this case, the remote + ;; file name must use either a local host name (first hop), or a + ;; host name matching the previous hop. + (let ((previous-host (or tramp-local-host-regexp ""))) + (setq choices target-alist) + (while (setq item (pop choices)) + (let ((host (tramp-file-name-host item))) + (unless + (or + ;; The host name is used for the remote shell command. + (member + '("%h") (tramp-get-method-parameter item 'tramp-login-args)) + ;; The host name must match previous hop. + (string-match-p previous-host host)) + (setq tramp-default-proxies-alist saved-tdpa) + (tramp-user-error + vec "Host name `%s' does not match `%s'" host previous-host)) + (setq previous-host (concat "^" (regexp-quote host) "$"))))) + + ;; Result. + target-alist)) + (defun tramp-direct-async-process-p (&rest args) "Whether direct async `make-process' can be called." (let ((v (tramp-dissect-file-name default-directory))) - (and (tramp-get-connection-property v"direct-async-process" nil) - (not (tramp-multi-hop-p v)) - (not (plist-get args :stderr))))) + (and (tramp-get-connection-property v "direct-async-process" nil) + (= (length (tramp-compute-multi-hops v)) 1) + (not (plist-get args :stderr))))) ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once diff --git a/lisp/erc/erc-compat.el b/lisp/obsolete/erc-compat.el index d71221b2674..7ef30d822ff 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/obsolete/erc-compat.el @@ -5,6 +5,7 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: Amin Bandali <bandali@gnu.org> ;; URL: https://www.emacswiki.org/emacs/ERC +;; Obsolete-since: 28.1 ;; This file is part of GNU Emacs. diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el index d71f79c87be..0de7aa096d6 100644 --- a/lisp/obsolete/tpu-edt.el +++ b/lisp/obsolete/tpu-edt.el @@ -287,14 +287,6 @@ ;;; ;;; User Configurable Variables ;;; -(defcustom tpu-have-ispell t - "Non-nil means `tpu-spell-check' uses `ispell-region' for spell checking. -Otherwise, use `spell-region'." - :type 'boolean - :group 'tpu) -(make-obsolete-variable 'tpu-have-ispell "the `spell' package is obsolete." - "23.1") - (defcustom tpu-kill-buffers-silently nil "If non-nil, TPU-edt kills modified buffers without asking." :type 'boolean @@ -315,7 +307,6 @@ Otherwise, use `spell-region'." ;;; Global Keymaps ;;; -(define-obsolete-variable-alias 'GOLD-map 'tpu-gold-map "23.1") (defvar tpu-gold-map (let ((map (make-keymap))) ;; Previously we used escape sequences here. We now instead presume @@ -892,8 +883,7 @@ With argument, fill and justify." if no region is selected." (interactive) (let ((m (tpu-mark))) - (apply (if tpu-have-ispell 'ispell-region - 'spell-region) + (apply 'ispell-region (if m (if (> m (point)) (list (point) m) (list m (point))) diff --git a/lisp/password-cache.el b/lisp/password-cache.el index f5007579a8a..2443f374a84 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el @@ -94,22 +94,6 @@ The variable `password-cache' control whether the cache is used." (or (password-read-from-cache key) (read-passwd prompt))) -(defun password-read-and-add (prompt &optional key) - "Read password, for use with KEY, from user, or from cache if wanted. -Then store the password in the cache. Uses `password-read' and -`password-cache-add'. Custom variables `password-cache' and -`password-cache-expiry' regulate cache behavior. - -Warning: the password is cached without checking that it is -correct. It is better to check the password before caching. If -you must use this function, take care to check passwords and -remove incorrect ones from the cache." - (declare (obsolete password-read "23.1")) - (let ((password (password-read prompt key))) - (when (and password key) - (password-cache-add key password)) - password)) - (defun password-cache-remove (key) "Remove password indexed by KEY from password cache. This is typically run by a timer setup from `password-cache-add', diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index c3a98d9c5cf..7b8b174c430 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -384,7 +384,7 @@ comment at the start of cc-engine.el for more info." c-macro-cache-syntactic nil c-macro-cache-no-comment nil)) (save-match-data - (let ((safe-pos (point))) ; a point ouside any literal. + (let ((safe-pos (point))) ; a point outside any literal. ;; Move over stuff followed by a multiline block comment lacking ;; escaped newlines each time around this loop. (while diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 0b9f417845f..a043bbcfa3c 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -316,8 +316,8 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) (gcc-include "^\\(?:In file included \\| \\|\t\\)from \ \\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\ -\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\(:\\)\\|\\(,\\|$\\)\\)?" - 1 2 3 (4 . 5)) +\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\([:,]\\|$\\)\\)?" + 1 2 3 (nil . 4)) (ruby-Test::Unit "^ [[ ]?\\([^ (].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2) @@ -2417,12 +2417,9 @@ and runs `compilation-filter-hook'." &optional object limit) (let (parsed res) (while (progn - ;; We parse the buffer here "on-demand" by chunks of 500 chars. - ;; But we could also just parse the whole buffer. (compilation--ensure-parse (setq parsed (max compilation--parsed - (min (+ position 500) - (or limit (point-max)))))) + (or limit (point-max))))) (and (or (not (setq res (next-single-property-change position prop object limit))) (eq res limit)) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 6122caf5189..2d2713a36ab 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3979,6 +3979,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (and (eq (preceding-char) ?.) (eq (char-after (- (point) 2)) ?.)) (bobp)) + ;; { $a++ / $b } doesn't start a regex, nor does $a-- + (not (and (memq (preceding-char) '(?+ ?-)) + (eq (preceding-char) (char-before (1- (point)))))) ;; m|blah| ? foo : bar; (not (and (eq c ?\?) diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index 08cf802bcbe..22c70bf734d 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -4527,7 +4527,7 @@ end (let* ((ebnf-tree tree) (ps-color-p (and ebnf-color-p (ps-color-device))) (ps-print-color-scale (if ps-color-p - (float (car (ps-color-values "white"))) + (float (car (color-values "white"))) 1.0)) (ebnf-total (length ebnf-tree)) (ebnf-nprod 0) @@ -4629,7 +4629,7 @@ end (let* ((ebnf-tree tree) (ps-color-p (and ebnf-color-p (ps-color-device))) (ps-print-color-scale (if ps-color-p - (float (car (ps-color-values "white"))) + (float (car (color-values "white"))) 1.0)) ps-zebra-stripes ps-line-number ps-razzle-dazzle ps-print-hook diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 2f44118edb5..21ba42a0fe1 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1420,10 +1420,12 @@ Intended for `eldoc-documentation-functions' (which see)." (defun elisp-eldoc-var-docstring (callback &rest _ignored) "Document variable at point. Intended for `eldoc-documentation-functions' (which see)." - (let ((sym (elisp--current-symbol))) - (when sym (funcall callback (elisp-get-var-docstring sym) - :thing sym - :face 'font-lock-variable-name-face)))) + (let* ((sym (elisp--current-symbol)) + (docstring (and sym (elisp-get-var-docstring sym)))) + (when docstring + (funcall callback docstring + :thing sym + :face 'font-lock-variable-name-face)))) (defun elisp-get-fnsym-args-string (sym &optional index) "Return a string containing the parameter list of the function SYM. diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index edadbbdafc1..2c5c36504a9 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1424,6 +1424,10 @@ hits the start of file." (goto-func goto-tag-location-function) tag tag-info pt) (forward-line 1) + ;; Exuberant ctags add a line starting with the DEL character; + ;; skip past it. + (when (looking-at "\177") + (forward-line 1)) (while (not (or (eobp) (looking-at "\f"))) ;; We used to use explicit tags when available, but the current goto-func ;; can only handle implicit tags. diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index d3a2308e06b..ec4fd58886a 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -267,7 +267,6 @@ support." (declare-function idlwave-find-class-definition "idlwave") (declare-function idlwave-find-inherited-class "idlwave") (declare-function idlwave-find-struct-tag "idlwave") -(declare-function idlwave-get-buffer-visiting "idlwave") (declare-function idlwave-in-quote "idlwave") (declare-function idlwave-make-full-name "idlwave") (declare-function idlwave-members-only "idlwave") @@ -880,7 +879,7 @@ This function can be used as `idlwave-extra-help-function'." (setq in-buf ; structure-tag completion is always in current buffer (if struct-tag idlwave-current-tags-buffer - (idlwave-get-buffer-visiting file))) + (find-buffer-visiting file))) ;; see if file is in a visited buffer, insert those contents (if in-buf (progn diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index f875915ca8e..99ac0877c8b 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -2640,7 +2640,7 @@ Assumes that `idlwave-shell-sources-alist' contains an entry for that module." (if (or (not source-file) (not (file-regular-p source-file)) (not (setq buf - (or (idlwave-get-buffer-visiting source-file) + (or (find-buffer-visiting source-file) (find-file-noselect source-file))))) (progn (message "The source file for module %s is probably not compiled" @@ -3241,8 +3241,7 @@ Does not work for a region with multiline blocks - use "Delete the temporary files and kill associated buffers." (if (stringp idlwave-shell-temp-pro-file) (condition-case nil - (let ((buf (idlwave-get-buffer-visiting - idlwave-shell-temp-pro-file))) + (let ((buf (find-buffer-visiting idlwave-shell-temp-pro-file))) (if (buffer-live-p buf) (kill-buffer buf)) (delete-file idlwave-shell-temp-pro-file)) @@ -3788,7 +3787,7 @@ handled by this command." (save-buffer) (setq idlwave-shell-last-save-and-action-file (buffer-file-name))) (idlwave-shell-last-save-and-action-file - (if (setq buf (idlwave-get-buffer-visiting + (if (setq buf (find-buffer-visiting idlwave-shell-last-save-and-action-file)) (with-current-buffer buf (save-buffer)))) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index f7e53ec02d6..153f2578bf1 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -581,12 +581,7 @@ like this: MyMethod <Class1,Class2,Class3> The value of this variable may be nil to inhibit display, or an integer to -indicate the maximum number of classes to display. - -On XEmacs, a full list of classes will also be placed into a `help-echo' -property on the completion items, so that the list of classes for the current -item is displayed in the echo area. If the value of this variable is a -negative integer, the `help-echo' property will be suppressed." +indicate the maximum number of classes to display." :group 'idlwave-completion :type '(choice (const :tag "Don't show" nil) (integer :tag "Number of classes shown" 1))) @@ -1054,7 +1049,6 @@ goto Goto Statements common-blocks Common Blocks keyword-parameters Keyword Parameters in routine definitions and calls system-variables System Variables -fixme FIXME: Warning in comments (on XEmacs only v. 21.0 and up) class-arrows Object Arrows with class property" :group 'idlwave-misc :type '(set @@ -1069,7 +1063,6 @@ class-arrows Object Arrows with class property" (const :tag "Common Blocks" common-blocks) (const :tag "Keyword Parameters" keyword-parameters) (const :tag "System Variables" system-variables) - (const :tag "FIXME: Warning" fixme) (const :tag "Object Arrows with class property " class-arrows))) (defcustom idlwave-mode-hook nil @@ -1138,23 +1131,16 @@ As a user, you should not set this to t.") ;; Common blocks (common-blocks '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?" - (1 font-lock-keyword-face) ; "common" - (2 font-lock-constant-face nil t) ; block name + (1 font-lock-keyword-face) ; "common" + (2 font-lock-constant-face nil t) ; block name ("[ \t]*\\(\\sw+\\)[ ,]*" ;; Start with point after block name and comma - (goto-char (match-end 0)) ; needed for XEmacs, could be nil - nil - (1 font-lock-variable-name-face) ; variable names - ))) + nil nil (1 font-lock-variable-name-face)))) ; variable names ;; Batch files (batch-files '("^[ \t]*\\(@[^ \t\n]+\\)" (1 font-lock-string-face))) - ;; FIXME warning. - (fixme - '("\\<FIXME:" (0 font-lock-warning-face t))) - ;; Labels (label '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-constant-face))) @@ -1241,9 +1227,6 @@ As a user, you should not set this to t.") ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w")) beginning-of-line)) -(put 'idlwave-mode 'font-lock-defaults - idlwave-font-lock-defaults) ; XEmacs - (defconst idlwave-comment-line-start-skip "^[ \t]*;" "Regexp to match the start of a full-line comment. That is the _beginning_ of a line containing a comment delimiter `;' preceded @@ -1479,9 +1462,7 @@ Otherwise ARGS forms a list that is evaluated." (define-key map "\M-\C-i" 'idlwave-complete) (define-key map "\C-c\C-i" 'idlwave-update-routine-info) (define-key map "\C-c=" 'idlwave-resolve) - (define-key map - (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) - 'idlwave-mouse-context-help) + (define-key map [(shift mouse-3)] 'idlwave-mouse-context-help) map) "Keymap used in IDL mode.") @@ -1916,8 +1897,6 @@ The main features of this mode are (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) ;; Font-lock additions - ;; Following line is for Emacs - XEmacs uses the corresponding property - ;; on the `idlwave-mode' symbol. (set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults) (set (make-local-variable 'font-lock-mark-block-function) 'idlwave-mark-subprogram) @@ -3814,15 +3793,8 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (setq start (match-end 0))) (setq ret_string (concat ret_string (substring string start last))))) -(defun idlwave-get-buffer-visiting (file) - ;; Return the buffer currently visiting FILE - (cond - ((boundp 'find-file-compare-truenames) ; XEmacs - (let ((find-file-compare-truenames t)) - (get-file-buffer file))) - ((fboundp 'find-buffer-visiting) ; Emacs - (find-buffer-visiting file)) - (t (error "This should not happen (idlwave-get-buffer-visiting)")))) +(define-obsolete-function-alias 'idlwave-get-buffer-visiting + #'find-buffer-visiting "28.1") (defvar idlwave-outlawed-buffers nil "List of buffers pulled up by IDLWAVE for special reasons. @@ -3830,7 +3802,7 @@ Buffers in this list may be killed by `idlwave-kill-autoloaded-buffers'.") (defun idlwave-find-file-noselect (file &optional why) ;; Return a buffer visiting file. - (or (idlwave-get-buffer-visiting file) + (or (find-buffer-visiting file) (let ((buf (find-file-noselect file))) (if why (add-to-list 'idlwave-outlawed-buffers (cons buf why))) buf))) @@ -6618,7 +6590,6 @@ This function is not general, can only be used for completion stuff." "A form to evaluate after completion selection in *Completions* buffer.") (defconst idlwave-completion-mark (make-marker) "A mark pointing to the beginning of the completion string.") -(defvar completion-highlight-first-word-only) ;XEmacs. (defun idlwave-complete-in-buffer (type stype list selector prompt isa &optional prepare-display-function @@ -6697,12 +6668,7 @@ accumulate information on matching completions." list)) (let* ((list all-completions) ;; "complete" means, this is already a valid completion - (complete (memq spart all-completions)) - (completion-highlight-first-word-only t)) ; XEmacs - ;; (completion-fixup-function ; Emacs - ;; (lambda () (and (eq (preceding-char) ?>) - ;; (re-search-backward " <" beg t))))) - + (complete (memq spart all-completions))) (setq list (sort list (lambda (a b) (string< (downcase a) (downcase b))))) (if prepare-display-function @@ -6764,7 +6730,6 @@ accumulate information on matching completions." (let* ((do-prop (and (>= show-classes 0) (>= emacs-major-version 21))) (do-buf (not (= show-classes 0))) - ;; (do-dots (featurep 'xemacs)) (do-dots t) (inherit (if (and (not (eq type 'class-tag)) super-classes) (cons class-selector super-classes))) @@ -6830,10 +6795,6 @@ accumulate information on matching completions." ;;---------------------------------------------------------------------- ;;---------------------------------------------------------------------- ;;---------------------------------------------------------------------- -(when (featurep 'xemacs) - (defvar rtn) - (defun idlwave-pset (item) - (set 'rtn item))) (defun idlwave-popup-select (ev list title &optional sort) "Select an item in LIST with a popup menu. @@ -6844,17 +6805,6 @@ sort the list before displaying." (cond ((null list)) ((= 1 (length list)) (setq rtn (car list))) - ((featurep 'xemacs) - (if sort (setq list (sort list (lambda (a b) - (string< (upcase a) (upcase b)))))) - (setq menu - (append (list title) - (mapcar (lambda (x) (vector x (list 'idlwave-pset - x))) - list))) - (setq menu (idlwave-split-menu-xemacs menu maxpopup)) - (let ((resp (get-popup-menu-response menu))) - (funcall (event-function resp) (event-object resp)))) (t (if sort (setq list (sort list (lambda (a b) (string< (upcase a) (upcase b)))))) @@ -6862,36 +6812,14 @@ sort the list before displaying." (list (append (list "") (mapcar (lambda(x) (cons x x)) list))))) - (setq menu (idlwave-split-menu-emacs menu maxpopup)) + (setq menu (idlwave-split-menu menu maxpopup)) (setq rtn (x-popup-menu ev menu)))) rtn)) -(defun idlwave-split-menu-xemacs (menu N) - "Split the MENU into submenus of maximum length N." - (if (<= (length menu) (1+ N)) - ;; No splitting needed - menu - (let* ((title (car menu)) - (entries (cdr menu)) - (menu (list title)) - (cnt 0) - (nextmenu nil)) - (while entries - (while (and entries (< cnt N)) - (setq cnt (1+ cnt) - nextmenu (cons (car entries) nextmenu) - entries (cdr entries))) - (setq nextmenu (nreverse nextmenu)) - (setq nextmenu (cons (format "%s...%s" - (aref (car nextmenu) 0) - (aref (nth (1- cnt) nextmenu) 0)) - nextmenu)) - (setq menu (cons nextmenu menu) - nextmenu nil - cnt 0)) - (nreverse menu)))) +(define-obsolete-function-alias 'idlwave-split-menu-emacs + #'idlwave-split-menu "28.1") -(defun idlwave-split-menu-emacs (menu N) +(defun idlwave-split-menu (menu N) "Split the MENU into submenus of maximum length N." (if (<= (length (nth 1 menu)) (1+ N)) ;; No splitting needed @@ -6946,10 +6874,7 @@ sort the list before displaying." (move-marker idlwave-completion-mark beg) (setq idlwave-before-completion-wconf (current-window-configuration))) - (if (featurep 'xemacs) - (idlwave-display-completion-list-xemacs - list) - (idlwave-display-completion-list-emacs list)) + (idlwave-display-completion-list-1 list) ;; Store a special value in `this-command'. When `idlwave-complete' ;; finds this in `last-command', it will scroll the *Completions* buffer. @@ -7007,8 +6932,7 @@ The key which is associated with each option is generated automatically. First, the strings are checked for preselected keys, like in \"[P]rint\". If these don't exist, a letter in the string is automatically selected." (let* ((alist (symbol-value sym)) - (temp-buffer-show-hook (if (fboundp 'fit-window-to-buffer) - '(fit-window-to-buffer))) + (temp-buffer-show-hook '(fit-window-to-buffer)) keys-alist char) ;; First check the cache (if (and (eq (symbol-value sym) (get sym :one-key-alist-last))) @@ -7094,42 +7018,17 @@ If these don't exist, a letter in the string is automatically selected." (and (local-variable-p var (current-buffer)) (symbol-value var)))) -;; In XEmacs, we can use :activate-callback directly to advice the -;; choose functions. We use the private keymap only for the online -;; help feature. - (defvar idlwave-completion-map nil "Keymap for `completion-list-mode' with `idlwave-complete'.") -(defun idlwave-display-completion-list-xemacs (list &rest cl-args) - (with-output-to-temp-buffer "*Completions*" - (apply 'display-completion-list list - ':activate-callback 'idlwave-default-choose-completion - cl-args)) - (with-current-buffer "*Completions*" - (use-local-map - (or idlwave-completion-map - (setq idlwave-completion-map - (idlwave-make-modified-completion-map-xemacs - (current-local-map))))))) - (defun idlwave-default-choose-completion (&rest args) "Execute `default-choose-completion' and then restore the win-conf." (apply 'idlwave-choose 'default-choose-completion args)) -(defun idlwave-make-modified-completion-map-xemacs (old-map) - "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." - (let ((new-map (copy-keymap old-map))) - (define-key new-map [button3up] 'idlwave-mouse-completion-help) - (define-key new-map [button3] (lambda () - (interactive) - (setq this-command last-command))) - new-map)) - -;; In Emacs we also replace keybindings in the completion -;; map in order to install our wrappers. +(define-obsolete-function-alias 'idlwave-display-completion-list-emacs + #'idlwave-display-completion-list-1 "28.1") -(defun idlwave-display-completion-list-emacs (list) +(defun idlwave-display-completion-list-1 (list) "Display completion list and install the choose wrappers." (with-output-to-temp-buffer "*Completions*" (display-completion-list list)) @@ -7137,10 +7036,12 @@ If these don't exist, a letter in the string is automatically selected." (use-local-map (or idlwave-completion-map (setq idlwave-completion-map - (idlwave-make-modified-completion-map-emacs - (current-local-map))))))) + (idlwave-make-modified-completion-map (current-local-map))))))) -(defun idlwave-make-modified-completion-map-emacs (old-map) +(define-obsolete-function-alias 'idlwave-make-modified-completion-map-emacs + #'idlwave-make-modified-completion-map "28.1") + +(defun idlwave-make-modified-completion-map (old-map) "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." (let ((new-map (copy-keymap old-map))) (substitute-key-definition @@ -7352,7 +7253,7 @@ class/struct definition." (file (idlwave-routine-source-file (nth 3 (idlwave-rinfo-assoc pro 'pro nil (idlwave-routines)))))) - (cons file (if file (idlwave-get-buffer-visiting file))))) + (cons file (if file (find-buffer-visiting file))))) (defun idlwave-scan-class-info (class) @@ -8223,15 +8124,9 @@ If we do not know about MODULE, just return KEYWORD literally." (defvar idlwave-rinfo-mouse-map (let ((map (make-sparse-keymap))) - (define-key map - (if (featurep 'xemacs) [button2] [mouse-2]) - 'idlwave-mouse-active-rinfo) - (define-key map - (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) - 'idlwave-mouse-active-rinfo-shift) - (define-key map - (if (featurep 'xemacs) [button3] [mouse-3]) - 'idlwave-mouse-active-rinfo-right) + (define-key map [mouse-2] 'idlwave-mouse-active-rinfo) + (define-key map [(shift mouse-2)] 'idlwave-mouse-active-rinfo-shift) + (define-key map [mouse-3] 'idlwave-mouse-active-rinfo-right) (define-key map " " 'idlwave-active-rinfo-space) (define-key map "q" 'idlwave-quit-help) map)) @@ -8283,7 +8178,6 @@ If we do not know about MODULE, just return KEYWORD literally." "Button2: Display info about same method in superclass") (col 0) (data (list name type class (current-buffer) nil initial-class)) - (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) (face 'idlwave-help-link) beg props win cnt total) ;; Fix keywords, but don't add chained super-classes, since these @@ -8308,7 +8202,7 @@ If we do not know about MODULE, just return KEYWORD literally." idlwave-current-obj_new-class) (when superclasses (setq props (list 'mouse-face 'highlight - km-prop idlwave-rinfo-mouse-map + 'local-map idlwave-rinfo-mouse-map 'help-echo help-echo-class 'data (cons 'class data))) (let ((classes (cons initial-class superclasses)) c) @@ -8324,7 +8218,7 @@ If we do not know about MODULE, just return KEYWORD literally." (add-text-properties beg (point) props)))) (insert "\n"))) (setq props (list 'mouse-face 'highlight - km-prop idlwave-rinfo-mouse-map + 'local-map idlwave-rinfo-mouse-map 'help-echo help-echo-use 'data (cons 'usage data))) (if html-file (setq props (append (list 'face face 'link html-file) @@ -8352,7 +8246,7 @@ If we do not know about MODULE, just return KEYWORD literally." (setq beg (point) ;; Relevant keywords already have link property attached props (list 'mouse-face 'highlight - km-prop idlwave-rinfo-mouse-map + 'local-map idlwave-rinfo-mouse-map 'data (cons 'keyword data) 'help-echo help-echo-kwd 'keyword (car x))) @@ -8366,7 +8260,7 @@ If we do not know about MODULE, just return KEYWORD literally." ;; Here entry is (key file (list of type-conses)) (while (setq entry (pop all)) (setq props (list 'mouse-face 'highlight - km-prop idlwave-rinfo-mouse-map + 'local-map idlwave-rinfo-mouse-map 'help-echo help-echo-src 'source (list (car (car (nth 2 entry))) ;type (nth 1 entry) @@ -8471,8 +8365,7 @@ to it." (add-text-properties beg (point) (list 'face 'bold))) (when (and file (not (equal file ""))) (setq beg (point)) - (insert (apply 'abbreviate-file-name - (if (featurep 'xemacs) (list file t) (list file)))) + (insert (apply 'abbreviate-file-name (list file))) (if file-props (add-text-properties beg (point) file-props))))) @@ -8632,10 +8525,9 @@ can be used to detect possible name clashes during this process." idlwave-user-catalog-routines idlwave-buffer-routines nil)) - (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) (keymap (make-sparse-keymap)) (props (list 'mouse-face 'highlight - km-prop keymap + 'local-map keymap 'help-echo "Mouse2: Find source")) (nroutines (length (or special-routines routines))) (step (/ nroutines 100)) @@ -8658,7 +8550,7 @@ can be used to detect possible name clashes during this process." (nth 2 b) (car b))))))) (message "Sorting routines...done") - (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)]) + (define-key keymap [(mouse-2)] (lambda (ev) (interactive "e") (mouse-set-point ev) @@ -9020,23 +8912,6 @@ Assumes that point is at the beginning of the unit as found by 'imenu) (error nil))))) -;; Here we hack func-menu.el in order to support this new mode. -;; The latest versions of func-menu.el already have this stuff in, so -;; we hack only if it is not already there. -(when (featurep 'xemacs) - (eval-after-load "func-menu" - '(progn - (or (assq 'idlwave-mode fume-function-name-regexp-alist) - (not (boundp 'fume-function-name-regexp-idl)) ; avoid problems - (setq fume-function-name-regexp-alist - (cons '(idlwave-mode . fume-function-name-regexp-idl) - fume-function-name-regexp-alist))) - (or (assq 'idlwave-mode fume-find-function-name-method-alist) - (not (fboundp 'fume-find-next-idl-function-name)) ; avoid problems - (setq fume-find-function-name-method-alist - (cons '(idlwave-mode . fume-find-next-idl-function-name) - fume-find-function-name-method-alist)))))) - (defun idlwave-edit-in-idlde () "Edit the current file in IDL Development environment." (interactive) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index ff0b6a331bc..127b24cb890 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -214,7 +214,9 @@ (defconst perl--syntax-exp-intro-regexp (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" (regexp-opt perl--syntax-exp-intro-keywords) - "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*"))) + "\\|[?:.,;|&*=!~({[]" + "\\|[^-+][-+]" ;Bug#42168: `+' is intro but `++' isn't! + "\\|\\(^\\)\\)[ \t\n]*"))) (defun perl-syntax-propertize-function (start end) (let ((case-fold-search nil)) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index b6161351f0b..8afd5ce7959 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,8 +1,8 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. -;; Version: 0.5.0 -;; Package-Requires: ((emacs "26.3")) +;; Version: 0.5.1 +;; Package-Requires: ((emacs "26.3") (xref "1.0.2")) ;; This is a GNU ELPA :core package. Avoid using functionality that ;; not compatible with the version of Emacs recorded above. @@ -731,24 +731,6 @@ pattern to search for." (user-error "No matches for: %s" regexp)) xrefs)) -(defun project--process-file-region (start end program - &optional buffer display - &rest args) - ;; FIXME: This branching shouldn't be necessary, but - ;; call-process-region *is* measurably faster, even for a program - ;; doing some actual work (for a period of time). Even though - ;; call-process-region also creates a temp file internally - ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html). - (if (not (file-remote-p default-directory)) - (apply #'call-process-region - start end program nil buffer display args) - (let ((infile (make-temp-file "ppfr"))) - (unwind-protect - (progn - (write-region start end infile nil 'silent) - (apply #'process-file program infile buffer display args)) - (delete-file infile))))) - (defun project--read-regexp () (let ((sym (thing-at-point 'symbol))) (read-regexp "Find regexp" (and sym (regexp-quote sym))))) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 3af55be4a19..d83af83b32e 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -283,24 +283,6 @@ :link '(emacs-commentary-link "python")) -;;; 24.x Compat - - -(eval-and-compile - (unless (fboundp 'prog-first-column) - (defun prog-first-column () - 0)) - (unless (fboundp 'file-local-name) - (defun file-local-name (file) - "Return the local name component of FILE. -It returns a file name which can be used directly as argument of -`process-file', `start-file-process', or `shell-command'." - (or (file-remote-p file 'localname) file)))) - -;; In Emacs 24.3 and earlier, `define-derived-mode' does not define -;; the hook variable, it only puts documentation on the symbol. -(defvar inferior-python-mode-hook) - ;;; Bindings @@ -2809,6 +2791,7 @@ variable. python-shell-comint-watch-for-first-prompt-output-filter python-comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)) + (setq-local comint-highlight-input nil) (set (make-local-variable 'compilation-error-regexp-alist) python-shell-compilation-regexp-alist) (add-hook 'completion-at-point-functions diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index f9b069fd4e5..0f2c9431f6e 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -115,6 +115,8 @@ treat nomenclature boundaries as word boundaries." (when subword-mode (superword-mode -1)) (subword-setup-buffer)) +;; This is defined also in cc-cmds.el, but as obsolete since 24.3. +;; Let's keep this until the other one can also be removed. (define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2") ;;;###autoload diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 3e3a37f6da5..bbf899e7017 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,8 +1,8 @@ ;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2020 Free Software Foundation, Inc. -;; Version: 1.0.1 -;; Package-Requires: ((emacs "26.3") (project "0.1.1")) +;; Version: 1.0.2 +;; Package-Requires: ((emacs "26.3")) ;; This is a GNU ELPA :core package. Avoid functionality that is not ;; compatible with the version of Emacs recorded above. @@ -263,13 +263,16 @@ be found, return nil. The default implementation uses `semantic-symref-tool-alist' to find a search tool; by default, this uses \"find | grep\" in the -`project-current' roots." +current project's main and external roots." (mapcan (lambda (dir) (xref-references-in-directory identifier dir)) (let ((pr (project-current t))) (cons - (project-root pr) + (if (fboundp 'project-root) + (project-root pr) + (with-no-warnings + (project-roots pr))) (project-external-roots pr))))) (cl-defgeneric xref-backend-apropos (backend pattern) @@ -1281,13 +1284,13 @@ FILES must be a list of absolute file names." (insert (mapconcat #'identity files "\0")) (setq default-directory dir) (setq status - (project--process-file-region (point-min) - (point-max) - shell-file-name - output - nil - shell-command-switch - command))) + (xref--process-file-region (point-min) + (point-max) + shell-file-name + output + nil + shell-command-switch + command))) (goto-char (point-min)) (when (and (/= (point-min) (point-max)) (not (looking-at grep-re)) @@ -1302,6 +1305,24 @@ FILES must be a list of absolute file names." hits))) (xref--convert-hits (nreverse hits) regexp))) +(defun xref--process-file-region ( start end program + &optional buffer display + &rest args) + ;; FIXME: This branching shouldn't be necessary, but + ;; call-process-region *is* measurably faster, even for a program + ;; doing some actual work (for a period of time). Even though + ;; call-process-region also creates a temp file internally + ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html). + (if (not (file-remote-p default-directory)) + (apply #'call-process-region + start end program nil buffer display args) + (let ((infile (make-temp-file "ppfr"))) + (unwind-protect + (progn + (write-region start end infile nil 'silent) + (apply #'process-file program infile buffer display args)) + (delete-file infile))))) + (defun xref--rgrep-command (regexp files dir ignores) (require 'find-dired) ; for `find-name-arg' (defvar grep-find-template) diff --git a/lisp/ps-def.el b/lisp/ps-def.el index f532511b977..65e8011f771 100644 --- a/lisp/ps-def.el +++ b/lisp/ps-def.el @@ -58,21 +58,11 @@ (define-obsolete-function-alias 'ps-frame-parameter #'frame-parameter "28.1") ;; Return t if the device (which can be changed during an emacs session) can -;; handle colors. This function is not yet implemented for GNU emacs. +;; handle colors. (defun ps-color-device () - (if (fboundp 'color-values) - (funcall 'color-values "Green") - t)) - - -(defun ps-color-values (x-color) - (cond - ((fboundp 'color-values) - (funcall 'color-values x-color)) - ((fboundp 'x-color-values) - (funcall 'x-color-values x-color)) - (t - (error "No available function to determine X color values")))) + (color-values "Green")) + +(define-obsolete-function-alias 'ps-color-values #'color-values "28.1") (defun ps-face-bold-p (face) diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 17b486bca11..1ca4a23ab2c 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -3856,7 +3856,7 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'." (defun ps-color-scale (color) ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval. (mapcar #'(lambda (value) (/ value ps-print-color-scale)) - (ps-color-values color))) + (color-values color))) (defun ps-face-underlined-p (face) @@ -5752,7 +5752,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") ;; evaluated at dump-time because X isn't initialized. ps-color-p (and ps-print-color-p (ps-color-device)) ps-print-color-scale (if ps-color-p - (float (car (ps-color-values "white"))) + (float (car (color-values "white"))) 1.0) ps-default-background (ps-rgb-color (cond @@ -6275,10 +6275,6 @@ If FACE is not a valid face name, use default face." (goto-char to)) -;; Ensure that face-list is fbound. -(or (fboundp 'face-list) (defalias 'face-list 'list-faces)) - - (defun ps-build-reference-face-lists () (setq ps-print-face-alist nil) (if ps-auto-font-detect diff --git a/lisp/savehist.el b/lisp/savehist.el index fcfdb47c7e8..4e52efe7f1a 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -4,7 +4,7 @@ ;; Author: Hrvoje Nikšić <hrvoje.niksic@avl.com> ;; Maintainer: emacs-devel@gnu.org -;; Keywords: minibuffer +;; Keywords: convenience, minibuffer ;; Version: 24 ;; This file is part of GNU Emacs. @@ -27,7 +27,7 @@ ;; Many editors (e.g. Vim) have the feature of saving minibuffer ;; history to an external file after exit. This package provides the ;; same feature in Emacs. When set up, it saves recorded minibuffer -;; histories to a file (`~/.emacs-history' by default). Additional +;; histories to a file (`~/.emacs.d/history' by default). Additional ;; variables may be specified by customizing ;; `savehist-additional-variables'. diff --git a/lisp/shell.el b/lisp/shell.el index f5e18bbc728..9667dab2afd 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -990,9 +990,6 @@ this feature; see the function `dirtrack-mode'." (add-hook 'comint-input-filter-functions #'shell-directory-tracker nil t) (remove-hook 'comint-input-filter-functions #'shell-directory-tracker t))) -(define-obsolete-function-alias 'shell-dirtrack-toggle #'shell-dirtrack-mode - "23.1") - (defun shell-cd (dir) "Do normal `cd' to DIR, and set `list-buffers-directory'." (cd dir) @@ -1038,25 +1035,41 @@ command again." (accept-process-output proc) (goto-char pt))) (goto-char pmark) (delete-char 1) ; remove the extra newline - ;; That's the dirlist. grab it & parse it. - (let* ((dl (buffer-substring (match-beginning 2) (1- (match-end 2)))) - (dl-len (length dl)) - (ds '()) ; new dir stack - (i 0)) - (while (< i dl-len) - ;; regexp = optional whitespace, (non-whitespace), optional whitespace - (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir - (setq ds (cons (concat comint-file-name-prefix - (substring dl (match-beginning 1) - (match-end 1))) - ds)) - (setq i (match-end 0))) - (let ((ds (nreverse ds))) - (with-demoted-errors "Couldn't cd: %s" - (shell-cd (car ds)) - (setq shell-dirstack (cdr ds) - shell-last-dir (car shell-dirstack)) - (shell-dirstack-message))))) + ;; That's the dirlist. Grab it & parse it. + (let* ((dls (buffer-substring-no-properties + (match-beginning 0) (1- (match-end 0)))) + (dlsl nil) + (pos 0) + (ds nil)) + ;; Split the dirlist into whitespace and non-whitespace chunks. + ;; dlsl will be a reversed list of tokens. + (while (string-match "\\(\\S-+\\|\\s-+\\)" dls pos) + (push (match-string 1 dls) dlsl) + (setq pos (match-end 1))) + + ;; Prepend trailing entries until they form an existing directory, + ;; whitespace and all. Discard the next whitespace and repeat. + (while dlsl + (let ((newelt "") + tem1 tem2) + (while newelt + ;; We need tem1 because we don't want to prepend + ;; `comint-file-name-prefix' repeatedly into newelt via tem2. + (setq tem1 (pop dlsl) + tem2 (concat comint-file-name-prefix tem1 newelt)) + (cond ((file-directory-p tem2) + (push tem2 ds) + (when (string= " " (car dlsl)) + (pop dlsl)) + (setq newelt nil)) + (t + (setq newelt (concat tem1 newelt))))))) + + (with-demoted-errors "Couldn't cd: %s" + (shell-cd (car ds)) + (setq shell-dirstack (cdr ds) + shell-last-dir (car shell-dirstack)) + (shell-dirstack-message)))) (if started-at-pmark (goto-char (marker-position pmark))))) ;; For your typing convenience: diff --git a/lisp/simple.el b/lisp/simple.el index 6f72c3b81b9..f08015372af 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -247,7 +247,7 @@ from which next-error navigated, and a target buffer TO-BUFFER." extra-test-exclusive) "Try the current buffer when outside navigation. But return nil if we navigated to the current buffer by the means -of `next-error' command. Othewise, return it if it's next-error +of `next-error' command. Otherwise, return it if it's next-error capable." ;; Check that next-error-buffer has no buffer-local value ;; (i.e. we never navigated to the current buffer from another), @@ -1323,7 +1323,9 @@ If called from Lisp, return the number of words between START and END, without printing any message." (interactive (list nil nil)) (cond ((not (called-interactively-p 'any)) - (let ((words 0)) + (let ((words 0) + ;; Count across field boundaries. (Bug#41761) + (inhibit-field-text-motion t)) (save-excursion (save-restriction (narrow-to-region start end) @@ -1556,6 +1558,8 @@ in *Help* buffer. See also the command `describe-char'." ;; Might as well bind TAB to completion, since inserting a TAB char is ;; much too rarely useful. (define-key m "\t" 'completion-at-point) + (define-key m "\r" 'read--expression-try-read) + (define-key m "\n" 'read--expression-try-read) (set-keymap-parent m minibuffer-local-map) m)) @@ -1652,8 +1656,6 @@ function `read-from-minibuffer'." (set-syntax-table emacs-lisp-mode-syntax-table) (add-hook 'completion-at-point-functions #'elisp-completion-at-point nil t) - (local-set-key "\r" 'read--expression-try-read) - (local-set-key "\n" 'read--expression-try-read) (run-hooks 'eval-expression-minibuffer-setup-hook)) (read-from-minibuffer prompt initial-contents read-expression-map t @@ -1845,9 +1847,15 @@ to get different commands to edit and resubmit." (lambda () ;; Get a command name at point in the original buffer ;; to propose it after M-n. - (with-current-buffer (window-buffer (minibuffer-selected-window)) - (and (commandp (function-called-at-point)) - (format "%S" (function-called-at-point))))))) + (let ((def (with-current-buffer + (window-buffer (minibuffer-selected-window)) + (and (commandp (function-called-at-point)) + (format "%S" (function-called-at-point))))) + (all (sort (minibuffer-default-add-completions) + #'string<))) + (if def + (cons def (delete def all)) + all))))) ;; Read a string, completing from and restricting to the set of ;; all defined commands. Don't provide any initial input. ;; Save the command read on the extended-command history list. diff --git a/lisp/so-long.el b/lisp/so-long.el index f2c078ba841..f8a5cc920d9 100644 --- a/lisp/so-long.el +++ b/lisp/so-long.el @@ -255,8 +255,7 @@ ;; `so-long-mode', completely bypassing the automated decision process. ;; Refer to M-: (info "(emacs) Specifying File Variables") RET ;; -;; If so-long itself is causing problems, it can be inhibited by setting the -;; `so-long-enabled' variable to nil, or by disabling the global mode with +;; If so-long itself causes problems, disable the automated behaviour with ;; M-- M-x global-so-long-mode, or M-: (global-so-long-mode 0) ;; * Example configuration @@ -282,6 +281,43 @@ ;; '((show-trailing-whitespace . nil) ;; (truncate-lines . nil)))) +;; * Mode-specific configuration +;; ----------------------------- +;; The `so-long-predicate' function is called in the context of the buffer's +;; original major mode, and therefore major mode hooks can be used to control +;; the criteria for calling `so-long' in any given mode (plus its derivatives) +;; by setting buffer-local values for the variables in question. This includes +;; `so-long-predicate' itself, as well as any variables used by the predicate +;; when determining the result. By default this means `so-long-max-lines', +;; `so-long-skip-leading-comments', and `so-long-threshold'. E.g.: +;; +;; (add-hook 'js-mode-hook 'my-js-mode-hook) +;; +;; (defun my-js-mode-hook () +;; "Custom `js-mode' behaviours." +;; (setq-local so-long-max-lines 100) +;; (setq-local so-long-threshold 1000)) +;; +;; `so-long-variable-overrides' and `so-long-minor-modes' may also be given +;; buffer-local values in order to apply different settings to different types +;; of file. For example, the Bidirectional Parentheses Algorithm does not apply +;; to `<' and `>' characters by default, and therefore one might prefer to not +;; set `bidi-inhibit-bpa' in XML files, on the basis that XML files with long +;; lines are less likely to trigger BPA-related performance problems: +;; +;; (add-hook 'nxml-mode-hook 'my-nxml-mode-hook) +;; +;; (defun my-nxml-mode-hook () +;; "Custom `nxml-mode' behaviours." +;; (require 'so-long) +;; (setq-local so-long-variable-overrides +;; (remove '(bidi-inhibit-bpa . t) so-long-variable-overrides))) +;; +;; Finally, note that setting `so-long-target-modes' to nil buffer-locally in +;; a major mode hook would prevent that mode from ever being targeted. With +;; `prog-mode' being targeted by default, specific derivatives of `prog-mode' +;; could therefore be un-targeted if desired. + ;; * Other ways of using so-long ;; ----------------------------- ;; It may prove useful to automatically invoke major mode `so-long-mode' for @@ -376,7 +412,6 @@ ;; - Added mode-line indicator, user option `so-long-mode-line-label', ;; and faces `so-long-mode-line-active', `so-long-mode-line-inactive'. ;; - New help commands `so-long-commentary' and `so-long-customize'. -;; - Renamed `so-long-mode-enabled' to `so-long-enabled'. ;; - Refactored the default hook values using variable overrides ;; (and returning all the hooks to nil default values). ;; - Performance improvements for `so-long-detected-long-line-p'. @@ -416,9 +451,14 @@ (declare-function longlines-mode "longlines") (defvar longlines-mode) (defvar so-long-enabled nil - "Set to nil to prevent `so-long' from being triggered automatically. - -Has no effect if `global-so-long-mode' is not enabled.") + ;; This was initially a renaming of the old `so-long-mode-enabled' and + ;; documented as "Set to nil to prevent `so-long' from being triggered + ;; automatically."; however `so-long--ensure-enabled' may forcibly re-enable + ;; it contrary to the user's expectations, so for the present this should be + ;; considered internal-use only (with `global-so-long-mode' the interface + ;; for enabling or disabling the automated behaviour). FIXME: Establish a + ;; way to support the original use-case, or rename to `so-long--enabled'. + "Internal use. Non-nil when any so-long functionality has been used.") (defvar-local so-long--active nil ; internal use "Non-nil when `so-long' mitigations are in effect.") @@ -886,9 +926,15 @@ buffer-local." Stores the existing value for each entry in `so-long-variable-overrides'. Stores the name of each enabled mode from the list `so-long-minor-modes'. +The lists themselves are also remembered, so that major mode hooks can +provide buffer-local modifications which are still accessible after changing +to `so-long-mode'. + If RESET is non-nil, remove any existing values before storing the new ones." (when reset (setq so-long-original-values nil)) + (so-long-remember 'so-long-variable-overrides) + (so-long-remember 'so-long-minor-modes) (dolist (ovar so-long-variable-overrides) (so-long-remember (car ovar))) (dolist (mode so-long-minor-modes) @@ -1288,7 +1334,7 @@ Calls `so-long-disable-minor-modes' and `so-long-override-variables'." (defun so-long-disable-minor-modes () "Disable any active minor modes listed in `so-long-minor-modes'." - (dolist (mode so-long-minor-modes) + (dolist (mode (so-long-original 'so-long-minor-modes)) (when (and (boundp mode) mode) (funcall mode 0)))) @@ -1304,7 +1350,7 @@ The modes are enabled in accordance with what was remembered in `so-long'." (defun so-long-override-variables () "Set the buffer-local values defined by `so-long-variable-overrides'." - (dolist (ovar so-long-variable-overrides) + (dolist (ovar (so-long-original 'so-long-variable-overrides)) (set (make-local-variable (car ovar)) (cdr ovar)))) (defun so-long-restore-variables () @@ -1879,7 +1925,7 @@ If it appears in `%s', you should remove it." ; LocalWords: defadvice nadvice whitespace ie bos eos eobp origmode un Un setq ; LocalWords: docstring auf Wiedersehen longlines alist autoload Refactored Inc ; LocalWords: MERCHANTABILITY RET REGEXP VAR ELPA WS mitigations EmacsWiki eval -; LocalWords: rx filename filenames bidi bpa +; LocalWords: rx filename filenames js defun bidi bpa prog FIXME ;; So long, farewell, auf Wiedersehen, goodbye ;; You have to go, this code is minified diff --git a/lisp/speedbar.el b/lisp/speedbar.el index e9c15b71ce6..5b98eb36bb9 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -3240,19 +3240,21 @@ With universal argument ARG, flush cached data." "Expand the line under the cursor and all descendants. Optional argument ARG indicates that any cache should be flushed." (interactive "P") - (speedbar-expand-line arg) - ;; Now, inside the area expanded here, expand all subnodes of - ;; the same descendant type. - (save-excursion - (speedbar-next 1) ;; Move into the list. - (let ((err nil)) - (while (not err) - (condition-case nil - (progn - (speedbar-expand-line-descendants arg) - (speedbar-restricted-next 1)) - (error (setq err t)))))) - ) + (save-restriction + (narrow-to-region (line-beginning-position) + (line-beginning-position 2)) + (speedbar-expand-line arg) + ;; Now, inside the area expanded here, expand all subnodes of + ;; the same descendant type. + (save-excursion + (speedbar-next 1) ;; Move into the list. + (let ((err nil)) + (while (not err) + (condition-case nil + (progn + (speedbar-expand-line-descendants arg) + (speedbar-restricted-next 1)) + (error (setq err t)))))))) (defun speedbar-contract-line-descendants () "Expand the line under the cursor and all descendants." diff --git a/lisp/startup.el b/lisp/startup.el index e58f27e7ebc..536a3de17a7 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -537,6 +537,9 @@ It is the default value of the variable `top-level'." (setq user-emacs-directory (startup--xdg-or-homedot startup--xdg-config-home-emacs nil)) + (when (boundp 'comp-eln-load-path) + (setq comp-eln-load-path (cons (concat user-emacs-directory "eln-cache/") + comp-eln-load-path))) ;; Look in each dir in load-path for a subdirs.el file. If we ;; find one, load it, which will add the appropriate subdirs of ;; that dir into load-path. This needs to be done before setting @@ -649,11 +652,12 @@ It is the default value of the variable `top-level'." ;; Use FOO/., so that if FOO is a symlink, file-attributes ;; describes the directory linked to, not FOO itself. (or (and default-directory - (equal (file-attributes - (concat (file-name-as-directory pwd) ".")) - (file-attributes - (concat (file-name-as-directory default-directory) - ".")))) + (ignore-errors + (equal (file-attributes + (concat (file-name-as-directory pwd) ".")) + (file-attributes + (concat (file-name-as-directory default-directory) + "."))))) (setq process-environment (delete (concat "PWD=" pwd) process-environment))))) diff --git a/lisp/subr.el b/lisp/subr.el index 0ae636b68b4..093cacc8cb6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1588,11 +1588,6 @@ be a list of the form returned by `event-start' and `event-end'." (make-obsolete 'string-as-multibyte "use `decode-coding-string'." "26.1") (make-obsolete 'string-make-multibyte "use `decode-coding-string'." "26.1") -(defun forward-point (n) - "Return buffer position N characters after (before if N negative) point." - (declare (obsolete "use (+ (point) N) instead." "23.1")) - (+ (point) n)) - (defun log10 (x) "Return (log X 10), the log base 10 of X." (declare (obsolete log "24.4")) @@ -1617,8 +1612,6 @@ be a list of the form returned by `event-start' and `event-end'." (make-obsolete 'set-window-redisplay-end-trigger nil "23.1") (make-obsolete 'run-window-configuration-change-hook nil "27.1") -(make-obsolete 'process-filter-multibyte-p nil "23.1") -(make-obsolete 'set-process-filter-multibyte nil "23.1") (make-obsolete-variable 'command-debug-status "expect it to be removed in a future version." "25.2") @@ -1661,7 +1654,8 @@ be a list of the form returned by `event-start' and `event-end'." (defalias 'point-at-eol 'line-end-position) (defalias 'point-at-bol 'line-beginning-position) -(defalias 'user-original-login-name 'user-login-name) +(define-obsolete-function-alias 'user-original-login-name + 'user-login-name "28.1") ;;;; Hook manipulation functions. diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el index a1af53d8c46..4feab71401e 100644 --- a/lisp/t-mouse.el +++ b/lisp/t-mouse.el @@ -63,8 +63,6 @@ (set-terminal-parameter nil 'gpm-mouse-active nil)) ;;;###autoload -(define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1") -;;;###autoload (define-minor-mode gpm-mouse-mode "Toggle mouse support in GNU/Linux consoles (GPM Mouse mode). diff --git a/lisp/term.el b/lisp/term.el index b990c83cfcb..99f1bf4f54f 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -467,6 +467,11 @@ Customize this option to nil if you want the previous behavior." :type 'boolean :group 'term) +(defcustom term-set-terminal-size nil + "If non-nil, set the LINES and COLUMNS environment variables." + :type 'boolean + :version "28.1") + (defcustom term-char-mode-point-at-process-mark t "If non-nil, keep point at the process mark in char mode. @@ -501,6 +506,14 @@ This variable is buffer-local." :type 'boolean :group 'term) +(defcustom term-scroll-snap-to-bottom t + "Control whether to keep the prompt at the bottom of the window. +If non-nil, when the prompt is visible within the window, then +scroll so that the prompt is on the bottom on any input or +output." + :version "28.1" + :type 'boolean) + (defcustom term-scroll-show-maximum-output nil "Controls how interpreter output causes window to scroll. If non-nil, then show the maximum output when the window is scrolled. @@ -1543,9 +1556,12 @@ Nil if unknown.") (format term-termcap-format "TERMCAP=" term-term-name term-height term-width) - (format "INSIDE_EMACS=%s,term:%s" emacs-version term-protocol-version) - (format "LINES=%d" term-height) - (format "COLUMNS=%d" term-width)) + (format "INSIDE_EMACS=%s,term:%s" + emacs-version term-protocol-version)) + (when term-set-terminal-size + (list + (format "LINES=%d" term-height) + (format "COLUMNS=%d" term-width))) process-environment)) (process-connection-type t) ;; We should suppress conversion of end-of-line format. @@ -3108,15 +3124,19 @@ See `term-prompt-regexp'." (or (eq scroll 'this) (not save-point))) (and (eq scroll 'others) (not (eq selected win)))) - (goto-char term-home-marker) - (recenter 0) + (when term-scroll-snap-to-bottom + (goto-char term-home-marker) + (recenter 0)) (goto-char (process-mark proc)) (if (not (pos-visible-in-window-p (point) win)) (recenter -1))) ;; Optionally scroll so that the text ;; ends at the bottom of the window. (when (and term-scroll-show-maximum-output - (>= (point) (process-mark proc))) + (>= (point) (process-mark proc)) + (or term-scroll-snap-to-bottom + (not (pos-visible-in-window-p + (point-max) win)))) (save-excursion (goto-char (point-max)) (recenter -1))))) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 6b9716ca307..f15337818b0 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -78,12 +78,8 @@ (require 'dnd) (require 'w32-vars) -;; Keep an obsolete alias for w32-focus-frame and w32-select-font in case -;; they are used by code outside Emacs. -(define-obsolete-function-alias 'w32-focus-frame 'x-focus-frame "23.1") (declare-function x-select-font "w32font.c" (&optional frame exclude-proportional)) -(define-obsolete-function-alias 'w32-select-font 'x-select-font "23.1") (defvar w32-color-map) ;; defined in w32fns.c (make-obsolete 'w32-default-color-map nil "24.1") diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 0018b89d858..910bd7dbb9d 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -3445,6 +3445,7 @@ if that value is non-nil. (set (make-local-variable 'syntax-propertize-function) (syntax-propertize-via-font-lock bibtex-font-lock-syntactic-keywords)) + (bibtex-set-dialect nil t) ;; Allow `bibtex-dialect' as a file-local variable. (add-hook 'hack-local-variables-hook #'bibtex-set-dialect nil t)) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 39a1b488a74..23f96d7e0ee 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -57,7 +57,6 @@ (defcustom flyspell-highlight-flag t "How Flyspell should indicate misspelled words. Non-nil means use highlight, nil means use minibuffer messages." - :group 'flyspell :type 'boolean) (defcustom flyspell-mark-duplications-flag t @@ -65,12 +64,10 @@ Non-nil means use highlight, nil means use minibuffer messages." See `flyspell-mark-duplications-exceptions' to add exceptions to this rule. Detection of repeated words is not implemented in \"large\" regions; see variable `flyspell-large-region'." - :group 'flyspell :type 'boolean) (defcustom flyspell-case-fold-duplications t "Non-nil means Flyspell matches duplicate words case-insensitively." - :group 'flyspell :type 'boolean :version "27.1") @@ -87,7 +84,6 @@ dictionary name (`ispell-local-dictionary' or EXCEPTION-LIST is a list of strings. The checked word is downcased before comparing with these exceptions." - :group 'flyspell :type '(alist :key-type (choice (const :tag "All dictionaries" nil) regexp) :value-type (repeat string)) @@ -97,7 +93,6 @@ downcased before comparing with these exceptions." "If non-nil, sort the corrections before popping them. The sorting is controlled by the `flyspell-sort-corrections-function' variable, and defaults to sorting alphabetically." - :group 'flyspell :version "21.1" :type 'boolean) @@ -109,8 +104,7 @@ function takes three parameters -- the two correction candidates to be sorted, and the third parameter is the word that's being corrected." :version "26.1" - :type 'function - :group 'flyspell) + :type 'function) (defun flyspell-sort-corrections-alphabetically (corr1 corr2 _) (string< corr1 corr2)) @@ -130,14 +124,12 @@ Flyspell uses a different face (`flyspell-duplicate') to highlight it. This variable specifies how far to search to find such a duplicate. -1 means no limit (search the whole buffer). 0 means do not search for duplicate unrecognized spellings." - :group 'flyspell :version "24.5" ; -1 -> 400000 :type '(choice (const :tag "no limit" -1) number)) (defcustom flyspell-delay 3 "The number of seconds to wait before checking, after a \"delayed\" command." - :group 'flyspell :type 'number) (defcustom flyspell-persistent-highlight t @@ -147,12 +139,10 @@ is highlighted, and the highlight is turned off as soon as point moves off the misspelled word. Make sure this variable is non-nil if you use `flyspell-region'." - :group 'flyspell :type 'boolean) (defcustom flyspell-highlight-properties t "Non-nil means highlight incorrect words even if a property exists for this word." - :group 'flyspell :type 'boolean) (defcustom flyspell-default-delayed-commands @@ -164,7 +154,6 @@ Make sure this variable is non-nil if you use `flyspell-region'." backward-delete-char-untabify) "The standard list of delayed commands for Flyspell. See `flyspell-delayed-commands'." - :group 'flyspell :version "21.1" :type '(repeat (symbol))) @@ -172,7 +161,6 @@ See `flyspell-delayed-commands'." "List of commands that are \"delayed\" for Flyspell mode. After these commands, Flyspell checking is delayed for a short time, whose length is specified by `flyspell-delay'." - :group 'flyspell :type '(repeat (symbol))) (defcustom flyspell-default-deplacement-commands @@ -182,7 +170,6 @@ whose length is specified by `flyspell-delay'." scroll-down) "The standard list of deplacement commands for Flyspell. See variable `flyspell-deplacement-commands'." - :group 'flyspell :version "21.1" :type '(repeat (symbol))) @@ -190,18 +177,15 @@ See variable `flyspell-deplacement-commands'." "List of commands that are \"deplacement\" for Flyspell mode. After these commands, Flyspell checking is performed only if the previous command was not the very same command." - :group 'flyspell :version "21.1" :type '(repeat (symbol))) (defcustom flyspell-issue-welcome-flag t "Non-nil means that Flyspell should display a welcome message when started." - :group 'flyspell :type 'boolean) (defcustom flyspell-issue-message-flag t "Non-nil means that Flyspell emits messages when checking words." - :group 'flyspell :type 'boolean) (defcustom flyspell-incorrect-hook nil @@ -213,7 +197,6 @@ of possible corrections as returned by `ispell-parse-output'. If any of the functions return non-nil, the word is not highlighted as incorrect." - :group 'flyspell :version "21.1" :type 'hook) @@ -225,14 +208,12 @@ when flyspell is started, the value of that variable is used instead of `flyspell-default-dictionary' to select the default dictionary. Otherwise, if `flyspell-default-dictionary' is nil, it means to use Ispell's ultimate default dictionary." - :group 'flyspell :version "21.1" :type '(choice string (const :tag "Default" nil))) (defcustom flyspell-tex-command-regexp "\\(\\(begin\\|end\\)[ \t]*{\\|\\(cite[a-z*]*\\|label\\|ref\\|eqref\\|usepackage\\|documentclass\\)[ \t]*\\(\\[[^]]*\\]\\)?{[^{}]*\\)" "A string that is the regular expression that matches TeX commands." - :group 'flyspell :version "21.1" :type 'regexp) @@ -241,34 +222,29 @@ Ispell's ultimate default dictionary." TeX math environments are discovered by `texmathp', implemented inside AUCTeX package. That package may be found at URL `https://www.gnu.org/software/auctex/'" - :group 'flyspell :type 'boolean) (defcustom flyspell-dictionaries-that-consider-dash-as-word-delimiter '("francais" "deutsch8" "norsk") "List of dictionary names that consider `-' as word delimiter." - :group 'flyspell :version "21.1" :type '(repeat (string))) (defcustom flyspell-abbrev-p nil "If non-nil, add correction to abbreviation table." - :group 'flyspell :version "21.1" :type 'boolean) (defcustom flyspell-use-global-abbrev-table-p nil "If non-nil, prefer global abbrev table to local abbrev table." - :group 'flyspell :version "21.1" :type 'boolean) (defcustom flyspell-mode-line-string " Fly" "String displayed on the mode line when flyspell is active. Set this to nil if you don't want a mode line indicator." - :group 'flyspell :type '(choice string (const :tag "None" nil))) (defcustom flyspell-large-region 1000 @@ -282,30 +258,25 @@ Doubled words are not detected in a large region, because Ispell does not check for them. If this variable is nil, all regions are treated as small." - :group 'flyspell :version "21.1" :type '(choice number (const :tag "All small" nil))) (defcustom flyspell-insert-function (function insert) "Function for inserting word by flyspell upon correction." - :group 'flyspell :type 'function) (defcustom flyspell-before-incorrect-word-string nil "String used to indicate an incorrect word starting." - :group 'flyspell :type '(choice string (const nil))) (defcustom flyspell-after-incorrect-word-string nil "String used to indicate an incorrect word ending." - :group 'flyspell :type '(choice string (const nil))) (defvar flyspell-mode-map) (defcustom flyspell-use-meta-tab t "Non-nil means that flyspell uses M-TAB to correct word." - :group 'flyspell :type 'boolean :initialize 'custom-initialize-default :set (lambda (sym val) @@ -316,8 +287,7 @@ If this variable is nil, all regions are treated as small." (defcustom flyspell-auto-correct-binding [(control ?\;)] "The key binding for flyspell auto correction." - :type 'key-sequence - :group 'flyspell) + :type 'key-sequence) ;;*---------------------------------------------------------------------*/ ;;* Mode specific options */ @@ -475,6 +445,22 @@ like <img alt=\"Some thing.\">." map) "Minor mode keymap for Flyspell mode--for the whole buffer.") +;; correct on mouse 3 +(defun flyspell--set-use-mouse-3-for-menu (var value) + (set-default var value) + (if value + (progn (define-key flyspell-mouse-map [mouse-2] nil) + (define-key flyspell-mouse-map [down-mouse-3] 'flyspell-correct-word)) + (define-key flyspell-mouse-map [mouse-2] 'flyspell-correct-word) + (define-key flyspell-mouse-map [down-mouse-3] nil))) + +(defcustom flyspell-use-mouse-3-for-menu nil + "Non-nil means to bind `mouse-3' to `flyspell-correct-word'. +If this is set, also unbind `mouse-2'." + :type 'boolean + :set 'flyspell--set-use-mouse-3-for-menu + :version "28.1") + ;; dash character machinery (defvar flyspell-consider-dash-as-word-delimiter-flag nil "Non-nil means that the `-' char is considered as a word delimiter.") @@ -493,8 +479,7 @@ like <img alt=\"Some thing.\">." (t :underline t :inherit error)) "Flyspell face for misspelled words." - :version "24.4" - :group 'flyspell) + :version "24.4") (defface flyspell-duplicate '((((supports :underline (:style wave))) @@ -503,8 +488,7 @@ like <img alt=\"Some thing.\">." :underline t :inherit warning)) "Flyspell face for words that appear twice in a row. See also `flyspell-duplicate-distance'." - :version "24.4" - :group 'flyspell) + :version "24.4") (defvar flyspell-overlay nil) @@ -546,7 +530,10 @@ in your init file. :group 'flyspell (if flyspell-mode (condition-case err - (flyspell-mode-on) + (progn + (when flyspell-use-mouse-3-for-menu + (flyspell--set-use-mouse-3-for-menu 'flyspell-use-mouse-3-for-menu t)) + (flyspell-mode-on)) (error (message "Error enabling Flyspell mode:\n%s" (cdr err)) (flyspell-mode -1))) (flyspell-mode-off))) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 65f61644b6d..b2ccbc8da24 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -621,15 +621,6 @@ For Aspell, non-nil also means to try to automatically find its dictionaries. Earlier Aspell versions do not consistently support charset encoding. Handling this would require some extra guessing in `ispell-aspell-find-dictionary'.") -(defvar ispell-aspell-supports-utf8 nil - "Non-nil if Aspell has consistent command line UTF-8 support. Obsolete. -ispell.el and flyspell.el will use for this purpose the more generic -variable `ispell-encoding8-command' for both Aspell and Hunspell. Is left -here just for backwards compatibility.") - -(make-obsolete-variable 'ispell-aspell-supports-utf8 - 'ispell-encoding8-command "23.1") - (defvar ispell-dicts-name2locale-equivs-alist '(("american" "en_US") ("brasileiro" "pt_BR") @@ -682,9 +673,7 @@ Otherwise returns the library directory name, if that is defined." ;; all versions, since versions earlier than 3.0.09 didn't identify ;; themselves on startup. (interactive "p") - (let ((default-directory (or (and (boundp 'temporary-file-directory) - temporary-file-directory) - default-directory)) + (let ((default-directory (or temporary-file-directory default-directory)) (get-config-var (lambda (var) (when (re-search-forward @@ -3734,8 +3723,7 @@ looking for a dictionary, please see the distribution of the GNU ispell program, or do an Internet search; there are various dictionaries available on the net." (interactive) - (if (and (boundp 'transient-mark-mode) transient-mark-mode - (boundp 'mark-active) mark-active) + (if (and transient-mark-mode mark-active) (ispell-region (region-beginning) (region-end)) (ispell-buffer))) diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index 279dbb4450c..7bc7dc1762e 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -487,9 +487,6 @@ Most useful for remembering things from other applications." (interactive) (remember-region (point-min) (point-max))) -;; Org needs this -(define-obsolete-function-alias 'remember-buffer 'remember-finalize "23.1") - (defun remember-destroy () "Destroy the current *Remember* buffer." (interactive) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 483a2c9bd83..3c2d766ffb1 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -258,7 +258,7 @@ E.g.: ;; Filenames -(defvar thing-at-point-file-name-chars "-~/[:alnum:]_.${}#%,:" +(defvar thing-at-point-file-name-chars "-@~/[:alnum:]_.${}#%,:" "Characters allowable in filenames.") (define-thing-chars filename thing-at-point-file-name-chars) diff --git a/lisp/time.el b/lisp/time.el index 44fd1a7e337..96b49ddabdd 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -25,8 +25,7 @@ ;; Facilities to display current time/date and a new-mail indicator ;; in the Emacs mode line. The entry point is `display-time'. -;; Display time world in a buffer, the entry point is -;; `display-time-world'. +;; Use `world-clock' to display world clock in a buffer. ;;; Code: @@ -35,23 +34,20 @@ :group 'mode-line :group 'mail) - (defcustom display-time-mail-file nil "File name of mail inbox file, for indicating existence of new mail. Non-nil and not a string means don't check for mail; nil means use default, which is system-dependent, and is the same as used by Rmail." :type '(choice (const :tag "None" none) (const :tag "Default" nil) - (file :format "%v")) - :group 'display-time) + (file :format "%v"))) (defcustom display-time-mail-directory nil "Name of mail inbox directory, for indicating existence of new mail. Any nonempty regular file in the directory is regarded as newly arrived mail. If nil, do not check a directory for arriving mail." :type '(choice (const :tag "None" nil) - (directory :format "%v")) - :group 'display-time) + (directory :format "%v"))) (defcustom display-time-mail-function nil "Function to call, for indicating existence of new mail. @@ -59,8 +55,7 @@ If nil, that means use the default method: check that the file specified by `display-time-mail-file' is nonempty or that the directory `display-time-mail-directory' contains nonempty files." :type '(choice (const :tag "Default" nil) - (function)) - :group 'display-time) + (function))) (defcustom display-time-default-load-average 0 "Which load average value will be shown in the mode line. @@ -75,8 +70,7 @@ The value can be one of: :type '(choice (const :tag "1 minute load" 0) (const :tag "5 minutes load" 1) (const :tag "15 minutes load" 2) - (const :tag "None" nil)) - :group 'display-time) + (const :tag "None" nil))) (defvar display-time-load-average nil "Value of the system's load average currently shown on the mode line. @@ -86,27 +80,23 @@ This is an internal variable; setting it has no effect.") (defcustom display-time-load-average-threshold 0.1 "Load-average values below this value won't be shown in the mode line." - :type 'number - :group 'display-time) + :type 'number) ;;;###autoload (defcustom display-time-day-and-date nil "\ Non-nil means \\[display-time] should display day and date as well as time." - :type 'boolean - :group 'display-time) + :type 'boolean) (defvar display-time-timer nil) (defcustom display-time-interval 60 "Seconds between updates of time in the mode line." - :type 'integer - :group 'display-time) + :type 'integer) (defcustom display-time-24hr-format nil "Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23. A value of nil means 1 <= hh <= 12, and an AM/PM suffix is used." - :type 'boolean - :group 'display-time) + :type 'boolean) (defvar display-time-string nil "String used in mode lines to display a time string. @@ -116,103 +106,12 @@ It should not be set directly, but is instead updated by the (defcustom display-time-hook nil "List of functions to be called when the time is updated on the mode line." - :type 'hook - :group 'display-time) + :type 'hook) (defvar display-time-server-down-time nil "Time when mail file's file system was recorded to be down. If that file system seems to be up, the value is nil.") -(defcustom zoneinfo-style-world-list - '(("America/Los_Angeles" "Seattle") - ("America/New_York" "New York") - ("Europe/London" "London") - ("Europe/Paris" "Paris") - ("Asia/Calcutta" "Bangalore") - ("Asia/Tokyo" "Tokyo")) - "Alist of zoneinfo-style time zones and places for `display-time-world'. -Each element has the form (TIMEZONE LABEL). -TIMEZONE should be a string of the form AREA/LOCATION, where AREA is -the name of a region -- a continent or ocean, and LOCATION is the name -of a specific location, e.g., a city, within that region. -LABEL is a string to display as the label of that TIMEZONE's time." - :group 'display-time - :type '(repeat (list string string)) - :version "23.1") - -(defcustom legacy-style-world-list - '(("PST8PDT" "Seattle") - ("EST5EDT" "New York") - ("GMT0BST" "London") - ("CET-1CDT" "Paris") - ("IST-5:30" "Bangalore") - ("JST-9" "Tokyo")) - "Alist of traditional-style time zones and places for `display-time-world'. -Each element has the form (TIMEZONE LABEL). -TIMEZONE should be a string of the form: - - std[+|-]offset[dst[offset][,date[/time],date[/time]]] - -See the documentation of the TZ environment variable on your system, -for more details about the format of TIMEZONE. -LABEL is a string to display as the label of that TIMEZONE's time." - :group 'display-time - :type '(repeat (list string string)) - :version "23.1") - -(defcustom display-time-world-list t - "Alist of time zones and places for `display-time-world' to display. -Each element has the form (TIMEZONE LABEL). -TIMEZONE should be in a format supported by your system. See the -documentation of `zoneinfo-style-world-list' and -`legacy-style-world-list' for two widely used formats. LABEL is -a string to display as the label of that TIMEZONE's time. - -If the value is t instead of an alist, use the value of -`zoneinfo-style-world-list' if it works on this platform, and of -`legacy-style-world-list' otherwise." - - :group 'display-time - :type '(choice (const :tag "Default" t) - (repeat :tag "List of zones and labels" - (list (string :tag "Zone") (string :tag "Label")))) - :version "23.1") - -(defun time--display-world-list () - (if (listp display-time-world-list) - display-time-world-list - ;; Determine if zoneinfo style timezones are supported by testing that - ;; America/New York and Europe/London return different timezones. - (let ((nyt (format-time-string "%z" nil "America/New_York")) - (gmt (format-time-string "%z" nil "Europe/London"))) - (if (string-equal nyt gmt) - legacy-style-world-list - zoneinfo-style-world-list)))) - -(defcustom display-time-world-time-format "%A %d %B %R %Z" - "Format of the time displayed, see `format-time-string'." - :group 'display-time - :type 'string - :version "23.1") - -(defcustom display-time-world-buffer-name "*wclock*" - "Name of the world clock buffer." - :group 'display-time - :type 'string - :version "23.1") - -(defcustom display-time-world-timer-enable t - "If non-nil, a timer will update the world clock." - :group 'display-time - :type 'boolean - :version "23.1") - -(defcustom display-time-world-timer-second 60 - "Interval in seconds for updating the world clock." - :group 'display-time - :type 'integer - :version "23.1") - ;;;###autoload (defun display-time () "Enable display of time, load level, and mail flag in mode lines. @@ -249,14 +148,12 @@ See `display-time-use-mail-icon' and `display-time-mail-face'.") "Non-nil means use an icon as mail indicator on a graphic display. Otherwise use `display-time-mail-string'. The icon may consume less of the mode line. It is specified by `display-time-mail-icon'." - :group 'display-time :type 'boolean) ;; Fixme: maybe default to the character if we can display Unicode. (defcustom display-time-mail-string "Mail" "String to use as the mail indicator in `display-time-string-forms'. This can use the Unicode letter character if you can display it." - :group 'display-time :version "22.1" :type '(choice (const "Mail") ;; Use :tag here because the Lucid menu won't display @@ -270,8 +167,7 @@ See the function `format-time-string' for an explanation of how to write this string. If this is nil, the defaults depend on `display-time-day-and-date' and `display-time-24hr-format'." :type '(choice (const :tag "Default" nil) - string) - :group 'display-time) + string)) (defcustom display-time-string-forms '((if (and (not display-time-format) display-time-day-and-date) @@ -325,8 +221,7 @@ For example: (if mail \" Mail\" \"\")) would give mode line times like `94/12/30 21:07:48 (UTC)'." - :type '(repeat sexp) - :group 'display-time) + :type '(repeat sexp)) (defun display-time-event-handler () (display-time-update) @@ -508,13 +403,129 @@ runs the normal hook `display-time-hook' after each update." (remove-hook 'rmail-after-get-new-mail-hook 'display-time-event-handler))) + +;;; Obsolete names + +(define-obsolete-variable-alias 'display-time-world-list + 'world-clock-list "28.1") +(define-obsolete-variable-alias 'display-time-world-time-format + 'world-clock-time-format "28.1") +(define-obsolete-variable-alias 'display-time-world-buffer-name + 'world-clock-buffer-name "28.1") +(define-obsolete-variable-alias 'display-time-world-timer-enable + 'world-clock-timer-enable "28.1") +(define-obsolete-variable-alias 'display-time-world-timer-second + 'world-clock-timer-second "28.1") + +(define-obsolete-function-alias 'display-time-world-mode + #'world-clock-mode "28.1") +(define-obsolete-function-alias 'display-time-world-display + #'world-clock-display "28.1") +(define-obsolete-function-alias 'display-time-world + #'world-clock "28.1") +(define-obsolete-function-alias 'display-time-world-timer + #'world-clock-update "28.1") + + +;;; World clock + +(defgroup world-clock nil + "Display a world clock." + :group 'display-time) + +(defcustom zoneinfo-style-world-list + '(("America/Los_Angeles" "Seattle") + ("America/New_York" "New York") + ("Europe/London" "London") + ("Europe/Paris" "Paris") + ("Asia/Calcutta" "Bangalore") + ("Asia/Tokyo" "Tokyo")) + "Alist of zoneinfo-style time zones and places for `world-clock'. +Each element has the form (TIMEZONE LABEL). +TIMEZONE should be a string of the form AREA/LOCATION, where AREA is +the name of a region -- a continent or ocean, and LOCATION is the name +of a specific location, e.g., a city, within that region. +LABEL is a string to display as the label of that TIMEZONE's time." + :type '(repeat (list string string)) + :version "23.1") + +(defcustom legacy-style-world-list + '(("PST8PDT" "Seattle") + ("EST5EDT" "New York") + ("GMT0BST" "London") + ("CET-1CDT" "Paris") + ("IST-5:30" "Bangalore") + ("JST-9" "Tokyo")) + "Alist of traditional-style time zones and places for `world-clock'. +Each element has the form (TIMEZONE LABEL). +TIMEZONE should be a string of the form: + + std[+|-]offset[dst[offset][,date[/time],date[/time]]] + +See the documentation of the TZ environment variable on your system, +for more details about the format of TIMEZONE. +LABEL is a string to display as the label of that TIMEZONE's time." + :type '(repeat (list string string)) + :version "23.1") + +(defcustom world-clock-list t + "Alist of time zones and places for `world-clock' to display. +Each element has the form (TIMEZONE LABEL). +TIMEZONE should be in a format supported by your system. See the +documentation of `zoneinfo-style-world-list' and +`legacy-style-world-list' for two widely used formats. LABEL is +a string to display as the label of that TIMEZONE's time. + +If the value is t instead of an alist, use the value of +`zoneinfo-style-world-list' if it works on this platform, and of +`legacy-style-world-list' otherwise." + :type '(choice (const :tag "Default" t) + (repeat :tag "List of zones and labels" + (list (string :tag "Zone") (string :tag "Label")))) + :version "28.1") + +(defun time--display-world-list () + (if (listp world-clock-list) + world-clock-list + ;; Determine if zoneinfo style timezones are supported by testing that + ;; America/New York and Europe/London return different timezones. + (let ((nyt (format-time-string "%z" nil "America/New_York")) + (gmt (format-time-string "%z" nil "Europe/London"))) + (if (string-equal nyt gmt) + legacy-style-world-list + zoneinfo-style-world-list)))) + +(defcustom world-clock-time-format "%A %d %B %R %Z" + "Time format for `world-clock', see `format-time-string'." + :type 'string + :version "28.1") + +(defcustom world-clock-buffer-name "*wclock*" + "Name of the `world-clock' buffer." + :type 'string + :version "28.1") + +(defcustom world-clock-timer-enable t + "If non-nil, a timer will update the `world-clock' buffer." + :type 'boolean + :version "28.1") + +(defcustom world-clock-timer-second 60 + "Interval in seconds for updating the `world-clock' buffer." + :type 'integer + :version "28.1") + +(defface world-clock-label + '((t :inherit font-lock-variable-name-face)) + "Face for time zone label in `world-clock' buffer.") -(define-derived-mode display-time-world-mode special-mode "World clock" +(define-derived-mode world-clock-mode special-mode "World clock" "Major mode for buffer that displays times in various time zones. -See `display-time-world'." +See `world-clock'." + (setq revert-buffer-function #'world-clock-update) (setq show-trailing-whitespace nil)) -(defun display-time-world-display (alist) +(defun world-clock-display (alist) "Replace current buffer text with times in various zones, based on ALIST." (let ((inhibit-read-only t) (buffer-undo-list t) @@ -526,42 +537,45 @@ See `display-time-world'." (let* ((label (cadr zone)) (width (string-width label))) (push (cons label - (format-time-string display-time-world-time-format + (format-time-string world-clock-time-format now (car zone))) result) (when (> width max-width) (setq max-width width)))) (setq fmt (concat "%-" (int-to-string max-width) "s %s\n")) (dolist (timedata (nreverse result)) - (insert (format fmt (car timedata) (cdr timedata)))) + (insert (format fmt + (propertize (car timedata) + 'face 'world-clock-label) + (cdr timedata)))) (delete-char -1)) (goto-char (point-min))) ;;;###autoload -(defun display-time-world () - "Enable updating display of times in various time zones. -`display-time-world-list' specifies the zones. -To turn off the world time display, go to that window and type `q'." +(defun world-clock () + "Display a world clock buffer with times in various time zones. +The variable `world-clock-list' specifies which time zones to use. +To turn off the world time display, go to the window and type `\\[quit-window]'." (interactive) - (when (and display-time-world-timer-enable - (not (get-buffer display-time-world-buffer-name))) - (run-at-time t display-time-world-timer-second 'display-time-world-timer)) - (with-current-buffer (get-buffer-create display-time-world-buffer-name) - (display-time-world-display (time--display-world-list)) - (display-buffer display-time-world-buffer-name - (cons nil '((window-height . fit-window-to-buffer)))) - (display-time-world-mode))) - -(defun display-time-world-timer () - (if (get-buffer display-time-world-buffer-name) - (with-current-buffer (get-buffer display-time-world-buffer-name) - (display-time-world-display (time--display-world-list))) + (when (and world-clock-timer-enable + (not (get-buffer world-clock-buffer-name))) + (run-at-time t world-clock-timer-second #'world-clock-update)) + (pop-to-buffer world-clock-buffer-name) + (world-clock-display (time--display-world-list)) + (world-clock-mode) + (fit-window-to-buffer)) + +(defun world-clock-update (&optional _arg _noconfirm) + "Update the `world-clock' buffer." + (if (get-buffer world-clock-buffer-name) + (with-current-buffer (get-buffer world-clock-buffer-name) + (world-clock-display (time--display-world-list))) ;; cancel timer (let ((list timer-list)) (while list (let ((elt (pop list))) (when (equal (symbol-name (timer--function elt)) - "display-time-world-timer") + "world-clock-update") (cancel-timer elt))))))) ;;;###autoload diff --git a/lisp/tooltip.el b/lisp/tooltip.el index f35f6b9a03e..5f5a4788b26 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -167,8 +167,6 @@ This variable has effect only on GUI frames." ;;; Variables that are not customizable. -(define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1") - (defvar tooltip-functions nil "Functions to call to display tooltips. Each function is called with one argument EVENT which is a copy diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el index f34ef810c4a..be9b5426dc4 100644 --- a/lisp/url/url-expand.el +++ b/lisp/url/url-expand.el @@ -120,7 +120,7 @@ path components followed by `..' are removed, along with the `..' itself." ;; Well, they told us the scheme, let's just go with it. nil (setf (url-type urlobj) (or (url-type urlobj) (url-type defobj))) - (setf (url-port urlobj) (or (url-portspec urlobj) + (setf (url-portspec urlobj) (or (url-portspec urlobj) (and (string= (url-type urlobj) (url-type defobj)) (url-port defobj)))) diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 6dd7a9c2aac..0a7e7e205e0 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -569,31 +569,6 @@ Has a preference for looking backward when not directly on a symbol." (setq url nil)) url))) -(defun url-generate-unique-filename (&optional fmt) - "Generate a unique filename in `url-temporary-directory'." - (declare (obsolete make-temp-file "23.1")) - ;; This variable is obsolete, but so is this function. - (let ((tempdir (with-no-warnings url-temporary-directory))) - (if (not fmt) - (let ((base (format "url-tmp.%d" (user-real-uid))) - (fname "") - (x 0)) - (setq fname (format "%s%d" base x)) - (while (file-exists-p - (expand-file-name fname tempdir)) - (setq x (1+ x) - fname (concat base (int-to-string x)))) - (expand-file-name fname tempdir)) - (let ((base (concat "url" (int-to-string (user-real-uid)))) - (fname "") - (x 0)) - (setq fname (format fmt (concat base (int-to-string x)))) - (while (file-exists-p - (expand-file-name fname tempdir)) - (setq x (1+ x) - fname (format fmt (concat base (int-to-string x))))) - (expand-file-name fname tempdir))))) - (defun url-extract-mime-headers () "Set `url-current-mime-headers' in current buffer." (save-excursion diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index d9277cf6f42..e35823ab9af 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -312,13 +312,6 @@ Applies when a protected document is denied by the server." :type 'integer :group 'url) -(defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp") - "Where temporary files go." - :type 'directory - :group 'url-file) -(make-obsolete-variable 'url-temporary-directory - 'temporary-file-directory "23.1") - (defcustom url-show-status t "Whether to show a running total of bytes transferred. Can cause a large hit if using a remote X display over a slow link, or diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index d194d6c0a0e..bd5ac9b9a62 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2518,7 +2518,7 @@ fixed, visit it in a buffer." '((?+ . (left-fringe diff-fringe-add diff-indicator-added)) (?- . (left-fringe diff-fringe-del diff-indicator-removed)) (?! . (left-fringe diff-fringe-rep diff-indicator-changed)) - (?\s . (left-fringe diff-fringe-nul)))))) + (?\s . (left-fringe diff-fringe-nul fringe)))))) (put-text-property (match-beginning 0) (match-end 0) 'display spec)))) ;; Mimicks the output of Magit's diff. ;; FIXME: This has only been tested with Git's diff output. diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index f5177bca112..04926af16ef 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -1573,9 +1573,8 @@ This default should work without changes." (defun ediff-convert-standard-filename (fname) - (if (fboundp 'convert-standard-filename) - (convert-standard-filename fname) - fname)) + (declare (obsolete convert-standard-filename "28.1")) + (convert-standard-filename fname)) (define-obsolete-function-alias 'ediff-with-syntax-table #'with-syntax-table "27.1") diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 4a84c1ecd9c..f56d31c7136 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -240,18 +240,16 @@ to invocation.") startup-hooks setup-parameters &optional merge-buffer-file) (run-hooks 'ediff-before-setup-hook) - ;; ediff-convert-standard-filename puts file names in the form appropriate + ;; convert-standard-filename puts file names in the form appropriate ;; for the OS at hand. - (setq file-A (ediff-convert-standard-filename (expand-file-name file-A))) - (setq file-B (ediff-convert-standard-filename (expand-file-name file-B))) + (setq file-A (convert-standard-filename (expand-file-name file-A))) + (setq file-B (convert-standard-filename (expand-file-name file-B))) (if (stringp file-C) - (setq file-C - (ediff-convert-standard-filename (expand-file-name file-C)))) + (setq file-C (convert-standard-filename (expand-file-name file-C)))) (if (stringp merge-buffer-file) (progn (setq merge-buffer-file - (ediff-convert-standard-filename - (expand-file-name merge-buffer-file))) + (convert-standard-filename (expand-file-name merge-buffer-file))) ;; check the directory exists (or (file-exists-p (file-name-directory merge-buffer-file)) (error "Directory %s given as place to save the merge doesn't exist" @@ -3069,10 +3067,8 @@ Hit \\[ediff-recenter] to reset the windows afterward." ;; for compatibility -(defmacro ediff-minibuffer-with-setup-hook (fun &rest body) - `(if (fboundp 'minibuffer-with-setup-hook) - (minibuffer-with-setup-hook ,fun ,@body) - ,@body)) +(define-obsolete-function-alias 'ediff-minibuffer-with-setup-hook + #'minibuffer-with-setup-hook "28.1") ;; This is adapted from a similar function in `emerge.el'. ;; PROMPT should not have a trailing ': ', so that it can be modified @@ -3101,7 +3097,7 @@ Hit \\[ediff-recenter] to reset the windows afterward." (and default-file (list default-file)) default-dir))) f) - (setq f (ediff-minibuffer-with-setup-hook + (setq f (minibuffer-with-setup-hook (lambda () (when defaults (setq minibuffer-default defaults))) (read-file-name @@ -3134,7 +3130,7 @@ Hit \\[ediff-recenter] to reset the windows afterward." ;; Also, save buffer from START to END in the file. ;; START defaults to (point-min), END to (point-max) (defun ediff-make-temp-file (buff &optional prefix given-file start end) - (let* ((p (ediff-convert-standard-filename (or prefix "ediff"))) + (let* ((p (convert-standard-filename (or prefix "ediff"))) (short-p p) (coding-system-for-write ediff-coding-system-for-write) f short-f) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 78a2fa08795..84aeb0a1105 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -210,6 +210,16 @@ toggle display of the entire list." widget)))) :version "27.1") +(defcustom vc-git-revision-complete-only-branches nil + "Control whether tags are returned by revision completion for Git. + +When non-nil, only branches and remotes will be returned by +`vc-git-revision-completion-table'. This is used by various VC +commands when completing branch names. When nil, tags are also +included in the completions." + :type 'boolean + :version "28.1") + ;; History of Git commands. (defvar vc-git-history nil) @@ -1415,9 +1425,11 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (with-temp-buffer (vc-git-command t nil nil "for-each-ref" "--format=%(refname)") (goto-char (point-min)) - (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$" - nil t) - (push (match-string 2) table))) + (let ((regexp (if vc-git-revision-complete-only-branches + "^refs/\\(heads\\|remotes\\)/\\(.*\\)$" + "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$"))) + (while (re-search-forward regexp nil t) + (push (match-string 2) table)))) table)) (defun vc-git-revision-completion-table (files) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index ce72a49b955..f09ceddcb37 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -505,14 +505,6 @@ If FILE is not registered, this function always returns nil." (vc-call-backend backend 'working-revision file)))))) -;; Backward compatibility. -(define-obsolete-function-alias - 'vc-workfile-version 'vc-working-revision "23.1") -(defun vc-default-working-revision (backend file) - (message - "`working-revision' not found: using the old `workfile-version' instead") - (vc-call-backend backend 'workfile-version file)) - (defun vc-default-registered (backend file) "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates." (let ((sym (vc-make-backend-sym backend 'master-templates))) diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el index 092d8b53968..3c26ffc0e58 100644 --- a/lisp/vc/vc-mtn.el +++ b/lisp/vc/vc-mtn.el @@ -60,7 +60,6 @@ switches." :version "25.1" :group 'vc-mtn) -(define-obsolete-variable-alias 'vc-mtn-command 'vc-mtn-program "23.1") (defcustom vc-mtn-program "mtn" "Name of the monotone executable." :type 'string diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 65775f8e46e..5561292d8c0 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2710,9 +2710,6 @@ to the working revision (except for keyword expansion)." (message "Reverting %s...done" (vc-delistify files))))) ;;;###autoload -(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1") - -;;;###autoload (defun vc-pull (&optional arg) "Update the current fileset or branch. You must be visiting a version controlled file, or in a `vc-dir' buffer. diff --git a/lisp/vcursor.el b/lisp/vcursor.el index fa0cbb74b0d..3601abcd6e4 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -1132,9 +1132,6 @@ line is treated like ordinary characters." (vcursor-copy (if (or (= count 0) arg) (1+ count) count))) ) -(define-obsolete-function-alias - 'vcursor-toggle-vcursor-map 'vcursor-use-vcursor-map "23.1") - (defun vcursor-post-command () (and vcursor-auto-disable (not vcursor-last-command) vcursor-overlay diff --git a/lisp/vt-control.el b/lisp/vt-control.el index fc3a514f921..d4c14197bdc 100644 --- a/lisp/vt-control.el +++ b/lisp/vt-control.el @@ -1,4 +1,4 @@ -;;; vt-control.el --- Common VTxxx control functions +;;; vt-control.el --- Common VTxxx control functions -*- lexical-binding:t -*- ;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/window.el b/lisp/window.el index f20940fa0ea..bb34a6d7b4c 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2642,12 +2642,17 @@ and no others." "Return t if WINDOW is the currently active minibuffer window." (and (window-live-p window) (eq window (active-minibuffer-window)))) -(defun count-windows (&optional minibuf) +(defun count-windows (&optional minibuf all-frames) "Return the number of live windows on the selected frame. + The optional argument MINIBUF specifies whether the minibuffer -window shall be counted. See `walk-windows' for the precise -meaning of this argument." - (length (window-list-1 nil minibuf))) +window is included in the count. + +If ALL-FRAMES is non-nil, count the windows in all frames instead +just the selected frame. + +See `walk-windows' for the precise meaning of this argument." + (length (window-list-1 nil minibuf all-frames))) ;;; Resizing windows. (defun window--size-to-pixel (window size &optional horizontal pixelwise round-maybe) @@ -5729,10 +5734,10 @@ window." WINDOW defaults to the selected window. DIRECTION can be nil (i.e. any), `height' or `width'." (with-current-buffer (window-buffer window) - (when (and (boundp 'window-size-fixed) window-size-fixed) - (not (and direction - (member (cons direction window-size-fixed) - '((height . width) (width . height)))))))) + (and window-size-fixed + (not (and direction + (member (cons direction window-size-fixed) + '((height . width) (width . height)))))))) ;;; A different solution to balance-windows. (defvar window-area-factor 1 diff --git a/lisp/woman.el b/lisp/woman.el index c0e27c57077..891a1263ace 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -914,8 +914,8 @@ Troff emulation is experimental and largely untested. :group 'faces) (defcustom woman-fontify - (or (and (fboundp 'display-color-p) (display-color-p)) - (and (fboundp 'display-graphic-p) (display-graphic-p)) + (or (display-color-p) + (display-graphic-p) (x-display-color-p)) "If non-nil then WoMan assumes that face support is available. It defaults to a non-nil value if the display supports either colors |