procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'origin/master'

Browse source
This commit is contained in:
Po Lu 2022-02-11 20:20:50 +08:00
commit f0f58cc5c7
8 changed files with 110 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
etc/DEVEL.HUMOR
View file

@ -188,3 +188,19 @@ wouldn't worry about it too much."
"Kind of late, but thanks for letting us know. I've just revoked your
write access to the repository for the obvious safety reasons,"
-- Bastien Guerry and Stefan Monnier
----------------------------------------------------------------------
"I should have known better than to think I could be right and you
wrong about some Emacs code I've just started looking at. Sorry about
that."
"No problem. It's one of the many joys of working on a code base
that's up to almost 40 years old: First you have to figure out what
the (no doubt smart) programmer meant to achieve with the code, and
then try to figure out whether it ever even did that, and then whether
it's still working the same way, and then whether it's still relevant
due to changes elsewhere, and then finally whether it can be improved
without breaking odd edge cases on obscure systems you don't have
access to. 🙃"
-- Ignacio Casso and Lars Ingebrigtsen

6
lisp/gnus/gnus-group.el
View file

@ -3226,7 +3226,8 @@ non-nil SPECS arg must be an alist with `search-query-spec' and
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
(seq-group-by
(lambda (elt) (gnus-group-server elt))
(lambda (elt) (gnus-method-to-server
(gnus-find-method-for-group elt)))
(or gnus-group-marked
(if (gnus-group-group-name)
(list (gnus-group-group-name))
@ -3277,7 +3278,8 @@ non-nil SPECS arg must be an alist with `search-query-spec' and
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
(seq-group-by
(lambda (elt) (gnus-group-server elt))
(lambda (elt) (gnus-method-to-server
(gnus-find-method-for-group elt)))
(or gnus-group-marked
(if (gnus-group-group-name)
(list (gnus-group-group-name))

39
lisp/gnus/gnus-search.el
View file

@ -762,6 +762,9 @@ the files in ARTLIST by that search key.")
(generate-new-buffer " *gnus-search-")))
(cl-call-next-method engine slots))
(defclass gnus-search-nnselect (gnus-search-engine)
nil)
(defclass gnus-search-imap (gnus-search-engine)
((literal-plus
:initarg :literal-plus
@ -907,13 +910,15 @@ quirks.")
(define-obsolete-variable-alias 'nnir-method-default-engines
'gnus-search-default-engines "28.1")
(defcustom gnus-search-default-engines '((nnimap . gnus-search-imap))
(defcustom gnus-search-default-engines '((nnimap . gnus-search-imap)
(nnselect . gnus-search-nnselect))
"Alist of default search engines keyed by server method."
:version "26.1"
:type `(repeat (cons (choice (const nnimap) (const nntp) (const nnspool)
(const nneething) (const nndir) (const nnmbox)
(const nnml) (const nnmh) (const nndraft)
(const nnfolder) (const nnmaildir))
(const nnfolder) (const nnmaildir)
(const nnselect))
(choice
,@(mapcar
(lambda (el) (list 'const (intern (car el))))
@ -1010,6 +1015,33 @@ Responsible for handling and, or, and parenthetical expressions.")
unseen all old new or not)
"Known IMAP search keys.")
(autoload 'nnselect-categorize "nnselect")
(autoload 'nnselect-get-artlist "nnselect" nil nil 'macro)
(autoload 'ids-by-group "nnselect")
;; nnselect interface
(cl-defmethod gnus-search-run-search ((_engine gnus-search-nnselect)
_srv query-spec groups)
(let ((artlist []))
(dolist (group groups)
(let* ((gnus-newsgroup-selection (nnselect-get-artlist group))
(group-spec
(nnselect-categorize
(mapcar 'car
(ids-by-group
(number-sequence 1
(length gnus-newsgroup-selection))))
(lambda (x)
(gnus-group-server x)))))
(setq artlist
(vconcat artlist
(seq-intersection
gnus-newsgroup-selection
(gnus-search-run-query
(list (cons 'search-query-spec query-spec)
(cons 'search-group-spec group-spec))))))))
artlist))
;; imap interface
(cl-defmethod gnus-search-run-search ((engine gnus-search-imap)
srv query groups)
@ -2155,7 +2187,8 @@ article came from is also searched."
(read-from-minibuffer
"Query: " nil gnus-search-minibuffer-map
nil 'gnus-search-history)))
(cons 'raw arg)))
(cons 'raw
(or (gnus-nnselect-group-p (gnus-group-group-name)) arg))))
(provide 'gnus-search)
;;; gnus-search.el ends here

3
lisp/gnus/nnselect.el
View file

@ -47,7 +47,8 @@
;;; Setup:
(require 'gnus-art)
(require 'gnus-search)
(autoload 'gnus-search-run-query "gnus-search")
(autoload 'gnus-search-server-to-engine "gnus-search")
(eval-when-compile (require 'cl-lib))

18
lisp/net/tramp-adb.el
View file

@ -1364,6 +1364,24 @@ connection if a previous connection has died for some reason."
`(:application tramp :protocol ,tramp-adb-method)
'tramp-adb-connection-local-default-shell-profile))
;; `shell-mode' tries to open remote files like "/adb::~/.history".
;; This fails, because the tilde cannot be expanded. Tell
;; `tramp-handle-expand-file-name' to tolerate this.
(defun tramp-adb-tolerate-tilde (orig-fun)
"Advice for `shell-mode' to tolerate tilde in remote file names."
(let ((tramp-tolerate-tilde
(or tramp-tolerate-tilde
(equal (file-remote-p default-directory 'method)
tramp-adb-method))))
(funcall orig-fun)))
(add-function
:around (symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde)
(add-hook 'tramp-adb-unload-hook
(lambda ()
(remove-function
(symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde)))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-adb 'force)))

6
lisp/net/tramp-gvfs.el
View file

@ -1151,6 +1151,10 @@ file names."
(replace-match
(tramp-get-connection-property v "default-location" "~")
nil t localname 1))))
;; Tilde expansion is not possible.
(when (and (not tramp-tolerate-tilde)
(string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
(tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
;; We do not pass "/..".
@ -1168,7 +1172,7 @@ file names."
;; Do normal `expand-file-name' (this does "/./" and "/../"),
;; unless there are tilde characters in file name.
(tramp-make-tramp-file-name
v (if (string-match-p "\\`~" localname)
v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
localname
(tramp-run-real-handler #'expand-file-name (list localname)))))))

21
lisp/net/tramp-sshfs.el
View file

@ -55,7 +55,8 @@
;; These are for remote processes.
(tramp-login-program "ssh")
(tramp-login-args (("-q")("-l" "%u") ("-p" "%p")
("-e" "none") ("%h") ("%l")))
("-e" "none") ("-t" "-t")
("%h") ("%l")))
(tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
@ -411,6 +412,24 @@ connection if a previous connection has died for some reason."
(with-tramp-connection-property
vec "gid-string" (tramp-get-local-gid 'string)))
;; `shell-mode' tries to open remote files like "/sshfs:user@host:~/.history".
;; This fails, because the tilde cannot be expanded. Tell
;; `tramp-handle-expand-file-name' to tolerate this.
(defun tramp-sshfs-tolerate-tilde (orig-fun)
"Advice for `shell-mode' to tolerate tilde in remote file names."
(let ((tramp-tolerate-tilde
(or tramp-tolerate-tilde
(equal (file-remote-p default-directory 'method)
tramp-sshfs-method))))
(funcall orig-fun)))
(add-function
:around (symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde)
(add-hook 'tramp-sshfs-unload-hook
(lambda ()
(remove-function
(symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde)))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-sshfs 'force)))

11
lisp/net/tramp.el
View file

@ -3458,6 +3458,10 @@ User is always nil."
(if (file-directory-p dir) dir (file-name-directory dir)) nil
(tramp-flush-directory-properties v localname)))
(defvar tramp-tolerate-tilde nil
"Indicator, that not expandable tilde shall be tolerated.
Let-bind it when necessary.")
(defun tramp-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
@ -3475,7 +3479,8 @@ User is always nil."
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
;; Tilde expansion is not possible.
(when (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
(when (and (not tramp-tolerate-tilde)
(string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
(tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
;; Do not keep "/..".
(when (string-match-p "^/\\.\\.?$" localname)
@ -3486,7 +3491,9 @@ User is always nil."
(let ((default-directory tramp-compat-temporary-file-directory))
(tramp-make-tramp-file-name
v (tramp-drop-volume-letter
(tramp-run-real-handler #'expand-file-name (list localname))))))))
(if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
localname
(tramp-run-real-handler #'expand-file-name (list localname)))))))))
(defun tramp-handle-file-accessible-directory-p (filename)
"Like `file-accessible-directory-p' for Tramp files."