diff options
| author | Andrea Corallo <akrl@sdf.org> | 2020-11-29 15:11:38 +0100 |
|---|---|---|
| committer | Andrea Corallo <akrl@sdf.org> | 2020-11-29 15:11:38 +0100 |
| commit | 6523b8401519a29ca0aefaf44c3dfa36f681f64e (patch) | |
| tree | a691422921ad1287fdeade2128efed4c59c14e8d /lisp | |
| parent | 2e0256e0a02edad129e0af1ea97b9e263c5d83fb (diff) | |
| parent | 38ed05f49fcfe7c6d6908041010881a04a7ff6b1 (diff) | |
| download | emacs-6523b8401519a29ca0aefaf44c3dfa36f681f64e.tar.gz emacs-6523b8401519a29ca0aefaf44c3dfa36f681f64e.tar.bz2 emacs-6523b8401519a29ca0aefaf44c3dfa36f681f64e.zip | |
Merge remote-tracking branch 'savannah/master' into HEAD
Diffstat (limited to 'lisp')
109 files changed, 786 insertions, 450 deletions
diff --git a/lisp/allout.el b/lisp/allout.el index a4802a1c2a6..880098c515f 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1621,8 +1621,7 @@ So `allout-post-command-business' should not reactivate it...") cur) (while menus (setq cur (car menus) - menus (cdr menus)) - (easy-menu-add cur)))) + menus (cdr menus))))) ;;;_ > allout-overlay-preparations (defun allout-overlay-preparations () "Set the properties of the allout invisible-text overlay and others." diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index ce0c061fc09..69a159a84a8 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1058,27 +1058,43 @@ return nil. Otherwise point is returned." (archive-goto-file short)) next)) -(defun archive-copy-file (file new-name) - "Copy FILE to a location specified by NEW-NAME. -Interactively, FILE is the file at point, and the function prompts -for NEW-NAME." +(defun archive-copy-file (files new-name) + "Copy FILES to a location specified by NEW-NAME. +FILES can be a single file or a list of files. + +Interactively, FILES is the list of marked files, or the file at +point if nothing is marked, and the function prompts for +NEW-NAME." (interactive - (let ((name (archive--file-desc-ext-file-name (archive-get-descr)))) - (list name - (read-file-name (format "Copy %s to: " name))))) - (when (file-directory-p new-name) - (setq new-name (expand-file-name file new-name))) - (when (and (file-exists-p new-name) - (not (yes-or-no-p (format "%s already exists; overwrite? " - new-name)))) - (user-error "Not overwriting %s" new-name)) - (let* ((descr (archive-get-descr)) - (archive (buffer-file-name)) - (extractor (archive-name "extract")) - (ename (archive--file-desc-ext-file-name descr))) - (with-temp-buffer - (archive--extract-file extractor archive ename) - (write-region (point-min) (point-max) new-name)))) + (let ((names + (mapcar + #'archive--file-desc-ext-file-name + (or (archive-get-marked ?*) (list (archive-get-descr)))))) + (list names + (read-file-name (format "Copy %s to: " (string-join names ", ")))))) + (unless (consp files) + (setq files (list files))) + (when (and (> (length files) 1) + (not (file-directory-p new-name))) + (user-error "Can't copy a list of files to a single file")) + (save-excursion + (dolist (file files) + (let ((write-to (if (file-directory-p new-name) + (expand-file-name file new-name) + new-name))) + (when (and (file-exists-p write-to) + (not (yes-or-no-p (format "%s already exists; overwrite? " + write-to)))) + (user-error "Not overwriting %s" write-to)) + (archive-goto-file file) + (let* ((descr (archive-get-descr)) + (archive (buffer-file-name)) + (extractor (archive-name "extract")) + (ename (archive--file-desc-ext-file-name descr))) + (with-temp-buffer + (set-buffer-multibyte nil) + (archive--extract-file extractor archive ename) + (write-region (point-min) (point-max) write-to))))))) (defun archive-extract (&optional other-window-p event) "In archive mode, extract this entry of the archive into its own buffer." diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el index 9d9a95fd763..2e3256f4be5 100644 --- a/lisp/cedet/ede/pmake.el +++ b/lisp/cedet/ede/pmake.el @@ -180,7 +180,7 @@ MFILENAME is the makefile to generate." ;; ;; NOTE: This is GNU Make specific. (if (and (oref this automatic-dependencies) df) - (insert "DEPS_MAGIC := $(shell mkdir .deps > /dev/null " + (insert "DEPS_MAGIC := $(shell mkdir .deps > " null-device " " "2>&1 || :)\n" "-include $(DEP_FILES)\n\n")) ;; diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index f71ac6c413e..b7670ef44b0 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1258,7 +1258,8 @@ common grammar menu." (unless (boundp ',symbol) (easy-menu-define ,symbol nil "Grammar Menu" (copy-sequence semantic-grammar-menu))) - (easy-menu-add ,symbol) + (when (featurep 'xemacs) + (easy-menu-add ,symbol)) (let ((,items (cdr ,mode-menu)) (,path (list (car ,symbol)))) (when ,items diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index eceba8fa4d6..a00cb17e298 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2900,14 +2900,20 @@ Modified means that the widget that holds the value has been edited by the user in a customize buffer. To check for other states, call `custom-variable-state'." (catch 'get-error - (let* ((symbol (widget-get widget :value)) + (let* ((form (widget-get widget :custom-form)) + (symbol (widget-get widget :value)) (get (or (get symbol 'custom-get) 'default-value)) (value (if (default-boundp symbol) (condition-case nil (funcall get symbol) (error (throw 'get-error t))) - (symbol-value symbol)))) - (not (equal value (widget-value (car (widget-get widget :children)))))))) + (symbol-value symbol))) + (orig-value (widget-value (car (widget-get widget :children))))) + (not (equal (if (memq form '(lisp mismatch)) + ;; Mimic `custom-variable-value-create'. + (custom-quote value) + value) + orig-value))))) (defun custom-variable-state-set (widget &optional state) "Set the state of WIDGET to STATE. @@ -5126,7 +5132,6 @@ Erase customizations; set options Entry to this mode calls the value of `Custom-mode-hook' if that value is non-nil." (use-local-map custom-mode-map) - (easy-menu-add Custom-mode-menu) (setq-local tool-bar-map (or custom-tool-bar-map ;; Set up `custom-tool-bar-map'. diff --git a/lisp/custom.el b/lisp/custom.el index 3f1e8cacb28..0b2b325bdaf 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -157,7 +157,9 @@ set to nil, as the value is no longer rogue." (if (keywordp doc) (error "Doc string is missing")) (let ((initialize #'custom-initialize-reset) - (requests nil)) + (requests nil) + ;; Whether automatically buffer-local. + buffer-local) (unless (memq :group args) (custom-add-to-group (custom-current-group) symbol 'custom-variable)) (while args @@ -183,7 +185,7 @@ set to nil, as the value is no longer rogue." (put symbol 'safe-local-variable value)) ((eq keyword :local) (when (memq value '(t permanent)) - (make-variable-buffer-local symbol)) + (setq buffer-local t)) (when (eq value 'permanent) (put symbol 'permanent-local t))) ((eq keyword :type) @@ -205,7 +207,9 @@ set to nil, as the value is no longer rogue." (put symbol 'custom-requests requests) ;; Do the actual initialization. (unless custom-dont-initialize - (funcall initialize symbol default))) + (funcall initialize symbol default)) + (when buffer-local + (make-variable-buffer-local symbol))) (run-hooks 'custom-define-hook) symbol) diff --git a/lisp/delsel.el b/lisp/delsel.el index df2adc7aeba..e1087fb3919 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -274,6 +274,8 @@ to `delete-selection-mode'." (put 'quoted-insert 'delete-selection t) (put 'yank 'delete-selection 'yank) +(put 'yank-pop 'delete-selection 'yank) +(put 'yank-from-kill-ring 'delete-selection 'yank) (put 'clipboard-yank 'delete-selection 'yank) (put 'insert-register 'delete-selection t) ;; delete-backward-char and delete-forward-char already delete the selection by diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 532f3d1a246..28c53bf1a67 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1799,7 +1799,7 @@ Files in subdirectories of DIRECTORY are processed also." (byte-recompile-directory directory nil t)) ;;;###autoload -(defun byte-recompile-directory (directory &optional arg force) +(defun byte-recompile-directory (directory &optional arg force follow-symlinks) "Recompile every `.el' file in DIRECTORY that needs recompilation. This happens when a `.elc' file exists but is older than the `.el' file. Files in subdirectories of DIRECTORY are processed also. @@ -1812,7 +1812,11 @@ compile it. A nonzero ARG also means ask about each subdirectory before scanning it. If the third argument FORCE is non-nil, recompile every `.el' file -that already has a `.elc' file." +that already has a `.elc' file. + +This command will normally not follow symlinks when compiling +files. If FOLLOW-SYMLINKS is non-nil, symlinked `.el' files will +also be compiled." (interactive "DByte recompile directory: \nP") (if arg (setq arg (prefix-numeric-value arg))) (if noninteractive @@ -1845,7 +1849,8 @@ that already has a `.elc' file." (if (file-directory-p source) (and (not (member file '("RCS" "CVS"))) (not (eq ?\. (aref file 0))) - (not (file-symlink-p source)) + (or follow-symlinks + (not (file-symlink-p source))) ;; This file is a subdirectory. Handle them differently. (or (null arg) (eq 0 arg) (y-or-n-p (concat "Check " source "? "))) diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index b0198dbf8d5..7a24af7963f 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -488,17 +488,14 @@ To implement dynamic menus, either call this from `menu-bar-update-hook' or use a menu filter." (easy-menu-add-item map path (easy-menu-create-menu name items) before)) -;; XEmacs needs the following two functions to add and remove menus. -;; In Emacs this is done automatically when switching keymaps, so -;; here easy-menu-remove and easy-menu-add are a noops. -(defalias 'easy-menu-remove 'ignore +(define-obsolete-function-alias 'easy-menu-remove #'ignore "28.1" "Remove MENU from the current menu bar. Contrary to XEmacs, this is a nop on Emacs since menus are automatically \(de)activated when the corresponding keymap is (de)activated. \(fn MENU)") -(defalias 'easy-menu-add #'ignore +(define-obsolete-function-alias 'easy-menu-add #'ignore "28.1" "Add the menu to the menubar. On Emacs this is a nop, because menus are already automatically activated when the corresponding keymap is activated. On XEmacs diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 78cb8f08c34..d81060ef165 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -591,7 +591,8 @@ Honor `eldoc-echo-area-use-multiline-p' and ;; format the *eldoc* buffer, using as most of its ;; contents as we know will fit. (with-current-buffer (eldoc--format-doc-buffer docs) - (eldoc--echo-area-substring available))) + (save-excursion + (eldoc--echo-area-substring available)))) (t ;; this is the "truncate brutally" situation (let ((string (with-current-buffer (eldoc--format-doc-buffer docs) diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 76c3ac31b85..6d33299e202 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1418,6 +1418,7 @@ into a plain rx-expression, collecting names into `rx--pcase-vars'." (cons head (mapcar #'rx--pcase-transform rest))) (_ rx))) +;;;###autoload (pcase-defmacro rx (&rest regexps) "A pattern that matches strings against `rx' REGEXPS in sexp form. REGEXPS are interpreted as in `rx'. The pattern matches any diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 30577679f24..ae3ed055c5d 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -767,6 +767,7 @@ as the ewoc pretty-printer." (setq-local revert-buffer-function #'tabulated-list-revert) (setq-local glyphless-char-display (tabulated-list-make-glyphless-char-display-table)) + (setq-local text-scale-remap-header-line t) ;; Avoid messing up the entries' display just because the first ;; column of the first entry happens to begin with a R2L letter. (setq bidi-paragraph-direction 'left-to-right) diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el index 9c02899057b..b36a1cb8fa9 100644 --- a/lisp/erc/erc-menu.el +++ b/lisp/erc/erc-menu.el @@ -114,22 +114,19 @@ ERC menu yet.") ;; make sure the menu only gets defined once, since Emacs 22 ;; activates it immediately (easy-menu-define erc-menu erc-mode-map "ERC menu" erc-menu-definition) - (setq erc-menu-defined t)) - (erc-menu-add)) - ((erc-menu-remove) - ;; `easy-menu-remove' is a no-op in Emacs 22 + (setq erc-menu-defined t))) + (;; `easy-menu-remove' is a no-op in Emacs 22 (message "You might have to restart Emacs to remove the ERC menu"))) -;; silence byte-compiler warning -(defvar erc-menu) - (defun erc-menu-add () "Add the ERC menu to the current buffer." - (easy-menu-add erc-menu erc-mode-map)) + (declare (obsolete nil "28.1")) + nil) (defun erc-menu-remove () "Remove the ERC menu from the current buffer." - (easy-menu-remove erc-menu)) + (declare (obsolete nil "28.1")) + nil) (provide 'erc-menu) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index b4154861908..b0443a4acee 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -382,8 +382,7 @@ it defaults to `insert'." "Set handle INDEX, using MODE, to point to TARGET." (when target (if (and (stringp target) - (or (string= target null-device) - (string= target "/dev/null"))) + (string= target (null-device))) (aset eshell-current-handles index nil) (let ((where (eshell-get-target target mode)) (current (car (aref eshell-current-handles index)))) diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 028269a4b0c..4ccd463aff2 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -229,6 +229,28 @@ Each positive or negative step scales the default face height by this amount." (defvar text-scale-mode-amount 0) (make-variable-buffer-local 'text-scale-mode-amount) +(defvar text-scale-remap-header-line nil + "If non-nil, text scaling may change font size of header lines too.") +(make-variable-buffer-local 'text-scale-header-line) + +(defun face-remap--clear-remappings () + (dolist (remapping + ;; This is a bit messy to stay backwards compatible. + ;; In the future, this can be simplified to just use + ;; `text-scale-mode-remapping'. + (if (consp (car-safe text-scale-mode-remapping)) + text-scale-mode-remapping + (list text-scale-mode-remapping))) + (face-remap-remove-relative remapping)) + (setq text-scale-mode-remapping nil)) + +(defun face-remap--remap-face (sym) + (push (face-remap-add-relative sym + :height + (expt text-scale-mode-step + text-scale-mode-amount)) + text-scale-mode-remapping)) + (define-minor-mode text-scale-mode "Minor mode for displaying buffer text in a larger/smaller font. @@ -240,21 +262,32 @@ face size by the value of the variable `text-scale-mode-step' The `text-scale-increase', `text-scale-decrease', and `text-scale-set' functions may be used to interactively modify the variable `text-scale-mode-amount' (they also enable or -disable `text-scale-mode' as necessary)." +disable `text-scale-mode' as necessary). + +If `text-scale-remap-header-line' is non-nil, also change +the font size of the header line." :lighter (" " text-scale-mode-lighter) - (when text-scale-mode-remapping - (face-remap-remove-relative text-scale-mode-remapping)) + (face-remap--clear-remappings) (setq text-scale-mode-lighter (format (if (>= text-scale-mode-amount 0) "+%d" "%d") text-scale-mode-amount)) - (setq text-scale-mode-remapping - (and text-scale-mode - (face-remap-add-relative 'default - :height - (expt text-scale-mode-step - text-scale-mode-amount)))) + (when text-scale-mode + (face-remap--remap-face 'default) + (when text-scale-remap-header-line + (face-remap--remap-face 'header-line))) (force-window-update (current-buffer))) +(defun text-scale--refresh (symbol newval operation where) + "Watcher for `text-scale-remap-header-line'. +See `add-variable-watcher'." + (when (and (eq symbol 'text-scale-remap-header-line) + (eq operation 'set) + text-scale-mode) + (with-current-buffer where + (let ((text-scale-remap-header-line newval)) + (text-scale-mode 1))))) +(add-variable-watcher 'text-scale-remap-header-line #'text-scale--refresh) + (defun text-scale-min-amount () "Return the minimum amount of text-scaling we allow." ;; When the resulting pixel-height of characters will become smaller diff --git a/lisp/files.el b/lisp/files.el index 777725903fa..a20182790fa 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2683,6 +2683,7 @@ since only a single case-insensitive search through the alist is made." ("\\.dir-locals\\(?:-2\\)?\\.el\\'" . lisp-data-mode) ("eww-bookmarks\\'" . lisp-data-mode) ("tramp\\'" . lisp-data-mode) + ("/archive-contents\\'" . lisp-data-mode) ("places\\'" . lisp-data-mode) ("\\.emacs-places\\'" . lisp-data-mode) ("\\.el\\'" . emacs-lisp-mode) diff --git a/lisp/filesets.el b/lisp/filesets.el index c7ec3f77f43..883871c4d80 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -203,8 +203,8 @@ key is supported." (defun filesets-select-command (cmd-list) "Select one command from CMD-LIST -- a string with space separated names." (let ((this (shell-command-to-string - (format "which --skip-alias %s 2> /dev/null | head -n 1" - cmd-list)))) + (format "which --skip-alias %s 2> %s | head -n 1" + cmd-list null-device)))) (if (equal this "") nil (file-name-nondirectory (substring this 0 (- (length this) 1)))))) @@ -1718,9 +1718,12 @@ Assume MODE (see `filesets-entry-mode'), if provided." (filesets-entry-get-master entry))))) (cons entry (filesets-ingroup-cache-get entry)))) (:tree - (let ((dir (nth 0 entry)) - (patt (nth 1 entry))) - (filesets-directory-files dir patt ':files t))) + (let* ((dirpatt (filesets-entry-get-tree entry)) + (dir (nth 0 dirpatt)) + (patt (nth 1 dirpatt)) + (depth (or (filesets-entry-get-tree-max-level entry) + filesets-tree-max-level))) + (filesets-files-under 0 depth entry dir patt))) (:pattern (let ((dirpatt (filesets-entry-get-pattern entry))) (if dirpatt @@ -1734,6 +1737,34 @@ Assume MODE (see `filesets-entry-mode'), if provided." (lambda (file) (not (filesets-filetype-property file event)))))) +(defun filesets-files-under (level depth entry dir patt &optional relativep) + "Files under DIR that match PATT. +LEVEL is the current level under DIR. +DEPTH is the maximal tree scanning depth for ENTRY. +ENTRY is a fileset. +DIR is a directory. +PATT is a regexp that included file names must match. +RELATIVEP non-nil means use relative file names." + (and (or (= depth 0) (< level depth)) + (let* ((dir (file-name-as-directory dir)) + (files-here (filesets-directory-files + dir patt nil (not relativep) + (filesets-entry-get-filter-dirs-flag entry))) + (subdirs (filesets-filter-dir-names files-here)) + (files + (filesets-filter-dir-names + (apply #'append + files-here + (mapcar + (lambda (subdir) + (let* ((subdir (file-name-as-directory subdir)) + (full-subdir (concat dir subdir))) + (filesets-files-under (+ level 1) depth entry + full-subdir patt))) + subdirs)) + t))) + files))) + (defun filesets-open (&optional mode name lookup-name) "Open the fileset called NAME. Use LOOKUP-NAME for searching additional data if provided." @@ -1878,7 +1909,7 @@ User will be queried, if no fileset name is provided." (substring (elt submenu 0) 2)))) (if (listp submenu) (cons name (cdr submenu)) - (apply 'vector (list name (cdr (append submenu nil))))))) + (apply 'vector (list name (cadr (append submenu nil))))))) ; (vconcat `[,name] (subseq submenu 1))))) (defun filesets-wrap-submenu (submenu-body) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 8f4ca7eb3b9..7f594c9c360 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -7251,7 +7251,6 @@ This is an extended text-mode. '(message-font-lock-keywords t)) (set (make-local-variable 'mail-header-separator) "") (set (make-local-variable 'gnus-article-edit-mode) t) - (easy-menu-add message-mode-field-menu message-mode-map) (mml-mode) (setq buffer-read-only nil) (buffer-enable-undo) diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 3218649761a..b6d6aa49298 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -286,8 +286,8 @@ colors of the displayed X-Faces." (setq file (car file)) (with-temp-buffer (shell-command - (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>/dev/null | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 | pbmtoxbm | compface" - file) + (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>%s | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 | pbmtoxbm | compface" + file null-device) (current-buffer)) ;;(sleep-for 3) (delete-file file) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 498da200dab..89d8cff9257 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1030,6 +1030,13 @@ Responsible for handling and, or, and parenthetical expressions.") (declare-function nnimap-buffer "nnimap" ()) (declare-function nnimap-command "nnimap" (&rest args)) +(defvar gnus-search-imap-search-keys + '(body cc bcc from header keyword larger smaller subject text to uid x-gm-raw + answered before deleted draft flagged on since recent seen sentbefore + senton sentsince unanswered undeleted undraft unflagged unkeyword + unseen all) + "Known IMAP search keys.") + ;; imap interface (cl-defmethod gnus-search-run-search ((engine gnus-search-imap) srv query groups) @@ -1059,6 +1066,15 @@ Responsible for handling and, or, and parenthetical expressions.") (setq q-string (gnus-search-make-query-string engine query)) + ;; A bit of backward-compatibility slash convenience: if the + ;; query string doesn't start with any known IMAP search + ;; keyword, assume it is a "TEXT" search. + (unless (and (string-match "\\`[[:word:]]+" q-string) + (memql (intern-soft (downcase + (match-string 0 q-string))) + gnus-search-imap-search-keys)) + (setq q-string (concat "TEXT " q-string))) + ;; If it's a thread query, make sure that all message-id ;; searches are also references searches. (when (alist-get 'thread query) @@ -1115,12 +1131,6 @@ Other capabilities could be tested here." (nnimap-get-response call))) (t (nnimap-command "UID SEARCH %s" query))))) -;; TODO: Don't exclude booleans and date keys, just check for them -;; before checking for general keywords. -(defvar gnus-search-imap-search-keys - '(body cc bcc from header keyword larger smaller subject text to uid x-gm-raw) - "Known IMAP search keys, excluding booleans and date keys.") - (cl-defmethod gnus-search-transform ((_ gnus-search-imap) (_query null)) "ALL") @@ -1303,6 +1313,7 @@ of whichever date elements are present." (pcase flag ("flag" "flagged") ("read" "seen") + ("replied" "answered") (_ flag))) (if (member flag '("seen" "answered" "deleted" "draft" "flagged")) (upcase flag) @@ -1365,10 +1376,13 @@ Returns a list of [group article score] vectors." server query &optional groups) (let ((prefix (slot-value engine 'remove-prefix)) (group-regexp (when groups - (regexp-opt - (mapcar - (lambda (x) (gnus-group-real-name x)) - groups)))) + (mapconcat + (lambda (x) + (replace-regexp-in-string + ;; Accept any of [.\/] as path separators. + "[.\\/]" "[.\\\\/]" + (gnus-group-real-name x))) + groups "\\|"))) artlist vectors article group) (goto-char (point-min)) (while (not (eobp)) @@ -1383,16 +1397,16 @@ Returns a list of [group article score] vectors." ;; Are we running an additional grep query? (when-let ((grep-reg (alist-get 'grep query))) (setq artlist (gnus-search-grep-search engine artlist grep-reg))) + ;; Prep prefix. + (when (and prefix (null (string-empty-p prefix))) + (setq prefix (file-name-as-directory (expand-file-name prefix)))) ;; Turn (file-name score) into [group article score]. (pcase-dolist (`(,f-name ,score) artlist) - (setq article (file-name-nondirectory f-name)) + (setq article (file-name-nondirectory f-name) + group (file-name-directory f-name)) ;; Remove prefix. - (when (and prefix - (file-name-absolute-p prefix) - (string-match (concat "^" - (file-name-as-directory prefix)) - f-name)) - (setq group (replace-match "" t t (file-name-directory f-name)))) + (when prefix + (setq group (string-remove-prefix prefix group))) ;; Break the directory name down until it's something that ;; (probably) can be used as a group name. (setq group diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 561f199531e..469fa36fb77 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -442,6 +442,16 @@ will go to the next group without confirmation." (const slightly-quietly) (sexp :menu-tag "on" t))) +(defcustom gnus-paging-select-next t + "Control whether to select the next/prev article when paging. +If non-nil, select the next article when reaching the end of the +article (or the previous article when paging backwards). + +If nil, don't do anything at the end/start of the articles." + :version "28.1" + :group 'gnus-summary-maneuvering + :type 'boolean) + (defcustom gnus-auto-select-same nil "If non-nil, select the next article with the same subject. If there are no more articles with the same subject, go to @@ -7898,7 +7908,8 @@ Also see the variable `gnus-article-skip-boring'." (gnus-message 3 "End of message")) (circular (gnus-summary-beginning-of-article)) - (lines + ((or lines + (not gnus-paging-select-next)) (gnus-message 3 "End of message")) ((null lines) (if (and (eq gnus-summary-goto-unread 'never) @@ -7929,7 +7940,8 @@ the beginning of the buffer." (gnus-eval-in-buffer-window gnus-article-buffer (setq endp (gnus-article-prev-page lines))) (when (and move endp) - (cond (lines + (cond ((or lines + (not gnus-paging-select-next)) (gnus-message 3 "Beginning of message")) ((null lines) (if (and (eq gnus-summary-goto-unread 'never) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 5bdf53763a2..288ccc494c9 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -3109,8 +3109,6 @@ Like `text-mode', but with these additional commands: '(message-font-lock-keywords t)) (if (boundp 'tool-bar-map) (set (make-local-variable 'tool-bar-map) (message-make-tool-bar))) - (easy-menu-add message-mode-menu message-mode-map) - (easy-menu-add message-mode-field-menu message-mode-map) ;; Mmmm... Forbidden properties... (add-hook 'after-change-functions #'message-strip-forbidden-properties nil 'local) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 45c9bbfe905..0765d7b245d 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -735,8 +735,9 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (let* ((coding-system-for-write 'binary) (coding-system-for-read 'binary) (data (shell-command-to-string - (format "%s --list-options no-show-photos --attribute-fd 3 --list-keys %s 3>&1 >/dev/null 2>&1" - (shell-quote-argument epg-gpg-program) key-id)))) + (format "%s --list-options no-show-photos --attribute-fd 3 --list-keys %s 3>&1 >%s 2>&1" + (shell-quote-argument epg-gpg-program) + key-id null-device)))) (when (> (length data) 0) (insert (substring data 16)) (condition-case nil diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index eb27fee88ce..08d45e53155 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -398,7 +398,7 @@ Any details (stdout and stderr) are left in the buffer specified by `smime-details-buffer'." (smime-new-details-buffer) (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t) - "smime" "-verify" "-noverify" "-out" '("/dev/null")) + "smime" "-verify" "-noverify" "-out" `(,null-device)) t (insert-buffer-substring smime-details-buffer) nil)) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index a4c0431aa44..d5b8df98189 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -126,17 +126,48 @@ with the current prefix. The files are chosen according to :group 'help :version "26.3") +(defun help--symbol-completion-table-affixation (completions) + (mapcar (lambda (c) + (let* ((s (intern c)) + (doc (condition-case nil (documentation s) (error nil))) + (doc (and doc (substring doc 0 (string-match "\n" doc))))) + (list c (propertize + (concat (cond ((commandp s) + "c") ; command + ((eq (car-safe (symbol-function s)) 'macro) + "m") ; macro + ((fboundp s) + "f") ; function + ((custom-variable-p s) + "u") ; user option + ((boundp s) + "v") ; variable + ((facep s) + "a") ; fAce + ((and (fboundp 'cl-find-class) + (cl-find-class s)) + "t") ; CL type + (" ")) ; something else + " ") ; prefix separator + 'face 'completions-annotations) + (if doc (propertize (format " -- %s" doc) + 'face 'completions-annotations) + "")))) + completions)) + (defun help--symbol-completion-table (string pred action) - (when help-enable-completion-autoload - (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string))) - (help--load-prefixes prefixes))) - (let ((prefix-completions - (and help-enable-completion-autoload - (mapcar #'intern (all-completions string definition-prefixes))))) - (complete-with-action action obarray string - (if pred (lambda (sym) - (or (funcall pred sym) - (memq sym prefix-completions))))))) + (if (and completions-detailed (eq action 'metadata)) + '(metadata (affixation-function . help--symbol-completion-table-affixation)) + (when help-enable-completion-autoload + (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string))) + (help--load-prefixes prefixes))) + (let ((prefix-completions + (and help-enable-completion-autoload + (mapcar #'intern (all-completions string definition-prefixes))))) + (complete-with-action action obarray string + (if pred (lambda (sym) + (or (funcall pred sym) + (memq sym prefix-completions)))))))) (defvar describe-function-orig-buffer nil "Buffer that was current when `describe-function' was invoked. diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index d361971a1fc..d59f2c0ebfc 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -3084,13 +3084,11 @@ on encoding." (puthash "BELL (BEL)" ?\a names) (setq ucs-names names)))) -(defun mule--ucs-names-annotation (name) - ;; FIXME: It would be much better to add this annotation before rather than - ;; after the char name, so the annotations are aligned. - ;; FIXME: The default behavior of displaying annotations in italics - ;; doesn't work well here. - (let ((char (gethash name ucs-names))) - (when char (format " (%c)" char)))) +(defun mule--ucs-names-affixation (names) + (mapcar (lambda (name) + (let ((char (gethash name ucs-names))) + (list name (concat (if char (format "%c" char) " ") "\t") ""))) + names)) (defun char-from-name (string &optional ignore-case) "Return a character as a number from its Unicode name STRING. @@ -3133,13 +3131,14 @@ octal). Treat otherwise-ambiguous strings like \"BED\" (U+1F6CF) as names, not numbers." (let* ((enable-recursive-minibuffers t) (completion-ignore-case t) + (completion-tab-width 4) (input (completing-read prompt (lambda (string pred action) (if (eq action 'metadata) '(metadata - (annotation-function . mule--ucs-names-annotation) + (affixation-function . mule--ucs-names-affixation) (category . unicode-name)) (complete-with-action action (ucs-names) string pred))))) (char diff --git a/lisp/isearch.el b/lisp/isearch.el index 4fba4370d98..a0aa250c4b6 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2500,11 +2500,18 @@ If search string is empty, just beep." "Replace just-yanked search string with previously killed string." (interactive) (if (not (memq last-command '(isearch-yank-kill isearch-yank-pop))) - ;; Fall back on `isearch-yank-kill' for the benefits of people - ;; who are used to the old behavior of `M-y' in isearch mode. In - ;; future, this fallback may be changed if we ever change - ;; `yank-pop' to do something like the kill-ring-browser. - (isearch-yank-kill) + ;; Yank string from kill-ring-browser. + (with-isearch-suspended + (let ((string (read-from-kill-ring))) + (if (and isearch-case-fold-search + (eq 'not-yanks search-upper-case)) + (setq string (downcase string))) + (if isearch-regexp (setq string (regexp-quote string))) + (setq isearch-yank-flag t) + (setq isearch-new-string (concat isearch-string string) + isearch-new-message (concat isearch-message + (mapconcat 'isearch-text-char-description + string ""))))) (isearch-pop-state) (isearch-yank-string (current-kill 1)))) diff --git a/lisp/leim/quail/arabic.el b/lisp/leim/quail/arabic.el index a3424c8404d..dd840c344cc 100644 --- a/lisp/leim/quail/arabic.el +++ b/lisp/leim/quail/arabic.el @@ -1,4 +1,4 @@ -;;; arabic.el --- Quail package for inputting Arabic -*- coding: utf-8;-*- +;;; arabic.el --- Quail package for inputting Arabic -*- coding: utf-8; lexical-binding:t -*- ;; Copyright (C) 2007-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/croatian.el b/lisp/leim/quail/croatian.el index 97bfb855fb3..2efd7ce6bbd 100644 --- a/lisp/leim/quail/croatian.el +++ b/lisp/leim/quail/croatian.el @@ -1,4 +1,4 @@ -;;; croatian.el -- Quail package for inputting Croatian -*-coding: utf-8;-*- +;;; croatian.el -- Quail package for inputting Croatian -*-coding: utf-8; lexical-binding:t -*- ;; Copyright (C) 2003-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/cyril-jis.el b/lisp/leim/quail/cyril-jis.el index 6109dfc0e08..730042b4bc0 100644 --- a/lisp/leim/quail/cyril-jis.el +++ b/lisp/leim/quail/cyril-jis.el @@ -1,4 +1,4 @@ -;;; cyril-jis.el --- Quail package for inputting JISX0208 Cyrillic letters +;;; cyril-jis.el --- Quail package for inputting JISX0208 Cyrillic letters -*- lexical-binding: t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, diff --git a/lisp/leim/quail/cyrillic.el b/lisp/leim/quail/cyrillic.el index 8845223e9a8..fa209f0bce2 100644 --- a/lisp/leim/quail/cyrillic.el +++ b/lisp/leim/quail/cyrillic.el @@ -1,4 +1,4 @@ -;;; cyrillic.el --- Quail package for inputting Cyrillic characters +;;; cyrillic.el --- Quail package for inputting Cyrillic characters -*- lexical-binding: t -*- ;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, diff --git a/lisp/leim/quail/czech.el b/lisp/leim/quail/czech.el index 7c208ef15e2..34416c2b91e 100644 --- a/lisp/leim/quail/czech.el +++ b/lisp/leim/quail/czech.el @@ -1,4 +1,4 @@ -;;; czech.el --- Quail package for inputting Czech -*-coding: utf-8;-*- +;;; czech.el --- Quail package for inputting Czech -*-coding: utf-8; lexical-binding:t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/ethiopic.el b/lisp/leim/quail/ethiopic.el index 8d19a233709..c8753effe0a 100644 --- a/lisp/leim/quail/ethiopic.el +++ b/lisp/leim/quail/ethiopic.el @@ -1,4 +1,4 @@ -;;; ethiopic.el --- Quail package for inputting Ethiopic characters -*-coding: utf-8-emacs;-*- +;;; ethiopic.el --- Quail package for inputting Ethiopic characters -*-coding: utf-8-emacs; lexical-binding:t -*- ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, ;; 2006, 2007, 2008, 2009, 2010, 2011 diff --git a/lisp/leim/quail/georgian.el b/lisp/leim/quail/georgian.el index b6da6befe12..e66477a66aa 100644 --- a/lisp/leim/quail/georgian.el +++ b/lisp/leim/quail/georgian.el @@ -1,4 +1,4 @@ -;;; georgian.el --- Quail package for inputting Georgian characters -*-coding: utf-8;-*- +;;; georgian.el --- Quail package for inputting Georgian characters -*- coding: utf-8; lexical-binding:t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/greek.el b/lisp/leim/quail/greek.el index 14bbacc4a39..eedfb9d0f60 100644 --- a/lisp/leim/quail/greek.el +++ b/lisp/leim/quail/greek.el @@ -1,4 +1,4 @@ -;;; greek.el --- Quail package for inputting Greek -*-coding: utf-8-*- +;;; greek.el --- Quail package for inputting Greek -*- coding: utf-8; lexical-binding:t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, diff --git a/lisp/leim/quail/hanja-jis.el b/lisp/leim/quail/hanja-jis.el index 6f753259456..c4eb4b57be8 100644 --- a/lisp/leim/quail/hanja-jis.el +++ b/lisp/leim/quail/hanja-jis.el @@ -1,4 +1,4 @@ -;;; hanja-jis.el --- Quail package for inputting Korean Hanja (JISX0208) +;;; hanja-jis.el --- Quail package for inputting Korean Hanja (JISX0208) -*- lexical-binding: t -*- ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, ;; 2006, 2007, 2008, 2009, 2010, 2011 diff --git a/lisp/leim/quail/hanja.el b/lisp/leim/quail/hanja.el index 455af12b0a9..3ca17c67bd3 100644 --- a/lisp/leim/quail/hanja.el +++ b/lisp/leim/quail/hanja.el @@ -1,4 +1,4 @@ -;;; hanja.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: utf-8;-*- +;;; hanja.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, diff --git a/lisp/leim/quail/hanja3.el b/lisp/leim/quail/hanja3.el index f318c01bea4..b380d40853d 100644 --- a/lisp/leim/quail/hanja3.el +++ b/lisp/leim/quail/hanja3.el @@ -1,4 +1,4 @@ -;;; hanja3.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: utf-8;-*- +;;; hanja3.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1997, 1999, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/hebrew.el b/lisp/leim/quail/hebrew.el index 772da70b5ce..fc6bb80596b 100644 --- a/lisp/leim/quail/hebrew.el +++ b/lisp/leim/quail/hebrew.el @@ -1,4 +1,4 @@ -;; hebrew.el --- Quail package for inputting Hebrew characters -*-coding: utf-8;-*- +;; hebrew.el --- Quail package for inputting Hebrew characters -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, ;; 2008, 2009, 2010, 2011 diff --git a/lisp/leim/quail/ipa-praat.el b/lisp/leim/quail/ipa-praat.el index 4c241ccf8ea..cc577c6aff2 100644 --- a/lisp/leim/quail/ipa-praat.el +++ b/lisp/leim/quail/ipa-praat.el @@ -1,4 +1,4 @@ -;;; ipa-praat.el --- Inputting IPA characters with the conventions of Praat +;;; ipa-praat.el --- Inputting IPA characters with the conventions of Praat -*- lexical-binding: t -*- ;; Copyright (C) 2011-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/latin-alt.el b/lisp/leim/quail/latin-alt.el index 06ab5e3d111..4661ba8cc84 100644 --- a/lisp/leim/quail/latin-alt.el +++ b/lisp/leim/quail/latin-alt.el @@ -1,4 +1,4 @@ -;;; latin-alt.el --- Quail package for inputting various European characters -*-coding: utf-8;-*- +;;; latin-alt.el --- Quail package for inputting various European characters -*-coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc. ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el index 1d6aeddc060..293c0c0b6ed 100644 --- a/lisp/leim/quail/latin-post.el +++ b/lisp/leim/quail/latin-post.el @@ -1,4 +1,4 @@ -;;; latin-post.el --- Quail packages for inputting various European characters -*-coding: utf-8;-*- +;;; latin-post.el --- Quail packages for inputting various European characters -*-coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, diff --git a/lisp/leim/quail/latin-pre.el b/lisp/leim/quail/latin-pre.el index f421a7eb1d2..802b70ec7cd 100644 --- a/lisp/leim/quail/latin-pre.el +++ b/lisp/leim/quail/latin-pre.el @@ -1,4 +1,4 @@ -;;; latin-pre.el --- Quail packages for inputting various European characters -*-coding: utf-8;-*- +;;; latin-pre.el --- Quail packages for inputting various European characters -*-coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1997-2020 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, diff --git a/lisp/leim/quail/persian.el b/lisp/leim/quail/persian.el index f12abc1ac9d..fcbf727e93a 100644 --- a/lisp/leim/quail/persian.el +++ b/lisp/leim/quail/persian.el @@ -1,4 +1,4 @@ -;;; persian.el --- Quail package for inputting Persian/Farsi keyboard -*- coding: utf-8;-*- +;;; persian.el --- Quail package for inputting Persian/Farsi keyboard -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2011-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/programmer-dvorak.el b/lisp/leim/quail/programmer-dvorak.el index 0429df01de0..c544c62d07b 100644 --- a/lisp/leim/quail/programmer-dvorak.el +++ b/lisp/leim/quail/programmer-dvorak.el @@ -1,4 +1,4 @@ -;;; programmer-dvorak.el --- Quail package for the programmer Dvorak layout +;;; programmer-dvorak.el --- Quail package for the programmer Dvorak layout -*- lexical-binding: t -*- ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/py-punct.el b/lisp/leim/quail/py-punct.el index 90fa474dd06..76bf6125ef8 100644 --- a/lisp/leim/quail/py-punct.el +++ b/lisp/leim/quail/py-punct.el @@ -1,4 +1,4 @@ -;;; py-punct.el --- Quail packages for Chinese (pinyin + extra symbols) +;;; py-punct.el --- Quail packages for Chinese (pinyin + extra symbols) -*- lexical-binding: t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, diff --git a/lisp/leim/quail/pypunct-b5.el b/lisp/leim/quail/pypunct-b5.el index 9f4e73c9f05..f9330bd24f9 100644 --- a/lisp/leim/quail/pypunct-b5.el +++ b/lisp/leim/quail/pypunct-b5.el @@ -1,4 +1,4 @@ -;;; pypunct-b5.el --- Quail packages for Chinese (pinyin + extra symbols) +;;; pypunct-b5.el --- Quail packages for Chinese (pinyin + extra symbols) -*- lexical-binding: t -*- ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, ;; 2006, 2007, 2008, 2009, 2010, 2011 diff --git a/lisp/leim/quail/rfc1345.el b/lisp/leim/quail/rfc1345.el index c2e7cd9fad3..7f98021dfe8 100644 --- a/lisp/leim/quail/rfc1345.el +++ b/lisp/leim/quail/rfc1345.el @@ -1,4 +1,4 @@ -;;; rfc1345.el --- Quail method for RFC 1345 mnemonics -*- coding: utf-8 -*- +;;; rfc1345.el --- Quail method for RFC 1345 mnemonics -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/sami.el b/lisp/leim/quail/sami.el index 66750c31406..33fe2878dff 100644 --- a/lisp/leim/quail/sami.el +++ b/lisp/leim/quail/sami.el @@ -1,4 +1,4 @@ -;;; sami.el --- Quail package for inputting Sámi -*-coding: utf-8;-*- +;;; sami.el --- Quail package for inputting Sámi -*-coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2019-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/sgml-input.el b/lisp/leim/quail/sgml-input.el index 5cc9f5e0ccc..df7ac984ce1 100644 --- a/lisp/leim/quail/sgml-input.el +++ b/lisp/leim/quail/sgml-input.el @@ -1,4 +1,4 @@ -;;; sgml-input.el --- Quail method for Unicode entered as SGML entities -*- coding: utf-8 -*- +;;; sgml-input.el --- Quail method for Unicode entered as SGML entities -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/slovak.el b/lisp/leim/quail/slovak.el index 828d25a2e32..c306be1e558 100644 --- a/lisp/leim/quail/slovak.el +++ b/lisp/leim/quail/slovak.el @@ -1,4 +1,4 @@ -;;; slovak.el --- Quail package for inputting Slovak -*-coding: utf-8;-*- +;;; slovak.el --- Quail package for inputting Slovak -*-coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/symbol-ksc.el b/lisp/leim/quail/symbol-ksc.el index ae33786c5ea..e346f7c7bd9 100644 --- a/lisp/leim/quail/symbol-ksc.el +++ b/lisp/leim/quail/symbol-ksc.el @@ -1,4 +1,4 @@ -;;; symbol-ksc.el --- Quail-package for Korean Symbol (KSC5601) -*-coding: utf-8;-*- +;;; symbol-ksc.el --- Quail-package for Korean Symbol (KSC5601) -*-coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, diff --git a/lisp/leim/quail/tamil-dvorak.el b/lisp/leim/quail/tamil-dvorak.el index 93ff0ccdac6..0a70c3bfe11 100644 --- a/lisp/leim/quail/tamil-dvorak.el +++ b/lisp/leim/quail/tamil-dvorak.el @@ -1,4 +1,4 @@ -;;; tamil-dvorak.el --- Quail package for Tamil input with Dvorak keyboard +;;; tamil-dvorak.el --- Quail package for Tamil input with Dvorak keyboard -*- lexical-binding: t -*- ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/vntelex.el b/lisp/leim/quail/vntelex.el index 385bc910bba..8d53ab0be04 100644 --- a/lisp/leim/quail/vntelex.el +++ b/lisp/leim/quail/vntelex.el @@ -1,4 +1,4 @@ -;;; vntelex.el --- Quail package for Vietnamese by Telex method +;;; vntelex.el --- Quail package for Vietnamese by Telex method -*- lexical-binding: t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/vnvni.el b/lisp/leim/quail/vnvni.el index 36cad8e9120..e7973044b0a 100644 --- a/lisp/leim/quail/vnvni.el +++ b/lisp/leim/quail/vnvni.el @@ -1,4 +1,4 @@ -;;; vnvni.el --- Quail package for Vietnamese by VNI method +;;; vnvni.el --- Quail package for Vietnamese by VNI method -*- lexical-binding: t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/leim/quail/welsh.el b/lisp/leim/quail/welsh.el index bc6e8ecd333..a62d2f50955 100644 --- a/lisp/leim/quail/welsh.el +++ b/lisp/leim/quail/welsh.el @@ -1,4 +1,4 @@ -;;; welsh.el --- Quail package for inputting Welsh characters -*-coding: utf-8;-*- +;;; welsh.el --- Quail package for inputting Welsh characters -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index 0a73ff45c2a..0fb5ebf1f78 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -656,9 +656,10 @@ perform the operation on all messages in that region. (mh-funcall-if-exists hl-line-mode 1) (setq revert-buffer-function 'mh-undo-folder) (add-to-list 'minor-mode-alist '(mh-showing-mode " Show")) - (easy-menu-add mh-folder-sequence-menu) - (easy-menu-add mh-folder-message-menu) - (easy-menu-add mh-folder-folder-menu) + (mh-do-in-xemacs + (easy-menu-add mh-folder-sequence-menu) + (easy-menu-add mh-folder-message-menu) + (easy-menu-add mh-folder-folder-menu)) (mh-inc-spool-make) (mh-set-help mh-folder-mode-help-messages) (if (and (featurep 'xemacs) diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el index ed239963391..23fa87de825 100644 --- a/lisp/mh-e/mh-identity.el +++ b/lisp/mh-e/mh-identity.el @@ -91,7 +91,7 @@ See `mh-identity-add-menu'." "Add the current Identity menu. See `mh-identity-make-menu'." (if mh-identity-menu - (easy-menu-add mh-identity-menu))) + (mh-do-in-xemacs (easy-menu-add mh-identity-menu)))) (defvar mh-identity-local nil "Buffer-local variable that holds the identity currently in use.") diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index 5e1ce403188..b8aca77ddc8 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -330,7 +330,7 @@ order). (t ;; ...or the header only (setq font-lock-defaults '((mh-show-font-lock-keywords) t)))) - (easy-menu-add mh-letter-menu) + (mh-do-in-xemacs (easy-menu-add mh-letter-menu)) ;; Maybe we want to use the existing Mail menu from mail-mode in ;; 9.0; in the mean time, let's remove it since the redundancy will ;; only produce confusion. diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index 6fb76beff27..5cfe67865ee 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -618,7 +618,7 @@ The hook `mh-search-mode-hook' is called upon entry to this mode. \\{mh-search-mode-map}" - (easy-menu-add mh-pick-menu) + (mh-do-in-xemacs (easy-menu-add mh-pick-menu)) (mh-set-help mh-search-mode-help-messages)) diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 7536f949e76..48ff74131d7 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -863,9 +863,10 @@ See also `mh-folder-mode'. (when mh-decode-mime-flag (mh-make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'mh-mime-cleanup nil t)) - (easy-menu-add mh-show-sequence-menu) - (easy-menu-add mh-show-message-menu) - (easy-menu-add mh-show-folder-menu) + (mh-do-in-xemacs + (easy-menu-add mh-show-sequence-menu) + (easy-menu-add mh-show-message-menu) + (easy-menu-add mh-show-folder-menu)) (make-local-variable 'mh-show-folder-buffer) (buffer-disable-undo) (use-local-map mh-show-mode-map)) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 9d57a817b25..d44d8968221 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -83,7 +83,6 @@ ;; - add support for ** to pcm. ;; - Add vc-file-name-completion-table to read-file-name-internal. -;; - A feature like completing-help.el. ;;; Code: @@ -121,6 +120,10 @@ This metadata is an alist. Currently understood keys are: - `annotation-function': function to add annotations in *Completions*. Takes one argument (STRING), which is a possible completion and returns a string to append to STRING. +- `affixation-function': function to prepend/append a prefix/suffix to + entries. Takes one argument (COMPLETIONS) and should return a list + of completions with a list of three elements: completion, its prefix + and suffix. - `display-sort-function': function to sort entries in *Completions*. Takes one argument (COMPLETIONS) and should return a new list of completions. Can operate destructively. @@ -1131,6 +1134,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-tab-width nil) (defvar completion-fail-discreetly nil "If non-nil, stay quiet when there is no match.") @@ -1669,18 +1673,27 @@ Return nil if there is no valid completion, else t." (#b000 nil) (_ t)))) -(defface completions-annotations '((t :inherit italic)) +(defface completions-annotations '((t :inherit (italic shadow))) "Face to use for annotations in the *Completions* buffer.") (defcustom completions-format 'horizontal "Define the appearance and sorting of completions. If the value is `vertical', display completions sorted vertically in columns in the *Completions* buffer. -If the value is `horizontal', display completions sorted -horizontally in alphabetical order, rather than down the screen." - :type '(choice (const horizontal) (const vertical)) +If the value is `horizontal', display completions sorted in columns +horizontally in alphabetical order, rather than down the screen. +If the value is `one-column', display completions down the screen +in one column." + :type '(choice (const horizontal) (const vertical) (const one-column)) :version "23.2") +(defcustom completions-detailed nil + "When non-nil, display completions with details added as prefix/suffix. +Some commands might provide a detailed view with more information prepended +or appended to completions." + :type 'boolean + :version "28.1") + (defun completion--insert-strings (strings) "Insert a list of STRINGS into the current buffer. Uses columns to keep the listing readable but compact. @@ -1689,8 +1702,7 @@ It also eliminates runs of equal strings." (let* ((length (apply #'max (mapcar (lambda (s) (if (consp s) - (+ (string-width (car s)) - (string-width (cadr s))) + (apply #'+ (mapcar #'string-width s)) (string-width s))) strings))) (window (get-buffer-window (current-buffer) 0)) @@ -1707,6 +1719,11 @@ It also eliminates runs of equal strings." (row 0) (first t) (laststring nil)) + (unless (or tab-stop-list (null completion-tab-width) + (zerop (mod colwidth completion-tab-width))) + ;; Align to tab positions for the case + ;; when the caller uses tabs inside prefix. + (setq colwidth (- colwidth (mod colwidth completion-tab-width)))) ;; The insertion should be "sensible" no matter what choices were made ;; for the parameters above. (dolist (str strings) @@ -1715,10 +1732,12 @@ It also eliminates runs of equal strings." ;; FIXME: `string-width' doesn't pay attention to ;; `display' properties. (let ((length (if (consp str) - (+ (string-width (car str)) - (string-width (cadr str))) + (apply #'+ (mapcar #'string-width str)) (string-width str)))) (cond + ((eq completions-format 'one-column) + ;; Nothing special + ) ((eq completions-format 'vertical) ;; Vertical format (when (> row rows) @@ -1745,23 +1764,46 @@ It also eliminates runs of equal strings." ;; already past the goal column, there is still ;; a space displayed. (set-text-properties (1- (point)) (point) - ;; We can't just set tab-width, because - ;; completion-setup-function will kill - ;; all local variables :-( + ;; We can set tab-width using + ;; completion-tab-width, but + ;; the caller can prefer using + ;; \t to align prefixes. `(display (space :align-to ,column))) nil)))) (setq first nil) (if (not (consp str)) (put-text-property (point) (progn (insert str) (point)) 'mouse-face 'highlight) - (put-text-property (point) (progn (insert (car str)) (point)) - 'mouse-face 'highlight) - (let ((beg (point)) - (end (progn (insert (cadr str)) (point)))) - (put-text-property beg end 'mouse-face nil) - (font-lock-prepend-text-property beg end 'face - 'completions-annotations))) + ;; If `str' is a list that has 2 elements, + ;; then the second element is a suffix annotation. + ;; If `str' has 3 elements, then the second element + ;; is a prefix, and the third element is a suffix. + (let* ((prefix (when (nth 2 str) (nth 1 str))) + (suffix (or (nth 2 str) (nth 1 str)))) + (when prefix + (let ((beg (point)) + (end (progn (insert prefix) (point)))) + (put-text-property beg end 'mouse-face nil) + ;; When both prefix and suffix are added + ;; by the caller via affixation-function, + ;; then allow the caller to decide + ;; what faces to put on prefix and suffix. + (unless prefix + (font-lock-prepend-text-property + beg end 'face 'completions-annotations)))) + (put-text-property (point) (progn (insert (car str)) (point)) + 'mouse-face 'highlight) + (let ((beg (point)) + (end (progn (insert suffix) (point)))) + (put-text-property beg end 'mouse-face nil) + ;; Put the predefined face only when suffix + ;; is added via annotation-function. + (unless prefix + (font-lock-prepend-text-property + beg end 'face 'completions-annotations))))) (cond + ((eq completions-format 'one-column) + (insert "\n")) ((eq completions-format 'vertical) ;; Vertical format (if (> column 0) @@ -1880,6 +1922,11 @@ These include: completion). The function can access the completion data via `minibuffer-completion-table' and related variables. +`:affixation-function': Function to prepend/append a prefix/suffix to + completions. The function must accept one argument, a list of + completions, and return a list where each element is a list of + three elements: a completion, a prefix and a suffix. + `:exit-function': Function to run after completion is performed. The function must accept two arguments, STRING and STATUS. @@ -1962,10 +2009,13 @@ variables.") base-size md minibuffer-completion-table minibuffer-completion-predicate)) - (afun (or (completion-metadata-get all-md 'annotation-function) - (plist-get completion-extra-properties - :annotation-function) - completion-annotate-function)) + (ann-fun (or (completion-metadata-get all-md 'annotation-function) + (plist-get completion-extra-properties + :annotation-function) + completion-annotate-function)) + (aff-fun (or (completion-metadata-get all-md 'affixation-function) + (plist-get completion-extra-properties + :affixation-function))) (mainbuf (current-buffer)) ;; If the *Completions* buffer is shown in a new ;; window, mark it as softly-dedicated, so bury-buffer in @@ -2006,12 +2056,15 @@ variables.") (if sort-fun (funcall sort-fun completions) (sort completions 'string-lessp)))) - (when afun + (when ann-fun (setq completions (mapcar (lambda (s) - (let ((ann (funcall afun s))) + (let ((ann (funcall ann-fun s))) (if ann (list s ann) s))) completions))) + (when aff-fun + (setq completions + (funcall aff-fun completions))) (with-current-buffer standard-output (set (make-local-variable 'completion-base-position) @@ -3034,19 +3087,6 @@ the commands start with a \"-\" or a SPC." :version "24.1" :type 'boolean) -(defcustom minibuffer-default-prompt-format " (default %s)" - "Format string used to output \"default\" values. -When prompting for input, there will often be a default value, -leading to prompts like \"Number of articles (default 50): \". -The \"default\" part of that prompt is controlled by this -variable, and can be set to, for instance, \" [%s]\" if you want -a shorter displayed prompt, or \"\", if you don't want to display -the default at all. - -This variable is used by the `format-prompt' function." - :version "28.1" - :type 'string) - (defun completion-pcm--pattern-trivial-p (pattern) (and (stringp (car pattern)) ;; It can be followed by `point' and "" and still be trivial. @@ -3864,6 +3904,19 @@ the minibuffer was activated, and execute the forms." (with-minibuffer-selected-window (scroll-other-window-down arg))) +(defcustom minibuffer-default-prompt-format " (default %s)" + "Format string used to output \"default\" values. +When prompting for input, there will often be a default value, +leading to prompts like \"Number of articles (default 50): \". +The \"default\" part of that prompt is controlled by this +variable, and can be set to, for instance, \" [%s]\" if you want +a shorter displayed prompt, or \"\", if you don't want to display +the default at all. + +This variable is used by the `format-prompt' function." + :version "28.1" + :type 'string) + (defun format-prompt (prompt default &rest format-args) "Format PROMPT with DEFAULT according to `minibuffer-default-prompt-format'. If FORMAT-ARGS is nil, PROMPT is used as a plain string. If diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 9ed01ecc473..0c43fc609a2 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -56,6 +56,13 @@ :group 'eww :type 'string) +(defcustom eww-use-browse-url "\\`mailto:" + "eww will use `browse-url' when following links that match this regexp. +The action to be taken can be further customized via +`browse-url-handlers'." + :version "28.1" + :type 'regexp) + (defun erc--download-directory () "Return the name of the download directory. If ~/Downloads/ exists, that will be used, and if not, the @@ -1731,7 +1738,7 @@ If EXTERNAL is double prefix, browse in new buffer." (cond ((not url) (message "No link under point")) - ((string-match-p "\\`mailto:" url) + ((string-match-p eww-use-browse-url url) ;; This respects the user options `browse-url-handlers' ;; and `browse-url-mailto-function'. (browse-url url)) diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index 08367c698f2..75bb4e242e2 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -143,8 +143,7 @@ require \"fileinto\"; (define-derived-mode sieve-manage-mode special-mode "Sieve-manage" "Mode used for sieve script management." (buffer-disable-undo (current-buffer)) - (setq truncate-lines t) - (easy-menu-add sieve-manage-mode-menu sieve-manage-mode-map)) + (setq truncate-lines t)) ;; Commands used in sieve-manage mode: diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index d2265ed1dfa..2851110826c 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4979,7 +4979,7 @@ connection if a previous connection has died for some reason." (setenv "PS1" tramp-initial-end-of-output) (unless (stringp tramp-encoding-shell) (tramp-error vec 'file-error "`tramp-encoding-shell' not set")) - (let* ((current-host (system-name)) + (let* ((current-host tramp-system-name) (target-alist (tramp-compute-multi-hops vec)) ;; We will apply `tramp-ssh-controlmaster-options' ;; only for the first hop. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index d40f9a5927c..6ae79be9e35 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -175,6 +175,12 @@ See the variable `tramp-encoding-shell' for more information." :version "24.1" :type '(choice (const nil) string)) +;; Since Emacs 26.1, `system-name' can return `nil' at build time if +;; Emacs is compiled with "--no-build-details". We do expect it to be +;; a string. (Bug#44481) +(defconst tramp-system-name (or (system-name) "") + "The system name Tramp is running locally.") + (defvar tramp-methods nil "Alist of methods for remote files. This is a list of entries of the form (NAME PARAM1 PARAM2 ...). @@ -417,7 +423,7 @@ empty string for the method name." (choice :tag " Host regexp" regexp sexp) (choice :tag " User name" string (const nil))))) -(defcustom tramp-default-host (system-name) +(defcustom tramp-default-host tramp-system-name "Default host to use for transferring files. Useful for su and sudo methods mostly." :type 'string) @@ -472,8 +478,8 @@ interpreted as a regular expression which always matches." (defcustom tramp-restricted-shell-hosts-alist (when (memq system-type '(windows-nt)) (list (format "\\`\\(%s\\|%s\\)\\'" - (regexp-quote (downcase (system-name))) - (regexp-quote (upcase (system-name)))))) + (regexp-quote (downcase tramp-system-name)) + (regexp-quote (upcase tramp-system-name))))) "List of hosts, which run a restricted shell. This is a list of regular expressions, which denote hosts running a restricted shell like \"rbash\". Those hosts can be used as @@ -486,7 +492,7 @@ host runs a restricted shell, it shall be added to this list, too." (concat "\\`" (regexp-opt - (list "localhost" "localhost6" (system-name) "127.0.0.1" "::1") t) + (list "localhost" "localhost6" tramp-system-name "127.0.0.1" "::1") t) "\\'") "Host names which are regarded as local host. If the local host runs a chrooted environment, set this to nil." diff --git a/lisp/obsolete/otodo-mode.el b/lisp/obsolete/otodo-mode.el index 2a4af290b6b..6aada0755ef 100644 --- a/lisp/obsolete/otodo-mode.el +++ b/lisp/obsolete/otodo-mode.el @@ -923,7 +923,8 @@ If INCLUDE-SEP is non-nil, return point after the separator." ;;;###autoload (define-derived-mode todo-mode nil "TODO" "Major mode for editing TODO lists." - (easy-menu-add todo-menu)) + (when (featurep 'xemacs) + (easy-menu-add todo-menu))) (with-suppressed-warnings ((lexical date entry)) (defvar date) diff --git a/lisp/org/ob-picolisp.el b/lisp/org/ob-picolisp.el index ec2a228456a..bf31197d486 100644 --- a/lisp/org/ob-picolisp.el +++ b/lisp/org/ob-picolisp.el @@ -111,11 +111,11 @@ This function is called by `org-babel-execute-src-block'." (cond ((or (member "code" result-params) (member "pp" result-params)) - (format "(pretty (out \"/dev/null\" %s))" full-body)) + (format "(pretty (out \"%s\" %s))" null-device full-body)) ((and (member "value" result-params) (not session)) - (format "(print (out \"/dev/null\" %s))" full-body)) + (format "(print (out \"%s\" %s))" null-device full-body)) ((member "value" result-params) - (format "(out \"/dev/null\" %s)" full-body)) + (format "(out \"%s\" %s)" null-device full-body)) (t full-body))) (result (if (not (string= session-name "none")) diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el index 837c18f8407..f663c9d197c 100644 --- a/lisp/org/ob-screen.el +++ b/lisp/org/ob-screen.el @@ -62,7 +62,7 @@ In case you want to use a different screen than one selected by your $PATH") (process-name (concat "org-babel: terminal (" session ")"))) (apply 'start-process process-name "*Messages*" terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location - "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session) + "-c" ,null-device "-mS" ,(concat "org-babel-session-" session) ,cmd)) ;; XXX: Is there a better way than the following? (while (not (org-babel-screen-session-socketname session)) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 689d134627e..82bf1b23f9d 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -2236,7 +2236,6 @@ The following commands are available: (setq mode-name "Org-Agenda") (setq indent-tabs-mode nil) (use-local-map org-agenda-mode-map) - (easy-menu-add org-agenda-menu) (when org-startup-truncated (setq truncate-lines t)) (setq-local line-move-visual nil) (add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 5c37cb1af52..4636baae73d 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -3287,7 +3287,6 @@ Parameters get priority." (setq-local org-selected-window sel-win) (use-local-map org-table-fedit-map) (add-hook 'post-command-hook #'org-table-fedit-post-command t t) - (easy-menu-add org-table-fedit-menu) (setq startline (org-current-line)) (dolist (entry eql) (let* ((type (cond @@ -5129,15 +5128,13 @@ When LOCAL is non-nil, show references for the table at point." orgtbl-line-start-regexp)) (when (fboundp 'font-lock-add-keywords) (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) - (org-restart-font-lock)) - (easy-menu-add orgtbl-mode-menu)) + (org-restart-font-lock))) (t (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) (remove-hook 'before-change-functions 'org-before-change-function t) (when (fboundp 'font-lock-remove-keywords) (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords) (org-restart-font-lock)) - (easy-menu-remove orgtbl-mode-menu) (force-mode-line-update 'all)))) (defun orgtbl-make-binding (fun n &rest keys) diff --git a/lisp/org/org.el b/lisp/org/org.el index d2a36dd0bad..de7dded158a 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -4791,7 +4791,6 @@ This is for getting out of special buffers like capture.") (require 'time-date) (unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) (require 'easymenu) -(autoload 'easy-menu-add "easymenu") (require 'overlay) ;; (require 'org-macs) moved higher up in the file before it is first used diff --git a/lisp/outline.el b/lisp/outline.el index 47e6528859f..9b11b86b9d2 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -1121,14 +1121,19 @@ Return either 'hide-all, 'headings-only, or 'show-all." (setq heading-end (point)) (outline-end-of-subtree) (setq end (point)) - (setq ov-list (cl-remove-if-not - (lambda (o) (eq (overlay-get o 'invisible) 'outline)) - (overlays-in start end))) - (cond ((eq ov-list nil) 'show-all) - ;; (eq (length ov-list) 1) wouldn’t work: what if there is - ;; one folded subheading? - ((and (eq (overlay-end (car ov-list)) end) - (eq (overlay-start (car ov-list)) heading-end)) + (setq ov-list + (seq-filter + (lambda (o) + (and (eq (overlay-get o 'invisible) 'outline) + (save-excursion + (goto-char (overlay-start o)) + (outline-on-heading-p t)))) + (overlays-in start end))) + (cond ((null ov-list) 'show-all) + ((and (or (= end (point-max) + (1+ (overlay-end (car ov-list)))) + (= (overlay-end (car ov-list)) end)) + (= (overlay-start (car ov-list)) heading-end)) 'hide-all) (t 'headings-only))))) @@ -1168,20 +1173,30 @@ Return either 'hide-all, 'headings-only, or 'show-all." (defun outline-cycle-buffer () "Cycle the whole buffer like in `outline-cycle'." (interactive) - (pcase outline--cycle-buffer-state - ('show-all - (outline-hide-sublevels 1) - (setq outline--cycle-buffer-state 'top-level) - (message "Top level headings")) - ('top-level - (outline-show-all) - (outline-hide-region-body (point-min) (point-max)) - (setq outline--cycle-buffer-state 'all-heading) - (message "All headings")) - ('all-heading - (outline-show-all) - (setq outline--cycle-buffer-state 'show-all) - (message "Show all")))) + (let (has-top-level) + (save-excursion + (goto-char (point-min)) + (while (not (or has-top-level (eobp))) + (when (outline-on-heading-p t) + (when (= (funcall outline-level) 1) + (setq has-top-level t))) + (outline-next-heading))) + (cond + ((and (eq outline--cycle-buffer-state 'show-all) + has-top-level) + (outline-hide-sublevels 1) + (setq outline--cycle-buffer-state 'top-level) + (message "Top level headings")) + ((or (eq outline--cycle-buffer-state 'show-all) + (eq outline--cycle-buffer-state 'top-level)) + (outline-show-all) + (outline-hide-region-body (point-min) (point-max)) + (setq outline--cycle-buffer-state 'all-heading) + (message "All headings")) + (t + (outline-show-all) + (setq outline--cycle-buffer-state 'show-all) + (message "Show all"))))) (provide 'outline) (provide 'noutline) diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el index c180fd06c34..ce40aba8e2e 100644 --- a/lisp/play/fortune.el +++ b/lisp/play/fortune.el @@ -96,7 +96,7 @@ Normally you won't have a reason to change it." "Options to pass to the strfile program (a string)." :type 'string) -(defcustom fortune-quiet-strfile-options "> /dev/null" +(defcustom fortune-quiet-strfile-options (concat "> " null-device) "Text added to the command for running `strfile'. By default it discards the output produced by `strfile'. Set this to \"\" if you would like to see the output." diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 9dacd5856cf..dc727aa3759 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -2592,7 +2592,8 @@ the default language." comment-start-skip "/\\*+ *\\|// *") ;; various ----------------------------------------------------------------- (set (make-local-variable 'font-lock-defaults) antlr-font-lock-defaults) - (easy-menu-add antlr-mode-menu) + (when (featurep 'xemacs) + (easy-menu-add antlr-mode-menu)) (set (make-local-variable 'imenu-create-index-function) 'antlr-imenu-create-index-function) (set (make-local-variable 'imenu-generic-expression) t) ; fool stupid test diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index c5201d1af54..5e8cf6161ef 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2597,7 +2597,8 @@ Key bindings: (setq abbrev-mode t) (c-init-language-vars-for 'c-mode) (c-common-init 'c-mode) - (easy-menu-add c-c-menu) + (when (featurep 'xemacs) + (easy-menu-add c-c-menu)) (cc-imenu-init cc-imenu-c-generic-expression) (add-hook 'flymake-diagnostic-functions 'flymake-cc nil t) (c-run-mode-hooks 'c-mode-common-hook)) @@ -2688,7 +2689,8 @@ Key bindings: (setq abbrev-mode t) (c-init-language-vars-for 'c++-mode) (c-common-init 'c++-mode) - (easy-menu-add c-c++-menu) + (when (featurep 'xemacs) + (easy-menu-add c-c++-menu)) (cc-imenu-init cc-imenu-c++-generic-expression) (add-hook 'flymake-diagnostic-functions 'flymake-cc nil t) (c-run-mode-hooks 'c-mode-common-hook)) @@ -2735,7 +2737,8 @@ Key bindings: (setq abbrev-mode t) (c-init-language-vars-for 'objc-mode) (c-common-init 'objc-mode) - (easy-menu-add c-objc-menu) + (when (featurep 'xemacs) + (easy-menu-add c-objc-menu)) (cc-imenu-init nil 'cc-imenu-objc-function) (c-run-mode-hooks 'c-mode-common-hook)) @@ -2785,7 +2788,8 @@ Key bindings: (setq abbrev-mode t) (c-init-language-vars-for 'java-mode) (c-common-init 'java-mode) - (easy-menu-add c-java-menu) + (when (featurep 'xemacs) + (easy-menu-add c-java-menu)) (cc-imenu-init cc-imenu-java-generic-expression) (c-run-mode-hooks 'c-mode-common-hook)) @@ -2827,7 +2831,8 @@ Key bindings: (c-initialize-cc-mode t) (c-init-language-vars-for 'idl-mode) (c-common-init 'idl-mode) - (easy-menu-add c-idl-menu) + (when (featurep 'xemacs) + (easy-menu-add c-idl-menu)) ;;(cc-imenu-init cc-imenu-idl-generic-expression) ;TODO (c-run-mode-hooks 'c-mode-common-hook)) @@ -2872,7 +2877,8 @@ Key bindings: (setq abbrev-mode t) (c-init-language-vars-for 'pike-mode) (c-common-init 'pike-mode) - (easy-menu-add c-pike-menu) + (when (featurep 'xemacs) + (easy-menu-add c-pike-menu)) ;;(cc-imenu-init cc-imenu-pike-generic-expression) ;TODO (c-run-mode-hooks 'c-mode-common-hook)) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index de9c9a209d1..787f5d5ef30 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -214,10 +214,6 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\ \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4)) - (cucumber - "\\(?:^cucumber\\(?: -p [^[:space:]]+\\)?\\|#\\)\ -\\(?: \\)\\([^(].*\\):\\([1-9][0-9]*\\)" 1 2) - (msft ;; Must be before edg-1, so that MSVC's longer messages are ;; considered before EDG. @@ -399,6 +395,17 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) (regexp "[0-9][0-9][0-9]"))) 1 (2 . 4) (3 . 5) (6 . 7)) + (cucumber + ,(rx (| (: bol + (| (: "cucumber" (? " -p " (+ (not space)))) + " ")) + "#") + " " + (group (not "(") (* nonl)) ; file + ":" + (group (in "1-9") (* (in "0-9")))) ; line + 1 2) + (lcc "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 2 3 4 (1)) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 30a80ea8f22..dd36c68c872 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1718,8 +1718,6 @@ or as help on variables `cperl-tips', `cperl-problems', (and (boundp 'msb-menu-cond) (not cperl-msb-fixed) (cperl-msb-fix)) - (if (fboundp 'easy-menu-add) - (easy-menu-add cperl-menu)) ; A NOP in Emacs. (if cperl-hook-after-change (add-hook 'after-change-functions #'cperl-after-change-function nil t)) ;; After hooks since fontification will break this @@ -8158,7 +8156,7 @@ the appropriate statement modifier." (defun cperl-pod2man-build-command () "Builds the entire background manpage and cleaning command." - (let ((command (concat pod2man-program " %s 2>/dev/null")) + (let ((command (concat pod2man-program " %s 2>" null-device)) (flist (and (boundp 'Man-filter-list) Man-filter-list))) (while (and flist (car flist)) (let ((pcom (car (car flist))) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index b286208fff9..efa7b2ffbf1 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1224,7 +1224,7 @@ default) no filter is applied." map)) ,@(pcase-let ((`(,ind ,face ,explain) (cond ((null known) - '("?" mode-line "No known backends")) + '("?" nil "No known backends")) (some-waiting `("Wait" compilation-mode-line-run ,(format "Waiting for %s running backend(s)" diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 2ad66ccc5e0..4dee72c737d 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -948,7 +948,6 @@ Key bindings: (add-hook 'change-major-mode-hook #'turn-off-hideshow nil t) - (easy-menu-add hs-minor-mode-menu) (set (make-local-variable 'line-move-ignore-invisible) t) (add-to-invisibility-spec '(hs . t))) (remove-from-invisibility-spec '(hs . t)) diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 89296ff5b50..af1a1b154b7 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -306,7 +306,6 @@ Jump: [h] to function doclib header Here are all keybindings. \\{idlwave-help-mode-map}" (buffer-disable-undo) - (easy-menu-add idlwave-help-menu idlwave-help-mode-map) (setq truncate-lines t) (setq case-fold-search t) (setq mode-line-format @@ -1201,16 +1200,9 @@ Useful when source code is displayed as help. See the option (setq idlwave-help-frame (make-frame idlwave-help-frame-parameters)) ;; Strip menubar (?) and toolbar from the Help frame. - (if (fboundp 'set-specifier) - (progn - ;; XEmacs - (let ((sval (cons idlwave-help-frame nil))) - ;; (set-specifier menubar-visible-p sval) - (set-specifier default-toolbar-visible-p sval))) - ;; Emacs - (modify-frame-parameters idlwave-help-frame - '(;;(menu-bar-lines . 0) - (tool-bar-lines . 0))))) + (modify-frame-parameters idlwave-help-frame + '(;;(menu-bar-lines . 0) + (tool-bar-lines . 0)))) (select-frame idlwave-help-frame)) (defun idlwave-help-get-help-buffer () diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 70b94596e10..31f18457e77 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -954,7 +954,6 @@ IDL has currently stepped.") nil 'local) (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local) (add-hook 'kill-emacs-hook 'idlwave-shell-delete-temp-files) - (easy-menu-add idlwave-shell-mode-menu idlwave-shell-mode-map) ;; Set the optional comint variables (when idlwave-shell-comint-settings @@ -4334,13 +4333,6 @@ Shell debugging commands are available as single key sequences." (easy-menu-define idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus" idlwave-shell-menu-def) -(save-current-buffer - (dolist (buf (buffer-list)) - (set-buffer buf) - (if (derived-mode-p 'idlwave-mode) - (progn - (easy-menu-remove idlwave-mode-debug-menu) - (easy-menu-add idlwave-mode-debug-menu))))) ;; The Breakpoint Glyph ------------------------------------------------------- diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 876c38da7e7..9107086b72e 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -1873,10 +1873,6 @@ The main features of this mode are (set (make-local-variable 'indent-tabs-mode) nil) (set (make-local-variable 'completion-ignore-case) t) - (when (featurep 'easymenu) - (easy-menu-add idlwave-mode-menu idlwave-mode-map) - (easy-menu-add idlwave-mode-debug-menu idlwave-mode-map)) - (setq abbrev-mode t) (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill) diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 4a5d872b790..87c20a2ee0e 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -946,10 +946,7 @@ The environment marked is the one that contains point or follows point." (set (make-local-variable 'font-lock-defaults) '(meta-font-lock-keywords nil nil ((?_ . "w")) nil - (font-lock-comment-start-regexp . "%"))) - - ;; Activate syntax table, keymap and menu. - (easy-menu-add meta-mode-menu)) + (font-lock-comment-start-regexp . "%")))) ;;;###autoload diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 55a78c6cc85..c313ad11792 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -619,9 +619,7 @@ Key bindings: (add-hook 'before-save-hook 'octave-sync-function-file-names nil t) (setq-local beginning-of-defun-function 'octave-beginning-of-defun) (and octave-font-lock-texinfo-comment (octave-font-lock-texinfo-comment)) - (add-hook 'eldoc-documentation-functions 'octave-eldoc-function nil t) - - (easy-menu-add octave-mode-menu)) + (add-hook 'eldoc-documentation-functions 'octave-eldoc-function nil t)) (defcustom inferior-octave-program "octave" diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 75e95d9b904..a4e677ba41d 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -1292,8 +1292,7 @@ To find out what version of Prolog mode you are running, enter (setq-local shell-dirstack-query "pwd.") (setq-local compilation-error-regexp-alist prolog-inferior-error-regexp-alist) - (compilation-shell-minor-mode) - (prolog-inferior-menu)) + (compilation-shell-minor-mode)) (defun prolog-input-filter (str) (cond ((string-match "\\`\\s *\\'" str) nil) ;whitespace @@ -3378,9 +3377,6 @@ PREFIX is the prefix of the search regexp." (defun prolog-menu () "Add the menus for the Prolog editing buffers." - (easy-menu-add prolog-edit-menu-insert-move) - (easy-menu-add prolog-edit-menu-runtime) - ;; Add predicate index menu (setq-local imenu-create-index-function 'imenu-default-create-index-function) @@ -3391,9 +3387,7 @@ PREFIX is the prefix of the search regexp." (if (and prolog-imenu-flag (< (count-lines (point-min) (point-max)) prolog-imenu-max-lines)) - (imenu-add-to-menubar "Predicates")) - - (easy-menu-add prolog-menu-help)) + (imenu-add-to-menubar "Predicates"))) (easy-menu-define prolog-inferior-menu-all prolog-inferior-mode-map @@ -3436,8 +3430,8 @@ PREFIX is the prefix of the search regexp." "Create the menus for the Prolog inferior buffer. This menu is dynamically created because one may change systems during the life of an Emacs session." - (easy-menu-add prolog-inferior-menu-all) - (easy-menu-add prolog-menu-help)) + (declare (obsolete nil "28.1")) + nil) (defun prolog-mode-version () "Echo the current version of Prolog mode in the minibuffer." diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 3b24cabe8bd..b7327e75583 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2801,12 +2801,12 @@ t means to return a list of all possible completions of STRING. (not (bolp)) ?\n) "exit:\n" - "rm $tmp* >&/dev/null" > \n) + "rm $tmp* >&" null-device > \n) (es (file-name-nondirectory (buffer-file-name)) > "local( signals = $signals sighup sigint;" \n > "tmp = `{ mktemp -t " str ".XXXXXX } ) {" \n > "catch @ e {" \n - > "rm $tmp^* >[2]/dev/null" \n + > "rm $tmp^* >[2]" null-device \n "throw $e" \n "} {" > \n _ \n @@ -2816,10 +2816,10 @@ t means to return a list of all possible completions of STRING. 7 "EXIT") (rc (file-name-nondirectory (buffer-file-name)) > "tmp = `{ mktemp -t " str ".XXXXXX }" \n - "fn sigexit { rm $tmp^* >[2]/dev/null }" \n) + "fn sigexit { rm $tmp^* >[2]" null-device " }" \n) (sh (file-name-nondirectory (buffer-file-name)) > "TMP=`mktemp -t " str ".XXXXXX`" \n - "trap \"rm $TMP* 2>/dev/null\" " ?0 \n)) + "trap \"rm $TMP* 2>" null-device "\" " ?0 \n)) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 6b0df2d700d..22099394ff0 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -4186,8 +4186,9 @@ must tell Emacs. Here's how to do that in your init file: (modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))" :abbrev-table sql-mode-abbrev-table - (if sql-mode-menu - (easy-menu-add sql-mode-menu)); XEmacs + (when (and (featurep 'xemacs) + sql-mode-menu) + (easy-menu-add sql-mode-menu)) ;; (smie-setup sql-smie-grammar #'sql-smie-rules) (set (make-local-variable 'comment-start) "--") @@ -4312,8 +4313,9 @@ you entered, right above the output it created. (setq mode-name (concat "SQLi[" (or (sql-get-product-feature sql-product :name) (symbol-name sql-product)) "]")) - (if sql-interactive-mode-menu - (easy-menu-add sql-interactive-mode-menu)) ; XEmacs + (when (and (featurep 'xemacs) + sql-interactive-mode-menu) + (easy-menu-add sql-interactive-mode-menu)) ;; Note that making KEYWORDS-ONLY nil will cause havoc if you try ;; SELECT 'x' FROM DUAL with SQL*Plus, because the title of the column diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index f0dd9afa4c0..ff3fb9657d6 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -654,9 +654,7 @@ already exist." #'tcl-add-log-defun) (setq-local beginning-of-defun-function #'tcl-beginning-of-defun-function) - (setq-local end-of-defun-function #'tcl-end-of-defun-function) - - (easy-menu-add tcl-mode-menu)) + (setq-local end-of-defun-function #'tcl-end-of-defun-function)) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index f288facba50..489092f58e6 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -4205,9 +4205,11 @@ STRING are replaced by `-' and substrings are converted to lower case." (defun vhdl-update-mode-menu () "Update VHDL Mode menu." (interactive) - (easy-menu-remove vhdl-mode-menu-list) ; for XEmacs + (when (featurep 'xemacs) + (easy-menu-remove vhdl-mode-menu-list)) (setq vhdl-mode-menu-list (vhdl-create-mode-menu)) - (easy-menu-add vhdl-mode-menu-list) ; for XEmacs + (when (featurep 'xemacs) + (easy-menu-add vhdl-mode-menu-list)) (easy-menu-define vhdl-mode-menu vhdl-mode-map "Menu keymap for VHDL Mode." vhdl-mode-menu-list)) @@ -4313,7 +4315,8 @@ The directory of the current source file is scanned." (push ["*Rescan*" vhdl-add-source-files-menu t] menu-list) (push "Sources" menu-list) ;; Create menu - (easy-menu-add menu-list) + (when (featurep 'xemacs) + (easy-menu-add menu-list)) (easy-menu-define vhdl-sources-menu newmap "VHDL source files menu" menu-list)) (message "")) @@ -4926,7 +4929,8 @@ Key bindings: ;; add source file menu (if vhdl-source-file-menu (vhdl-add-source-files-menu)) ;; add VHDL menu - (easy-menu-add vhdl-mode-menu-list) ; for XEmacs + (when (featurep 'xemacs) + (easy-menu-add vhdl-mode-menu-list)) (easy-menu-define vhdl-mode-menu vhdl-mode-map "Menu keymap for VHDL Mode." vhdl-mode-menu-list) ;; initialize hideshow and add menu diff --git a/lisp/server.el b/lisp/server.el index 763f651fefc..2fd94552dda 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -648,7 +648,17 @@ the `server-process' variable." ;; Remove any leftover socket or authentication file. (ignore-errors (let (delete-by-moving-to-trash) - (delete-file server-file))) + (delete-file server-file) + ;; Also delete the directory that the server file was + ;; created in -- but only in /tmp (see bug#44644). + ;; There may be other servers running, too, so this may + ;; fail. + (when (equal (file-name-directory + (directory-file-name + (file-name-directory server-file))) + "/tmp/") + (ignore-errors + (delete-directory (file-name-directory server-file)))))) (setq server-mode nil) ;; already set by the minor mode code (display-warning 'server diff --git a/lisp/shell.el b/lisp/shell.el index 43ad58774b8..51937cdeef3 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -605,7 +605,7 @@ buffer." (t "~/.history"))))) (if (or (equal comint-input-ring-file-name "") (equal (file-truename comint-input-ring-file-name) - (file-truename "/dev/null"))) + (file-truename null-device))) (setq comint-input-ring-file-name nil)) ;; Arrange to write out the input ring on exit, if the shell doesn't ;; do this itself. diff --git a/lisp/simple.el b/lisp/simple.el index bb28145502b..93fda7de8a1 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5344,7 +5344,7 @@ Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.") (defun yank-pop (&optional arg) "Replace just-yanked stretch of killed text with a different stretch. -This command is allowed only immediately after a `yank' or a +The main use of this command is immediately after a `yank' or a `yank-pop'. At such a time, the region contains a stretch of reinserted previously-killed text. `yank-pop' deletes that text and inserts in its place a different stretch of killed text by @@ -5359,30 +5359,36 @@ comes the newest one. This command honors the `yank-handled-properties' and `yank-excluded-properties' variables, and the `yank-handler' text -property, in the way that `yank' does." - (interactive "*p") +property, in the way that `yank' does. + +When this command is called not immediately after a `yank' or a +`yank-pop', then it activates the minibuffer with its completion +and history filled with previously-killed items from the +`kill-ring' variable, and reads a string to yank at point. +See `yank-from-kill-ring' for more details." + (interactive "p") (if (not (eq last-command 'yank)) - (user-error "Previous command was not a yank")) - (setq this-command 'yank) - (unless arg (setq arg 1)) - (let ((inhibit-read-only t) - (before (< (point) (mark t)))) - (if before - (funcall (or yank-undo-function 'delete-region) (point) (mark t)) - (funcall (or yank-undo-function 'delete-region) (mark t) (point))) - (setq yank-undo-function nil) - (set-marker (mark-marker) (point) (current-buffer)) - (insert-for-yank (current-kill arg)) - ;; Set the window start back where it was in the yank command, - ;; if possible. - (set-window-start (selected-window) yank-window-start t) - (if before - ;; This is like exchange-point-and-mark, but doesn't activate the mark. - ;; It is cleaner to avoid activation, even though the command - ;; loop would deactivate the mark because we inserted text. - (goto-char (prog1 (mark t) - (set-marker (mark-marker) (point) (current-buffer)))))) - nil) + (yank-from-kill-ring (read-from-kill-ring) current-prefix-arg) + (setq this-command 'yank) + (unless arg (setq arg 1)) + (let ((inhibit-read-only t) + (before (< (point) (mark t)))) + (if before + (funcall (or yank-undo-function 'delete-region) (point) (mark t)) + (funcall (or yank-undo-function 'delete-region) (mark t) (point))) + (setq yank-undo-function nil) + (set-marker (mark-marker) (point) (current-buffer)) + (insert-for-yank (current-kill arg)) + ;; Set the window start back where it was in the yank command, + ;; if possible. + (set-window-start (selected-window) yank-window-start t) + (if before + ;; This is like exchange-point-and-mark, but doesn't activate the mark. + ;; It is cleaner to avoid activation, even though the command + ;; loop would deactivate the mark because we inserted text. + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) (current-buffer)))))) + nil)) (defun yank (&optional arg) "Reinsert (\"paste\") the last stretch of killed text. @@ -5449,6 +5455,77 @@ See also the command `yank-pop' (\\[yank-pop])." With ARG, rotate that many kills forward (or backward, if negative)." (interactive "p") (current-kill arg)) + +(defvar read-from-kill-ring-history) +(defun read-from-kill-ring () + "Read a string from `kill-ring' using completion and minibuffer history." + (let* ((history-add-new-input nil) + (ellipsis (if (char-displayable-p ?…) "…" "...")) + ;; Remove keymaps from text properties of copied string, + ;; because typing RET in the minibuffer might call + ;; an irrelevant command from the map of copied string. + (read-from-kill-ring-history + (mapcar (lambda (s) + (remove-list-of-text-properties + 0 (length s) + '( + keymap local-map action mouse-action + button category help-args) + s) + s) + kill-ring)) + (completions + (mapcar (lambda (s) + (let* ((s (query-replace-descr s)) + (b 0) + (limit (frame-text-cols))) + ;; Add ellipsis on leading whitespace + (when (string-match "\\`[[:space:]]+" s) + (setq b (match-end 0)) + (add-text-properties 0 b `(display ,ellipsis) s)) + ;; Add ellipsis at the end of a long string + (when (> (length s) (+ limit b)) + (add-text-properties + (min (+ limit b) (length s)) (length s) + `(display ,ellipsis) s)) + s)) + read-from-kill-ring-history))) + (minibuffer-with-setup-hook + (lambda () + ;; Allow ‘SPC’ to be self-inserting + (use-local-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map (current-local-map)) + (define-key map " " nil) + (define-key map "?" nil) + map))) + (completing-read + "Yank from kill-ring: " + (lambda (string pred action) + (if (eq action 'metadata) + ;; Keep sorted by recency + '(metadata (display-sort-function . identity)) + (complete-with-action action completions string pred))) + nil nil nil + 'read-from-kill-ring-history)))) + +(defun yank-from-kill-ring (string &optional arg) + "Insert the `kill-ring' item selected from the minibuffer history. +Use minibuffer navigation and search commands to browse the +previously-killed items from the `kill-ring' variable in the +minibuffer history before typing RET to insert the selected item, +or use completion on the elements of `kill-ring'. You can edit +the item in the minibuffer before inserting it. + +With \\[universal-argument] as argument, put point at beginning, +and mark at end, like `yank' does." + (interactive (list (read-from-kill-ring) current-prefix-arg)) + (push-mark) + (insert-for-yank string) + (if (consp arg) + ;; Swap point and mark like in `yank'. + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) (current-buffer)))))) ;; Some kill commands. @@ -8745,6 +8822,8 @@ Called from `temp-buffer-show-hook'." insert-fun)) (set (make-local-variable 'completion-reference-buffer) mainbuf) (if base-dir (setq default-directory base-dir)) + (when completion-tab-width + (setq tab-width completion-tab-width)) ;; Maybe insert help string. (when completion-show-help (goto-char (point-min)) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 3619b23d9e6..34687805b57 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -1144,6 +1144,7 @@ frame and window to be the currently active frame and window." (defvar speedbar-previous-menu nil "The menu before the last `speedbar-reconfigure-keymaps' was called.") +(make-obsolete-variable 'speedbar-previous-menu "no longer used." "28.1") (defun speedbar-reconfigure-keymaps () "Reconfigure the menu-bar in a speedbar frame. @@ -1195,10 +1196,7 @@ and the existence of packages." (speedbar-initial-keymap) ;; This creates a small keymap we can glom the ;; menu adjustments into. - (speedbar-make-specialized-keymap))) - ;; Delete the old menu if applicable. - (if speedbar-previous-menu (easy-menu-remove speedbar-previous-menu)) - (setq speedbar-previous-menu md) + (speedbar-make-specialized-keymap))) ;; Now add the new menu (easy-menu-define speedbar-menu-map (current-local-map) "Speedbar menu" md)) diff --git a/lisp/subr.el b/lisp/subr.el index f9ca50f95ec..c07d615489b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3041,7 +3041,21 @@ to `accept-change-group' or `cancel-change-group'." (dolist (elt handle) (with-current-buffer (car elt) (if (eq buffer-undo-list t) - (setq buffer-undo-list nil))))) + (setq buffer-undo-list nil) + ;; Add a boundary to make sure the upcoming changes won't be + ;; merged/combined with any previous changes (bug#33341). + ;; We're not supposed to introduce a real (visible) + ;; `undo-boundary', tho, so we have to push something else + ;; that acts like a boundary w.r.t preventing merges while + ;; being harmless. + ;; We use for that an "empty insertion", but in order to be harmless, + ;; it has to be at a harmless position. Currently only + ;; insertions are ever merged/combined, so we use such a "boundary" + ;; only when the last change was an insertion and we use the position + ;; of the last insertion. + (when (numberp (caar buffer-undo-list)) + (push (cons (caar buffer-undo-list) (caar buffer-undo-list)) + buffer-undo-list)))))) (defun accept-change-group (handle) "Finish a change group made with `prepare-change-group' (which see). @@ -4551,10 +4565,9 @@ and replace a sub-expression, e.g. (when (= me mb) (setq me (min l (1+ mb)))) ;; Generate a replacement for the matched substring. ;; Operate on only the substring to minimize string consing. - ;; Set up match data for the substring for replacement; - ;; presumably this is likely to be faster than munging the - ;; match data directly in Lisp. - (string-match regexp (setq str (substring string mb me))) + ;; Translate the match data so that it applies to the matched substring. + (match-data--translate (- mb)) + (setq str (substring string mb me)) (setq matches (cons (replace-match (if (stringp rep) rep diff --git a/lisp/term.el b/lisp/term.el index 585232be6c3..148d7a7c286 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1107,8 +1107,6 @@ Entry to this mode runs the hooks on `term-mode-hook'." (term--reset-scroll-region) - (easy-menu-add term-terminal-menu) - (easy-menu-add term-signals-menu) (or term-input-ring (setq term-input-ring (make-ring term-input-ring-size))) (term-update-mode-line)) @@ -1293,8 +1291,6 @@ intervention from Emacs, except for the escape character (usually C-c)." (when (term-in-line-mode) (setq term-old-mode-map (current-local-map)) (use-local-map term-raw-map) - (easy-menu-add term-terminal-menu) - (easy-menu-add term-signals-menu) ;; Don't allow changes to the buffer or to point which are not ;; caused by the process filter. @@ -1576,9 +1572,9 @@ Nil if unknown.") process-environment)) (apply #'start-process name buffer "/bin/sh" "-c" - (format "stty -nl echo rows %d columns %d sane 2>/dev/null;\ + (format "stty -nl echo rows %d columns %d sane 2>%s;\ if [ $1 = .. ]; then shift; fi; exec \"$@\"" - term-height term-width) + term-height term-width null-device) ".." command switches))) @@ -3550,9 +3546,6 @@ The top-most line is line 0." ;; (stop-process process)) (setq term-pager-old-local-map (current-local-map)) (use-local-map term-pager-break-map) - (easy-menu-add term-terminal-menu) - (easy-menu-add term-signals-menu) - (easy-menu-add term-pager-menu) (make-local-variable 'term-old-mode-line-format) (setq term-old-mode-line-format mode-line-format) (setq mode-line-format diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el index 6dfea8f1887..712955e84de 100644 --- a/lisp/textmodes/dns-mode.el +++ b/lisp/textmodes/dns-mode.el @@ -184,8 +184,7 @@ Turning on DNS mode runs `dns-mode-hook'." (set (make-local-variable 'font-lock-defaults) '(dns-mode-font-lock-keywords nil nil ((?_ . "w")))) (add-hook 'before-save-hook 'dns-mode-soa-maybe-increment-serial - nil t) - (easy-menu-add dns-mode-menu dns-mode-map)) + nil t)) ;;;###autoload (defalias 'zone-mode 'dns-mode) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index a1e30269d29..bebda483679 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -408,7 +408,8 @@ Here are all local bindings. (make-local-hook 'post-command-hook) (make-local-hook 'pre-command-hook)) (make-local-variable 'reftex-last-follow-point) - (easy-menu-add reftex-index-menu reftex-index-mode-map) + (when (featurep 'xemacs) + (easy-menu-add reftex-index-menu reftex-index-mode-map)) (add-hook 'post-command-hook 'reftex-index-post-command-hook nil t) (add-hook 'pre-command-hook 'reftex-index-pre-command-hook nil t)) @@ -1386,7 +1387,8 @@ Here are all local bindings. :syntax-table reftex-index-phrases-syntax-table (set (make-local-variable 'font-lock-defaults) reftex-index-phrases-font-lock-defaults) - (easy-menu-add reftex-index-phrases-menu reftex-index-phrases-mode-map) + (when (featurep 'xemacs) + (easy-menu-add reftex-index-phrases-menu reftex-index-phrases-mode-map)) (set (make-local-variable 'reftex-index-phrases-marker) (make-marker))) ;; (add-hook 'reftex-index-phrases-mode-hook 'turn-on-font-lock) diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 02e7e3a8f12..eb6ed2ff441 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -153,7 +153,8 @@ Here are all local bindings. (make-local-variable 'reftex-last-follow-point) (add-hook 'post-command-hook 'reftex-toc-post-command-hook nil t) (add-hook 'pre-command-hook 'reftex-toc-pre-command-hook nil t) - (easy-menu-add reftex-toc-menu reftex-toc-mode-map)) + (when (featurep 'xemacs) + (easy-menu-add reftex-toc-menu reftex-toc-mode-map))) (defvar reftex-last-toc-file nil "Stores the file name from which `reftex-toc' was called. For redo command.") diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 4071c0dd074..29ebab5f9bb 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -207,7 +207,8 @@ on the menu bar. (if reftex-mode (progn ;; Mode was turned on - (easy-menu-add reftex-mode-menu) + (when (featurep 'xemacs) + (easy-menu-add reftex-mode-menu)) (and reftex-plug-into-AUCTeX (reftex-plug-into-AUCTeX)) (unless (get 'reftex-auto-view-crossref 'initialized) @@ -224,7 +225,8 @@ on the menu bar. (run-hooks 'reftex-mode-hook)) ;; Mode was turned off - (easy-menu-remove reftex-mode-menu))) + (when (featurep 'xemacs) + (easy-menu-remove reftex-mode-menu)))) (defvar reftex-docstruct-symbol) (defun reftex-kill-buffer-hook () diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 065fdd09ccb..984cc08de85 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -620,13 +620,6 @@ (defvar flyspell-mode) (defvar real-last-command) (defvar delete-selection-mode) -;; This is evil!! -;; (eval-when-compile -;; (unless (fboundp 'set-face-property) -;; (defun set-face-property (face prop value))) -;; (unless (fboundp 'unibyte-char-to-multibyte) -;; (defun unibyte-char-to-multibyte (char))) -;; (defun table--point-in-cell-p (&optional location))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -811,13 +804,6 @@ simply by any key input." (setplist 'table-disable-incompatibility-warning nil) -(defvar table-disable-menu (null (and (locate-library "easymenu") - (require 'easymenu) - (fboundp 'easy-menu-add-item))) - "When non-nil, use of menu by table package is disabled. -It must be set before loading this package `table.el' for the first -time.") - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -1202,12 +1188,11 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu )) ;; register table menu under global tools menu -(unless table-disable-menu - (easy-menu-define table-global-menu-map nil - "Table global menu" table-global-menu) - (easy-menu-add-item (current-global-map) '("menu-bar" "tools") "--") - (easy-menu-add-item (current-global-map) - '("menu-bar" "tools") table-global-menu-map)) +(easy-menu-define table-global-menu-map nil + "Table global menu" table-global-menu) +(easy-menu-add-item (current-global-map) '("menu-bar" "tools") "--") +(easy-menu-add-item (current-global-map) + '("menu-bar" "tools") table-global-menu-map) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -1287,12 +1272,8 @@ the last cache point coordinate." ;; set up the update timer unless it is explicitly inhibited. (unless table-inhibit-update (table--update-cell))))) -(if (null (fboundp 'font-lock-add-keywords)) - nil - ;; Color it as a keyword. - (font-lock-add-keywords - 'emacs-lisp-mode - '("\\<table-with-cache-buffer\\>"))) +;; Color it as a keyword. +(font-lock-add-keywords 'emacs-lisp-mode '("\\<table-with-cache-buffer\\>")) (defmacro table-put-source-info (prop value) "Register source generation information." @@ -1975,7 +1956,7 @@ is negative the cell becomes inactive, meaning that the cell becomes plain text and loses all the table specific features." (interactive "i\ni\np") (table--make-cell-map) - (if (or force (not (memq (table--get-last-command) table-command-list))) + (if (or force (not (memq real-last-command table-command-list))) (let* ((cell (table--probe-cell (called-interactively-p 'interactive))) (cache-buffer (get-buffer-create table-cache-buffer-name)) (modified-flag (buffer-modified-p)) @@ -3863,9 +3844,8 @@ converts a table into plain text without frames. It is a companion to (setq table-cell-map map) (fset 'table-cell-map map))) ;; Add menu for table cells. - (unless table-disable-menu - (easy-menu-define table-cell-menu-map table-cell-map - "Table cell menu" table-cell-menu)) + (easy-menu-define table-cell-menu-map table-cell-map + "Table cell menu" table-cell-menu) (run-hooks 'table-cell-map-hook)) ;; Create the keymap after running the user init file so that the user @@ -4056,16 +4036,15 @@ key binding (defun *table--present-cell-popup-menu (event) "Present and handle cell popup menu." (interactive "e") - (unless table-disable-menu - (select-window (posn-window (event-start event))) - (goto-char (posn-point (event-start event))) - (let ((item-list (x-popup-menu event table-cell-menu-map)) - (func table-cell-menu-map)) - (while item-list - (setq func (nth 3 (assoc (car item-list) func))) - (setq item-list (cdr item-list))) - (if (and (symbolp func) (fboundp func)) - (call-interactively func))))) + (select-window (posn-window (event-start event))) + (goto-char (posn-point (event-start event))) + (let ((item-list (x-popup-menu event table-cell-menu-map)) + (func table-cell-menu-map)) + (while item-list + (setq func (nth 3 (assoc (car item-list) func))) + (setq item-list (cdr item-list))) + (if (and (symbolp func) (fboundp func)) + (call-interactively func)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -4086,9 +4065,10 @@ cache buffer into the designated cell in the table buffer." (and (boundp 'quail-translating) quail-translating)) (setq table-update-timer - (table--set-timer table-time-before-update - (function table--update-cell) - 'now)) + (run-with-idle-timer table-time-before-update + nil + (function table--update-cell) + 'now)) (save-current-buffer (set-buffer table-cell-buffer) (let ((cache-buffer (get-buffer-create table-cache-buffer-name)) @@ -4125,9 +4105,10 @@ cache buffer into the designated cell in the table buffer." (setq table-widen-timer nil)) (if (not now) (setq table-widen-timer - (table--set-timer (+ table-time-before-update table-time-before-reformat) - (function table--update-cell-widened) - 'now)) + (run-with-idle-timer (+ table-time-before-update table-time-before-reformat) + nil + (function table--update-cell-widened) + 'now)) (save-current-buffer (if table-update-timer (table--update-cell 'now)) @@ -4164,9 +4145,10 @@ cache buffer into the designated cell in the table buffer." (setq table-heighten-timer nil)) (if (not now) (setq table-heighten-timer - (table--set-timer (+ table-time-before-update table-time-before-reformat) - (function table--update-cell-heightened) - 'now)) + (run-with-idle-timer (+ table-time-before-update table-time-before-reformat) + nil + (function table--update-cell-heightened) + 'now)) (save-current-buffer (if table-update-timer (table--update-cell 'now)) @@ -4710,8 +4692,7 @@ in the list." (defun table--cell-insert-char (char &optional overwrite) "Insert CHAR inside a table cell." - (let ((delete-selection-p (and (boundp 'delete-selection-mode) - delete-selection-mode + (let ((delete-selection-p (and delete-selection-mode transient-mark-mode mark-active (not buffer-read-only))) (mark-coordinate (table--transcoord-table-to-cache (table--get-coordinate (mark t))))) @@ -5239,8 +5220,7 @@ This feature is disabled when `table-disable-incompatibility-warning' is non-nil. The warning is done only once per session for each item." (unless (and table-disable-incompatibility-warning (not (called-interactively-p 'interactive))) - (when (and (boundp 'flyspell-mode) - flyspell-mode + (when (and flyspell-mode (not (get 'table-disable-incompatibility-warning 'flyspell))) (put 'table-disable-incompatibility-warning 'flyspell t) (display-warning 'table @@ -5443,15 +5423,24 @@ It returns COLUMN unless STR contains some wide characters." idx nil))) + +;;;; Obsolete. + +(defvar table-disable-menu nil + "When non-nil, use of menu by table package is disabled. +It must be set before loading this package `table.el' for the first +time.") +(make-obsolete-variable 'table-disable-menu "no longer used." "28.1") + (defun table--set-timer (seconds func args) "Generic wrapper for setting up a timer." + (declare (obsolete run-with-idle-timer "28.1")) (run-with-idle-timer seconds nil func args)) (defun table--get-last-command () "Generic wrapper for getting the real last command." - (if (boundp 'real-last-command) - real-last-command - last-command)) + (declare (obsolete real-last-command "28.1")) + real-last-command) (run-hooks 'table-load-hook) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 0a906136047..51f41803169 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2326,7 +2326,7 @@ where DEFUN... is a list of function names found in FILE." ;; would look for non-existent files like ;; /dev/null. (diff-find-source-location - (not (equal "/dev/null" + (not (equal null-device (car (diff-hunk-file-names t)))))) (other-buf nil) (goto-otherbuf @@ -2567,8 +2567,8 @@ fixed, visit it in a buffer." (concat "diff.*\n" "\\(?:\\(?:new file\\|deleted\\).*\n\\)?" "\\(?:index.*\n\\)?" - "--- \\(?:/dev/null\\|a/\\(.*\\)\\)\n" - "\\+\\+\\+ \\(?:/dev/null\\|b/\\(.*\\)\\)\n")))) + "--- \\(?:" null-device "\\|a/\\(.*\\)\\)\n" + "\\+\\+\\+ \\(?:" null-device "\\|b/\\(.*\\)\\)\n")))) (put-text-property (match-beginning 0) (or (match-beginning 2) (match-beginning 1)) 'display (propertize diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index c977291a524..b48377815a4 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -2317,7 +2317,7 @@ If this is a session registry buffer then just bury it." (meta-patchbuf ediff-meta-patchbufer) session-buf beg-marker end-marker) - (if (or (file-directory-p file) (string-match "/dev/null" file)) + (if (or (file-directory-p file) (string-match null-device file)) (user-error "`%s' is not an ordinary file" (file-name-as-directory file))) (setq session-buf (ediff-get-session-buffer info) beg-marker (ediff-get-session-objB-name info) diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index f6af5a45550..08640fcece9 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -193,7 +193,7 @@ program." (let ((count 0) (mark1 (point-min-marker)) (mark1-end (point-min)) - (possible-file-names '("/dev/null" . "/dev/null")) + (possible-file-names `(,null-device . ,null-device)) mark2-end mark2 filenames beg1 beg2 end1 end2 patch-map opoint) @@ -217,10 +217,10 @@ program." (setq possible-file-names (cons (if (and beg1 end1) (buffer-substring beg1 end1) - "/dev/null") + null-device) (if (and beg2 end2) (buffer-substring beg2 end2) - "/dev/null"))) + null-device))) ;; Remove file junk (Bug#26084). (while (re-search-backward (concat "^\\(?:" diff-file-junk-re "\\)") mark1-end t) @@ -309,12 +309,12 @@ program." (file-exists-p (cdr m2))) (setq base-dir1 (car m1) base-dir2 (car m2)))))))) - (or (string= (car proposed-file-names) "/dev/null") + (or (string= (car proposed-file-names) null-device) (setcar proposed-file-names (ediff-file-name-sans-prefix (car proposed-file-names) base-dir1))) (or (string= - (cdr proposed-file-names) "/dev/null") + (cdr proposed-file-names) null-device) (setcdr proposed-file-names (ediff-file-name-sans-prefix (cdr proposed-file-names) base-dir2))) @@ -323,7 +323,7 @@ program." ;; take the given file name into account (or (file-directory-p filename) - (string= "/dev/null" filename) + (string= null-device filename) (setcar (ediff-get-session-objA (car ediff-patch-map)) (cons (file-name-nondirectory filename) (file-name-nondirectory filename)))) @@ -582,7 +582,7 @@ optional argument, then use it." patch-buf (if (and ediff-patch-map (not (string-match-p - "^/dev/null" + (concat "^" null-device) ;; this is the file to patch (ediff-get-session-objA-name (car ediff-patch-map)))) (> (length diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 56ecc64671c..e7b6eea807c 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -208,15 +208,7 @@ If it is nil, `log-view-toggle-entry-display' does nothing.") "Face for the message header line in `log-view-mode'." :group 'log-view) -(defface log-view-commit-body - '((((class color) (min-colors 88) (background light)) - :background "gray95" :foreground "black" :extend t) - (((class color) (min-colors 88) (background dark)) - :background "gray5" :foreground "white" :extend t) - (((class color) (min-colors 8) (background light)) - :foreground "black") - (((class color) (min-colors 8) (background dark)) - :foreground "white")) +(defface log-view-commit-body '((t :inherit font-lock-comment-face)) "Face for the commit body in `log-view-mode'." :version "28.1") diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 83f2596865f..1a246119a69 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1774,7 +1774,7 @@ Return t if the buffer had changes, nil otherwise." ;; Diff it against /dev/null. (apply #'vc-do-command buffer (if async 'async 1) "diff" file - (append (vc-switches nil 'diff) '("/dev/null")))))) + (append (vc-switches nil 'diff) `(,(null-device))))))) (setq files (nreverse filtered)))) (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer async) (set-buffer buffer) diff --git a/lisp/wdired.el b/lisp/wdired.el index bb32da3e3a2..ebe19613943 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -763,7 +763,7 @@ If OLD, return the old target. If MOVE, move point before it." (unless (equal link-to-new link-to-ori) (setq changes t) (if (equal link-to-new "") ;empty filename! - (setq link-to-new "/dev/null")) + (setq link-to-new (null-device))) (condition-case err (progn (delete-file link-from) diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el index 53f918cff9c..f5c3d486f4d 100644 --- a/lisp/wid-browse.el +++ b/lisp/wid-browse.el @@ -77,8 +77,6 @@ if that value is non-nil." (setq major-mode 'widget-browse-mode mode-name "Widget") (use-local-map widget-browse-mode-map) - (easy-menu-add widget-browse-mode-customize-menu) - (easy-menu-add widget-browse-mode-menu) (run-mode-hooks 'widget-browse-mode-hook)) (put 'widget-browse-mode 'mode-class 'special) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 4e2cf7416d4..8250316bcc7 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -591,9 +591,25 @@ Otherwise, just return the value." (widget-put widget :args args))) (widget-apply widget :default-get))))) +(defun widget-inline-p (widget &optional bubblep) + "Non-nil if the widget WIDGET is inline. + +With BUBBLEP non-nil, check also if WIDGET has a member that bubbles its inline +property (if any), up to WIDGET, so that WIDGET can act as an inline widget." + (or (widget-get widget :inline) + (and bubblep + (widget-get widget :inline-bubbles-p) + (widget-apply widget :inline-bubbles-p)))) + (defun widget-match-inline (widget vals) - "In WIDGET, match the start of VALS." - (cond ((widget-get widget :inline) + "In WIDGET, match the start of VALS. + +For an inline widget or for a widget that acts like one (see `widget-inline-p'), +try to match elements in VALS as far as possible. Otherwise, match the first +element of the list VALS. + +Return a list whose car contains all members of VALS that matched WIDGET." + (cond ((widget-inline-p widget t) (widget-apply widget :match-inline vals)) ((and (listp vals) (widget-apply widget :match (car vals))) @@ -2198,7 +2214,7 @@ But if NO-TRUNCATE is non-nil, include them." (let ((value (widget-get widget :value)) (args (widget-get widget :args)) (explicit (widget-get widget :explicit-choice)) - current) + current val inline-p fun) (if explicit (progn ;; If the user specified the choice for this value, @@ -2207,15 +2223,24 @@ But if NO-TRUNCATE is non-nil, include them." widget explicit value))) (widget-put widget :choice explicit) (widget-put widget :explicit-choice nil)) + (setq inline-p (widget-inline-p widget t)) (while args (setq current (car args) args (cdr args)) - (when (widget-apply current :match value) - (widget-put widget :children (list (widget-create-child-value - widget current value))) - (widget-put widget :choice current) - (setq args nil - current nil))) + (if inline-p + (if (widget-get current :inline) + (setq val value + fun :match-inline) + (setq val (car value) + fun :match)) + (setq val value + fun :match)) + (when (widget-apply current fun val) + (widget-put widget :children (list (widget-create-child-value + widget current val))) + (widget-put widget :choice current) + (setq args nil + current nil))) (when current (let ((void (widget-get widget :void))) (widget-put widget :children (list (widget-create-child-and-convert @@ -2438,7 +2463,7 @@ If the item is checked, CHOSEN is a cons whose cdr is the value." (let ((child (widget-create-child widget type))) (widget-apply child :deactivate) child)) - ((widget-get type :inline) + ((widget-inline-p type t) (widget-create-child-value widget type (cdr chosen))) (t @@ -2795,7 +2820,7 @@ Return an alist of (TYPE MATCH)." (if answer (setq children (cons (widget-editable-list-entry-create widget - (if (widget-get type :inline) + (if (widget-inline-p type t) (car answer) (car (car answer))) t) @@ -2979,7 +3004,7 @@ Save CHILD into the :last-deleted list, so it can be inserted later." (insert-char ?\s (widget-get widget :indent))) (push (cond ((null answer) (widget-create-child widget arg)) - ((widget-get arg :inline) + ((widget-inline-p arg t) (widget-create-child-value widget arg (car answer))) (t (widget-create-child-value widget arg (car (car answer))))) @@ -3900,12 +3925,17 @@ example: `(cons :format "Key: %v" ,key-type ,value-type))) (define-widget 'choice 'menu-choice - "A union of several sexp types." + "A union of several sexp types. + +If one of the choices of a choice widget has an :inline t property, +then the choice widget can act as an inline widget on its own if the +current choice is inline." :tag "Choice" :format "%{%t%}: %[Value Menu%] %v" :button-prefix 'widget-push-button-prefix :button-suffix 'widget-push-button-suffix - :prompt-value 'widget-choice-prompt-value) + :prompt-value 'widget-choice-prompt-value + :inline-bubbles-p #'widget-choice-inline-bubbles-p) (defun widget-choice-prompt-value (widget prompt value _unbound) "Make a choice." @@ -3948,6 +3978,20 @@ example: (if current (widget-prompt-value current prompt nil t) value))) + +(defun widget-choice-inline-bubbles-p (widget) + "Non-nil if the choice WIDGET has at least one choice that is inline. +This is used when matching values, because a choice widget needs to +match a value inline rather than just match it if at least one of its choices +is inline." + (let ((args (widget-get widget :args)) + cur found) + (while (and args (not found)) + (setq cur (car args) + args (cdr args) + found (widget-get cur :inline))) + found)) + (define-widget 'radio 'radio-button-choice "A union of several sexp types." |