[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master f0f58cc5c7 2/3: Merge remote-tracking branch 'origin/master'
|
From: |
Po Lu |
|
Subject: |
master f0f58cc5c7 2/3: Merge remote-tracking branch 'origin/master' |
|
Date: |
Fri, 11 Feb 2022 07:30:54 -0500 (EST) |
branch: master
commit f0f58cc5c753d4bf9225bfe320ba5f213b3aca5c
Merge: f726ca161c bced4d26d9
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master'
---
etc/DEVEL.HUMOR | 16 ++++++++++++++++
lisp/gnus/gnus-group.el | 6 ++++--
lisp/gnus/gnus-search.el | 39 ++++++++++++++++++++++++++++++++++++---
lisp/gnus/nnselect.el | 3 ++-
lisp/net/tramp-adb.el | 18 ++++++++++++++++++
lisp/net/tramp-gvfs.el | 6 +++++-
lisp/net/tramp-sshfs.el | 21 ++++++++++++++++++++-
lisp/net/tramp.el | 11 +++++++++--
8 files changed, 110 insertions(+), 10 deletions(-)
diff --git a/etc/DEVEL.HUMOR b/etc/DEVEL.HUMOR
index 6db69bb4b5..bd51845cb1 100644
--- a/etc/DEVEL.HUMOR
+++ b/etc/DEVEL.HUMOR
@@ -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
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 8937df2601..e59a972350 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -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))
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index bf88abae76..4babe9f96f 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -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
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index f8a0c33d4e..f5be477d26 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -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))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 75e6b7179b..85cd2d9bc1 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -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)))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index d3634b0cc2..23290de685 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -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)))))))
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 72837793de..664dbc31b1 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -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)))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index f93ca7601a..32712efb3e 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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."