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> |
68 |
|
|
69 |
;;; Change Log: |
;;; Change Log: |
70 |
|
|
|
;; $Id$ |
|
|
|
|
71 |
;;; Code: |
;;; Code: |
72 |
|
|
73 |
(require 'cl) |
(require 'cl) |
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) |
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 |
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. |
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) |
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. |
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. |
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 |
|
|
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 |
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 |
|
|
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." |
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 |
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)) |
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) |
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)) |
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) |
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: |