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

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

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

revision 1.5 by miles, Mon Sep 1 15:45:33 2003 UTC revision 1.6 by wohler, Tue Jul 13 03:06:24 2004 UTC
# Line 1  Line 1 
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>
# Line 43  Line 43 
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)
# Line 259  checksum -> (origin-folder, origin-index Line 260  checksum -> (origin-folder, origin-index
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.
# Line 293  they are concatenated to construct the b Line 344  they are concatenated to construct the b
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    
# Line 308  index search, then the search is repeate Line 360  index search, then the search is repeate
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
# Line 344  This has the effect of renaming already Line 395  This has the effect of renaming already
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
# Line 360  This has the effect of renaming already Line 412  This has the effect of renaming already
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)
# Line 401  This has the effect of renaming already Line 460  This has the effect of renaming already
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))
# Line 425  This has the effect of renaming already Line 484  This has the effect of renaming already
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
# Line 437  This has the effect of renaming already Line 503  This has the effect of renaming already
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'."
# Line 452  This has the effect of renaming already Line 590  This has the effect of renaming already
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)
# Line 463  NOT as appropriate. Then the resulting s Line 602  NOT as appropriate. Then the resulting s
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 ")
# Line 498  NOT as appropriate. Then the resulting s Line 639  NOT as appropriate. Then the resulting s
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)
# Line 632  we find a new folder name." Line 773  we find a new folder name."
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))
# Line 646  Returns an alist with the the folder nam Line 787  Returns an alist with the the folder nam
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)
# Line 722  Also `mh-update-unseen' is called in the Line 863  Also `mh-update-unseen' is called in the
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    
# Line 1051  REGEXP-LIST is an alist of fields and va Line 1281  REGEXP-LIST is an alist of fields and va
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    

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

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