1 |
;;; mh-index -- MH-E interface to indexing programs |
;;; mh-index -- MH-E interface to indexing programs |
2 |
|
|
3 |
;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. |
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Satyaki Das <satyaki@theforce.stanford.edu> |
;; Author: Satyaki Das <satyaki@theforce.stanford.edu> |
6 |
;; Maintainer: Bill Wohler <wohler@newt.com> |
;; Maintainer: Bill Wohler <wohler@newt.com> |
43 |
|
|
44 |
;;; Code: |
;;; Code: |
45 |
|
|
46 |
(require 'cl) |
(require 'mh-utils) |
47 |
|
(mh-require-cl) |
48 |
(require 'mh-e) |
(require 'mh-e) |
49 |
(require 'mh-mime) |
(require 'mh-mime) |
50 |
(require 'mh-pick) |
(require 'mh-pick) |
260 |
(save-excursion |
(save-excursion |
261 |
(set-buffer folder) |
(set-buffer folder) |
262 |
(mh-index-update-single-msg msg checksum origin-map))) |
(mh-index-update-single-msg msg checksum origin-map))) |
263 |
(forward-line)))))) |
(forward-line))))) |
264 |
|
(mh-index-write-data)) |
265 |
|
|
266 |
(defvar mh-flists-results-folder "new" |
(defvar mh-unpropagated-sequences '(cur range subject search) |
267 |
|
"List of sequences that aren't preserved.") |
268 |
|
|
269 |
|
(defun mh-unpropagated-sequences () |
270 |
|
"Return a list of sequences that aren't propagated to the source folders. |
271 |
|
It is just the sequences in the variable `mh-unpropagated-sequences' in |
272 |
|
addition to the Previous-Sequence (see mh-profile 5)." |
273 |
|
(if mh-previous-seq |
274 |
|
(cons mh-previous-seq mh-unpropagated-sequences) |
275 |
|
mh-unpropagated-sequences)) |
276 |
|
|
277 |
|
;;;###mh-autoload |
278 |
|
(defun mh-create-sequence-map (seq-list) |
279 |
|
"Return a map from msg number to list of sequences in which it is present. |
280 |
|
SEQ-LIST is an assoc list whose keys are sequence names and whose cdr is the |
281 |
|
list of messages in that sequence." |
282 |
|
(loop with map = (make-hash-table) |
283 |
|
for seq in seq-list |
284 |
|
when (and (not (memq (car seq) (mh-unpropagated-sequences))) |
285 |
|
(mh-valid-seq-p (car seq))) |
286 |
|
do (loop for msg in (cdr seq) |
287 |
|
do (push (car seq) (gethash msg map))) |
288 |
|
finally return map)) |
289 |
|
|
290 |
|
;;;###mh-autoload |
291 |
|
(defun mh-index-create-sequences () |
292 |
|
"Mirror sequences present in source folders in index folder." |
293 |
|
(let ((seq-hash (make-hash-table :test #'equal)) |
294 |
|
(seq-list ())) |
295 |
|
(loop for folder being the hash-keys of mh-index-data |
296 |
|
do (setf (gethash folder seq-hash) |
297 |
|
(mh-create-sequence-map |
298 |
|
(mh-read-folder-sequences folder nil)))) |
299 |
|
(dolist (msg (mh-translate-range mh-current-folder "all")) |
300 |
|
(let* ((checksum (gethash msg mh-index-msg-checksum-map)) |
301 |
|
(pair (gethash checksum mh-index-checksum-origin-map)) |
302 |
|
(ofolder (car pair)) |
303 |
|
(omsg (cdr pair))) |
304 |
|
(loop for seq in (gethash omsg (gethash ofolder seq-hash)) |
305 |
|
do (if (assoc seq seq-list) |
306 |
|
(push msg (cdr (assoc seq seq-list))) |
307 |
|
(push (list seq msg) seq-list))))) |
308 |
|
(loop for seq in seq-list |
309 |
|
do (apply #'mh-exec-cmd "mark" mh-current-folder |
310 |
|
"-sequence" (symbol-name (car seq)) "-add" |
311 |
|
(mapcar #'(lambda (x) (format "%s" x)) (cdr seq)))))) |
312 |
|
|
313 |
|
(defvar mh-flists-results-folder "sequence" |
314 |
"Subfolder for `mh-index-folder' where flists output is placed.") |
"Subfolder for `mh-index-folder' where flists output is placed.") |
315 |
|
(defvar mh-flists-sequence) |
316 |
|
(defvar mh-flists-called-flag nil) |
317 |
|
|
318 |
(defun mh-index-generate-pretty-name (string) |
(defun mh-index-generate-pretty-name (string) |
319 |
"Given STRING generate a name which is suitable for use as a folder name. |
"Given STRING generate a name which is suitable for use as a folder name. |
344 |
(subst-char-in-region (point-min) (point-max) ?\r ?_ t) |
(subst-char-in-region (point-min) (point-max) ?\r ?_ t) |
345 |
(subst-char-in-region (point-min) (point-max) ?/ ?$ t) |
(subst-char-in-region (point-min) (point-max) ?/ ?$ t) |
346 |
(let ((out (truncate-string-to-width (buffer-string) 20))) |
(let ((out (truncate-string-to-width (buffer-string) 20))) |
347 |
(cond ((eq mh-indexer 'flists) mh-flists-results-folder) |
(cond ((eq mh-indexer 'flists) |
348 |
|
(format "%s/%s" mh-flists-results-folder mh-flists-sequence)) |
349 |
((equal out mh-flists-results-folder) (concat out "1")) |
((equal out mh-flists-results-folder) (concat out "1")) |
350 |
(t out))))) |
(t out))))) |
351 |
|
|
352 |
;;;###mh-autoload |
;;;###mh-autoload |
353 |
(defun* mh-index-search (redo-search-flag folder search-regexp |
(defun* mh-index-search (redo-search-flag folder search-regexp |
354 |
&optional window-config unseen-flag) |
&optional window-config) |
355 |
"Perform an indexed search in an MH mail folder. |
"Perform an indexed search in an MH mail folder. |
356 |
Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below. |
Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below. |
357 |
|
|
360 |
SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is |
SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is |
361 |
\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG |
\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG |
362 |
stores the window configuration that will be restored after the user quits the |
stores the window configuration that will be restored after the user quits the |
363 |
folder containing the index search results. If optional argument UNSEEN-FLAG |
folder containing the index search results. |
|
is non-nil, then all the messages are marked as unseen. |
|
364 |
|
|
365 |
Four indexing programs are supported; if none of these are present, then grep |
Four indexing programs are supported; if none of these are present, then grep |
366 |
is used. This function picks the first program that is available on your |
is used. This function picks the first program that is available on your |
395 |
(list current-prefix-arg |
(list current-prefix-arg |
396 |
(progn |
(progn |
397 |
(unless mh-find-path-run (mh-find-path)) |
(unless mh-find-path-run (mh-find-path)) |
398 |
(or (and current-prefix-arg (car mh-index-previous-search)) |
(or (and current-prefix-arg mh-index-sequence-search-flag) |
399 |
|
(and current-prefix-arg (car mh-index-previous-search)) |
400 |
(mh-prompt-for-folder "Search" "+" nil "all" t))) |
(mh-prompt-for-folder "Search" "+" nil "all" t))) |
401 |
(progn |
(progn |
402 |
;; Yes, we do want to call mh-index-choose every time in case the |
;; Yes, we do want to call mh-index-choose every time in case the |
412 |
mh-index-regexp-builder) |
mh-index-regexp-builder) |
413 |
(current-window-configuration) |
(current-window-configuration) |
414 |
nil))) |
nil))) |
415 |
|
;; Redoing a sequence search? |
416 |
|
(when (and redo-search-flag mh-index-data mh-index-sequence-search-flag |
417 |
|
(not mh-flists-called-flag)) |
418 |
|
(let ((mh-flists-called-flag t)) |
419 |
|
(apply #'mh-index-sequenced-messages mh-index-previous-search)) |
420 |
|
(return-from mh-index-search)) |
421 |
|
;; We have fancy query parsing |
422 |
(when (symbolp search-regexp) |
(when (symbolp search-regexp) |
423 |
(mh-search-folder folder window-config) |
(mh-search-folder folder window-config) |
424 |
(setq mh-searching-function 'mh-index-do-search) |
(setq mh-searching-function 'mh-index-do-search) |
460 |
|
|
461 |
;; Copy the search results over |
;; Copy the search results over |
462 |
(maphash #'(lambda (folder msgs) |
(maphash #'(lambda (folder msgs) |
463 |
(let ((msgs (sort (loop for msg being the hash-keys of msgs |
(let ((cur (car (mh-translate-range folder "cur"))) |
464 |
|
(msgs (sort (loop for msg being the hash-keys of msgs |
465 |
collect msg) |
collect msg) |
466 |
#'<))) |
#'<))) |
467 |
(mh-exec-cmd "refile" msgs "-src" folder |
(mh-exec-cmd "refile" msgs "-src" folder |
468 |
"-link" index-folder) |
"-link" index-folder) |
469 |
|
;; Restore cur to old value, that refile changed |
470 |
|
(when cur |
471 |
|
(mh-exec-cmd-quiet nil "mark" folder "-add" "-zero" |
472 |
|
"-sequence" "cur" (format "%s" cur))) |
473 |
(loop for msg in msgs |
(loop for msg in msgs |
474 |
do (incf result-count) |
do (incf result-count) |
475 |
(setf (gethash result-count origin-map) |
(setf (gethash result-count origin-map) |
476 |
(cons folder msg))))) |
(cons folder msg))))) |
477 |
folder-results-map) |
folder-results-map) |
478 |
|
|
479 |
;; Mark messages as unseen (if needed) |
;; Vist the results folder |
|
(when (and unseen-flag (> result-count 0)) |
|
|
(mh-exec-cmd "mark" index-folder "all" |
|
|
"-sequence" (symbol-name mh-unseen-seq) "-add")) |
|
|
|
|
|
;; Generate scan lines for the hits. |
|
480 |
(mh-visit-folder index-folder () (list folder-results-map origin-map)) |
(mh-visit-folder index-folder () (list folder-results-map origin-map)) |
481 |
|
|
482 |
(goto-char (point-min)) |
(goto-char (point-min)) |
484 |
(mh-update-sequences) |
(mh-update-sequences) |
485 |
(mh-recenter nil) |
(mh-recenter nil) |
486 |
|
|
487 |
|
;; Update the speedbar, if needed |
488 |
|
(when (mh-speed-flists-active-p) |
489 |
|
(mh-speed-flists t mh-current-folder)) |
490 |
|
|
491 |
;; Maintain history |
;; Maintain history |
492 |
(when (or (and redo-search-flag previous-search) window-config) |
(when (or (and redo-search-flag previous-search) window-config) |
493 |
(setq mh-previous-window-config old-window-config)) |
(setq mh-previous-window-config old-window-config)) |
494 |
(setq mh-index-previous-search (list folder search-regexp)) |
(setq mh-index-previous-search (list folder search-regexp)) |
495 |
|
|
496 |
|
;; Write out data to disk |
497 |
|
(unless mh-flists-called-flag (mh-index-write-data)) |
498 |
|
|
499 |
(message "%s found %s matches in %s folders" |
(message "%s found %s matches in %s folders" |
500 |
(upcase-initials (symbol-name mh-indexer)) |
(upcase-initials (symbol-name mh-indexer)) |
501 |
(loop for msg-hash being hash-values of mh-index-data |
(loop for msg-hash being hash-values of mh-index-data |
503 |
(loop for msg-hash being hash-values of mh-index-data |
(loop for msg-hash being hash-values of mh-index-data |
504 |
count (> (hash-table-count msg-hash) 0)))))) |
count (> (hash-table-count msg-hash) 0)))))) |
505 |
|
|
506 |
|
|
507 |
|
|
508 |
|
;;; Functions to serialize index data... |
509 |
|
|
510 |
|
(defun mh-index-write-data () |
511 |
|
"Write index data to file." |
512 |
|
(ignore-errors |
513 |
|
(unless (eq major-mode 'mh-folder-mode) |
514 |
|
(error "Can't be called from folder in `%s'" major-mode)) |
515 |
|
(let ((data mh-index-data) |
516 |
|
(msg-checksum-map mh-index-msg-checksum-map) |
517 |
|
(checksum-origin-map mh-index-checksum-origin-map) |
518 |
|
(previous-search mh-index-previous-search) |
519 |
|
(sequence-search-flag mh-index-sequence-search-flag) |
520 |
|
(outfile (concat buffer-file-name mh-index-data-file)) |
521 |
|
(print-length nil) |
522 |
|
(print-level nil)) |
523 |
|
(with-temp-file outfile |
524 |
|
(mh-index-write-hashtable |
525 |
|
data (lambda (x) (loop for y being the hash-keys of x collect y))) |
526 |
|
(mh-index-write-hashtable msg-checksum-map #'identity) |
527 |
|
(mh-index-write-hashtable checksum-origin-map #'identity) |
528 |
|
(pp previous-search (current-buffer)) (insert "\n") |
529 |
|
(pp sequence-search-flag (current-buffer)) (insert "\n"))))) |
530 |
|
|
531 |
|
;;;###mh-autoload |
532 |
|
(defun mh-index-read-data () |
533 |
|
"Read index data from file." |
534 |
|
(ignore-errors |
535 |
|
(unless (eq major-mode 'mh-folder-mode) |
536 |
|
(error "Can't be called from folder in `%s'" major-mode)) |
537 |
|
(let ((infile (concat buffer-file-name mh-index-data-file)) |
538 |
|
t1 t2 t3 t4 t5) |
539 |
|
(with-temp-buffer |
540 |
|
(insert-file-contents-literally infile) |
541 |
|
(goto-char (point-min)) |
542 |
|
(setq t1 (mh-index-read-hashtable |
543 |
|
(lambda (data) |
544 |
|
(loop with table = (make-hash-table :test #'equal) |
545 |
|
for x in data do (setf (gethash x table) t) |
546 |
|
finally return table))) |
547 |
|
t2 (mh-index-read-hashtable #'identity) |
548 |
|
t3 (mh-index-read-hashtable #'identity) |
549 |
|
t4 (read (current-buffer)) |
550 |
|
t5 (read (current-buffer)))) |
551 |
|
(setq mh-index-data t1 |
552 |
|
mh-index-msg-checksum-map t2 |
553 |
|
mh-index-checksum-origin-map t3 |
554 |
|
mh-index-previous-search t4 |
555 |
|
mh-index-sequence-search-flag t5)))) |
556 |
|
|
557 |
|
(defun mh-index-write-hashtable (table proc) |
558 |
|
"Write TABLE to `current-buffer'. |
559 |
|
PROC is used to serialize the values corresponding to the hash table keys." |
560 |
|
(pp (loop for x being the hash-keys of table |
561 |
|
collect (cons x (funcall proc (gethash x table)))) |
562 |
|
(current-buffer)) |
563 |
|
(insert "\n")) |
564 |
|
|
565 |
|
(defun mh-index-read-hashtable (proc) |
566 |
|
"From BUFFER read a hash table serialized as a list. |
567 |
|
PROC is used to convert the value to actual data." |
568 |
|
(loop with table = (make-hash-table :test #'equal) |
569 |
|
for pair in (read (current-buffer)) |
570 |
|
do (setf (gethash (car pair) table) (funcall proc (cdr pair))) |
571 |
|
finally return table)) |
572 |
|
|
573 |
|
;;;###mh-autoload |
574 |
|
(defun mh-index-p () |
575 |
|
"Non-nil means that this folder was generated by an index search." |
576 |
|
mh-index-data) |
577 |
|
|
578 |
;;;###mh-autoload |
;;;###mh-autoload |
579 |
(defun mh-index-do-search () |
(defun mh-index-do-search () |
580 |
"Construct appropriate regexp and call `mh-index-search'." |
"Construct appropriate regexp and call `mh-index-search'." |
590 |
(defun mh-replace-string (old new) |
(defun mh-replace-string (old new) |
591 |
"Replace all occurrences of OLD with NEW in the current buffer." |
"Replace all occurrences of OLD with NEW in the current buffer." |
592 |
(goto-char (point-min)) |
(goto-char (point-min)) |
593 |
(while (search-forward old nil t) |
(let ((case-fold-search t)) |
594 |
(replace-match new))) |
(while (search-forward old nil t) |
595 |
|
(replace-match new t t)))) |
596 |
|
|
597 |
;;;###mh-autoload |
;;;###mh-autoload |
598 |
(defun mh-index-parse-search-regexp (input-string) |
(defun mh-index-parse-search-regexp (input-string) |
602 |
(let (input) |
(let (input) |
603 |
(with-temp-buffer |
(with-temp-buffer |
604 |
(insert input-string) |
(insert input-string) |
|
(downcase-region (point-min) (point-max)) |
|
605 |
;; replace tabs |
;; replace tabs |
606 |
(mh-replace-string "\t" " ") |
(mh-replace-string "\t" " ") |
607 |
;; synonyms of AND |
;; synonyms of AND |
608 |
|
(mh-replace-string " AND " " and ") |
609 |
(mh-replace-string "&" " and ") |
(mh-replace-string "&" " and ") |
610 |
(mh-replace-string " -and " " and ") |
(mh-replace-string " -and " " and ") |
611 |
;; synonyms of OR |
;; synonyms of OR |
612 |
|
(mh-replace-string " OR " " or ") |
613 |
(mh-replace-string "|" " or ") |
(mh-replace-string "|" " or ") |
614 |
(mh-replace-string " -or " " or ") |
(mh-replace-string " -or " " or ") |
615 |
;; synonyms of NOT |
;; synonyms of NOT |
616 |
|
(mh-replace-string " NOT " " not ") |
617 |
(mh-replace-string "!" " not ") |
(mh-replace-string "!" " not ") |
618 |
(mh-replace-string "~" " not ") |
(mh-replace-string "~" " not ") |
619 |
(mh-replace-string " -not " " not ") |
(mh-replace-string " -not " " not ") |
639 |
(multiple-value-setq (op-stack operand-stack) |
(multiple-value-setq (op-stack operand-stack) |
640 |
(mh-index-evaluate op-stack operand-stack)) |
(mh-index-evaluate op-stack operand-stack)) |
641 |
(when (eq (car op-stack) 'not) |
(when (eq (car op-stack) 'not) |
642 |
(pop op-stack) |
(setq op-stack (cdr op-stack)) |
643 |
(push `(not ,(pop operand-stack)) operand-stack)) |
(push `(not ,(pop operand-stack)) operand-stack)) |
644 |
(when (eq (car op-stack) 'and) |
(when (eq (car op-stack) 'and) |
645 |
(pop op-stack) |
(setq op-stack (cdr op-stack)) |
646 |
(setq oper1 (pop operand-stack)) |
(setq oper1 (pop operand-stack)) |
647 |
(push `(and ,(pop operand-stack) ,oper1) operand-stack))) |
(push `(and ,(pop operand-stack) ,oper1) operand-stack))) |
648 |
((eq (car op-stack) 'not) |
((eq (car op-stack) 'not) |
649 |
(pop op-stack) |
(setq op-stack (cdr op-stack)) |
650 |
(push `(not ,token) operand-stack) |
(push `(not ,token) operand-stack) |
651 |
(when (eq (car op-stack) 'and) |
(when (eq (car op-stack) 'and) |
652 |
(pop op-stack) |
(setq op-stack (cdr op-stack)) |
653 |
(setq oper1 (pop operand-stack)) |
(setq oper1 (pop operand-stack)) |
654 |
(push `(and ,(pop operand-stack) ,oper1) operand-stack))) |
(push `(and ,(pop operand-stack) ,oper1) operand-stack))) |
655 |
((eq (car op-stack) 'and) |
((eq (car op-stack) 'and) |
656 |
(pop op-stack) |
(setq op-stack (cdr op-stack)) |
657 |
(push `(and ,(pop operand-stack) ,token) operand-stack)) |
(push `(and ,(pop operand-stack) ,token) operand-stack)) |
658 |
(t (push token operand-stack)))) |
(t (push token operand-stack)))) |
659 |
(prog1 (pop operand-stack) |
(prog1 (pop operand-stack) |
773 |
(setq current-folder (car (gethash (gethash (mh-get-msg-num nil) |
(setq current-folder (car (gethash (gethash (mh-get-msg-num nil) |
774 |
mh-index-msg-checksum-map) |
mh-index-msg-checksum-map) |
775 |
mh-index-checksum-origin-map))) |
mh-index-checksum-origin-map))) |
776 |
(when (and current-folder (not (eq current-folder last-folder))) |
(when (and current-folder (not (equal current-folder last-folder))) |
777 |
(insert (if last-folder "\n" "") current-folder "\n") |
(insert (if last-folder "\n" "") current-folder "\n") |
778 |
(setq last-folder current-folder)) |
(setq last-folder current-folder)) |
779 |
(forward-line)) |
(forward-line)) |
787 |
list of messages originally from that folder." |
list of messages originally from that folder." |
788 |
(save-excursion |
(save-excursion |
789 |
(goto-char (point-min)) |
(goto-char (point-min)) |
790 |
(let ((result-table (make-hash-table))) |
(let ((result-table (make-hash-table :test #'equal))) |
791 |
(loop for msg being hash-keys of mh-index-msg-checksum-map |
(loop for msg being hash-keys of mh-index-msg-checksum-map |
792 |
do (push msg (gethash (car (gethash |
do (push msg (gethash (car (gethash |
793 |
(gethash msg mh-index-msg-checksum-map) |
(gethash msg mh-index-msg-checksum-map) |
863 |
(string-equal (buffer-substring-no-properties (point) (line-end-position)) |
(string-equal (buffer-substring-no-properties (point) (line-end-position)) |
864 |
checksum))) |
checksum))) |
865 |
|
|
866 |
|
(defun mh-index-matching-source-msgs (msgs &optional delete-from-index-data) |
867 |
|
"Return a table of original messages and folders for messages in MSGS. |
868 |
|
If optional argument DELETE-FROM-INDEX-DATA is non-nil, then each of the |
869 |
|
messages, whose counter-part is found in some source folder, is removed from |
870 |
|
`mh-index-data'." |
871 |
|
(let ((table (make-hash-table :test #'equal))) |
872 |
|
(dolist (msg msgs) |
873 |
|
(let* ((checksum (gethash msg mh-index-msg-checksum-map)) |
874 |
|
(pair (gethash checksum mh-index-checksum-origin-map))) |
875 |
|
(when (and checksum (car pair) (cdr pair) |
876 |
|
(mh-index-match-checksum (cdr pair) (car pair) checksum)) |
877 |
|
(push (cdr pair) (gethash (car pair) table)) |
878 |
|
(when delete-from-index-data |
879 |
|
(remhash (cdr pair) (gethash (car pair) mh-index-data)))))) |
880 |
|
table)) |
881 |
|
|
882 |
;;;###mh-autoload |
;;;###mh-autoload |
883 |
(defun mh-index-execute-commands () |
(defun mh-index-execute-commands () |
884 |
"Delete/refile the actual messages. |
"Delete/refile the actual messages. |
885 |
The copies in the searched folder are then deleted/refiled to get the desired |
The copies in the searched folder are then deleted/refiled to get the desired |
886 |
result. Before deleting the messages we make sure that the message being |
result. Before deleting the messages we make sure that the message being |
887 |
deleted is identical to the one that the user has marked in the index buffer." |
deleted is identical to the one that the user has marked in the index buffer." |
888 |
(let ((message-table (make-hash-table :test #'equal))) |
(save-excursion |
889 |
(dolist (msg-list (cons mh-delete-list (mapcar #'cdr mh-refile-list))) |
(let ((folders ()) |
890 |
(dolist (msg msg-list) |
(mh-speed-flists-inhibit-flag t)) |
891 |
(let* ((checksum (gethash msg mh-index-msg-checksum-map)) |
(maphash |
892 |
(pair (gethash checksum mh-index-checksum-origin-map))) |
(lambda (folder msgs) |
893 |
(when (and checksum (car pair) (cdr pair) |
(push folder folders) |
894 |
(mh-index-match-checksum (cdr pair) (car pair) checksum)) |
(if (not (get-buffer folder)) |
895 |
(push (cdr pair) (gethash (car pair) message-table)) |
;; If source folder not open, just delete the messages... |
896 |
(remhash (cdr pair) (gethash (car pair) mh-index-data)))))) |
(apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs)) |
897 |
(maphash (lambda (folder msgs) |
;; Otherwise delete the messages in the source buffer... |
898 |
(apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs))) |
(save-excursion |
899 |
message-table))) |
(set-buffer folder) |
900 |
|
(let ((old-refile-list mh-refile-list) |
901 |
|
(old-delete-list mh-delete-list)) |
902 |
|
(setq mh-refile-list nil |
903 |
|
mh-delete-list msgs) |
904 |
|
(unwind-protect (mh-execute-commands) |
905 |
|
(setq mh-refile-list |
906 |
|
(mapcar (lambda (x) |
907 |
|
(cons (car x) |
908 |
|
(loop for y in (cdr x) |
909 |
|
unless (memq y msgs) collect y))) |
910 |
|
old-refile-list) |
911 |
|
mh-delete-list |
912 |
|
(loop for x in old-delete-list |
913 |
|
unless (memq x msgs) collect x)) |
914 |
|
(mh-set-folder-modified-p (mh-outstanding-commands-p)) |
915 |
|
(when (mh-outstanding-commands-p) |
916 |
|
(mh-notate-deleted-and-refiled))))))) |
917 |
|
(mh-index-matching-source-msgs (append (loop for x in mh-refile-list |
918 |
|
append (cdr x)) |
919 |
|
mh-delete-list) |
920 |
|
t)) |
921 |
|
folders))) |
922 |
|
|
923 |
|
;;;###mh-autoload |
924 |
|
(defun mh-index-add-to-sequence (seq msgs) |
925 |
|
"Add to SEQ the messages in the list MSGS. |
926 |
|
This function updates the source folder sequences. Also makes an attempt to |
927 |
|
update the source folder buffer if we have it open." |
928 |
|
;; Don't need to do anything for cur |
929 |
|
(save-excursion |
930 |
|
(when (and (not (memq seq (mh-unpropagated-sequences))) |
931 |
|
(mh-valid-seq-p seq)) |
932 |
|
(let ((folders ()) |
933 |
|
(mh-speed-flists-inhibit-flag t)) |
934 |
|
(maphash (lambda (folder msgs) |
935 |
|
(push folder folders) |
936 |
|
;; Add messages to sequence in source folder... |
937 |
|
(apply #'mh-exec-cmd-quiet nil "mark" folder |
938 |
|
"-add" "-nozero" "-sequence" (symbol-name seq) |
939 |
|
(mapcar (lambda (x) (format "%s" x)) |
940 |
|
(mh-coalesce-msg-list msgs))) |
941 |
|
;; Update source folder buffer if we have it open... |
942 |
|
(when (get-buffer folder) |
943 |
|
(save-excursion |
944 |
|
(set-buffer folder) |
945 |
|
(mh-put-msg-in-seq msgs seq)))) |
946 |
|
(mh-index-matching-source-msgs msgs)) |
947 |
|
folders)))) |
948 |
|
|
949 |
|
;;;###mh-autoload |
950 |
|
(defun mh-index-delete-from-sequence (seq msgs) |
951 |
|
"Delete from SEQ the messages in MSGS. |
952 |
|
This function updates the source folder sequences. Also makes an attempt to |
953 |
|
update the source folder buffer if present." |
954 |
|
(save-excursion |
955 |
|
(when (and (not (memq seq (mh-unpropagated-sequences))) |
956 |
|
(mh-valid-seq-p seq)) |
957 |
|
(let ((folders ()) |
958 |
|
(mh-speed-flists-inhibit-flag t)) |
959 |
|
(maphash (lambda (folder msgs) |
960 |
|
(push folder folders) |
961 |
|
;; Remove messages from sequence in source folder... |
962 |
|
(apply #'mh-exec-cmd-quiet nil "mark" folder |
963 |
|
"-del" "-nozero" "-sequence" (symbol-name seq) |
964 |
|
(mapcar (lambda (x) (format "%s" x)) |
965 |
|
(mh-coalesce-msg-list msgs))) |
966 |
|
;; Update source folder buffer if we have it open... |
967 |
|
(when (get-buffer folder) |
968 |
|
(save-excursion |
969 |
|
(set-buffer folder) |
970 |
|
(mh-delete-msg-from-seq msgs seq t)))) |
971 |
|
(mh-index-matching-source-msgs msgs)) |
972 |
|
folders)))) |
973 |
|
|
974 |
|
|
975 |
|
|
1281 |
|
|
1282 |
(defvar mh-flists-search-folders) |
(defvar mh-flists-search-folders) |
1283 |
|
|
1284 |
|
;; XXX: This should probably be in mh-utils.el and used in other places where |
1285 |
|
;; MH-E calls out to /bin/sh. |
1286 |
|
(defun mh-index-quote-for-shell (string) |
1287 |
|
"Quote STRING for /bin/sh." |
1288 |
|
(concat "\"" |
1289 |
|
(loop for x across string |
1290 |
|
concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x)) |
1291 |
|
"\"")) |
1292 |
|
|
1293 |
(defun mh-flists-execute (&rest args) |
(defun mh-flists-execute (&rest args) |
1294 |
"Search for unseen messages in `mh-flists-search-folders'. |
"Execute flists. |
1295 |
If `mh-recursive-folders-flag' is t, then the folders are searched |
Search for messages belonging to `mh-flists-sequence' in the folders |
1296 |
recursively. All parameters ARGS are ignored." |
specified by `mh-flists-search-folders'. If `mh-recursive-folders-flag' is t, |
1297 |
|
then the folders are searched recursively. All parameters ARGS are ignored." |
1298 |
(set-buffer (get-buffer-create mh-index-temp-buffer)) |
(set-buffer (get-buffer-create mh-index-temp-buffer)) |
1299 |
(erase-buffer) |
(erase-buffer) |
1300 |
(unless (executable-find "sh") |
(unless (executable-find "sh") |
1301 |
(error "Didn't find sh")) |
(error "Didn't find sh")) |
1302 |
(with-temp-buffer |
(with-temp-buffer |
1303 |
(let ((unseen (symbol-name mh-unseen-seq))) |
(let ((seq (symbol-name mh-flists-sequence))) |
1304 |
(insert "for folder in `flists " |
(insert "for folder in `" (expand-file-name "flists" mh-progs) " " |
1305 |
(cond ((eq mh-flists-search-folders t) mh-inbox) |
(cond ((eq mh-flists-search-folders t) |
1306 |
|
(mh-index-quote-for-shell mh-inbox)) |
1307 |
((eq mh-flists-search-folders nil) "") |
((eq mh-flists-search-folders nil) "") |
1308 |
((listp mh-flists-search-folders) |
((listp mh-flists-search-folders) |
1309 |
(loop for folder in mh-flists-search-folders |
(loop for folder in mh-flists-search-folders |
1310 |
concat (concat " " folder)))) |
concat |
1311 |
|
(concat " " (mh-index-quote-for-shell folder))))) |
1312 |
(if mh-recursive-folders-flag " -recurse" "") |
(if mh-recursive-folders-flag " -recurse" "") |
1313 |
" -sequence " unseen " -noshowzero -fast` ; do\n" |
" -sequence " seq " -noshowzero -fast` ; do\n" |
1314 |
"mhpath \"+$folder\" " unseen "\n" "done\n")) |
(expand-file-name "mhpath" mh-progs) " \"+$folder\" " seq "\n" |
1315 |
|
"done\n")) |
1316 |
(call-process-region |
(call-process-region |
1317 |
(point-min) (point-max) "sh" nil (get-buffer mh-index-temp-buffer)))) |
(point-min) (point-max) "sh" nil (get-buffer mh-index-temp-buffer)))) |
1318 |
|
|
1319 |
;;;###mh-autoload |
;;;###mh-autoload |
1320 |
(defun mh-index-new-messages (folders) |
(defun mh-index-sequenced-messages (folders sequence) |
1321 |
"Display new messages. |
"Display messages from FOLDERS in SEQUENCE. |
|
All messages in the `mh-unseen-seq' sequence from FOLDERS are displayed. |
|
1322 |
By default the folders specified by `mh-index-new-messages-folders' are |
By default the folders specified by `mh-index-new-messages-folders' are |
1323 |
searched. With a prefix argument, enter a space-separated list of folders, or |
searched. With a prefix argument, enter a space-separated list of folders, or |
1324 |
nothing to search all folders." |
nothing to search all folders. |
1325 |
|
|
1326 |
|
Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the |
1327 |
|
function searches for in each of the FOLDERS. With a prefix argument, enter a |
1328 |
|
sequence to use." |
1329 |
(interactive |
(interactive |
1330 |
(list (if current-prefix-arg |
(list (if current-prefix-arg |
1331 |
(split-string (read-string "Folders to search: ")) |
(split-string (read-string "Search folder(s) [all]? ")) |
1332 |
mh-index-new-messages-folders))) |
mh-index-new-messages-folders) |
1333 |
|
(mh-read-seq-default "Search" nil))) |
1334 |
|
(unless sequence (setq sequence mh-unseen-seq)) |
1335 |
(let* ((mh-flists-search-folders folders) |
(let* ((mh-flists-search-folders folders) |
1336 |
|
(mh-flists-sequence sequence) |
1337 |
|
(mh-flists-called-flag t) |
1338 |
(mh-indexer 'flists) |
(mh-indexer 'flists) |
1339 |
(mh-index-execute-search-function 'mh-flists-execute) |
(mh-index-execute-search-function 'mh-flists-execute) |
1340 |
(mh-index-next-result-function 'mh-mairix-next-result) |
(mh-index-next-result-function 'mh-mairix-next-result) |
1341 |
(mh-mairix-folder mh-user-path) |
(mh-mairix-folder mh-user-path) |
1342 |
(mh-index-regexp-builder nil) |
(mh-index-regexp-builder nil) |
1343 |
(new-folder (format "%s/%s" mh-index-folder mh-flists-results-folder)) |
(new-folder (format "%s/%s/%s" mh-index-folder |
1344 |
|
mh-flists-results-folder sequence)) |
1345 |
(window-config (if (equal new-folder mh-current-folder) |
(window-config (if (equal new-folder mh-current-folder) |
1346 |
mh-previous-window-config |
mh-previous-window-config |
1347 |
(current-window-configuration))) |
(current-window-configuration))) |
1348 |
(redo-flag nil)) |
(redo-flag nil) |
1349 |
|
message) |
1350 |
(cond ((buffer-live-p (get-buffer new-folder)) |
(cond ((buffer-live-p (get-buffer new-folder)) |
1351 |
;; The destination folder is being visited. Trick `mh-index-search' |
;; The destination folder is being visited. Trick `mh-index-search' |
1352 |
;; into thinking that the folder was the result of a previous search. |
;; into thinking that the folder resulted from a previous search. |
1353 |
(set-buffer new-folder) |
(set-buffer new-folder) |
1354 |
(setq mh-index-previous-search (list "+" mh-flists-results-folder)) |
(setq mh-index-previous-search (list folders sequence)) |
1355 |
(setq redo-flag t)) |
(setq redo-flag t)) |
1356 |
((mh-folder-exists-p new-folder) |
((mh-folder-exists-p new-folder) |
1357 |
;; Folder exists but we don't have it open. That means they are |
;; Folder exists but we don't have it open. That means they are |
1358 |
;; stale results from a old flists search. Clear it out. |
;; stale results from a old flists search. Clear it out. |
1359 |
(mh-exec-cmd-quiet nil "rmf" new-folder))) |
(mh-exec-cmd-quiet nil "rmf" new-folder))) |
1360 |
(mh-index-search redo-flag "+" mh-flists-results-folder window-config t))) |
(setq message (mh-index-search redo-flag "+" mh-flists-results-folder |
1361 |
|
window-config) |
1362 |
|
mh-index-sequence-search-flag t |
1363 |
|
mh-index-previous-search (list folders sequence)) |
1364 |
|
(mh-index-write-data) |
1365 |
|
(when (stringp message) (message message)))) |
1366 |
|
|
1367 |
|
;;;###mh-autoload |
1368 |
|
(defun mh-index-new-messages (folders) |
1369 |
|
"Display unseen messages. |
1370 |
|
All messages in the `unseen' sequence from FOLDERS are displayed. |
1371 |
|
By default the folders specified by `mh-index-new-messages-folders' |
1372 |
|
are searched. With a prefix argument, enter a space-separated list of |
1373 |
|
folders, or nothing to search all folders." |
1374 |
|
(interactive |
1375 |
|
(list (if current-prefix-arg |
1376 |
|
(split-string (read-string "Search folder(s) [all]? ")) |
1377 |
|
mh-index-new-messages-folders))) |
1378 |
|
(mh-index-sequenced-messages folders mh-unseen-seq)) |
1379 |
|
|
1380 |
|
;;;###mh-autoload |
1381 |
|
(defun mh-index-ticked-messages (folders) |
1382 |
|
"Display ticked messages. |
1383 |
|
All messages in the `tick' sequence from FOLDERS are displayed. |
1384 |
|
By default the folders specified by `mh-index-ticked-messages-folders' |
1385 |
|
are searched. With a prefix argument, enter a space-separated list of |
1386 |
|
folders, or nothing to search all folders." |
1387 |
|
(interactive |
1388 |
|
(list (if current-prefix-arg |
1389 |
|
(split-string (read-string "Search folder(s) [all]? ")) |
1390 |
|
mh-index-ticked-messages-folders))) |
1391 |
|
(mh-index-sequenced-messages folders mh-tick-seq)) |
1392 |
|
|
1393 |
|
|
1394 |
|
|