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

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

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

revision 1.2 by wohler, Mon Feb 3 20:55:30 2003 UTC revision 1.3 by wohler, Fri Apr 25 05:52:00 2003 UTC
# Line 1  Line 1 
1  ;;; mh-seq.el --- MH-E sequences support  ;;; mh-seq.el --- MH-E sequences support
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 68  Line 68 
68    
69  ;;; Change Log:  ;;; Change Log:
70    
 ;; $Id$  
   
71  ;;; Code:  ;;; Code:
72    
73  (require 'cl)  (require 'cl)
# Line 146  redone to get the new thread tree. This Line 144  redone to get the new thread tree. This
144      (mh-undefine-sequence sequence '("all"))      (mh-undefine-sequence sequence '("all"))
145      (mh-delete-seq-locally sequence)      (mh-delete-seq-locally sequence)
146      (mh-iterate-on-messages-in-region msg (point-min) (point-max)      (mh-iterate-on-messages-in-region msg (point-min) (point-max)
147        (when (and (member msg msg-list) (not (mh-seq-containing-msg msg nil)))        (cond ((and mh-tick-seq (eq sequence mh-tick-seq))
148          (mh-notate nil ?  (1+ mh-cmd-note))))))               (mh-notate-tick msg ()))
149                ((and (member msg msg-list) (not (mh-seq-containing-msg msg nil)))
150                 (mh-notate nil ?  (1+ mh-cmd-note)))))))
151    
152  ;; Avoid compiler warnings  ;; Avoid compiler warnings
153  (defvar view-exit-action)  (defvar view-exit-action)
# Line 195  redone to get the new thread tree. This Line 195  redone to get the new thread tree. This
195    
196  ;;;###mh-autoload  ;;;###mh-autoload
197  (defun mh-msg-is-in-seq (message)  (defun mh-msg-is-in-seq (message)
198    "Display the sequences that contain MESSAGE (default: current message)."    "Display the sequences that contain MESSAGE.
199    Default is the displayed message."
200    (interactive (list (mh-get-msg-num t)))    (interactive (list (mh-get-msg-num t)))
201    (let* ((dest-folder (loop for seq in mh-refile-list    (let* ((dest-folder (loop for seq in mh-refile-list
202                              when (member message (cdr seq)) return (car seq)))                              until (member message (cdr seq))
203                                finally return (car seq)))
204           (deleted-flag (unless dest-folder (member message mh-delete-list))))           (deleted-flag (unless dest-folder (member message mh-delete-list))))
205      (message "Message %d%s is in sequences: %s"      (message "Message %d%s is in sequences: %s"
206               message               message
# Line 209  redone to get the new thread tree. This Line 211  redone to get the new thread tree. This
211                          (mh-list-to-string (mh-seq-containing-msg message t))                          (mh-list-to-string (mh-seq-containing-msg message t))
212                          " "))))                          " "))))
213    
214    ;; Avoid compiler warning
215    (defvar tool-bar-map)
216    
217  ;;;###mh-autoload  ;;;###mh-autoload
218  (defun mh-narrow-to-seq (sequence)  (defun mh-narrow-to-seq (sequence)
219    "Restrict display of this folder to just messages in SEQUENCE.    "Restrict display of this folder to just messages in SEQUENCE.
# Line 224  Use \\<mh-folder-mode-map>\\[mh-widen] t Line 229  Use \\<mh-folder-mode-map>\\[mh-widen] t
229               (setq mh-thread-scan-line-map (make-hash-table :test #'eql))               (setq mh-thread-scan-line-map (make-hash-table :test #'eql))
230               (mh-copy-seq-to-eob sequence)               (mh-copy-seq-to-eob sequence)
231               (narrow-to-region eob (point-max))               (narrow-to-region eob (point-max))
232                 (setq mh-narrowed-to-seq sequence)
233               (mh-notate-user-sequences)               (mh-notate-user-sequences)
234               (mh-notate-deleted-and-refiled)               (mh-notate-deleted-and-refiled)
235               (mh-notate-cur)               (mh-notate-cur)
# Line 233  Use \\<mh-folder-mode-map>\\[mh-widen] t Line 239  Use \\<mh-folder-mode-map>\\[mh-widen] t
239               (setq mh-mode-line-annotation (symbol-name sequence))               (setq mh-mode-line-annotation (symbol-name sequence))
240               (mh-make-folder-mode-line)               (mh-make-folder-mode-line)
241               (mh-recenter nil)               (mh-recenter nil)
242               (if (and (boundp 'tool-bar-mode) tool-bar-mode)               (when (and (boundp 'tool-bar-mode) tool-bar-mode)
243                   (set (make-local-variable 'tool-bar-map)                 (set (make-local-variable 'tool-bar-map)
244                        mh-folder-seq-tool-bar-map))                      mh-folder-seq-tool-bar-map)
245               (setq mh-narrowed-to-seq sequence)                 (when (buffer-live-p (get-buffer mh-show-buffer))
246                     (save-excursion
247                       (set-buffer (get-buffer mh-show-buffer))
248                       (set (make-local-variable 'tool-bar-map)
249                            mh-show-seq-tool-bar-map))))
250               (push 'widen mh-view-ops)))               (push 'widen mh-view-ops)))
251            (t            (t
252             (error "No messages in sequence `%s'" (symbol-name sequence))))))             (error "No messages in sequence `%s'" (symbol-name sequence))))))
253    
254  ;;;###mh-autoload  ;;;###mh-autoload
255  (defun mh-put-msg-in-seq (msg-or-seq sequence)  (defun mh-put-msg-in-seq (msg-or-seq sequence)
256    "Add MSG-OR-SEQ (default: displayed message) to SEQUENCE.    "Add MSG-OR-SEQ to SEQUENCE.
257  If optional prefix argument provided, then prompt for the message sequence.  Default is the displayed message.
258  If variable `transient-mark-mode' is non-nil and the mark is active, then  If optional prefix argument is provided, then prompt for the message sequence.
259  the selected region is added to the sequence."  If variable `transient-mark-mode' is non-nil and the mark is active, then the
260    (interactive (list (cond  selected region is added to the sequence.
261                        ((mh-mark-active-p t)  In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
262                         (cons (region-beginning) (region-end)))  region in a cons cell, or a sequence."
263                        (current-prefix-arg    (interactive (list (mh-interactive-msg-or-seq "Add messages from")
                        (mh-read-seq-default "Add messages from" t))  
                       (t  
                        (cons (line-beginning-position) (line-end-position))))  
264                       (mh-read-seq-default "Add to" nil)))                       (mh-read-seq-default "Add to" nil)))
265    (let ((internal-seq-flag (mh-internal-seq sequence))    (when (and (interactive-p) mh-tick-seq (eq sequence mh-tick-seq))
266          msg-list)      (error "Use `mh-toggle-tick' to add messages to %s" mh-tick-seq))
267      (cond ((and (consp msg-or-seq)    (let* ((internal-seq-flag (mh-internal-seq sequence))
268                  (numberp (car msg-or-seq)) (numberp (cdr msg-or-seq)))           (note-seq (if internal-seq-flag nil mh-note-seq))
269             (mh-iterate-on-messages-in-region m (car msg-or-seq) (cdr msg-or-seq)           (msg-list ()))
270               (push m msg-list)      (mh-iterate-on-msg-or-seq m msg-or-seq
271               (unless internal-seq-flag        (push m msg-list)
272                 (mh-notate nil mh-note-seq (1+ mh-cmd-note))))        (mh-notate nil note-seq (1+ mh-cmd-note)))
273             (mh-add-msgs-to-seq msg-list sequence internal-seq-flag t))      (mh-add-msgs-to-seq msg-list sequence nil t)
           ((or (numberp msg-or-seq) (listp msg-or-seq))  
            (when (numberp msg-or-seq)  
              (setq msg-or-seq (list msg-or-seq)))  
            (mh-add-msgs-to-seq msg-or-seq sequence internal-seq-flag))  
           (t (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) sequence)))  
274      (if (not internal-seq-flag)      (if (not internal-seq-flag)
275          (setq mh-last-seq-used sequence))))          (setq mh-last-seq-used sequence))
276        (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
277          (mh-speed-flists t mh-current-folder))))
278    
279  (defun mh-valid-view-change-operation-p (op)  (defun mh-valid-view-change-operation-p (op)
280    "Check if the view change operation can be performed.    "Check if the view change operation can be performed.
# Line 300  OP is one of 'widen and 'unthread." Line 304  OP is one of 'widen and 'unthread."
304          (mh-make-folder-mode-line))          (mh-make-folder-mode-line))
305        (if msg        (if msg
306            (mh-goto-msg msg t t))            (mh-goto-msg msg t t))
307          (setq mh-narrowed-to-seq nil)
308          (setq mh-tick-seq-changed-when-narrowed-flag nil)
309        (mh-notate-deleted-and-refiled)        (mh-notate-deleted-and-refiled)
310        (mh-notate-user-sequences)        (mh-notate-user-sequences)
311        (mh-notate-cur)        (mh-notate-cur)
312        (mh-recenter nil)))        (mh-recenter nil)))
313    (if (and (boundp 'tool-bar-mode) tool-bar-mode)    (when (and (boundp 'tool-bar-mode) tool-bar-mode)
314        (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))      (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
315    (setq mh-narrowed-to-seq nil))      (when (buffer-live-p (get-buffer mh-show-buffer))
316          (save-excursion
317            (set-buffer (get-buffer mh-show-buffer))
318            (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)))))
319    
320  ;; FIXME?  We may want to clear all notations and add one for current-message  ;; FIXME?  We may want to clear all notations and add one for current-message
321  ;;         and process user sequences.  ;;         and process user sequences.
# Line 408  In addition to notating the current mess Line 417  In addition to notating the current mess
417  uses `overlay-arrow-position' to put a marker in the fringe."  uses `overlay-arrow-position' to put a marker in the fringe."
418    (let ((cur (car (mh-seq-to-msgs 'cur))))    (let ((cur (car (mh-seq-to-msgs 'cur))))
419      (when (and cur (mh-goto-msg cur t t))      (when (and cur (mh-goto-msg cur t t))
       (mh-notate nil mh-note-cur mh-cmd-note)  
420        (beginning-of-line)        (beginning-of-line)
421          (when (looking-at mh-scan-good-msg-regexp)
422            (mh-notate nil mh-note-cur mh-cmd-note))
423        (setq mh-arrow-marker (set-marker mh-arrow-marker (point)))        (setq mh-arrow-marker (set-marker mh-arrow-marker (point)))
424        (setq overlay-arrow-position mh-arrow-marker))))        (setq overlay-arrow-position mh-arrow-marker))))
425    
# Line 431  uses `overlay-arrow-position' to put a m Line 441  uses `overlay-arrow-position' to put a m
441  ;  ;; LOCATION in the current buffer.  ;  ;; LOCATION in the current buffer.
442  ;  (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))  ;  (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
443    
444    (defvar mh-thread-last-ancestor)
445    
446  (defun mh-copy-seq-to-eob (seq)  (defun mh-copy-seq-to-eob (seq)
447    "Copy SEQ to the end of the buffer."    "Copy SEQ to the end of the buffer."
448    ;; It is quite involved to write something which will work at any place in    ;; It is quite involved to write something which will work at any place in
# Line 455  uses `overlay-arrow-position' to put a m Line 467  uses `overlay-arrow-position' to put a m
467                   (forward-line))                   (forward-line))
468                 ;; Remove scan lines and read results from pre-computed tree                 ;; Remove scan lines and read results from pre-computed tree
469                 (delete-region (point-min) (point-max))                 (delete-region (point-min) (point-max))
470                 (let ((thread-tree (mh-thread-generate mh-current-folder ()))                 (mh-thread-print-scan-lines
471                       (mh-thread-body-width                  (mh-thread-generate mh-current-folder ())))
                       (- (window-width) mh-cmd-note  
                          (1- mh-scan-field-subject-start-offset)))  
                      (mh-thread-last-ancestor nil))  
                  (mh-thread-generate-scan-lines thread-tree -2)))  
472                (mh-index-data                (mh-index-data
473                 (mh-index-insert-folder-headers)))))))                 (mh-index-insert-folder-headers)))))))
474    
# Line 491  If VAR is nil then the loop is executed Line 499  If VAR is nil then the loop is executed
499    (let ((binding-needed-flag var))    (let ((binding-needed-flag var))
500      `(save-excursion      `(save-excursion
501         (goto-char ,begin)         (goto-char ,begin)
502           (beginning-of-line)
503         (while (and (<= (point) ,end) (not (eobp)))         (while (and (<= (point) ,end) (not (eobp)))
504           (when (looking-at mh-scan-valid-regexp)           (when (looking-at mh-scan-valid-regexp)
505             (let ,(if binding-needed-flag `((,var (mh-get-msg-num t))) ())             (let ,(if binding-needed-flag `((,var (mh-get-msg-num t))) ())
506               ,@body))               ,@body))
507           (forward-line 1)))))           (forward-line 1)))))
508    
509    (put 'mh-iterate-on-messages-in-region 'lisp-indent-hook 'defun)
510    
511    ;;;###mh-autoload
512    (defmacro mh-iterate-on-msg-or-seq (var msg-or-seq &rest body)
513      "Iterate an operation over a region or sequence.
514    
515    VAR is bound to each message in turn in a loop over MSG-OR-SEQ, which can be a
516    message number, a list of message numbers, a sequence, or a region in a cons
517    cell. In each iteration, BODY is executed.
518    
519    The parameter MSG-OR-SEQ is usually created with `mh-interactive-msg-or-seq'
520    in order to provide a uniform interface to MH-E functions."
521      (unless (symbolp var)
522        (error "Can not bind the non-symbol %s" var))
523      (let ((binding-needed-flag var)
524            (msgs (make-symbol "msgs"))
525            (seq-hash-table (make-symbol "seq-hash-table")))
526        `(cond ((numberp ,msg-or-seq)
527                (when (mh-goto-msg ,msg-or-seq t t)
528                  (let ,(if binding-needed-flag `((,var ,msg-or-seq)) ())
529                    ,@body)))
530               ((and (consp ,msg-or-seq)
531                     (numberp (car ,msg-or-seq)) (numberp (cdr ,msg-or-seq)))
532                (mh-iterate-on-messages-in-region ,var
533                  (car ,msg-or-seq) (cdr ,msg-or-seq)
534                  ,@body))
535               (t (let ((,msgs (if (and ,msg-or-seq (symbolp ,msg-or-seq))
536                                   (mh-seq-to-msgs ,msg-or-seq)
537                                 ,msg-or-seq))
538                        (,seq-hash-table (make-hash-table)))
539                    (dolist (msg ,msgs)
540                      (setf (gethash msg ,seq-hash-table) t))
541                    (mh-iterate-on-messages-in-region v (point-min) (point-max)
542                      (when (gethash v ,seq-hash-table)
543                        (let ,(if binding-needed-flag `((,var v)) ())
544                          ,@body))))))))
545    
546    (put 'mh-iterate-on-msg-or-seq 'lisp-indent-hook 'defun)
547    
548    ;;;###mh-autoload
549    (defun mh-msg-or-seq-to-msg-list (msg-or-seq)
550      "Return a list of messages for MSG-OR-SEQ.
551    MSG-OR-SEQ can be a message number, a list of message numbers, a sequence, or
552    a region in a cons cell."
553      (let (msg-list)
554        (mh-iterate-on-msg-or-seq msg msg-or-seq
555          (push msg msg-list))
556        (nreverse msg-list)))
557    
558    ;;;###mh-autoload
559    (defun mh-interactive-msg-or-seq (sequence-prompt)
560      "Return interactive specification for message, sequence, or region.
561    By convention, the name of this argument is msg-or-seq.
562    
563    If variable `transient-mark-mode' is non-nil and the mark is active, then this
564    function returns a cons-cell of the region.
565    If optional prefix argument provided, then prompt for message sequence with
566    SEQUENCE-PROMPT and return sequence.
567    Otherwise, the message number at point is returned.
568    
569    This function is usually used with `mh-iterate-on-msg-or-seq' in order to
570    provide a uniform interface to MH-E functions."
571      (cond
572       ((mh-mark-active-p t)
573        (cons (region-beginning) (region-end)))
574       (current-prefix-arg
575        (mh-read-seq-default sequence-prompt t))
576       (t
577        (mh-get-msg-num t))))
578    
579  ;;;###mh-autoload  ;;;###mh-autoload
580  (defun mh-region-to-msg-list (begin end)  (defun mh-region-to-msg-list (begin end)
581    "Return a list of messages within the region between BEGIN and END."    "Return a list of messages within the region between BEGIN and END."
# Line 1005  All messages after START-POINT are added Line 1084  All messages after START-POINT are added
1084            (buffer-read-only nil)            (buffer-read-only nil)
1085            (old-buffer-modified-flag (buffer-modified-p)))            (old-buffer-modified-flag (buffer-modified-p)))
1086        (delete-region (point-min) (point-max))        (delete-region (point-min) (point-max))
1087        (let ((mh-thread-body-width (- (window-width) mh-cmd-note        (mh-thread-print-scan-lines thread-tree)
                                      (1- mh-scan-field-subject-start-offset)))  
             (mh-thread-last-ancestor nil))  
         (mh-thread-generate-scan-lines thread-tree -2))  
1088        (mh-notate-user-sequences)        (mh-notate-user-sequences)
1089        (mh-notate-deleted-and-refiled)        (mh-notate-deleted-and-refiled)
1090        (mh-notate-cur)        (mh-notate-cur)
1091        (set-buffer-modified-p old-buffer-modified-flag))))        (set-buffer-modified-p old-buffer-modified-flag))))
1092    
 (defvar mh-thread-last-ancestor)  
   
1093  (defun mh-thread-generate-scan-lines (tree level)  (defun mh-thread-generate-scan-lines (tree level)
1094    "Generate scan lines.    "Generate scan lines.
1095  TREE is the hierarchical tree of messages, SCAN-LINE-MAP maps message indices  TREE is the hierarchical tree of messages, SCAN-LINE-MAP maps message indices
# Line 1099  Otherwise uses the line at point as the Line 1173  Otherwise uses the line at point as the
1173                  (mh-thread-parse-scan-line (format "%s%s" spaces old-line)))))                  (mh-thread-parse-scan-line (format "%s%s" spaces old-line)))))
1174        (forward-line 1))))        (forward-line 1))))
1175    
1176    (defun mh-thread-print-scan-lines (thread-tree)
1177      "Print scan lines in THREAD-TREE in threaded mode."
1178      (let ((mh-thread-body-width (- (window-width) mh-cmd-note
1179                                     (1- mh-scan-field-subject-start-offset)))
1180            (mh-thread-last-ancestor nil))
1181        (if (null mh-index-data)
1182            (mh-thread-generate-scan-lines thread-tree -2)
1183          (loop for x in (mh-index-group-by-folder)
1184                do (let* ((old-map mh-thread-scan-line-map)
1185                          (mh-thread-scan-line-map (make-hash-table)))
1186                     (setq mh-thread-last-ancestor nil)
1187                     (loop for msg in (cdr x)
1188                           do (let ((v (gethash msg old-map)))
1189                                (when v
1190                                  (setf (gethash msg mh-thread-scan-line-map) v))))
1191                     (when (> (hash-table-count mh-thread-scan-line-map) 0)
1192                       (insert (if (bobp) "" "\n") (car x) "\n")
1193                       (mh-thread-generate-scan-lines thread-tree -2)))))))
1194    
1195  (defun mh-thread-folder ()  (defun mh-thread-folder ()
1196    "Generate thread view of folder."    "Generate thread view of folder."
1197    (message "Threading %s..." (buffer-name))    (message "Threading %s..." (buffer-name))
# Line 1115  Otherwise uses the line at point as the Line 1208  Otherwise uses the line at point as the
1208      (let* ((range (mh-coalesce-msg-list msg-list))      (let* ((range (mh-coalesce-msg-list msg-list))
1209             (thread-tree (mh-thread-generate (buffer-name) range)))             (thread-tree (mh-thread-generate (buffer-name) range)))
1210        (delete-region (point-min) (point-max))        (delete-region (point-min) (point-max))
1211        (let ((mh-thread-body-width (- (window-width) mh-cmd-note        (mh-thread-print-scan-lines thread-tree)
                                      (1- mh-scan-field-subject-start-offset)))  
             (mh-thread-last-ancestor nil))  
         (mh-thread-generate-scan-lines thread-tree -2))  
1212        (mh-notate-user-sequences)        (mh-notate-user-sequences)
1213        (mh-notate-deleted-and-refiled)        (mh-notate-deleted-and-refiled)
1214        (mh-notate-cur)        (mh-notate-cur)
# Line 1137  Otherwise uses the line at point as the Line 1227  Otherwise uses the line at point as the
1227             (let ((msg-list ()))             (let ((msg-list ()))
1228               (goto-char (point-min))               (goto-char (point-min))
1229               (while (not (eobp))               (while (not (eobp))
1230                 (let ((index (mh-get-msg-num t)))                 (let ((index (mh-get-msg-num nil)))
1231                   (when index                   (when index
1232                     (push index msg-list)))                     (push index msg-list)))
1233                 (forward-line))                 (forward-line))
# Line 1161  Otherwise uses the line at point as the Line 1251  Otherwise uses the line at point as the
1251           (id-index (gethash id mh-thread-id-index-map))           (id-index (gethash id mh-thread-id-index-map))
1252           (duplicates (gethash id mh-thread-duplicates)))           (duplicates (gethash id mh-thread-duplicates)))
1253      (remhash index mh-thread-index-id-map)      (remhash index mh-thread-index-id-map)
1254        (remhash index mh-thread-scan-line-map)
1255      (cond ((and (eql index id-index) (null duplicates))      (cond ((and (eql index id-index) (null duplicates))
1256             (remhash id mh-thread-id-index-map))             (remhash id mh-thread-id-index-map))
1257            ((eql index id-index)            ((eql index id-index)
# Line 1308  start of the region and the second is th Line 1399  start of the region and the second is th
1399                 (mh-refile-a-msg nil folder))                 (mh-refile-a-msg nil folder))
1400               (mh-next-msg)))))               (mh-next-msg)))))
1401    
1402    
1403    
1404    ;; Tick mark handling
1405    
1406    ;; Functions to highlight and unhighlight ticked messages.
1407    (defun mh-tick-add-overlay ()
1408      "Add tick overlay to current line."
1409      (with-mh-folder-updating (t)
1410        (let ((overlay
1411               (or (mh-funcall-if-exists make-overlay (point) (line-end-position))
1412                   (mh-funcall-if-exists make-extent (point) (line-end-position)))))
1413          (or (mh-funcall-if-exists overlay-put overlay 'face 'mh-folder-tick-face)
1414              (mh-funcall-if-exists set-extent-face overlay 'mh-folder-tick-face))
1415          (mh-funcall-if-exists set-extent-priority overlay 10)
1416          (add-text-properties (point) (line-end-position) `(mh-tick ,overlay)))))
1417    
1418    (defun mh-tick-remove-overlay ()
1419      "Remove tick overlay from current line."
1420      (let ((overlay (get-text-property (point) 'mh-tick)))
1421        (when overlay
1422          (with-mh-folder-updating (t)
1423            (or (mh-funcall-if-exists delete-overlay overlay)
1424                (mh-funcall-if-exists delete-extent overlay))
1425            (remove-text-properties (point) (line-end-position) `(mh-tick nil))))))
1426    
1427    ;;;###mh-autoload
1428    (defun mh-notate-tick (msg ticked-msgs &optional ignore-narrowing)
1429      "Highlight current line if MSG is in TICKED-MSGS.
1430    If optional argument IGNORE-NARROWING is non-nil then highlighting is carried
1431    out even if folder is narrowed to `mh-tick-seq'."
1432      (when mh-tick-seq
1433        (let ((narrowed-to-tick (and (not ignore-narrowing)
1434                                     (eq mh-narrowed-to-seq mh-tick-seq)))
1435              (overlay (get-text-property (point) 'mh-tick))
1436              (in-tick (member msg ticked-msgs)))
1437          (cond (narrowed-to-tick (mh-tick-remove-overlay))
1438                ((and (not overlay) in-tick) (mh-tick-add-overlay))
1439                ((and overlay (not in-tick)) (mh-tick-remove-overlay))))))
1440    
1441    ;; Interactive function to toggle tick.
1442    ;;;###mh-autoload
1443    (defun mh-toggle-tick (begin end)
1444      "Toggle tick mark of all messages in region BEGIN to END."
1445      (interactive (cond ((mh-mark-active-p t)
1446                          (list (region-beginning) (region-end)))
1447                         (t (list (line-beginning-position) (line-end-position)))))
1448      (unless mh-tick-seq
1449        (error "Enable ticking by customizing `mh-tick-seq'"))
1450      (let* ((tick-seq (mh-find-seq mh-tick-seq))
1451             (tick-seq-msgs (mh-seq-msgs tick-seq)))
1452        (mh-iterate-on-messages-in-region msg begin end
1453          (cond ((member msg tick-seq-msgs)
1454                 (mh-undefine-sequence mh-tick-seq (list msg))
1455                 (setcdr tick-seq (delq msg (cdr tick-seq)))
1456                 (when (null (cdr tick-seq)) (setq mh-last-seq-used nil))
1457                 (mh-tick-remove-overlay))
1458                (t
1459                 (mh-add-msgs-to-seq (list msg) mh-tick-seq nil t)
1460                 (setq mh-last-seq-used mh-tick-seq)
1461                 (mh-tick-add-overlay))))
1462        (when (and (eq mh-tick-seq mh-narrowed-to-seq)
1463                   (not mh-tick-seq-changed-when-narrowed-flag))
1464          (setq mh-tick-seq-changed-when-narrowed-flag t)
1465          (let ((ticked-msgs (mh-seq-msgs (mh-find-seq mh-tick-seq))))
1466            (mh-iterate-on-messages-in-region msg (point-min) (point-max)
1467              (mh-notate-tick msg ticked-msgs t))))))
1468    
1469    ;;;###mh-autoload
1470    (defun mh-narrow-to-tick ()
1471      "Restrict display of this folder to just messages in `mh-tick-seq'.
1472    Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
1473      (interactive)
1474      (cond ((not mh-tick-seq)
1475             (error "Enable ticking by customizing `mh-tick-seq'"))
1476            ((null (mh-seq-msgs (mh-find-seq mh-tick-seq)))
1477             (message "No messages in tick sequence"))
1478            (t (mh-narrow-to-seq mh-tick-seq))))
1479    
1480    
1481  (provide 'mh-seq)  (provide 'mh-seq)
1482    
1483  ;;; Local Variables:  ;;; Local Variables:

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

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