* lisp/mail/mspools.el: Use lexical-scoping. Autoload mspools-show.
(mspools-mode-map): Remove bindings made redundant by `special-mode-map`. (mspools-show): Autoload. Use `erase-buffer`. (mspools-visit-spool): Use `inhibit-read-only`; simplify a bit. (mspools-get-spool-files): Avoid `setq`. Use `pcase-dolist`. (mspools-revert-buffer): Make (unused) args optional. (mspools-help, mspools-show-again, mspools-quit): Declare obsolete.
This commit is contained in:
Stefan Monnier
parent
ae6daa680a
commit
6f88247a6c
2 changed files with 48 additions and 48 deletions
3
etc/NEWS
3
etc/NEWS
|
|
@ -167,6 +167,9 @@ same for a button.
|
|||
|
||||
* Changes in Specialized Modes and Packages in Emacs 28.1
|
||||
|
||||
** mspool.el
|
||||
---
|
||||
*** Autoload the main entry point 'mspool-show'
|
||||
** Windows
|
||||
|
||||
*** The key prefix 'C-x 4 1' displays next command buffer in the same window.
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; mspools.el --- show mail spools waiting to be read
|
||||
;;; mspools.el --- show mail spools waiting to be read -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -170,11 +170,8 @@ your primary spool is. If this fails, set it to something like
|
|||
(define-key map "\C-c\C-c" 'mspools-visit-spool)
|
||||
(define-key map "\C-m" 'mspools-visit-spool)
|
||||
(define-key map " " 'mspools-visit-spool)
|
||||
(define-key map "?" 'mspools-help)
|
||||
(define-key map "q" 'mspools-quit)
|
||||
(define-key map "n" 'next-line)
|
||||
(define-key map "p" 'previous-line)
|
||||
(define-key map "g" 'revert-buffer)
|
||||
map)
|
||||
"Keymap for the *spools* buffer.")
|
||||
|
||||
|
|
@ -216,14 +213,15 @@ your primary spool is. If this fails, set it to something like
|
|||
(concat mspools-folder-directory s "." mspools-suffix)
|
||||
(concat mspools-folder-directory s ".crash")))
|
||||
;; So I create a vm-spool-files entry for each of those mail drops
|
||||
(mapcar 'file-name-sans-extension
|
||||
(mapcar #'file-name-sans-extension
|
||||
(directory-files mspools-folder-directory nil
|
||||
(format "\\`[^.]+\\.%s" mspools-suffix)))
|
||||
))
|
||||
))
|
||||
|
||||
;;; MSPOOLS-SHOW -- the main function
|
||||
(defun mspools-show ( &optional noshow)
|
||||
;;;###autoload
|
||||
(defun mspools-show (&optional noshow)
|
||||
"Show the list of non-empty spool files in the *spools* buffer.
|
||||
Buffer is not displayed if SHOW is non-nil."
|
||||
(interactive)
|
||||
|
|
@ -232,7 +230,7 @@ Buffer is not displayed if SHOW is non-nil."
|
|||
(progn
|
||||
(set-buffer mspools-buffer)
|
||||
(setq buffer-read-only nil)
|
||||
(delete-region (point-min) (point-max)))
|
||||
(erase-buffer))
|
||||
;; else buffer doesn't exist so create it
|
||||
(get-buffer-create mspools-buffer))
|
||||
|
||||
|
|
@ -255,8 +253,8 @@ Buffer is not displayed if SHOW is non-nil."
|
|||
(defun mspools-visit-spool ()
|
||||
"Visit the folder on the current line of the *spools* buffer."
|
||||
(interactive)
|
||||
(let ( spool-name folder-name)
|
||||
(setq spool-name (mspools-get-spool-name))
|
||||
(let ((spool-name (mspools-get-spool-name))
|
||||
folder-name)
|
||||
(if (null spool-name)
|
||||
(message "No spool on current line")
|
||||
|
||||
|
|
@ -265,19 +263,20 @@ Buffer is not displayed if SHOW is non-nil."
|
|||
;; put in a little "*" to indicate spool file has been read.
|
||||
(if (not mspools-update)
|
||||
(save-excursion
|
||||
(setq buffer-read-only nil)
|
||||
(beginning-of-line)
|
||||
(insert "*")
|
||||
(delete-char 1)
|
||||
(setq buffer-read-only t)
|
||||
))
|
||||
(let ((inhibit-read-only t))
|
||||
(insert "*")
|
||||
(delete-char 1))))
|
||||
|
||||
(message "folder %s spool %s" folder-name spool-name)
|
||||
(if (eq (count-lines (point-min) (point-at-eol))
|
||||
mspools-files-len)
|
||||
(forward-line (- 1 mspools-files-len)) ;back to top of list
|
||||
;; else just on to next line
|
||||
(forward-line 1))
|
||||
(forward-line (if (eq (count-lines (point-min) (point-at-eol))
|
||||
mspools-files-len)
|
||||
;; FIXME: Why use `mspools-files-len' instead
|
||||
;; of looking if we're on the last line and
|
||||
;; jumping to the first one if so?
|
||||
(- 1 mspools-files-len) ;back to top of list
|
||||
;; else just on to next line
|
||||
1))
|
||||
|
||||
;; Choose whether to use VM or RMAIL for reading folder.
|
||||
(if mspools-using-vm
|
||||
|
|
@ -291,8 +290,8 @@ Buffer is not displayed if SHOW is non-nil."
|
|||
|
||||
(if mspools-update
|
||||
;; generate new list of spools.
|
||||
(save-excursion
|
||||
(mspools-show-again 'noshow))))))
|
||||
(save-excursion ;;FIXME: Why?
|
||||
(mspools-revert-buffer))))))
|
||||
|
||||
(defun mspools-get-folder-from-spool (name)
|
||||
"Return folder name corresponding to the spool file NAME."
|
||||
|
|
@ -314,27 +313,31 @@ Buffer is not displayed if SHOW is non-nil."
|
|||
(defun mspools-get-spool-name ()
|
||||
"Return the name of the spool on the current line."
|
||||
(let ((line-num (1- (count-lines (point-min) (point-at-eol)))))
|
||||
;; FIXME: Why not extract the name directly from the current line's text?
|
||||
(car (nth line-num mspools-files))))
|
||||
|
||||
;;; Spools mode functions
|
||||
|
||||
(defun mspools-revert-buffer (ignore noconfirm)
|
||||
"Re-run mspools-show to revert the *spools* buffer."
|
||||
(defun mspools-revert-buffer (&optional _ignore _noconfirm)
|
||||
"Re-run `mspools-show' to revert the *spools* buffer."
|
||||
(mspools-show 'noshow))
|
||||
|
||||
(defun mspools-show-again (&optional noshow)
|
||||
"Update the *spools* buffer. This is useful if mspools-update is
|
||||
nil."
|
||||
"Update the *spools* buffer.
|
||||
This is useful if `mspools-update' is nil."
|
||||
(declare (obsolete revert-buffer "28.1"))
|
||||
(interactive)
|
||||
(mspools-show noshow))
|
||||
|
||||
(defun mspools-help ()
|
||||
"Show help for `mspools-mode'."
|
||||
(declare (obsolete describe-mode "28.1"))
|
||||
(interactive)
|
||||
(describe-function 'mspools-mode))
|
||||
|
||||
(defun mspools-quit ()
|
||||
"Quit the *spools* buffer."
|
||||
(declare (obsolete quit-window "28.1"))
|
||||
(interactive)
|
||||
(kill-buffer mspools-buffer))
|
||||
|
||||
|
|
@ -348,32 +351,26 @@ nil."
|
|||
|
||||
(defun mspools-get-spool-files ()
|
||||
"Find the list of spool files and display them in *spools* buffer."
|
||||
(let (folders head spool len beg end any)
|
||||
(if (null mspools-folder-directory)
|
||||
(error "Set `mspools-folder-directory' to where the spool files are"))
|
||||
(setq folders (directory-files mspools-folder-directory nil
|
||||
(if (null mspools-folder-directory)
|
||||
(error "Set `mspools-folder-directory' to where the spool files are"))
|
||||
(let* ((folders (directory-files mspools-folder-directory nil
|
||||
(format "\\`[^.]+\\.%s\\'" mspools-suffix)))
|
||||
(setq folders (mapcar 'mspools-size-folder folders))
|
||||
(setq folders (delq nil folders))
|
||||
(folders (delq nil (mapcar #'mspools-size-folder folders)))
|
||||
;; beg end
|
||||
)
|
||||
(setq mspools-files folders)
|
||||
(setq mspools-files-len (length mspools-files))
|
||||
(set-buffer mspools-buffer)
|
||||
(while folders
|
||||
(setq any t)
|
||||
(setq head (car folders))
|
||||
(setq spool (car head))
|
||||
(setq len (cdr head))
|
||||
(setq folders (cdr folders))
|
||||
(setq beg (point))
|
||||
(insert (format " %10d %s" len spool))
|
||||
(setq end (point))
|
||||
(insert "\n")
|
||||
;;(put-text-property beg end 'mouse-face 'highlight)
|
||||
)
|
||||
(if any
|
||||
(delete-char -1)) ;delete last RET
|
||||
(goto-char (point-min))
|
||||
))
|
||||
(with-current-buffer mspools-buffer
|
||||
(pcase-dolist (`(,spool . ,len) folders)
|
||||
;; (setq beg (point))
|
||||
(insert (format " %10d %s" len spool))
|
||||
;; (setq end (point))
|
||||
(insert "\n")
|
||||
;;(put-text-property beg end 'mouse-face 'highlight)
|
||||
)
|
||||
(if (not (bolp))
|
||||
(delete-char -1)) ;delete last RET
|
||||
(goto-char (point-min)))))
|
||||
|
||||
(defun mspools-size-folder (spool)
|
||||
"Return (SPOOL . SIZE ), if SIZE of spool file is non-zero."
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue