/[emacs]/emacs/lisp/mh-e/mh-funcs.el
ViewVC logotype

Diff of /emacs/lisp/mh-e/mh-funcs.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by lektu, Tue Feb 4 13:15:32 2003 UTC revision 1.4 by wohler, Fri Apr 25 05:52:00 2003 UTC
# Line 1  Line 1 
1  ;;; mh-funcs.el --- MH-E functions not everyone will use right away  ;;; mh-funcs.el --- MH-E functions not everyone will use right away
2    
3  ;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.  ;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc.
4    
5  ;; Author: Bill Wohler <wohler@newt.com>  ;; Author: Bill Wohler <wohler@newt.com>
6  ;; Maintainer: Bill Wohler <wohler@newt.com>  ;; Maintainer: Bill Wohler <wohler@newt.com>
# Line 32  Line 32 
32    
33  ;;; Change Log:  ;;; Change Log:
34    
 ;; $Id$  
   
35  ;;; Code:  ;;; Code:
36    
37  (require 'mh-e)  (require 'mh-e)
# Line 76  digest are inserted into the folder afte Line 74  digest are inserted into the folder afte
74  ;;;###mh-autoload  ;;;###mh-autoload
75  (defun mh-copy-msg (msg-or-seq folder)  (defun mh-copy-msg (msg-or-seq folder)
76    "Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.    "Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
77  Default is the displayed message. If optional prefix argument is provided,  Default is the displayed message.
78  then prompt for the message sequence."  If optional prefix argument is provided, then prompt for the message sequence.
79    (interactive (list (cond  If variable `transient-mark-mode' is non-nil and the mark is active, then the
80                        ((mh-mark-active-p t)  selected region is copied.
81                         (cons (region-beginning) (region-end)))  In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
82                        (current-prefix-arg  region in a cons cell, or a sequence."
83                         (mh-read-seq-default "Copy" t))    (interactive (list (mh-interactive-msg-or-seq "Copy")
                       (t  
                        (cons (line-beginning-position) (line-end-position))))  
84                       (mh-prompt-for-folder "Copy to" "" t)))                       (mh-prompt-for-folder "Copy to" "" t)))
85    (let ((msg-list (cond ((numberp msg-or-seq) (list msg-or-seq))    (let ((msg-list (let ((result ()))
86                          ((symbolp msg-or-seq) (mh-seq-to-msgs msg-or-seq))                      (mh-iterate-on-msg-or-seq msg msg-or-seq
87                          ((and (consp msg-or-seq) (numberp (car msg-or-seq))                        (mh-notate nil mh-note-copied mh-cmd-note)
88                                (numberp (cdr msg-or-seq)))                        (push msg result))
89                           (let ((result ()))                      result)))
                            (mh-iterate-on-messages-in-region msg  
                                (car msg-or-seq) (cdr msg-or-seq)  
                              (mh-notate nil mh-note-copied mh-cmd-note)  
                              (push msg result))  
                            result))  
                         (t msg-or-seq))))  
90      (mh-exec-cmd "refile" (mh-coalesce-msg-list msg-list)      (mh-exec-cmd "refile" (mh-coalesce-msg-list msg-list)
91                   "-link" "-src" mh-current-folder folder)                   "-link" "-src" mh-current-folder folder)))
     (cond ((numberp msg-or-seq)  
            (mh-notate msg-or-seq mh-note-copied mh-cmd-note))  
           ((symbolp msg-or-seq)  
            (mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note)))))  
92    
93  ;;;###mh-autoload  ;;;###mh-autoload
94  (defun mh-kill-folder ()  (defun mh-kill-folder ()
# Line 111  Removes all of the messages (files) with Line 97  Removes all of the messages (files) with
97  and then removes the folder (directory) itself."  and then removes the folder (directory) itself."
98    (interactive)    (interactive)
99    (if (or mh-index-data    (if (or mh-index-data
100            (yes-or-no-p (format "Remove folder %s (and all included messages)?"            (yes-or-no-p (format "Remove folder %s (and all included messages)? "
101                                 mh-current-folder)))                                 mh-current-folder)))
102        (let ((folder mh-current-folder)        (let ((folder mh-current-folder)
103              (window-config mh-previous-window-config))              (window-config mh-previous-window-config))
# Line 246  Otherwise just send the message's body w Line 232  Otherwise just send the message's body w
232    
233  ;;;###mh-autoload  ;;;###mh-autoload
234  (defun mh-print-msg (msg-or-seq)  (defun mh-print-msg (msg-or-seq)
235    "Print MSG-OR-SEQ (default: displayed message) on printer.    "Print MSG-OR-SEQ on printer.
236  If optional prefix argument provided, then prompt for the message sequence.  Default is the displayed message.
237    If optional prefix argument is provided, then prompt for the message sequence.
238    If variable `transient-mark-mode' is non-nil and the mark is active, then the
239    selected region is printed.
240    In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
241    region in a cons cell, or a sequence.
242    
243  The variable `mh-lpr-command-format' is used to generate the print command.  The variable `mh-lpr-command-format' is used to generate the print command.
244  The messages are formatted by mhl. See the variable `mhl-formfile'."  The messages are formatted by mhl. See the variable `mhl-formfile'."
245    (interactive (list (if current-prefix-arg    (interactive (list (mh-interactive-msg-or-seq "Print")))
246                           (reverse (mh-seq-to-msgs    (message "Printing...")
247                                     (mh-read-seq-default "Print" t)))    (let (msgs)
248                         (mh-get-msg-num t))))      ;; Gather message numbers and add them to "printed" sequence.
249    (if (numberp msg-or-seq)      (mh-iterate-on-msg-or-seq msg msg-or-seq
250        (message "Printing message...")        (mh-add-msgs-to-seq msg 'printed t)
251      (message "Printing sequence..."))        (mh-notate nil mh-note-printed mh-cmd-note)
252    (let ((print-command        (push msg msgs))
253           (if (numberp msg-or-seq)      (setq msgs (nreverse msgs))
254               (format "%s -nobell -clear %s %s | %s"      ;; Print scan listing if we have more than one message.
255                       (expand-file-name "mhl" mh-lib-progs)      (if (> (length msgs) 1)
256                       (mh-msg-filename msg-or-seq)          (let* ((msgs-string
257                       (if (stringp mhl-formfile)                  (mapconcat 'identity (mh-list-to-string
258                           (format "-form %s" mhl-formfile)                                        (mh-coalesce-msg-list msgs)) " "))
259                         "")                 (lpr-command
260                       (format mh-lpr-command-format                  (format mh-lpr-command-format
261                               (if (numberp msg-or-seq)                          (cond ((listp msg-or-seq)
262                                   (format "%s/%d" mh-current-folder                                 (format "Folder: %s, Messages: %s"
263                                           msg-or-seq)                                         mh-current-folder msgs-string))
264                                 (format "Sequence from %s" mh-current-folder))))                                ((symbolp msg-or-seq)
265             (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"                                 (format "Folder: %s, Sequence: %s"
266                     (mapconcat (function (lambda (msg) msg)) msg-or-seq " ")                                         mh-current-folder msg-or-seq)))))
267                     (expand-file-name "mhl" mh-lib-progs)                 (scan-command
268                     (if (stringp mhl-formfile)                  (format "scan %s | %s" msgs-string lpr-command)))
269                         (format "-form %s" mhl-formfile)            (if mh-print-background-flag
270                       "")                (mh-exec-cmd-daemon shell-file-name nil "-c" scan-command)
271                     (mh-msg-filenames msg-or-seq)              (call-process shell-file-name nil nil nil "-c" scan-command))))
272                     (format mh-lpr-command-format      ;; Print the messages
273                             (if (numberp msg-or-seq)      (dolist (msg msgs)
274                                 (format "%s/%d" mh-current-folder        (let* ((mhl-command (format "%s %s %s"
275                                         msg-or-seq)                                    (expand-file-name "mhl" mh-lib-progs)
276                               (format "Sequence from %s"                                    (if mhl-formfile
277                                       mh-current-folder)))))))                                        (format " -form %s" mhl-formfile)
278      (if mh-print-background-flag                                      "")
279          (mh-exec-cmd-daemon shell-file-name nil "-c" print-command)                                    (mh-msg-filename msg)))
280        (call-process shell-file-name nil nil nil "-c" print-command))               (lpr-command
281      (if (numberp msg-or-seq)                (format mh-lpr-command-format
282          (mh-notate msg-or-seq mh-note-printed mh-cmd-note)                        (format "%s/%s" mh-current-folder msg)))
283        (mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note))               (print-command
284      (mh-add-msgs-to-seq msg-or-seq 'printed t)                (format "%s | %s" mhl-command lpr-command)))
285      (if (numberp msg-or-seq)          (if mh-print-background-flag
286          (message "Printing message...done")              (mh-exec-cmd-daemon shell-file-name nil "-c" print-command)
287        (message "Printing sequence...done"))))            (call-process shell-file-name nil nil nil "-c" print-command)))))
288      (message "Printing...done"))
 (defun mh-msg-filenames (msgs &optional folder)  
   "Return a list of file names for MSGS in FOLDER (default current folder)."  
   (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " "))  
289    
290  ;;;###mh-autoload  ;;;###mh-autoload
291  (defun mh-sort-folder (&optional extra-args)  (defun mh-sort-folder (&optional extra-args)
# Line 314  argument EXTRA-ARGS is given." Line 303  argument EXTRA-ARGS is given."
303      (when mh-index-data      (when mh-index-data
304        (mh-index-update-maps mh-current-folder))        (mh-index-update-maps mh-current-folder))
305      (message "Sorting folder...done")      (message "Sorting folder...done")
     (mh-reset-threads-and-narrowing)  
306      (mh-scan-folder mh-current-folder "all")      (mh-scan-folder mh-current-folder "all")
307      (cond (threaded-flag (mh-toggle-threads))      (cond (threaded-flag (mh-toggle-threads))
308            (mh-index-data (mh-index-insert-folder-headers)))))            (mh-index-data (mh-index-insert-folder-headers)))))
# Line 334  Argument IGNORE is deprecated." Line 322  Argument IGNORE is deprecated."
322             (mh-unmark-all-headers t)))             (mh-unmark-all-headers t)))
323          (t          (t
324           (message "Commands not undone.")           (message "Commands not undone.")
325           (sit-for 2))))           ;; Remove by 2003-06-30 if nothing seems amiss. XXX
326             ;; (sit-for 2)
327             )))
328    
329  ;;;###mh-autoload  ;;;###mh-autoload
330  (defun mh-store-msg (directory)  (defun mh-store-msg (directory)
# Line 378  Default directory is the last directory Line 368  Default directory is the last directory
368                            (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$")                            (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$")
369                                nil       ;most likely end of a uuencode                                nil       ;most likely end of a uuencode
370                              (point))))))                              (point))))))
         (log-buffer (get-buffer-create "*Store Output*"))  
371          (command "sh")          (command "sh")
372          (uudecode-filename "(unknown filename)"))          (uudecode-filename "(unknown filename)")
373            log-begin)
374      (if (not sh-start)      (if (not sh-start)
375          (save-excursion          (save-excursion
376            (goto-char (point-min))            (goto-char (point-min))
# Line 389  Default directory is the last directory Line 379  Default directory is the last directory
379                      (buffer-substring (point)                      (buffer-substring (point)
380                                        (progn (end-of-line) (point)))))))                                        (progn (end-of-line) (point)))))))
381      (save-excursion      (save-excursion
382        (set-buffer log-buffer)        (set-buffer (get-buffer-create mh-log-buffer))
383        (erase-buffer)        (setq log-begin (mh-truncate-log-buffer))
384        (if (not (file-directory-p store-directory))        (if (not (file-directory-p store-directory))
385            (progn            (progn
386              (insert "mkdir " directory "\n")              (insert "mkdir " directory "\n")
387              (call-process "mkdir" nil log-buffer t store-directory)))              (call-process "mkdir" nil mh-log-buffer t store-directory)))
388        (insert "cd " directory "\n")        (insert "cd " directory "\n")
389        (setq mh-store-default-directory directory)        (setq mh-store-default-directory directory)
390        (if (not sh-start)        (if (not sh-start)
391            (progn            (progn
392              (setq command "uudecode")              (setq command "uudecode")
393              (insert uudecode-filename " being uudecoded...\n"))))              (insert uudecode-filename " being uudecoded...\n"))))
394      (set-window-start (display-buffer log-buffer) 0) ;watch progress      (set-window-start (display-buffer mh-log-buffer) log-begin) ;watch progress
395      (let (value)      (let ((default-directory (file-name-as-directory store-directory)))
396        (let ((default-directory (file-name-as-directory store-directory)))        (if (equal (call-process-region sh-start (point-max) command
397          (setq value (call-process-region sh-start (point-max) command                                        nil mh-log-buffer t)
398                                           nil log-buffer t)))                   0)
399        (set-buffer log-buffer)            (save-excursion
400        (mh-handle-process-error command value))              (set-buffer mh-log-buffer)
401      (insert "\n(mh-store finished)\n")))              (insert "\n(mh-store finished)\n"))
402            (error "Error occurred during execution of %s" command)))))
403    
404    
405    
406  ;;; Help Functions  ;;; Help Functions
407    
408    ;;;###mh-autoload
409  (defun mh-ephem-message (string)  (defun mh-ephem-message (string)
410    "Display STRING in the minibuffer momentarily."    "Display STRING in the minibuffer momentarily."
411    (message "%s" string)    (message "%s" string)

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26