/[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.3 by lektu, Tue Feb 4 13:15:32 2003 UTC revision 1.4 by wohler, Fri Apr 25 05:52:00 2003 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 Free Software Foundation, Inc.  ;; Copyright (C) 2002, 2003 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 29  Line 29 
29  ;;;  (1) The following search engines are supported:  ;;;  (1) The following search engines are supported:
30  ;;;        swish++  ;;;        swish++
31  ;;;        swish-e  ;;;        swish-e
32    ;;;        mairix
33  ;;;        namazu  ;;;        namazu
34  ;;;        glimpse  ;;;        glimpse
35  ;;;        grep  ;;;        grep
# Line 40  Line 41 
41    
42  ;;; Change Log:  ;;; Change Log:
43    
 ;; $Id$  
   
44  ;;; Code:  ;;; Code:
45    
46  (require 'cl)  (require 'cl)
# Line 165  The current buffer contains a list of st Line 164  The current buffer contains a list of st
164  will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'  will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
165  strings to it. This is repeated till all the strings have been used."  strings to it. This is repeated till all the strings have been used."
166    (goto-char (point-min))    (goto-char (point-min))
167    (let ((out (get-buffer-create " *mh-xargs-output*")))    (let ((current-buffer (current-buffer)))
168      (save-excursion      (with-temp-buffer
169        (set-buffer out)        (let ((out (current-buffer)))
170        (erase-buffer))          (set-buffer current-buffer)
171      (while (not (eobp))          (while (not (eobp))
172        (let ((arg-list (reverse args))            (let ((arg-list (reverse args))
173              (count 0))                  (count 0))
174          (while (and (not (eobp)) (< count mh-index-max-cmdline-args))              (while (and (not (eobp)) (< count mh-index-max-cmdline-args))
175            (push (buffer-substring-no-properties (point) (line-end-position))                (push (buffer-substring-no-properties (point) (line-end-position))
176                  arg-list)                      arg-list)
177            (incf count)                (incf count)
178            (forward-line))                (forward-line))
179          (apply #'call-process cmd nil (list out nil) nil (nreverse arg-list))))              (apply #'call-process cmd nil (list out nil) nil
180      (erase-buffer)                     (nreverse arg-list))))
181      (insert-buffer-substring out)))          (erase-buffer)
182            (insert-buffer-substring out)))))
183    
184    
185    
# Line 230  checksum -> (origin-folder, origin-index Line 230  checksum -> (origin-folder, origin-index
230                       (point) (line-end-position)))                       (point) (line-end-position)))
231            (forward-line)            (forward-line)
232            (save-excursion            (save-excursion
233              (cond ((eolp)              (cond ((not (string-match "^[0-9]*$" msg)))
234                      ((eolp)
235                     ;; need to compute checksum                     ;; need to compute checksum
236                     (set-buffer mh-checksum-buffer)                     (set-buffer mh-checksum-buffer)
237                     (insert mh-user-path (substring folder 1) "/" msg "\n"))                     (insert mh-user-path (substring folder 1) "/" msg "\n"))
# Line 260  checksum -> (origin-folder, origin-index Line 261  checksum -> (origin-folder, origin-index
261                (mh-index-update-single-msg msg checksum origin-map)))                (mh-index-update-single-msg msg checksum origin-map)))
262            (forward-line))))))            (forward-line))))))
263    
264    (defvar mh-flists-results-folder "new"
265      "Subfolder for `mh-index-folder' where flists output is placed.")
266    
267  (defun mh-index-generate-pretty-name (string)  (defun mh-index-generate-pretty-name (string)
268    "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.
269  White space from the beginning and end are removed. All spaces in the name are  White space from the beginning and end are removed. All spaces in the name are
# Line 288  they are concatenated to construct the b Line 292  they are concatenated to construct the b
292      (subst-char-in-region (point-min) (point-max) ?\n ?_ t)      (subst-char-in-region (point-min) (point-max) ?\n ?_ t)
293      (subst-char-in-region (point-min) (point-max) ?\r ?_ t)      (subst-char-in-region (point-min) (point-max) ?\r ?_ t)
294      (subst-char-in-region (point-min) (point-max) ?/ ?$ t)      (subst-char-in-region (point-min) (point-max) ?/ ?$ t)
295      (truncate-string-to-width (buffer-substring (point-min) (point-max)) 20)))      (let ((out (truncate-string-to-width (buffer-string) 20)))
296          (cond ((eq mh-indexer 'flists) mh-flists-results-folder)
297                ((equal out mh-flists-results-folder) (concat out "1"))
298                (t out)))))
299    
300  ;;;###mh-autoload  ;;;###mh-autoload
301  (defun* mh-index-search (redo-search-flag folder search-regexp  (defun* mh-index-search (redo-search-flag folder search-regexp
302                          &optional window-config)                          &optional window-config unseen-flag)
303    "Perform an indexed search in an MH mail folder.    "Perform an indexed search in an MH mail folder.
304    Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below.
305    
306  If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a  If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
307  index search, then the search is repeated. Otherwise, FOLDER is searched with  index search, then the search is repeated. Otherwise, FOLDER is searched with
308  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
309  \"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG  \"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG
310  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
311  folder containing the index search results.  folder containing the index search results. If optional argument UNSEEN-FLAG
312    is non-nil, then all the messages are marked as unseen.
313    
314  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
315  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 381  This has the effect of renaming already Line 390  This has the effect of renaming already
390        (message "Processing %s output... " mh-indexer)        (message "Processing %s output... " mh-indexer)
391        (goto-char (point-min))        (goto-char (point-min))
392        (loop for next-result = (funcall mh-index-next-result-function)        (loop for next-result = (funcall mh-index-next-result-function)
393              when (null next-result) return nil              while next-result
394              do (unless (eq next-result 'error)              do (unless (eq next-result 'error)
395                   (unless (gethash (car next-result) folder-results-map)                   (unless (gethash (car next-result) folder-results-map)
396                     (setf (gethash (car next-result) folder-results-map)                     (setf (gethash (car next-result) folder-results-map)
# Line 403  This has the effect of renaming already Line 412  This has the effect of renaming already
412                                   (cons folder msg)))))                                   (cons folder msg)))))
413                 folder-results-map)                 folder-results-map)
414    
415          ;; Mark messages as unseen (if needed)
416          (when (and unseen-flag (> result-count 0))
417            (mh-exec-cmd "mark" index-folder "all"
418                         "-sequence" (symbol-name mh-unseen-seq) "-add"))
419    
420        ;; Generate scan lines for the hits.        ;; Generate scan lines for the hits.
421        (let ((mh-show-threads-flag nil))        (mh-visit-folder index-folder () (list folder-results-map origin-map))
         (mh-visit-folder index-folder () (list folder-results-map origin-map)))  
422    
423        (goto-char (point-min))        (goto-char (point-min))
424        (forward-line)        (forward-line)
# Line 548  The function is only applicable to folde Line 561  The function is only applicable to folde
561  With non-nil optional argument BACKWARD-FLAG, jump to the previous group of  With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
562  results."  results."
563    (interactive "P")    (interactive "P")
564    (if (or (null mh-index-data)    (if (null mh-index-data)
565            (memq 'unthread mh-view-ops))        (message "Only applicable in an MH-E index search buffer")
       (message "Only applicable in an unthreaded MH-E index search buffer")  
566      (let ((point (point)))      (let ((point (point)))
567        (forward-line (if backward-flag -1 1))        (forward-line (if backward-flag -1 1))
568        (cond ((if backward-flag        (cond ((if backward-flag
# Line 628  we find a new folder name." Line 640  we find a new folder name."
640      (set-buffer-modified-p old-buffer-modified-flag)))      (set-buffer-modified-p old-buffer-modified-flag)))
641    
642  ;;;###mh-autoload  ;;;###mh-autoload
643    (defun mh-index-group-by-folder ()
644      "Partition the messages based on source folder.
645    Returns an alist with the the folder names in the car and the cdr being the
646    list of messages originally from that folder."
647      (save-excursion
648        (goto-char (point-min))
649        (let ((result-table (make-hash-table)))
650          (loop for msg being hash-keys of mh-index-msg-checksum-map
651                do (push msg (gethash (car (gethash
652                                            (gethash msg mh-index-msg-checksum-map)
653                                            mh-index-checksum-origin-map))
654                                      result-table)))
655          (loop for x being the hash-keys of result-table
656                collect (cons x (nreverse (gethash x result-table)))))))
657    
658    ;;;###mh-autoload
659  (defun mh-index-delete-folder-headers ()  (defun mh-index-delete-folder-headers ()
660    "Delete the folder headers."    "Delete the folder headers."
661    (let ((cur-msg (mh-get-msg-num nil))    (let ((cur-msg (mh-get-msg-num nil))
# Line 662  we find a new folder name." Line 690  we find a new folder name."
690      (when (not folder)      (when (not folder)
691        (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)        (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
692                                   mh-index-checksum-origin-map))))                                   mh-index-checksum-origin-map))))
693      (mh-visit-folder      (when (or (not (get-buffer folder))
694       folder (loop for x being the hash-keys of (gethash folder mh-index-data)                (y-or-n-p (format "Reuse buffer displaying %s? " folder)))
695                    when (mh-msg-exists-p x folder) collect x))))        (mh-visit-folder
696           folder (loop for x being the hash-keys of (gethash folder mh-index-data)
697                        when (mh-msg-exists-p x folder) collect x)))))
698    
699    ;;;###mh-autoload
700    (defun mh-index-update-unseen (msg)
701      "Remove counterpart of MSG in source folder from `mh-unseen-seq'.
702    Also `mh-update-unseen' is called in the original folder, if we have it open."
703      (let* ((checksum (gethash msg mh-index-msg-checksum-map))
704             (folder-msg-pair (gethash checksum mh-index-checksum-origin-map))
705             (orig-folder (car folder-msg-pair))
706             (orig-msg (cdr folder-msg-pair)))
707        (when (mh-index-match-checksum orig-msg orig-folder checksum)
708          (when (get-buffer orig-folder)
709            (save-excursion
710              (set-buffer orig-folder)
711              (unless (member orig-msg mh-seen-list) (push orig-msg mh-seen-list))
712              (mh-update-unseen)))
713          (mh-exec-cmd-daemon "mark" #'ignore orig-folder (format "%s" orig-msg)
714                              "-sequence" (symbol-name mh-unseen-seq) "-del"))))
715    
716  (defun mh-index-match-checksum (msg folder checksum)  (defun mh-index-match-checksum (msg folder checksum)
717    "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."    "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
# Line 918  FOLDER-PATH is the directory in which SE Line 965  FOLDER-PATH is the directory in which SE
965          (when (or (eobp) (and (bolp) (eolp)))          (when (or (eobp) (and (bolp) (eolp)))
966            (return nil))            (return nil))
967          (unless (eq (char-after) ?/)          (unless (eq (char-after) ?/)
968            (return error))            (return 'error))
969          (let ((start (point))          (let ((start (point))
970                end msg-start)                end msg-start)
971            (setq end (line-end-position))            (setq end (line-end-position))
# Line 1000  REGEXP-LIST is an alist of fields and va Line 1047  REGEXP-LIST is an alist of fields and va
1047    
1048    
1049    
1050    ;; Interface to unseen messages script
1051    
1052    (defvar mh-flists-search-folders)
1053    
1054    (defun mh-flists-execute (&rest args)
1055      "Search for unseen messages in `mh-flists-search-folders'.
1056    If `mh-recursive-folders-flag' is t, then the folders are searched
1057    recursively. All parameters ARGS are ignored."
1058      (set-buffer (get-buffer-create mh-index-temp-buffer))
1059      (erase-buffer)
1060      (unless (executable-find "sh")
1061        (error "Didn't find sh"))
1062      (with-temp-buffer
1063        (let ((unseen (symbol-name mh-unseen-seq)))
1064          (insert "for folder in `flists "
1065                  (cond ((eq mh-flists-search-folders t) mh-inbox)
1066                        ((eq mh-flists-search-folders nil) "")
1067                        ((listp mh-flists-search-folders)
1068                         (loop for folder in mh-flists-search-folders
1069                               concat (concat " " folder))))
1070                  (if mh-recursive-folders-flag " -recurse" "")
1071                  " -sequence " unseen " -noshowzero -fast` ; do\n"
1072                  "mhpath \"+$folder\" " unseen "\n" "done\n"))
1073        (call-process-region
1074         (point-min) (point-max) "sh" nil (get-buffer mh-index-temp-buffer))))
1075    
1076    ;;;###mh-autoload
1077    (defun mh-index-new-messages (folders)
1078      "Display new messages.
1079    All messages in the `mh-unseen-seq' sequence from FOLDERS are displayed.
1080    By default the folders specified by `mh-index-new-messages-folders' are
1081    searched. With a prefix argument, enter a space-separated list of folders, or
1082    nothing to search all folders."
1083      (interactive
1084       (list (if current-prefix-arg
1085                 (split-string (read-string "Folders to search: "))
1086               mh-index-new-messages-folders)))
1087      (let* ((mh-flists-search-folders folders)
1088             (mh-indexer 'flists)
1089             (mh-index-execute-search-function 'mh-flists-execute)
1090             (mh-index-next-result-function 'mh-mairix-next-result)
1091             (mh-mairix-folder mh-user-path)
1092             (mh-index-regexp-builder nil)
1093             (new-folder (format "%s/%s" mh-index-folder mh-flists-results-folder))
1094             (window-config (if (equal new-folder mh-current-folder)
1095                                mh-previous-window-config
1096                              (current-window-configuration)))
1097             (redo-flag nil))
1098        (cond ((buffer-live-p (get-buffer new-folder))
1099               ;; The destination folder is being visited. Trick `mh-index-search'
1100               ;; into thinking that the folder was the result of a previous search.
1101               (set-buffer new-folder)
1102               (setq mh-index-previous-search (list "+" mh-flists-results-folder))
1103               (setq redo-flag t))
1104              ((mh-folder-exists-p new-folder)
1105               ;; Folder exists but we don't have it open. That means they are
1106               ;; stale results from a old flists search. Clear it out.
1107               (mh-exec-cmd-quiet nil "rmf" new-folder)))
1108        (mh-index-search redo-flag "+" mh-flists-results-folder window-config t)))
1109    
1110    
1111    
1112  ;; Swish interface  ;; Swish interface
1113    
1114  (defvar mh-swish-binary (executable-find "swish-e"))  (defvar mh-swish-binary (executable-find "swish-e"))
# Line 1163  FOLDER-PATH is the directory in which SE Line 1272  FOLDER-PATH is the directory in which SE
1272  (defun mh-swish++-regexp-builder (regexp-list)  (defun mh-swish++-regexp-builder (regexp-list)
1273    "Generate query for swish++.    "Generate query for swish++.
1274  REGEXP-LIST is an alist of fields and values."  REGEXP-LIST is an alist of fields and values."
1275    (let ((regexp "") meta)    (let ((regexp ""))
1276      (dolist (elem regexp-list)      (dolist (elem regexp-list)
1277        (when (cdr elem)        (when (cdr elem)
1278          (setq regexp (concat regexp " and "          (setq regexp (concat regexp " and "
# Line 1264  FOLDER-PATH is the directory in which SE Line 1373  FOLDER-PATH is the directory in which SE
1373    
1374    
1375    
1376    ;;;###mh-autoload
1377  (defun mh-index-choose ()  (defun mh-index-choose ()
1378    "Choose an indexing function.    "Choose an indexing function.
1379  The side-effects of this function are that the variables `mh-indexer',  The side-effects of this function are that the variables `mh-indexer',

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

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