1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-12 09:28:24 +00:00
emacs/lisp/mail/mh-seq.el

239 lines
7.7 KiB
EmacsLisp
Raw Normal View History

;;; mh-seq.el --- mh-e sequences support
;; Time-stamp: <2001-07-14 13:10:33 pavel>
1994-03-15 06:16:30 +00:00
1995-04-09 22:31:08 +00:00
;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
1994-03-15 06:16:30 +00:00
;; This file is part of GNU Emacs.
1994-03-15 06:16:30 +00:00
1995-04-10 00:20:07 +00:00
;; GNU Emacs is free software; you can redistribute it and/or modify
1994-03-15 06:16:30 +00:00
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
1995-04-10 00:20:07 +00:00
;; GNU Emacs is distributed in the hope that it will be useful,
1994-03-15 06:16:30 +00:00
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
1996-01-14 07:34:30 +00:00
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
1994-03-15 06:16:30 +00:00
;;; Commentary:
;; Internal support for mh-e package.
1995-04-09 22:31:08 +00:00
;;; Change Log:
;; $Id: mh-seq.el,v 1.6 1996/01/29 23:16:57 kwzh Exp $
1995-04-09 22:31:08 +00:00
1994-03-15 06:16:30 +00:00
;;; Code:
(provide 'mh-seq)
(require 'mh-e)
1995-04-09 22:31:08 +00:00
;;; Internal variables:
(defvar mh-last-seq-used nil) ;Name of seq to which a msg was last added.
(defvar mh-non-seq-mode-line-annotation nil) ;Saved value of mh-mode-line-annotation when narrowed to a seq.
1994-03-15 06:16:30 +00:00
1995-04-09 22:31:08 +00:00
(defun mh-delete-seq (sequence)
1994-03-15 06:16:30 +00:00
"Delete the SEQUENCE."
(interactive (list (mh-read-seq-default "Delete" t)))
1995-04-09 22:31:08 +00:00
(mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note)
sequence)
(mh-undefine-sequence sequence '("all"))
(mh-delete-seq-locally sequence))
1994-03-15 06:16:30 +00:00
(defun mh-list-sequences (folder)
"List the sequences defined in FOLDER."
(interactive (list (mh-prompt-for-folder "List sequences in"
mh-current-folder t)))
1995-04-09 22:31:08 +00:00
(let ((temp-buffer mh-temp-buffer)
1994-03-15 06:16:30 +00:00
(seq-list mh-seq-list))
(with-output-to-temp-buffer temp-buffer
(save-excursion
(set-buffer temp-buffer)
(erase-buffer)
(message "Listing sequences ...")
(insert "Sequences in folder " folder ":\n")
(while seq-list
(let ((name (mh-seq-name (car seq-list)))
(sorted-seq-msgs
(sort (copy-sequence (mh-seq-msgs (car seq-list))) '<))
(last-col (- (window-width) 4))
name-spec)
(insert (setq name-spec (format "%20s:" name)))
(while sorted-seq-msgs
(if (> (current-column) last-col)
(progn
(insert "\n")
(move-to-column (length name-spec))))
(insert (format " %s" (car sorted-seq-msgs)))
(setq sorted-seq-msgs (cdr sorted-seq-msgs)))
(insert "\n"))
(setq seq-list (cdr seq-list)))
(goto-char (point-min))
(message "Listing sequences...done")))))
1995-04-09 22:31:08 +00:00
(defun mh-msg-is-in-seq (message)
"Display the sequences that contain MESSAGE (default: current message)."
1994-03-15 06:16:30 +00:00
(interactive (list (mh-get-msg-num t)))
(message "Message %d is in sequences: %s"
1995-04-09 22:31:08 +00:00
message
1994-03-15 06:16:30 +00:00
(mapconcat 'concat
1995-04-09 22:31:08 +00:00
(mh-list-to-string (mh-seq-containing-msg message t))
1994-03-15 06:16:30 +00:00
" ")))
1995-04-09 22:31:08 +00:00
(defun mh-narrow-to-seq (sequence)
"Restrict display of this folder to just messages in SEQUENCE.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
1994-03-15 06:16:30 +00:00
(interactive (list (mh-read-seq "Narrow to" t)))
1995-04-09 22:31:08 +00:00
(with-mh-folder-updating (t)
(cond ((mh-seq-to-msgs sequence)
(mh-widen)
(let ((eob (point-max)))
(mh-copy-seq-to-point sequence eob)
1994-03-15 06:16:30 +00:00
(narrow-to-region eob (point-max))
1995-04-09 22:31:08 +00:00
(make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
(setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
(setq mh-mode-line-annotation (symbol-name sequence))
(mh-make-folder-mode-line)
1994-03-15 06:16:30 +00:00
(mh-recenter nil)
1995-04-09 22:31:08 +00:00
(setq mh-narrowed-to-seq sequence)))
(t
(error "No messages in sequence `%s'" (symbol-name sequence))))))
1994-03-15 06:16:30 +00:00
1995-04-09 22:31:08 +00:00
(defun mh-put-msg-in-seq (msg-or-seq sequence)
1994-03-15 06:16:30 +00:00
"Add MESSAGE(s) (default: displayed message) to SEQUENCE.
If optional prefix argument provided, then prompt for the message sequence."
(interactive (list (if current-prefix-arg
(mh-read-seq-default "Add messages from" t)
(mh-get-msg-num t))
(mh-read-seq-default "Add to" nil)))
1995-04-09 22:31:08 +00:00
(if (not (mh-internal-seq sequence))
(setq mh-last-seq-used sequence))
1994-03-15 06:16:30 +00:00
(mh-add-msgs-to-seq (if (numberp msg-or-seq)
msg-or-seq
(mh-seq-to-msgs msg-or-seq))
1995-04-09 22:31:08 +00:00
sequence))
1994-03-15 06:16:30 +00:00
(defun mh-widen ()
"Remove restrictions from current folder, thereby showing all messages."
(interactive)
(if mh-narrowed-to-seq
(with-mh-folder-updating (t)
(delete-region (point-min) (point-max))
(widen)
1995-04-09 22:31:08 +00:00
(setq mh-mode-line-annotation mh-non-seq-mode-line-annotation)
1994-03-15 06:16:30 +00:00
(mh-make-folder-mode-line)))
(setq mh-narrowed-to-seq nil))
;;; Commands to manipulate sequences. Sequences are stored in an alist
;;; of the form:
;;; ((seq-name msgs ...) (seq-name msgs ...) ...)
(defun mh-read-seq-default (prompt not-empty)
;; Read and return sequence name with default narrowed or previous sequence.
1995-04-09 22:31:08 +00:00
(mh-read-seq prompt not-empty
(or mh-narrowed-to-seq
mh-last-seq-used
(car (mh-seq-containing-msg (mh-get-msg-num nil) nil)))))
1994-03-15 06:16:30 +00:00
(defun mh-read-seq (prompt not-empty &optional default)
;; Read and return a sequence name. Prompt with PROMPT, raise an error
;; if the sequence is empty and the NOT-EMPTY flag is non-nil, and supply
;; an optional DEFAULT sequence.
;; A reply of '%' defaults to the first sequence containing the current
;; message.
(let* ((input (completing-read (format "%s %s %s" prompt "sequence:"
(if default
(format "[%s] " default)
""))
(mh-seq-names mh-seq-list)))
1995-04-09 22:31:08 +00:00
(seq (cond ((equal input "%")
(car (mh-seq-containing-msg (mh-get-msg-num t) nil)))
1994-03-15 06:16:30 +00:00
((equal input "") default)
(t (intern input))))
(msgs (mh-seq-to-msgs seq)))
(if (and (null msgs) not-empty)
(error "No messages in sequence `%s'" seq))
1994-03-15 06:16:30 +00:00
seq))
(defun mh-seq-names (seq-list)
;; Return an alist containing the names of the SEQUENCES.
(mapcar (function (lambda (entry) (list (symbol-name (mh-seq-name entry)))))
seq-list))
1995-04-09 22:31:08 +00:00
(defun mh-rename-seq (sequence new-name)
"Rename SEQUENCE to have NEW-NAME."
1994-03-15 06:16:30 +00:00
(interactive (list (mh-read-seq "Old" t)
(intern (read-string "New sequence name: "))))
1995-04-09 22:31:08 +00:00
(let ((old-seq (mh-find-seq sequence)))
1994-03-15 06:16:30 +00:00
(or old-seq
1995-04-09 22:31:08 +00:00
(error "Sequence %s does not exist" sequence))
;; create new sequence first, since it might raise an error.
1994-03-15 06:16:30 +00:00
(mh-define-sequence new-name (mh-seq-msgs old-seq))
1995-04-09 22:31:08 +00:00
(mh-undefine-sequence sequence (mh-seq-msgs old-seq))
1994-03-15 06:16:30 +00:00
(rplaca old-seq new-name)))
(defun mh-map-to-seq-msgs (func seq &rest args)
;; Invoke the FUNCTION at each message in the SEQUENCE, passing the
;; remaining ARGS as arguments.
(save-excursion
(let ((msgs (mh-seq-to-msgs seq)))
(while msgs
(if (mh-goto-msg (car msgs) t t)
(apply func (car msgs) args))
(setq msgs (cdr msgs))))))
(defun mh-notate-seq (seq notation offset)
;; Mark the scan listing of all messages in the SEQUENCE with the CHARACTER
;; at the given OFFSET from the beginning of the listing line.
(mh-map-to-seq-msgs 'mh-notate seq notation offset))
(defun mh-add-to-sequence (seq msgs)
;; Add to a SEQUENCE each message the list of MSGS.
(if (not (mh-folder-name-p seq))
(if msgs
(apply 'mh-exec-cmd "mark" mh-current-folder "-add"
"-sequence" (symbol-name seq)
1995-04-09 22:31:08 +00:00
(mh-coalesce-msg-list msgs)))))
1994-03-15 06:16:30 +00:00
(defun mh-copy-seq-to-point (seq location)
;; Copy the scan listing of the messages in SEQUENCE to after the point
;; LOCATION in the current buffer.
(mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
(defun mh-copy-line-to-point (msg location)
;; Copy the current line to the LOCATION in the current buffer.
(beginning-of-line)
1995-04-09 22:31:08 +00:00
(save-excursion
(let ((beginning-of-line (point))
end)
(forward-line 1)
(setq end (point))
(goto-char location)
(insert-buffer-substring (current-buffer) beginning-of-line end))))
1994-03-15 06:16:30 +00:00
;;; mh-seq.el ends here