commit 6ce08a165cb11b8d62738c85fc2c7af8c022f6d5 (HEAD, refs/remotes/origin/master) Author: Amin Bandali Date: Mon Sep 7 19:07:24 2020 -0400 * etc/NEWS: Mention the new erc-status-sidebar.el diff --git a/etc/NEWS b/etc/NEWS index aa3acc26b3..ebae168842 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -869,6 +869,10 @@ The 'erc-current-nick-highlight-type', 'erc-pal-highlight-type', 'erc-dangerous-host-highlight-type' variables now support a 'message' type for highlighting the entire message but not the sender's nick. +*** erc-status-sidebar.el is now part of ERC. +The 'erc-status-sidebar' package which provides a HexChat-like +activity overview sidebar for joined IRC channels is now part of ERC. + ** Battery --- commit 6fd03b0fbebc3cd2875bda8a0f820811579d7087 Author: Amin Bandali Date: Mon Sep 7 19:05:39 2020 -0400 * lisp/erc/erc-status-sidebar.el: Fix header and make small tweaks diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el index 5649ed3fc7..033c7d600f 100644 --- a/lisp/erc/erc-status-sidebar.el +++ b/lisp/erc/erc-status-sidebar.el @@ -1,10 +1,9 @@ -;;; erc-status-sidebar.el --- Hexchat-like activity overview for ERC +;;; erc-status-sidebar.el --- HexChat-like activity overview for ERC ;; Copyright (C) 2017, 2020 Free Software Foundation, Inc. ;; Author: Andrew Barbarello -;; Version: 0.1 -;; Package-Requires: ((emacs "24.5") (seq "2.3")) +;; Maintainer: Amin Bandali ;; URL: https://github.com/drewbarbs/erc-status-sidebar ;; This file is part of GNU Emacs. @@ -24,10 +23,10 @@ ;;; Commentary: -;; This package is provides a hexchat-like status bar for joined -;; channels in ERC. It relies on the `erc-track' module, and displays -;; all of the same information that `erc-track' does in the mode line, -;; but in an alternative format in form of a sidebar. +;; This package provides a HexChat-like sidebar for joined channels in +;; ERC. It relies on the `erc-track' module, and displays all of the +;; same information that `erc-track' does in the mode line, but in an +;; alternative format in form of a sidebar. ;; Shout out to sidebar.el ;; and outline-toc.el for @@ -268,7 +267,7 @@ hooks that invoke it with arguments." #'erc-status-sidebar-set-window-preserve-size)) (defun erc-status-sidebar-set-window-preserve-size () - "Tell Emacs to preserve the current height/width of the ERC statusbar window. + "Tell Emacs to preserve the current height/width of the ERC sidebar window. Note that preserve status needs to be reset when the window is manually resized, so `erc-status-sidebar-mode' adds this function commit 4ffc370373b3c7f209adf9a617bd10ea8e9589dc Author: Andrew Barbarello Date: Mon Sep 7 19:04:22 2020 -0400 * lisp/erc/erc-status-sidebar.el: New file Taken from commit 87210a3ccc16a86e6b5992744b68daabed3b2d11 of https://github.com/drewbarbs/erc-status-sidebar. diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el new file mode 100644 index 0000000000..5649ed3fc7 --- /dev/null +++ b/lisp/erc/erc-status-sidebar.el @@ -0,0 +1,305 @@ +;;; erc-status-sidebar.el --- Hexchat-like activity overview for ERC + +;; Copyright (C) 2017, 2020 Free Software Foundation, Inc. + +;; Author: Andrew Barbarello +;; Version: 0.1 +;; Package-Requires: ((emacs "24.5") (seq "2.3")) +;; URL: https://github.com/drewbarbs/erc-status-sidebar + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This package is provides a hexchat-like status bar for joined +;; channels in ERC. It relies on the `erc-track' module, and displays +;; all of the same information that `erc-track' does in the mode line, +;; but in an alternative format in form of a sidebar. + +;; Shout out to sidebar.el +;; and outline-toc.el for +;; the sidebar window management ideas. + +;; Usage: + +;; Use M-x erc-status-sidebar-open RET to open the ERC status sidebar +;; in the current frame. Make sure that the `erc-track' module is +;; active (this is the default). + +;; Use M-x erc-status-sidebar-close RET to close the sidebar on the +;; current frame. With a prefix argument, it closes the sidebar on +;; all frames. + +;; Use M-x erc-status-sidebar-kill RET to kill the sidebar buffer and +;; close the sidebar on all frames. + +;;; Code: + +(require 'erc) +(require 'erc-track) +(require 'fringe) +(require 'seq) + +(defgroup erc-status-sidebar nil + "A sidebar for ERC channel status." + :group 'convenience) + +(defcustom erc-status-sidebar-buffer-name "*ERC Status*" + "Name of the sidebar buffer." + :type 'string + :group 'erc-status-sidebar) + +(defcustom erc-status-sidebar-mode-line-format "ERC Status" + "Mode line format for the status sidebar." + :type 'string + :group 'erc-status-sidebar) + +(defcustom erc-status-sidebar-header-line-format nil + "Header line format for the status sidebar." + :type 'string + :group 'erc-status-sidebar) + +(defcustom erc-status-sidebar-width 15 + "Default width of the sidebar (in columns)." + :type 'number + :group 'erc-status-sidebar) + +(defcustom erc-status-sidebar-channel-sort + 'erc-status-sidebar-default-chansort + "Sorting function used to determine order of channels in the sidebar." + :type 'function + :group 'erc-status-sidebar) + +(defcustom erc-status-sidebar-channel-format + 'erc-status-sidebar-default-chan-format + "Function used to format channel names for display in the sidebar." + :type 'function + :group 'erc-status-sidebar) + +(defun erc-status-sidebar-display-window () + "Display the status buffer in a side window. Return the new window." + (display-buffer + (erc-status-sidebar-get-buffer) + `(display-buffer-in-side-window . ((side . left) + (window-width . ,erc-status-sidebar-width))))) + +(defun erc-status-sidebar-get-window (&optional no-creation) + "Return the created/existing window displaying the status buffer. + +If NO-CREATION is non-nil, the window is not created." + (let ((sidebar-window (get-buffer-window erc-status-sidebar-buffer-name))) + (unless (or sidebar-window no-creation) + (with-current-buffer (erc-status-sidebar-get-buffer) + (setq-local vertical-scroll-bar nil)) + (setq sidebar-window (erc-status-sidebar-display-window)) + (set-window-dedicated-p sidebar-window t) + (set-window-parameter sidebar-window 'no-delete-other-windows t) + ;; Don't cycle to this window with `other-window'. + (set-window-parameter sidebar-window 'no-other-window t) + (internal-show-cursor sidebar-window nil) + (set-window-fringes sidebar-window 0 0) + ;; Set a custom display table so the window doesn't show a + ;; truncation symbol when a channel name is too big. + (let ((dt (make-display-table))) + (set-window-display-table sidebar-window dt) + (set-display-table-slot dt 'truncation ?\ ))) + sidebar-window)) + +(defun erc-status-sidebar-buffer-exists-p () + "Check if the sidebar buffer exists." + (get-buffer erc-status-sidebar-buffer-name)) + +(defun erc-status-sidebar-get-buffer () + "Return the sidebar buffer, creating it if it doesn't exist." + (get-buffer-create erc-status-sidebar-buffer-name)) + +(defun erc-status-sidebar-close (&optional all-frames) + "Close the sidebar. + +If called with prefix argument (ALL-FRAMES non-nil), the sidebar +will be closed on all frames. + +The erc-status-sidebar buffer is left alone, but the window +containing it on the current frame is closed. See +`erc-status-sidebar-kill'." + (interactive "P") + (mapcar #'delete-window + (get-buffer-window-list (erc-status-sidebar-get-buffer) + nil (if all-frames t)))) + +(defmacro erc-status-sidebar-writable (&rest body) + "Make the status buffer writable while executing BODY." + `(let ((buffer-read-only nil)) + ,@body)) + +;;;###autoload +(defun erc-status-sidebar-open () + "Open or create a sidebar." + (interactive) + (save-excursion + (let ((sidebar-exists (erc-status-sidebar-buffer-exists-p)) + (sidebar-buffer (erc-status-sidebar-get-buffer)) + (sidebar-window (erc-status-sidebar-get-window))) + (unless sidebar-exists + (with-current-buffer sidebar-buffer + (erc-status-sidebar-mode) + (erc-status-sidebar-refresh)))))) + +;;;###autoload +(defun erc-status-sidebar-toggle () + "Toggle the sidebar open/closed on the current frame." + (interactive) + (if (get-buffer-window erc-status-sidebar-buffer-name nil) + (erc-status-sidebar-close) + (erc-status-sidebar-open))) + +(defun erc-status-sidebar-get-channame (buffer) + "Return name of BUFFER with all leading \"#\" characters removed." + (let ((s (buffer-name buffer))) + (if (string-match "^#\\{1,2\\}" s) + (setq s (replace-match "" t t s))) + (downcase s))) + +(defun erc-status-sidebar-default-chansort (chanlist) + "Sort CHANLIST case-insensitively for display in the sidebar." + (sort chanlist (lambda (x y) + (string< (erc-status-sidebar-get-channame x) + (erc-status-sidebar-get-channame y))))) + +(defun erc-status-sidebar-default-chan-format (channame + &optional num-messages erc-face) + "Format CHANNAME for display in the sidebar. + +If NUM-MESSAGES is non-nil, append it to the channel name. If +ERC-FACE is non-nil, apply it to channel name. If it is equal to +`erc-default-face', also apply bold property to make the channel +name stand out." + (when num-messages + (setq channame (format "%s [%d]" channame num-messages))) + (when erc-face + (put-text-property 0 (length channame) 'face erc-face channame) + (when (eq erc-face 'erc-default-face) + (add-face-text-property 0 (length channame) 'bold t channame))) + channame) + +(defun erc-status-sidebar-refresh () + "Update the content of the sidebar." + (interactive) + (let ((chanlist (apply erc-status-sidebar-channel-sort + (erc-channel-list nil) nil))) + (with-current-buffer (erc-status-sidebar-get-buffer) + (erc-status-sidebar-writable + (delete-region (point-min) (point-max)) + (goto-char (point-min)) + (dolist (chanbuf chanlist) + (let* ((tup (seq-find (lambda (tup) (eq (car tup) chanbuf)) + erc-modified-channels-alist)) + (count (if tup (cadr tup))) + (face (if tup (cddr tup))) + (channame (apply erc-status-sidebar-channel-format + (buffer-name chanbuf) count face nil)) + (cnlen (length channame))) + (put-text-property 0 cnlen 'erc-buf chanbuf channame) + (put-text-property 0 cnlen 'mouse-face 'highlight channame) + (put-text-property + 0 cnlen 'help-echo + "mouse-1: switch to buffer in other window" channame) + (insert channame "\n"))))))) + +(defun erc-status-sidebar-kill () + "Close the ERC status sidebar and its buffer." + (interactive) + (ignore-errors (kill-buffer erc-status-sidebar-buffer-name))) + +(defun erc-status-sidebar-click (event) + "Handle click EVENT in `erc-status-sidebar-mode-map'." + (interactive "e") + (save-excursion + (let ((window (posn-window (event-end event))) + (pos (posn-point (event-end event)))) + (set-buffer (window-buffer window)) + (let ((buf (get-text-property pos 'erc-buf))) + (when buf + (select-window window) + (switch-to-buffer-other-window buf)))))) + +(defvar erc-status-sidebar-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map special-mode-map) + (define-key map [mouse-1] #'erc-status-sidebar-click) + map)) + +(defvar erc-status-sidebar-refresh-triggers + '(erc-track-list-changed-hook + erc-join-hook + erc-part-hook + erc-kill-buffer-hook + erc-kill-channel-hook + erc-kill-server-hook + erc-kick-hook + erc-disconnected-hook + erc-quit-hook)) + +(defun erc-status-sidebar--post-refresh (&rest ignore) + "Schedule sidebar refresh for execution after command stack is cleared. + +Ignore arguments in IGNORE, allowing this function to be added to +hooks that invoke it with arguments." + (run-at-time 0 nil #'erc-status-sidebar-refresh)) + +(defun erc-status-sidebar-mode--unhook () + "Remove hooks installed by `erc-status-sidebar-mode'." + (dolist (hk erc-status-sidebar-refresh-triggers) + (remove-hook hk #'erc-status-sidebar--post-refresh)) + (remove-hook 'window-configuration-change-hook + #'erc-status-sidebar-set-window-preserve-size)) + +(defun erc-status-sidebar-set-window-preserve-size () + "Tell Emacs to preserve the current height/width of the ERC statusbar window. + +Note that preserve status needs to be reset when the window is +manually resized, so `erc-status-sidebar-mode' adds this function +to the `window-configuration-change-hook'." + (when (and (eq (selected-window) (erc-status-sidebar-get-window)) + (fboundp 'window-preserve-size)) + (unless (eq (window-total-width) (window-min-size nil t)) + (apply 'window-preserve-size (selected-window) t t nil)))) + +(define-derived-mode erc-status-sidebar-mode special-mode "ERC Sidebar" + "Major mode for ERC status sidebar" + ;; Don't scroll the buffer horizontally, if a channel name is + ;; obscured then the window can be resized. + (setq-local auto-hscroll-mode nil) + (setq cursor-type nil + buffer-read-only t + mode-line-format erc-status-sidebar-mode-line-format + header-line-format erc-status-sidebar-header-line-format) + (erc-status-sidebar-set-window-preserve-size) + + (add-hook 'window-configuration-change-hook + #'erc-status-sidebar-set-window-preserve-size nil t) + (dolist (hk erc-status-sidebar-refresh-triggers) + (add-hook hk #'erc-status-sidebar--post-refresh)) + + ;; `change-major-mode-hook' is run *before* the + ;; erc-status-sidebar-mode initialization code, so it won't undo the + ;; add-hook's we did in the previous expressions. + (add-hook 'change-major-mode-hook #'erc-status-sidebar-mode--unhook nil t) + (add-hook 'kill-buffer-hook #'erc-status-sidebar-mode--unhook nil t) + :group 'erc-status-sidebar) + +(provide 'erc-status-sidebar) +;;; erc-status-sidebar.el ends here commit de4f347901adffd07bc9bff028dc073fb3c6df33 Author: Lars Ingebrigtsen Date: Mon Sep 7 22:10:01 2020 +0200 Use format-prompt in read-file-name calls that have a default * lisp/xwidget.el (xwidget-webkit-save-as-file): * lisp/vc/vc.el (vc-backend-for-registration, vc-delete-file) (vc-rename-file): * lisp/vc/ediff-ptch.el (ediff-prompt-for-patch-file): * lisp/vc/diff-mode.el (diff-tell-file-name): * lisp/progmodes/etags.el (visit-tags-table) (visit-tags-table-buffer): * lisp/misearch.el (multi-isearch-read-files): * lisp/mail/rmailmm.el (rmail-mime-save): * lisp/help-fns.el (doc-file-to-man, doc-file-to-info): * lisp/gnus/gnus-bookmark.el (gnus-bookmark-load): * lisp/files.el (write-file, basic-save-buffer): * lisp/dired.el (dired-read-dir-and-switches): * lisp/bookmark.el (bookmark-save, bookmark-load): * lisp/abbrev.el (write-abbrev-file, abbrev-edit-save-to-file): Use format-prompt in read-file-name calls that have a default. diff --git a/lisp/abbrev.el b/lisp/abbrev.el index be6f9ee343..50d0011e81 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -233,7 +233,7 @@ If VERBOSE is non-nil, display a message indicating where abbrevs have been saved." (interactive (list - (read-file-name "Write abbrev file: " + (read-file-name (format-prompt "Write abbrev file" abbrev-file-name) (file-name-directory (expand-file-name abbrev-file-name)) abbrev-file-name))) (or (and file (> (length file) 0)) @@ -262,7 +262,7 @@ have been saved." (defun abbrev-edit-save-to-file (file) "Save all user-level abbrev definitions in current buffer to FILE." (interactive - (list (read-file-name "Save abbrevs to file: " + (list (read-file-name (format-prompt "Save abbrevs to file" abbrev-file-name) (file-name-directory (expand-file-name abbrev-file-name)) abbrev-file-name))) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index dcb03adadd..206c87223c 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1425,8 +1425,8 @@ for a file, defaulting to the file defined by variable bookmark-default-file))) (if parg ;; This should be part of the `interactive' spec. - (read-file-name (format "File to save bookmarks in: (%s) " - default) + (read-file-name (format-prompt "File to save bookmarks in" + default) (file-name-directory default) default) default)))) (bookmark-write-file file) @@ -1538,7 +1538,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." (or (car bookmark-bookmarks-timestamp) (expand-file-name bookmark-default-file)))) (prefix current-prefix-arg)) - (list (read-file-name (format "Load bookmarks from: (%s) " default) + (list (read-file-name (format-prompt "Load bookmarks from" default) (file-name-directory default) default 'confirm) prefix nil prefix))) (let* ((file (expand-file-name file)) diff --git a/lisp/dired.el b/lisp/dired.el index e4bc4decf8..733d83e580 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -896,8 +896,9 @@ ERROR can be a string with the error message." (if (next-read-file-uses-dialog-p) (read-directory-name (format "Dired %s(directory): " str) nil default-directory nil) - (read-file-name (format "Dired %s(directory): " str) - nil default-directory nil))))) + (read-file-name (format-prompt "Dired %s(directory)" + default-directory str) + nil default-directory))))) ;; We want to switch to a more sophisticated version of ;; dired-read-dir-and-switches like the following, if there is a way diff --git a/lisp/files.el b/lisp/files.el index e6629d2a21..71951dd349 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4527,13 +4527,12 @@ Interactively, confirmation is required unless you supply a prefix argument." ;; (interactive "FWrite file: ") (interactive (list (if buffer-file-name - (read-file-name "Write file: " - nil nil nil nil) - (read-file-name "Write file: " default-directory - (expand-file-name - (file-name-nondirectory (buffer-name)) - default-directory) - nil nil)) + (read-file-name "Write file: ") + (read-file-name + (format-prompt "Write file" (file-name-nondirectory (buffer-name))) + default-directory + (expand-file-name (file-name-nondirectory (buffer-name)) + default-directory))) (not current-prefix-arg))) (or (null filename) (string-equal filename "") (progn @@ -5271,10 +5270,13 @@ Before and after saving the buffer, this function runs (unless (run-hook-with-args-until-success 'write-contents-functions) ;; If buffer has no file name, ask user for one. (or buffer-file-name - (let ((filename - (expand-file-name - (read-file-name "File to save in: " - nil (expand-file-name (buffer-name)))))) + (let* ((default (expand-file-name (buffer-name))) + (filename + (expand-file-name + (read-file-name + (format-prompt "File to save in" + (file-name-nondirectory default)) + nil default)))) (if (file-exists-p filename) (if (file-directory-p filename) ;; Signal an error if the user specified the name of an diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 1b00bbbc69..7e9684394a 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -315,8 +315,7 @@ affect point." "Load Gnus bookmarks from FILE (which must be in bookmark format)." (interactive (list (read-file-name - (format "Load Gnus bookmarks from: (%s) " - gnus-bookmark-default-file) + (format-prompt "Load Gnus bookmarks from" gnus-bookmark-default-file) "~/" gnus-bookmark-default-file 'confirm))) (setq file (expand-file-name file)) (if (file-readable-p file) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index a9943ccd7f..0e20d0f353 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1813,8 +1813,9 @@ one of them returns non-nil." ;;;###autoload (defun doc-file-to-man (file) "Produce an nroff buffer containing the doc-strings from the DOC file." - (interactive (list (read-file-name "Name of DOC file: " doc-directory - internal-doc-file-name t))) + (interactive (list (read-file-name (format-prompt "Name of DOC file" + internal-doc-file-name) + doc-directory internal-doc-file-name t))) (or (file-readable-p file) (error "Cannot read file `%s'" file)) (pop-to-buffer (generate-new-buffer "*man-doc*")) @@ -1843,8 +1844,9 @@ one of them returns non-nil." ;;;###autoload (defun doc-file-to-info (file) "Produce a texinfo buffer with sorted doc-strings from the DOC file." - (interactive (list (read-file-name "Name of DOC file: " doc-directory - internal-doc-file-name t))) + (interactive (list (read-file-name (format-prompt "Name of DOC file" + internal-doc-file-name) + doc-directory internal-doc-file-name t))) (or (file-readable-p file) (error "Cannot read file `%s'" file)) (let ((i 0) type name doc alist) diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 29c6dcf40e..0b9af8292b 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -269,7 +269,7 @@ TRUNCATED is non-nil if the text of this entity was truncated." (unless (y-or-n-p "This entity is truncated; save anyway? ") (error "Aborted"))) (setq filename (expand-file-name - (read-file-name (format "Save as (default: %s): " filename) + (read-file-name (format-prompt "Save as" filename) directory (expand-file-name filename directory)) directory)) diff --git a/lisp/misearch.el b/lisp/misearch.el index 958c10a1bf..7796df49c4 100644 --- a/lisp/misearch.el +++ b/lisp/misearch.el @@ -316,9 +316,10 @@ Every next/previous file in the defined sequence is visited by (defun multi-isearch-read-files () "Return a list of files specified interactively, one by one." ;; Most code from `multi-occur'. - (let* ((files (list (read-file-name "First file to search: " - default-directory - buffer-file-name))) + (let* ((files (list (read-file-name + (format-prompt "First file to search: " + (file-name-nondirectory buffer-file-name)) + default-directory buffer-file-name))) (file nil)) (while (not (string-equal (setq file (read-file-name diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 2c5c36504a..81cb2b7cd7 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -292,7 +292,7 @@ file the tag was in." (or (locate-dominating-file default-directory "TAGS") default-directory))) (list (read-file-name - "Visit tags table (default TAGS): " + (format-prompt "Visit tags table" "TAGS") ;; default to TAGS from default-directory up to root. default-tag-dir (expand-file-name "TAGS" default-tag-dir) @@ -625,7 +625,7 @@ Returns t if it visits a tags table, or nil if there are no more in the list." (car list)) ;; Finally, prompt the user for a file name. (expand-file-name - (read-file-name "Visit tags table (default TAGS): " + (read-file-name (format-prompt "Visit tags table" "TAGS") default-directory "TAGS" t)))))) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 9c41d508b6..a1fdd11ca0 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -911,10 +911,11 @@ like \(diff-merge-strings \"b/foo\" \"b/bar\" \"/a/c/foo\")." If the OLD prefix arg is passed, tell the file NAME of the old file." (interactive (let* ((old current-prefix-arg) - (fs (diff-hunk-file-names current-prefix-arg))) + (fs (diff-hunk-file-names current-prefix-arg)) + (default (diff-find-file-name old 'noprompt))) (unless fs (error "No file name to look for")) - (list old (read-file-name (format "File for %s: " (car fs)) - nil (diff-find-file-name old 'noprompt) t)))) + (list old (read-file-name (format-prompt "File for %s" default (car fs)) + nil default t)))) (let ((fs (diff-hunk-file-names old))) (unless fs (error "No file name to look for")) (push (cons fs name) diff-remembered-files-alist))) diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index f6af5a4555..8b122093c1 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -499,15 +499,11 @@ are two possible targets for this %spatch. However, these files do not exist." patch-file-name) (setq patch-file-name (read-file-name - (format "Patch is in file%s: " - (cond ((and buffer-file-name + (format-prompt "Patch is in file" + (and buffer-file-name (equal (expand-file-name dir) - (file-name-directory buffer-file-name))) - (concat - " (default " - (file-name-nondirectory buffer-file-name) - ")")) - (t ""))) + (file-name-directory buffer-file-name)) + (file-name-nondirectory buffer-file-name))) dir buffer-file-name 'must-match)) (if (file-directory-p patch-file-name) (error "Patch file cannot be a directory: %s" patch-file-name) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 4cbd2658f8..983fb598f7 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -953,10 +953,9 @@ use." ;; repository, make sure it's a parent of ;; file. (read-file-name - (format "create %s repository in: " bk) + (format-prompt "create %s repository in" def-dir bk) default-directory def-dir t nil (lambda (arg) - (message "arg %s" arg) (and (file-directory-p arg) (string-prefix-p (expand-file-name arg) def-dir))))))) (let ((default-directory repo-dir)) @@ -2900,10 +2899,10 @@ backend to NEW-BACKEND, and unregister FILE from the current backend. "Delete file and mark it as such in the version control system. If called interactively, read FILE, defaulting to the current buffer's file name if it's under version control." - (interactive (list (read-file-name "VC delete file: " nil - (when (vc-backend buffer-file-name) - buffer-file-name) - t))) + (interactive (list (let ((default (when (vc-backend buffer-file-name) + buffer-file-name))) + (read-file-name "VC delete file" default) + nil default t))) (setq file (expand-file-name file)) (let ((buf (get-file-buffer file)) (backend (vc-backend file))) @@ -2944,9 +2943,10 @@ buffer's file name if it's under version control." "Rename file OLD to NEW in both work area and repository. If called interactively, read OLD and NEW, defaulting OLD to the current buffer's file name if it's under version control." - (interactive (list (read-file-name "VC rename file: " nil - (when (vc-backend buffer-file-name) - buffer-file-name) t) + (interactive (list (let ((default (when (vc-backend buffer-file-name) + buffer-file-name))) + (read-file-name (format-prompt "VC rename file" default) + nil default t)) (read-file-name "Rename to: "))) ;; in CL I would have said (setq new (merge-pathnames new old)) (let ((old-base (file-name-nondirectory old))) diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 074320855c..d6ca300f3a 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -326,14 +326,15 @@ If non-nil, plugins are enabled. Otherwise, disabled.")) FILE-NAME combined with `xwidget-webkit-download-dir' is the default file name of the prompt when reading. When the file name the user specified is a directory, URL is saved at the specified directory as FILE-NAME." - (let ((save-name (read-file-name - (format "Save URL `%s' of type `%s' in file/directory: " - url mime-type) - xwidget-webkit-download-dir - (when file-name - (expand-file-name - file-name - xwidget-webkit-download-dir))))) + (let* ((default (when file-name + (expand-file-name + file-name + xwidget-webkit-download-dir))) + (save-name + (read-file-name + (format-prompt "Save URL `%s' of type `%s' in file/directory" + default url mime-type) + xwidget-webkit-download-dir default))) (if (file-directory-p save-name) (setq save-name (expand-file-name (file-name-nondirectory file-name) save-name))) commit 151486931c82f6af38a912631c9cd41b677aae47 Author: Reuben Thomas Date: Mon Sep 7 20:56:58 2020 +0100 Fix Enchant dictionary finding routine * lisp/textmodes/ispell.el (ispell-find-enchant-dictionaries): Don’t pass `buffer-string' to enchant-lsmod. Remove zero-length substrings from the split output of `enchant-lsmod`, as the output ends with a separator. Pass the current language to `ispell--get-extra-word-characters', so we get the result for the current language, not the default language. (Patch from Jorge P. de Morais Neto.) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 11f90f41a8..a99dfe4067 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1236,11 +1236,11 @@ If LANG is omitted, get the extra word characters for the default language." "Find Enchant's dictionaries, and record in `ispell-enchant-dictionary-alist'." (let* ((dictionaries (split-string - (ispell--call-enchant-lsmod "-list-dicts" (buffer-string)) " ([^)]+)\n")) + (ispell--call-enchant-lsmod "-list-dicts") " ([^)]+)\n" t)) (found (mapcar #'(lambda (lang) `(,lang "[[:alpha:]]" "[^[:alpha:]]" - ,(ispell--get-extra-word-characters) t nil nil utf-8)) + ,(ispell--get-extra-word-characters lang) t nil nil utf-8)) dictionaries))) ;; Merge into FOUND any elements from the standard ispell-dictionary-base-alist ;; which have no element in FOUND at all. commit 0ebe2678002ffb82a25311c56cbc4b8ba3bd5fa1 Author: Juri Linkov Date: Mon Sep 7 21:33:13 2020 +0300 * lisp/char-fold.el (char-fold-to-regexp): Handle lax-whitespace (bug#38539) diff --git a/lisp/char-fold.el b/lisp/char-fold.el index 5a3c20c783..34561a2efe 100644 --- a/lisp/char-fold.el +++ b/lisp/char-fold.el @@ -324,6 +324,13 @@ from which to start." (while (< i end) (pcase (aref string i) (?\s (setq spaces (1+ spaces))) + ((pred (lambda (c) (and char-fold-symmetric + (if isearch-regexp + isearch-regexp-lax-whitespace + isearch-lax-whitespace) + (stringp search-whitespace-regexp) + (string-match-p search-whitespace-regexp (char-to-string c))))) + (setq spaces (1+ spaces))) (c (when (> spaces 0) (push (char-fold--make-space-string spaces) out) (setq spaces 0)) commit 5312e56d43c82ab5e1c3fe407e24bdf1014e4313 Author: Lars Ingebrigtsen Date: Mon Sep 7 18:19:40 2020 +0200 Fix test failure in custom--test-theme-variables * test/lisp/custom-tests.el (custom--test-theme-variables): "make check" in the main directory didn't work because the path was wrong. Use EMACS_TEST_DIRECTORY to find the test directory instead. diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el index 7853c84bb6..cabbf861f1 100644 --- a/test/lisp/custom-tests.el +++ b/test/lisp/custom-tests.el @@ -101,7 +101,9 @@ "Test variables setting with enabling / disabling a custom theme." ;; We load custom-resources/custom--test-theme.el. (let ((custom-theme-load-path - `(,(expand-file-name "custom-resources" (file-name-directory #$))))) + `(,(expand-file-name + "custom-resources" + (expand-file-name "lisp" (getenv "EMACS_TEST_DIRECTORY")))))) (load-theme 'custom--test 'no-confirm 'no-enable) ;; The variables have still their initial values. (should (equal custom--test-user-option 'foo)) commit f681c097f2b6e6271612eee04120d20b002502c4 Author: Lars Ingebrigtsen Date: Mon Sep 7 18:13:58 2020 +0200 Require ert in the cperl tests, since it's reloading itself diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index b549b92404..4e477a40e8 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -31,6 +31,7 @@ (defvar cperl-test-mode #'cperl-mode) (require 'cperl-mode) +(require 'ert) (defvar cperl-mode-tests-data-directory (expand-file-name "lisp/progmodes/cperl-mode-resources" commit 37f454f5826c199cb510fd49f2499fa2053340b1 Author: Viktor Slavkovikj Date: Mon Sep 7 17:57:42 2020 +0200 Use auth-source for passwords in rmail * lisp/mail/rmail.el (rmail-get-remote-password): Use auth-source for passwords (bug#24274). (rmail-parse-url): Pass in user/host. Copyright-paperwork-exempt: yes diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index f14025a93a..8bcb9af4d1 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -39,6 +39,7 @@ (require 'mail-utils) (require 'rfc2047) +(require 'auth-source) (require 'rmail-loaddefs) @@ -1884,7 +1885,8 @@ interactively." (when rmail-remote-password-required (setq got-password (not (rmail-have-password))) (setq supplied-password (rmail-get-remote-password - (string-match "^imaps?" proto)))) + (string-match "^imaps?" proto) + user host))) ;; FIXME ;; The password is embedded. Strip it out since movemail ;; does not really like it, in spite of the movemail spec. @@ -1904,14 +1906,12 @@ interactively." ((string-match "^po:\\([^:]+\\)\\(:\\(.*\\)\\)?" file) (let (got-password supplied-password - ;; (proto "pop") - ;; (user (match-string 1 file)) - ;; (host (match-string 3 file)) - ) + (user (match-string 1 file)) + (host (match-string 3 file))) (when rmail-remote-password-required (setq got-password (not (rmail-have-password))) - (setq supplied-password (rmail-get-remote-password nil))) + (setq supplied-password (rmail-get-remote-password nil user host))) (list file "pop" supplied-password got-password))) @@ -4461,15 +4461,30 @@ TEXT and INDENT are not used." (setq rmail-remote-password nil) (setq rmail-encoded-remote-password nil))) -(defun rmail-get-remote-password (imap) - "Get the password for retrieving mail from a POP or IMAP server. If none -has been set, then prompt the user for one." +(defun rmail-get-remote-password (imap user host) + "Get the password for retrieving mail from a POP or IMAP server. +If none has been set, the password is found via auth-source. If +you use ~/.authinfo as your auth-source backend, then put +something like the following in that file: + +machine mymachine login myloginname password mypassword + +If auth-source search yields no result, prompt the user for the +password." (when (not rmail-encoded-remote-password) (if (not rmail-remote-password) - (setq rmail-remote-password - (read-passwd (if imap - "IMAP password: " - "POP password: ")))) + (setq rmail-remote-password + (let ((found (nth 0 (auth-source-search + :max 1 :user user :host host + :require '(:secret))))) + (if found + (let ((secret (plist-get found :secret))) + (if (functionp secret) + (funcall secret) + secret)) + (read-passwd (if imap + "IMAP password: " + "POP password: ")))))) (rmail-set-remote-password rmail-remote-password) (setq rmail-remote-password nil)) (rmail-encode-string rmail-encoded-remote-password (emacs-pid))) commit 438cdc33288e0a34299c1f1985b7e405d63e75a5 Author: Daniel Martín Date: Mon Sep 7 17:10:30 2020 +0200 Add support for horizontal scrolling in tab-line * lisp/tab-line.el ([tab-line wheel-left]): Bind left and right tab line scrolling to the 'wheel-left' and 'wheel-right' mouse events. ([tab-line S-wheel-right]): Analogous change for the functions that switch tabs. * etc/NEWS: Announce the new feature (bug#43224). Copyright-paperwork-exempt: yes diff --git a/etc/NEWS b/etc/NEWS index f0644c8ea9..aa3acc26b3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -206,6 +206,11 @@ of the next command to be displayed in a new tab. Show/hide the tab bar independently for each frame, according to the value of 'tab-bar-show'. +--- +*** The tabs in the tab line can now be scrolled using horizontal scroll. +If your mouse or trackpad supports it, you can now scroll tabs when +the mouse pointer is in the tab line by scrolling left or right. + ** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and 'previous-error-no-select' bound to 'p'. diff --git a/lisp/tab-line.el b/lisp/tab-line.el index e8c4dc4d93..40f80959cc 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -764,11 +764,15 @@ from the tab line." (global-set-key [tab-line mouse-5] 'tab-line-hscroll-right) (global-set-key [tab-line wheel-up] 'tab-line-hscroll-left) (global-set-key [tab-line wheel-down] 'tab-line-hscroll-right) +(global-set-key [tab-line wheel-left] 'tab-line-hscroll-left) +(global-set-key [tab-line wheel-right] 'tab-line-hscroll-right) (global-set-key [tab-line S-mouse-4] 'tab-line-switch-to-prev-tab) (global-set-key [tab-line S-mouse-5] 'tab-line-switch-to-next-tab) (global-set-key [tab-line S-wheel-up] 'tab-line-switch-to-prev-tab) (global-set-key [tab-line S-wheel-down] 'tab-line-switch-to-next-tab) +(global-set-key [tab-line S-wheel-left] 'tab-line-switch-to-prev-tab) +(global-set-key [tab-line S-wheel-right] 'tab-line-switch-to-next-tab) (provide 'tab-line) commit 0c4789e2defee35237651961391d0da69fbe26d8 Author: Lars Ingebrigtsen Date: Mon Sep 7 16:29:59 2020 +0200 Show the status of signed + encrypted S/MIME messages in Gnus * lisp/gnus/mm-decode.el (mm-possibly-verify-or-decrypt): Use the data to tell the caller (i.e., Gnus) something about the validation of signed + encrypted S/MIME messages. * lisp/gnus/mm-view.el (mm-view-pkcs7-verify): Pass along details about whether we could validate the signature or not (bug#42637). diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index a01fd2729a..1bce6ca020 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1665,12 +1665,14 @@ If RECURSIVE, search recursively." (let ((type (car ctl)) (subtype (cadr (split-string (car ctl) "/"))) (mm-security-handle ctl) ;; (car CTL) is the type. + (smime-type (cdr (assq 'smime-type (mm-handle-type parts)))) protocol func functest) (cond ((or (equal type "application/x-pkcs7-mime") (equal type "application/pkcs7-mime")) (with-temp-buffer (when (and (cond + ((equal smime-type "signed-data") t) ((eq mm-decrypt-option 'never) nil) ((eq mm-decrypt-option 'always) t) ((eq mm-decrypt-option 'known) t) @@ -1691,7 +1693,21 @@ If RECURSIVE, search recursively." (unless (mail-fetch-field "content-type") (goto-char (point-max)) (insert "Content-type: text/plain\n\n"))) - (setq parts (mm-dissect-buffer t))))) + (setq parts + (if (equal smime-type "signed-data") + (list (propertize + "multipart/signed" + 'protocol "application/pkcs7-signature" + 'gnus-info + (format + "%s:%s" + (get-text-property 0 'gnus-info + (car mm-security-handle)) + (get-text-property 0 'gnus-details + (car mm-security-handle)))) + (mm-dissect-buffer t) + parts) + (mm-dissect-buffer t)))))) ((equal subtype "signed") (unless (and (setq protocol (mm-handle-multipart-ctl-parameter ctl 'protocol)) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index bd5960c18b..cb39ffe946 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -597,8 +597,16 @@ If MODE is not set, try to find mode automatically." (with-temp-buffer (insert-buffer-substring (mm-handle-buffer handle)) (goto-char (point-min)) - (let ((part (base64-decode-string (buffer-string)))) - (epg-verify-string (epg-make-context 'CMS) part)))) + (let ((part (base64-decode-string (buffer-string))) + (context (epg-make-context 'CMS))) + (prog1 + (epg-verify-string context part) + (let ((result (car (epg-context-result-for context 'verify)))) + (mm-sec-status + 'gnus-info (epg-signature-status result) + 'gnus-details + (format "%s:%s" (epg-signature-validity result) + (epg-signature-key-id result)))))))) (with-temp-buffer (insert "MIME-Version: 1.0\n") (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m") commit c8472cc69d4bce7f53c9a62966245a4de3d99fbd Author: João Távora Date: Mon Sep 7 10:52:46 2020 +0100 Better explain behaviour of icomplete--sorted-completions * lisp/icomplete.el (icomplete--sorted-completions): Overhaul comment diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 47d78a0bc8..38115ab2c8 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -469,33 +469,70 @@ Usually run by inclusion in `minibuffer-setup-hook'." with beg = (icomplete--field-beg) with end = (icomplete--field-end) with all = (completion-all-sorted-completions beg end) - ;; First, establish the "bubble up" predicates. + ;; Icomplete mode re-sorts candidates, bubbling the default to + ;; top if it's found somewhere down the list. This loop's + ;; iteration variable, `fn' iterates through these "bubble up + ;; predicates" which may vary depending on specific + ;; `completing-read' invocations, described below: for fn in (cond ((and minibuffer-default (stringp minibuffer-default) ; bug#38992 (= (icomplete--field-end) (icomplete--field-beg))) - ;; When we have a non-nil string default and - ;; no input whatsoever: we want to make sure - ;; that default is bubbled to the top so that - ;; `icomplete-force-complete-and-exit' will - ;; select it (do that even if the match - ;; doesn't match the completion perfectly. - `(,(lambda (comp) + ;; Here, we have a non-nil string default and + ;; no input whatsoever. We want to make sure + ;; that the default is bubbled to the top so + ;; that `icomplete-force-complete-and-exit' + ;; will select it. We want to do that even if + ;; the match doesn't match the completion + ;; perfectly. + ;; + `(;; The first predicate ensures that: + ;; + ;; (completing-read "thing? " '("foo" "bar") + ;; nil nil nil nil "bar") + ;; + ;; Has "bar" at the top, so RET will select + ;; it, as desired. + ,(lambda (comp) (equal minibuffer-default comp)) + ;; Why do we need this second predicate? + ;; Because that'll make things like M-x man + ;; RET RET, when invoked with point on the + ;; "bar" word, behave correctly. There, the + ;; default doesn't quite match any + ;; candidate. So: + ;; + ;; (completing-read "Man entry? " '("foo(1)" "bar(1)") + ;; nil nil nil nil "bar") + ;; + ;; Will place "bar(1)" on top, and RET will + ;; select it -- again, as desired. + ;; + ;; FIXME: it's arguable that this second + ;; behaviour should be a property of the + ;; completion table and not the completion + ;; frontend such as we have done + ;; here. However, it seems generically + ;; useful for a very broad spectrum of + ;; cases. ,(lambda (comp) (string-prefix-p minibuffer-default comp)))) ((and fido-mode (not minibuffer-default) (eq (icomplete--category) 'file)) - ;; `fido-mode' has some extra file-sorting - ;; semantics even if there isn't a default, - ;; which is to bubble "./" to the top if it - ;; exists. This makes M-x dired RET RET go to - ;; the directory of current file, which is - ;; what vanilla Emacs and `ido-mode' both do. + ;; When there isn't a default, `fido-mode' + ;; specifically also has some extra + ;; file-sorting semantics inherited from Ido. + ;; Those make the directory "./" bubble to the + ;; top (if it exists). This makes M-x dired + ;; RET RET go to the directory of current + ;; file, which is non-Icomplete vanilla Emacs + ;; and `ido-mode' both do. `(,(lambda (comp) (string= "./" comp))))) - ;; Now, look for a completion matching one of those predicates - ;; to bubble up (unless that completion is already on top). + ;; After we have setup the predicates, look for a completion + ;; matching one of them and bubble up it, destructively on + ;; `completion-all-sorted-completions' (unless that completion + ;; happens to be already on top). thereis (or (and (funcall fn (car all)) all) (cl-loop commit 811dcb7e8f8198c416ad1d3e018ff2c6c05c0ca8 Author: Lars Ingebrigtsen Date: Mon Sep 7 11:19:29 2020 +0200 Remove debugging code inadvertently checked in * lisp/gnus/gnus-fun.el (gnus-face-from-file): Remove debugging code inadvertently checked in. diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 24fced15a9..c95449762e 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -181,7 +181,6 @@ different input formats." (gnus-message 9 "Length %d; trying quant %d" (length attempt) quant)) (setq done t))) - (setq a attempt) (if done (mm-with-unibyte-buffer (insert attempt)