home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / emacs-19.28-src.tgz / tar.out / fsf / emacs / lisp / mh-seq.el < prev    next >
Lisp/Scheme  |  1996-09-28  |  7KB  |  223 lines
  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.  
  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.  
  223.