Subject: 30.0.50; [PATCH] desktop-save-mode with expiring remote buffers
From: Manuel Giraud <[email-masked]>
To: [email-masked]
Date: Mon, 23 Oct 2023 11:21:47 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

Hi,

I'm using desktop-save-mode and regularly open files via Tramp with a
method that asks for a password and that would eventually expire.  By
default 'desktop-files-not-to-save' is "\\(\\`/[^/:]*:\\|(ftp)\\'\\)" so
I expect that those remote buffer are not saved by desktop-save.

When such a remote buffer is opened (but not displayed nor used), Emacs
will keep asking me for this password and I find it annoying.

I try to track down this issue and found out that the call to
'desktop-buffer-info' on each buffer triggered this password prompt.

The following patch tries to solve this.
From 5aa566db6214d61ebfad79a84ea8630e791aec33 Mon Sep 17 00:00:00 2001
From: Manuel Giraud <[email-masked]>
Date: Mon, 23 Oct 2023 11:04:29 +0200
Subject: [PATCH] Test 'desktop-files-not-to-save' early

* lisp/desktop.el (desktop-buffer-info): Replace 'set-buffer'
with 'with-current-buffer' and fix docstring.
(desktop-save-file-name-p): New function to isolate test on
'desktop-files-not-to-save'.
(desktop-save-buffer-p): Use it.
(desktop-save): Test wheter the buffer's filename should be
saved before accessing its 'desktop-buffer-info'.
---
 lisp/desktop.el | 136 +++++++++++++++++++++++++-----------------------
 1 file changed, 70 insertions(+), 66 deletions(-)

diff --git a/lisp/desktop.el b/lisp/desktop.el
index f096f13ab80..738a26a42af 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -843,8 +843,6 @@ desktop-list*
 ;; ----------------------------------------------------------------------------
 (defun desktop-buffer-info (buffer)
   "Return information describing BUFFER.
-This function is not pure, as BUFFER is made current with
-`set-buffer'.
 
 Returns a list of all the necessary information to recreate the
 buffer, which is (in order):
@@ -860,49 +858,49 @@ desktop-buffer-info
     auxiliary information given by `desktop-save-buffer';
     local variables;
     auxiliary information given by `desktop-var-serdes-funs'."
-  (set-buffer buffer)
-  `(
-    ;; base name of the buffer; replaces the buffer name if managed by uniquify
-    ,(and (fboundp 'uniquify-buffer-base-name) (uniquify-buffer-base-name))
-    ;; basic information
-    ,(desktop-file-name (buffer-file-name) desktop-dirname)
-    ,(buffer-name)
-    ,major-mode
-    ;; minor modes
-    ,(seq-filter
-      (lambda (minor-mode)
-        ;; Just two sanity checks.
-        (and (boundp minor-mode)
-             (symbol-value minor-mode)
-             (let ((special
-                    (assq minor-mode desktop-minor-mode-table)))
-               (or (not special)
-                   (cadr special)))))
-      local-minor-modes)
-    ;; point and mark, and read-only status
-    ,(point)
-    ,(list (mark t) mark-active)
-    ,buffer-read-only
-    ;; auxiliary information
-    ,(when (functionp desktop-save-buffer)
-       (funcall desktop-save-buffer desktop-dirname))
-    ;; local variables
-    ,(let ((loclist (buffer-local-variables))
-           (ll nil))
-       (dolist (local desktop-locals-to-save)
-         (let ((here (assq local loclist)))
-           (cond (here
-                  (push here ll))
-                 ((member local loclist)
-                  (push local ll)))))
-       ll)
-   ,@(when (>= desktop-io-file-version 208)
-       (list
-        (mapcar (lambda (record)
-                  (let ((var (car record)))
-                    (list var
-                          (funcall (cadr record) (symbol-value var)))))
-                desktop-var-serdes-funs)))))
+  (with-current-buffer buffer
+    `(
+      ;; base name of the buffer; replaces the buffer name if managed by uniquify
+      ,(and (fboundp 'uniquify-buffer-base-name) (uniquify-buffer-base-name))
+      ;; basic information
+      ,(desktop-file-name (buffer-file-name) desktop-dirname)
+      ,(buffer-name)
+      ,major-mode
+      ;; minor modes
+      ,(seq-filter
+        (lambda (minor-mode)
+          ;; Just two sanity checks.
+          (and (boundp minor-mode)
+               (symbol-value minor-mode)
+               (let ((special
+                      (assq minor-mode desktop-minor-mode-table)))
+                 (or (not special)
+                     (cadr special)))))
+        local-minor-modes)
+      ;; point and mark, and read-only status
+      ,(point)
+      ,(list (mark t) mark-active)
+      ,buffer-read-only
+      ;; auxiliary information
+      ,(when (functionp desktop-save-buffer)
+         (funcall desktop-save-buffer desktop-dirname))
+      ;; local variables
+      ,(let ((loclist (buffer-local-variables))
+             (ll nil))
+         (dolist (local desktop-locals-to-save)
+           (let ((here (assq local loclist)))
+             (cond (here
+                    (push here ll))
+                   ((member local loclist)
+                    (push local ll)))))
+         ll)
+      ,@(when (>= desktop-io-file-version 208)
+          (list
+           (mapcar (lambda (record)
+                     (let ((var (car record)))
+                       (list var
+                             (funcall (cadr record) (symbol-value var)))))
+                   desktop-var-serdes-funs))))))
 
 ;; ----------------------------------------------------------------------------
 (defun desktop--v2s (value)
@@ -1029,6 +1027,12 @@ desktop-buffers-not-to-save-function
 `desktop-save-buffer-p' and should return nil if buffer should not
 have its state saved in the desktop file.")
 
+(defun desktop-save-file-name-p (filename)
+  "Return t if FILENAME should have its state saved."
+  (and filename
+       (or (not (stringp desktop-files-not-to-save))
+	   (not (string-match-p desktop-files-not-to-save filename)))))
+
 (defun desktop-save-buffer-p (filename bufname mode &rest rest)
   "Return t if buffer should have its state saved in the desktop file.
 FILENAME is the visited file name, BUFNAME is the buffer name, and
@@ -1041,9 +1045,7 @@ desktop-save-buffer-p
 	     (not (stringp desktop-buffers-not-to-save))
 	     (not (string-match-p desktop-buffers-not-to-save bufname)))
 	 (not (memq mode desktop-modes-not-to-save))
-	 (or (and filename
-		  (or no-regexp-to-check
-		      (not (string-match-p desktop-files-not-to-save filename))))
+	 (or (desktop-save-file-name-p filename)
 	     (and (memq mode '(dired-mode vc-dir-mode))
 		  (or no-regexp-to-check
 		      (not (setq dired-skip
@@ -1204,24 +1206,26 @@ desktop-save
 	     " kill-ring))\n"))
 
 	  (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
-	  (dolist (l (mapcar #'desktop-buffer-info (buffer-list)))
-	    (let ((base (pop l)))
-	      (when (apply #'desktop-save-buffer-p l)
-		(insert "("
-			(if (or (not (integerp eager))
-				(if (zerop eager)
-				    nil
-				  (setq eager (1- eager))))
-			    "desktop-create-buffer"
-			  "desktop-append-buffer-args")
-			" "
-			(format "%d" desktop-io-file-version))
-		;; If there's a non-empty base name, we save it instead of the buffer name
-		(when (and base (not (string= base "")))
-		  (setcar (nthcdr 1 l) base))
-		(dolist (e l)
-		  (insert "\n  " (desktop-value-to-string e)))
-		(insert ")\n\n"))))
+	  (dolist (buffer (buffer-list))
+            (when (desktop-save-file-name-p (buffer-file-name buffer))
+	      (let* ((l (desktop-buffer-info buffer))
+		     (base (pop l)))
+	        (when (apply #'desktop-save-buffer-p l)
+		  (insert "("
+			  (if (or (not (integerp eager))
+				  (if (zerop eager)
+				      nil
+				    (setq eager (1- eager))))
+			      "desktop-create-buffer"
+			    "desktop-append-buffer-args")
+			  " "
+			  (format "%d" desktop-io-file-version))
+		  ;; If there's a non-empty base name, we save it instead of the buffer name
+		  (when (and base (not (string= base "")))
+		    (setcar (nthcdr 1 l) base))
+		  (dolist (e l)
+		    (insert "\n  " (desktop-value-to-string e)))
+		  (insert ")\n\n")))))
 
 	  (setq default-directory desktop-dirname)
 	  ;; When auto-saving, avoid writing if nothing has changed since the last write.
-- 
2.42.0

In GNU Emacs 30.0.50 (build 1, x86_64-unknown-openbsd7.4) of 2023-10-23
 built on computer
Repository revision: 4ff0c738d050942932e73c627a7d6e31ca5c6244
Repository branch: mgi/auto-save-pred
Windowing system distributor 'The X.Org Foundation', version 11.0.12101008
System Description: OpenBSD computer 7.4 GENERIC.MP#1397 amd64

Configured using:
 'configure --prefix=/home/manuel/emacs --bindir=/home/manuel/bin
 --with-x-toolkit=no --with-toolkit-scroll-bars=no --without-cairo
 --without-sound --without-compress-install
 CPPFLAGS=-I/usr/local/include LDFLAGS=-L/usr/local/lib'

Configured features:
DBUS FREETYPE GIF GLIB GMP GNUTLS GSETTINGS HARFBUZZ JPEG JSON LCMS2
LIBOTF LIBXML2 MODULES NOTIFY KQUEUE OLDXMENU PDUMPER PNG RSVG SQLITE3
THREADS TIFF TREE_SITTER WEBP X11 XDBE XFT XIM XINPUT2 XPM ZLIB

Important settings:
  value of $LC_ALL: en_US.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Dired by name

Minor modes in effect:
  gnus-dired-mode: t
  server-mode: t
  override-global-mode: t
  repeat-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  show-paren-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  minibuffer-regexp-mode: t
  buffer-read-only: t
  line-number-mode: t
  indent-tabs-mode: t
  transient-mark-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t

Load-path shadows:
/home/manuel/.emacs.d/elpa/ef-themes-1.3.0/theme-loaddefs hides /home/manuel/emacs/share/emacs/30.0.50/lisp/theme-loaddefs

Features:
(shadow emacsbug pcmpl-git log-edit add-log shortdoc comp comp-cstr
help-fns radix-tree descr-text sort gnus-cite flow-fill mail-extr
textsec uni-scripts idna-mapping ucs-normalize uni-confusable
textsec-check gnus-async gnus-bcklg gnus-ml gnus-topic mm-archive
url-cache qp utf-7 imap rfc2104 nndoc nndraft nnmh network-stream
nnfolder nnml gnus-agent gnus-srvr gnus-score score-mode nnvirtual nntp
gnus-cache nnrss conf-mode tramp-cmds tramp-cache time-stamp tramp-sh
smerge-mode diff whitespace dabbrev pulse ibuf-ext ibuffer
ibuffer-loaddefs cus-start misearch multi-isearch org-duration
org-agenda org-indent view pascal org-element org-persist org-id
avl-tree oc-basic ol-eww ol-rmail ol-mhe ol-irc ol-info ol-gnus nnselect
ol-docview doc-view jka-compr image-mode exif ol-bibtex bibtex ol-bbdb
ol-w3m ol-doi org-link-doi gnus-icalendar org-capture org-refile org ob
ob-tangle ob-ref ob-lob ob-table ob-exp org-macro org-src ob-comint
org-pcomplete org-list org-footnote org-faces org-entities ob-emacs-lisp
ob-core ob-eval org-cycle org-table ol org-fold org-fold-core org-keys
oc org-loaddefs org-version org-compat org-macs vc-bzr vc-src vc-sccs
vc-svn vc-cvs vc-rcs log-view pcvs-util vc-hg sh-script smie treesit
executable eww url-queue mm-url vc-dir ewoc mule-util on-screen texinfo
texinfo-loaddefs emacs-news-mode gnus-dired vc autorevert filenotify
vc-git diff-mode vc-dispatcher bug-reference paredit warnings time
battery cus-load exwm-randr xcb-randr exwm-config ido exwm exwm-input
xcb-keysyms xcb-xkb exwm-manage exwm-floating xcb-cursor xcb-render
exwm-layout exwm-workspace exwm-core xcb-ewmh xcb-icccm xcb xcb-xproto
xcb-types xcb-debug server ef-summer-theme ef-themes zone speed-type
url-http url-auth url-gw nsm compat ytdious mingus libmpdee reporter
edebug debug backtrace transmission color calc-bin calc-ext calc
calc-loaddefs rect calc-macs supercite regi ebdb-message ebdb-gnus
gnus-msg gnus-art mm-uu mml2015 mm-view mml-smime smime gnutls dig
gnus-sum shr pixel-fill kinsoku url-file svg dom gnus-group gnus-undo
gnus-start gnus-dbus gnus-cloud nnimap nnmail mail-source utf7 nnoo
gnus-spec gnus-int gnus-range message sendmail yank-media puny rfc822
mml mml-sec epa epg rfc6068 epg-config mm-decode mm-bodies mm-encode
mail-parse rfc2231 rfc2047 rfc2045 ietf-drums gmm-utils mailheader
gnus-win ebdb-mua ebdb-com crm ebdb-format ebdb mailabbrev eieio-opt
speedbar ezimage dframe find-func eieio-base pcase timezone icalendar
gnus nnheader gnus-util mail-utils range mm-util mail-prsvr wid-edit
visual-basic-mode cl web-mode derived disp-table erlang-start
smart-tabs-mode skeleton cc-mode cc-fonts cc-guess cc-menus cc-cmds
cc-styles cc-align cc-engine cc-vars cc-defs slime-asdf grep slime-tramp
tramp rx trampver tramp-integration files-x tramp-message tramp-compat
xdg shell pcomplete parse-time iso8601 time-date format-spec
tramp-loaddefs slime-fancy slime-indentation slime-cl-indent cl-indent
slime-trace-dialog slime-fontifying-fu slime-package-fu slime-references
slime-compiler-notes-tree advice slime-scratch slime-presentations
bridge slime-macrostep macrostep slime-mdot-fu slime-enclosing-context
slime-fuzzy slime-fancy-trace slime-fancy-inspector slime-c-p-c
slime-editing-commands slime-autodoc slime-repl slime-parse slime
apropos compile text-property-search etags fileloop generator xref
project arc-mode archive-mode noutline outline icons pp comint ansi-osc
ansi-color ring hyperspec thingatpt slime-autoloads edmacro kmacro
use-package-bind-key bind-key appt diary-lib diary-loaddefs cal-menu
calendar cal-loaddefs dired-x dired-aux dired dired-loaddefs
notifications dbus xml cl-extra help-mode use-package-core repeat
easy-mmode desktop frameset debbugs-autoloads ebdb-autoloads
ef-themes-autoloads exwm-autoloads hyperbole-autoloads magit-autoloads
git-commit-autoloads finder-inf magit-section-autoloads dash-autoloads
on-screen-autoloads osm-autoloads paredit-autoloads request-autoloads
rust-mode-autoloads s-autoloads speed-type-autoloads
transmission-autoloads tree-mode-autoloads with-editor-autoloads info
compat-autoloads ytdious-autoloads package browse-url url url-proxy
url-privacy url-expand url-methods url-history url-cookie
generate-lisp-file url-domsuf url-util mailcap url-handlers url-parse
auth-source cl-seq eieio eieio-core cl-macs password-cache json subr-x
map byte-opt gv bytecomp byte-compile url-vars cl-loaddefs cl-lib rmc
iso-transl tooltip cconv eldoc paren electric uniquify ediff-hook
vc-hooks lisp-float-type elisp-mode mwheel term/x-win x-win
term/common-win x-dnd touch-screen tool-bar dnd fontset image regexp-opt
fringe tabulated-list replace newcomment text-mode lisp-mode prog-mode
register page tab-bar menu-bar rfn-eshadow isearch easymenu timer select
scroll-bar mouse jit-lock font-lock syntax font-core term/tty-colors
frame minibuffer nadvice seq simple cl-generic indonesian philippine
cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao
korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech
european ethiopic indian cyrillic chinese composite emoji-zwj charscript
charprop case-table epa-hook jka-cmpr-hook help abbrev obarray oclosure
cl-preloaded button loaddefs theme-loaddefs faces cus-face macroexp
files window text-properties overlay sha1 md5 base64 format env
code-pages mule custom widget keymap hashtable-print-readable backquote
threads dbusbind kqueue lcms2 dynamic-setting system-font-setting
font-render-setting xinput2 x multi-tty move-toolbar
make-network-process emacs)

Memory information:
((conses 16 1090540 641027) (symbols 48 72542 5)
 (strings 32 363748 18296) (string-bytes 1 11744990)
 (vectors 16 186883) (vector-slots 8 3624315 209906)
 (floats 8 645 1052) (intervals 56 38440 4146) (buffers 992 113))

-- 
Manuel Giraud