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

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

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

revision 1.18 by ttn, Wed May 18 11:01:20 2005 UTC revision 1.19 by wohler, Sat May 28 22:04:54 2005 UTC
# Line 1  Line 1 
1  ;;; mh-e.el --- GNU Emacs interface to the MH mail system  ;;; mh-e.el --- GNU Emacs interface to the MH mail system
2    
3  ;; Copyright (C) 1985, 86, 87, 88, 90, 92, 93, 94, 95, 97, 1999,  ;; Copyright (C) 1985, 1986, 1987, 1988,
4  ;;  2000, 2005 Free Software Foundation, Inc.  ;;  1990, 1992, 1993, 1994, 1995, 1997, 1999,
5    ;;  2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
6    
7  ;; Author: Bill Wohler <wohler@newt.com>  ;; Author: Bill Wohler <wohler@newt.com>
8  ;; Maintainer: Bill Wohler <wohler@newt.com>  ;; Maintainer: Bill Wohler <wohler@newt.com>
9  ;; Version: 7.82  ;; Version: 7.84
10  ;; Keywords: mail  ;; Keywords: mail
11    
12  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 97  Line 98 
98  (defvar font-lock-auto-fontify)  (defvar font-lock-auto-fontify)
99  (defvar font-lock-defaults)  (defvar font-lock-defaults)
100    
101  (defconst mh-version "7.82" "Version number of MH-E.")  (defconst mh-version "7.84" "Version number of MH-E.")
   
 ;;; Autoloads  
 (autoload 'Info-goto-node "info")  
102    
103  (defvar mh-partial-folder-mode-line-annotation "select"  (defvar mh-partial-folder-mode-line-annotation "select"
104    "Annotation when displaying part of a folder.    "Annotation when displaying part of a folder.
# Line 578  Do not call this function from outside M Line 576  Do not call this function from outside M
576        (setq folder mh-inbox))        (setq folder mh-inbox))
577    (let ((threading-needed-flag nil))    (let ((threading-needed-flag nil))
578      (let ((config (current-window-configuration)))      (let ((config (current-window-configuration)))
579        (delete-other-windows)        (when (and mh-show-buffer (get-buffer mh-show-buffer))
580            (delete-windows-on mh-show-buffer))
581        (cond ((not (get-buffer folder))        (cond ((not (get-buffer folder))
582               (mh-make-folder folder)               (mh-make-folder folder)
583               (setq threading-needed-flag mh-show-threads-flag)               (setq threading-needed-flag mh-show-threads-flag)
# Line 717  updated." Line 716  updated."
716      (mh-refile-a-msg nil folder))      (mh-refile-a-msg nil folder))
717    (when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg)))    (when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg)))
718    
719  (defun mh-refile-or-write-again (message)  (defun mh-refile-or-write-again (range &optional interactive-flag)
720    "Re-execute the last refile or write command on the given MESSAGE.    "Re-execute the last refile or write command on the given RANGE.
721  Default is the displayed message. Use the same folder or file as the previous  Default is the displayed message. Use the same folder or file as the previous
722  refile or write command."  refile or write command.
723    (interactive (list (mh-get-msg-num t)))  If INTERACTIVE-FLAG is non-nil then the function was called interactively."
724      (interactive (list (mh-interactive-range "Redo") t))
725    (if (null mh-last-destination)    (if (null mh-last-destination)
726        (error "No previous refile or write"))        (error "No previous refile or write"))
727    (let (output)    (let (output)
728      (setq output      (setq output
729            (cond ((eq (car mh-last-destination) 'refile)            (cond ((eq (car mh-last-destination) 'refile)
730                   (mh-refile-a-msg message (cdr mh-last-destination))                   (mh-refile-msg range (cdr mh-last-destination))
731                   (format "Destination folder: %s" (cdr mh-last-destination)))                   (format "Destination folder: %s" (cdr mh-last-destination)))
732                  (t                  (t
733                   (apply 'mh-write-msg-to-file message (cdr mh-last-destination))                   (mh-iterate-on-range msg range
734                       (apply 'mh-write-msg-to-file msg (cdr mh-last-destination)))
735                     (mh-next-msg interactive-flag)
736                   (format "Destination: %s" (cdr mh-last-destination)))))                   (format "Destination: %s" (cdr mh-last-destination)))))
     (mh-next-msg (interactive-p))  
737      (message output)))      (message output)))
738    
739  (defun mh-quit ()  (defun mh-quit ()
# Line 1801  Return in the current buffer." Line 1802  Return in the current buffer."
1802          (message "inc %s..." folder))          (message "inc %s..." folder))
1803        (setq mh-next-direction 'forward)        (setq mh-next-direction 'forward)
1804        (goto-char (point-max))        (goto-char (point-max))
1805        (mh-remove-all-notation)        (mh-remove-cur-notation)
1806        (let ((start-of-inc (point)))        (let ((start-of-inc (point)))
1807          (if maildrop-name          (if maildrop-name
1808              ;; I think MH 5 used "-ms-file" instead of "-file",              ;; I think MH 5 used "-ms-file" instead of "-file",
# Line 1827  Return in the current buffer." Line 1828  Return in the current buffer."
1828                                           start-of-inc (point-max))))                                           start-of-inc (point-max))))
1829                          (delete-region start-of-inc (point-max))                          (delete-region start-of-inc (point-max))
1830                          (unwind-protect (mh-widen t)                          (unwind-protect (mh-widen t)
1831                            (mh-remove-all-notation)                            (mh-remove-cur-notation)
1832                            (goto-char (point-max))                            (goto-char (point-max))
1833                            (setq start-of-inc (point))                            (setq start-of-inc (point))
1834                            (insert saved-text)                            (insert saved-text)
# Line 1846  Return in the current buffer." Line 1847  Return in the current buffer."
1847                (t                (t
1848                 (setq new-mail-flag t)))                 (setq new-mail-flag t)))
1849          (keep-lines mh-scan-valid-regexp) ; Flush random scan lines          (keep-lines mh-scan-valid-regexp) ; Flush random scan lines
1850          (setq mh-seq-list (mh-read-folder-sequences folder t))          (let* ((sequences (mh-read-folder-sequences folder t))
1851                   (new-cur (assoc 'cur sequences))
1852                   (new-unseen (assoc mh-unseen-seq sequences)))
1853              (unless (assoc 'cur mh-seq-list)
1854                (push (list 'cur) mh-seq-list))
1855              (unless (assoc mh-unseen-seq mh-seq-list)
1856                (push (list mh-unseen-seq) mh-seq-list))
1857              (setcdr (assoc 'cur mh-seq-list) (cdr new-cur))
1858              (setcdr (assoc mh-unseen-seq mh-seq-list) (cdr new-unseen)))
1859          (when (equal (point-max) start-of-inc)          (when (equal (point-max) start-of-inc)
1860            (mh-notate-cur))            (mh-notate-cur))
1861          (if new-mail-flag          (if new-mail-flag
# Line 1858  Return in the current buffer." Line 1867  Return in the current buffer."
1867                  (mh-thread-inc folder start-of-inc))                  (mh-thread-inc folder start-of-inc))
1868                (mh-goto-cur-msg))                (mh-goto-cur-msg))
1869            (goto-char point-before-inc))            (goto-char point-before-inc))
1870          (mh-notate-user-sequences)          (mh-notate-user-sequences (cons start-of-inc (point-max)))))))
         (mh-notate-deleted-and-refiled)))))  
1871    
1872  (defun mh-make-folder-mode-line (&optional ignored)  (defun mh-make-folder-mode-line (&optional ignored)
1873    "Set the fields of the mode line for a folder buffer.    "Set the fields of the mode line for a folder buffer.
# Line 2033  with no arguments, before the commands a Line 2041  with no arguments, before the commands a
2041                              (mh-coalesce-msg-list msgs))                              (mh-coalesce-msg-list msgs))
2042                       (mh-delete-scan-msgs msgs)                       (mh-delete-scan-msgs msgs)
2043                       ;; Preserve sequences in destination folder...                       ;; Preserve sequences in destination folder...
2044                       (when (and mh-refile-preserves-sequences-flag                       (when mh-refile-preserves-sequences-flag
                                 (numberp last))  
2045                         (clrhash dest-map)                         (clrhash dest-map)
2046                         (loop for i from (1+ last)                         (loop for i from (1+ (or last 0))
2047                               for msg in (sort (copy-sequence msgs) #'<)                               for msg in (sort (copy-sequence msgs) #'<)
2048                               do (loop for seq-name in (gethash msg seq-map)                               do (loop for seq-name in (gethash msg seq-map)
2049                                        do (push i (gethash seq-name dest-map))))                                        do (push i (gethash seq-name dest-map))))
2050                         (maphash                         (maphash
2051                          #'(lambda (seq msgs)                          #'(lambda (seq msgs)
2052                              ;; Run it in the background, since we don't care                              ;; Can't be run in the background, since the
2053                              ;; about the results.                              ;; current folder is changed by mark this could
2054                              (apply #'mh-exec-cmd-daemon "mark" #'ignore                              ;; lead to a race condition with the next refile.
2055                                (apply #'mh-exec-cmd "mark"
2056                                     "-sequence" (symbol-name seq) dest-folder                                     "-sequence" (symbol-name seq) dest-folder
2057                                     "-add" (mapcar #'(lambda (x) (format "%s" x))                                     "-add" (mapcar #'(lambda (x) (format "%s" x))
2058                                                    (mh-coalesce-msg-list msgs))))                                                    (mh-coalesce-msg-list msgs))))
# Line 2201  Expands ranges into set of individual nu Line 2209  Expands ranges into set of individual nu
2209          (end-of-line (save-excursion (end-of-line) (point)))          (end-of-line (save-excursion (end-of-line) (point)))
2210          num)          num)
2211      (while (re-search-forward "[0-9]+" end-of-line t)      (while (re-search-forward "[0-9]+" end-of-line t)
2212        (setq num (string-to-int (buffer-substring (match-beginning 0)        (setq num (string-to-number (buffer-substring (match-beginning 0)
2213                                                   (match-end 0))))                                                      (match-end 0))))
2214        (cond ((looking-at "-")           ; Message range        (cond ((looking-at "-")           ; Message range
2215               (forward-char 1)               (forward-char 1)
2216               (re-search-forward "[0-9]+" end-of-line t)               (re-search-forward "[0-9]+" end-of-line t)
2217               (let ((num2 (string-to-int (buffer-substring (match-beginning 0)               (let ((num2 (string-to-number
2218                                                            (match-end 0)))))                            (buffer-substring (match-beginning 0)
2219                                                (match-end 0)))))
2220                 (if (< num2 num)                 (if (< num2 num)
2221                     (error "Bad message range: %d-%d" num num2))                     (error "Bad message range: %d-%d" num num2))
2222                 (while (<= num num2)                 (while (<= num num2)

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.19

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