code.delx.au - gnu-emacs/blob - lisp/mail/mh-seq.el

   1 ;;; mh-seq --- mh-e sequences support
   2 ;; Time-stamp: <93/12/02 09:36:09 gildea>
   3
   4 ;; Copyright 1993 Free Software Foundation, Inc.
   5
   6 ;; This file is part of mh-e.
   7
   8 ;; mh-e is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; mh-e is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with mh-e; see the file COPYING.  If not, write to
  20 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21
  22 ;;; Commentary:
  23
  24 ;; Internal support for mh-e package.
  25
  26 ;;; Code:
  27
  28 (provide 'mh-seq)
  29 (require 'mh-e)
  30
  31 (defvar mh-last-seq-used nil
  32   "Name of the sequence to which a message was last added.")
  33
  34
  35 (defun mh-delete-seq (seq)
  36   "Delete the SEQUENCE."
  37   (interactive (list (mh-read-seq-default "Delete" t)))
  38   (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq seq ?  (1+ mh-cmd-note) seq)
  39   (mh-undefine-sequence seq "all")
  40   (mh-delete-seq-locally seq))
  41
  42
  43 (defun mh-list-sequences (folder)
  44   "List the sequences defined in FOLDER."
  45   (interactive (list (mh-prompt-for-folder "List sequences in"
  46                                            mh-current-folder t)))
  47   (let ((temp-buffer " *mh-temp*")
  48         (seq-list mh-seq-list))
  49     (with-output-to-temp-buffer temp-buffer
  50       (save-excursion
  51         (set-buffer temp-buffer)
  52         (erase-buffer)
  53         (message "Listing sequences ...")
  54         (insert "Sequences in folder " folder ":\n")
  55         (while seq-list
  56           (let ((name (mh-seq-name (car seq-list)))
  57                 (sorted-seq-msgs
  58                  (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<))
  59                 (last-col (- (window-width) 4))
  60                 name-spec)
  61             (insert (setq name-spec (format "%20s:" name)))
  62             (while sorted-seq-msgs
  63               (if (> (current-column) last-col)
  64                   (progn
  65                     (insert "\n")
  66                     (move-to-column (length name-spec))))
  67               (insert (format " %s" (car sorted-seq-msgs)))
  68               (setq sorted-seq-msgs (cdr sorted-seq-msgs)))
  69             (insert "\n"))
  70           (setq seq-list (cdr seq-list)))
  71         (goto-char (point-min))
  72         (message "Listing sequences...done")))))
  73
  74
  75 (defun mh-msg-is-in-seq (msg)
  76   "Display the sequences that contain MESSAGE (default: displayed message)."
  77   (interactive (list (mh-get-msg-num t)))
  78   (message "Message %d is in sequences: %s"
  79            msg
  80            (mapconcat 'concat
  81                       (mh-list-to-string (mh-seq-containing-msg msg))
  82                       " ")))
  83
  84
  85 (defun mh-narrow-to-seq (seq)
  86   "Restrict display of this folder to just messages in a sequence.
  87 Reads which sequence.\\<mh-folder-mode-map>  Use \\[mh-widen] to undo this command."
  88   (interactive (list (mh-read-seq "Narrow to" t)))
  89   (let ((eob (point-max)))
  90     (with-mh-folder-updating (t)
  91       (cond ((mh-seq-to-msgs seq)
  92              (mh-copy-seq-to-point seq eob)
  93              (narrow-to-region eob (point-max))
  94              (mh-make-folder-mode-line (symbol-name seq))
  95              (mh-recenter nil)
  96              (setq mh-narrowed-to-seq seq))
  97             (t
  98              (error "No messages in sequence `%s'" (symbol-name seq)))))))
  99
 100
 101 (defun mh-put-msg-in-seq (msg-or-seq to)
 102   "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
 103 If optional prefix argument provided, then prompt for the message sequence."
 104   (interactive (list (if current-prefix-arg
 105                          (mh-read-seq-default "Add messages from" t)
 106                          (mh-get-msg-num t))
 107                      (mh-read-seq-default "Add to" nil)))
 108   (setq mh-last-seq-used to)
 109   (mh-add-msgs-to-seq (if (numberp msg-or-seq)
 110                           msg-or-seq
 111                           (mh-seq-to-msgs msg-or-seq))
 112                       to))
 113
 114
 115 (defun mh-widen ()
 116   "Remove restrictions from current folder, thereby showing all messages."
 117   (interactive)
 118   (if mh-narrowed-to-seq
 119       (with-mh-folder-updating (t)
 120         (delete-region (point-min) (point-max))
 121         (widen)
 122         (mh-make-folder-mode-line)))
 123   (setq mh-narrowed-to-seq nil))
 124
 125 \f
 126
 127 ;;; Commands to manipulate sequences.  Sequences are stored in an alist
 128 ;;; of the form:
 129 ;;;     ((seq-name msgs ...) (seq-name msgs ...) ...)
 130
 131
 132 (defun mh-read-seq-default (prompt not-empty)
 133   ;; Read and return sequence name with default narrowed or previous sequence.
 134   (mh-read-seq prompt not-empty (or mh-narrowed-to-seq mh-last-seq-used)))
 135
 136
 137 (defun mh-read-seq (prompt not-empty &optional default)
 138   ;; Read and return a sequence name.  Prompt with PROMPT, raise an error
 139   ;; if the sequence is empty and the NOT-EMPTY flag is non-nil, and supply
 140   ;; an optional DEFAULT sequence.
 141   ;; A reply of '%' defaults to the first sequence containing the current
 142   ;; message.
 143   (let* ((input (completing-read (format "%s %s %s" prompt "sequence:"
 144                                          (if default
 145                                              (format "[%s] " default)
 146                                              ""))
 147                                  (mh-seq-names mh-seq-list)))
 148          (seq (cond ((equal input "%") (mh-msg-to-seq (mh-get-msg-num t)))
 149                     ((equal input "") default)
 150                     (t (intern input))))
 151          (msgs (mh-seq-to-msgs seq)))
 152     (if (and (null msgs) not-empty)
 153         (error (format "No messages in sequence `%s'" seq)))
 154     seq))
 155
 156
 157 (defun mh-msg-to-seq (msg)
 158   ;; Given a MESSAGE number, return the first sequence in which it occurs.
 159   (car (mh-seq-containing-msg msg)))
 160
 161
 162 (defun mh-seq-names (seq-list)
 163   ;; Return an alist containing the names of the SEQUENCES.
 164   (mapcar (function (lambda (entry) (list (symbol-name (mh-seq-name entry)))))
 165           seq-list))
 166
 167
 168 (defun mh-rename-seq (seq new-name)
 169   "Rename a SEQUENCE to have a new NAME."
 170   (interactive (list (mh-read-seq "Old" t)
 171                      (intern (read-string "New sequence name: "))))
 172   (let ((old-seq (mh-find-seq seq)))
 173     (or old-seq
 174         (error "Sequence %s does not exist" seq))
 175     ;; create new seq first, since it might raise an error.
 176     (mh-define-sequence new-name (mh-seq-msgs old-seq))
 177     (mh-undefine-sequence seq (mh-seq-msgs old-seq))
 178     (rplaca old-seq new-name)))
 179
 180
 181 (defun mh-map-to-seq-msgs (func seq &rest args)
 182   ;; Invoke the FUNCTION at each message in the SEQUENCE, passing the
 183   ;; remaining ARGS as arguments.
 184   (save-excursion
 185     (let ((msgs (mh-seq-to-msgs seq)))
 186       (while msgs
 187         (if (mh-goto-msg (car msgs) t t)
 188             (apply func (car msgs) args))
 189         (setq msgs (cdr msgs))))))
 190
 191
 192 (defun mh-notate-seq (seq notation offset)
 193   ;; Mark the scan listing of all messages in the SEQUENCE with the CHARACTER
 194   ;; at the given OFFSET from the beginning of the listing line.
 195   (mh-map-to-seq-msgs 'mh-notate seq notation offset))
 196
 197
 198 (defun mh-add-to-sequence (seq msgs)
 199   ;; Add to a SEQUENCE each message the list of MSGS.
 200   (if (not (mh-folder-name-p seq))
 201       (if msgs
 202           (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
 203                  "-sequence" (symbol-name seq)
 204                  msgs))))
 205
 206
 207 (defun mh-copy-seq-to-point (seq location)
 208   ;; Copy the scan listing of the messages in SEQUENCE to after the point
 209   ;; LOCATION in the current buffer.
 210   (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
 211
 212
 213 (defun mh-copy-line-to-point (msg location)
 214   ;; Copy the current line to the LOCATION in the current buffer.
 215   (beginning-of-line)
 216   (let ((beginning-of-line (point)))
 217     (forward-line 1)
 218     (copy-region-as-kill beginning-of-line (point))
 219     (goto-char location)
 220     (yank)
 221     (goto-char beginning-of-line)))
 222