lisp/mail/mh-seq.el

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