/[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.4.3 by miles, Sat Jul 17 02:51:49 2004 UTC revision 1.3.4.4 by miles, Sat Sep 4 09:22:56 2004 UTC
# Line 31  Line 31 
31  ;;;        swish-e  ;;;        swish-e
32  ;;;        mairix  ;;;        mairix
33  ;;;        namazu  ;;;        namazu
 ;;;        glimpse  
34  ;;;        grep  ;;;        grep
35  ;;;  ;;;
36  ;;;  (2) To use this package, you first have to build an index. Please read  ;;;  (2) To use this package, you first have to build an index. Please read
# Line 43  Line 42 
42    
43  ;;; Code:  ;;; Code:
44    
45  (require 'mh-utils)  (eval-when-compile (require 'mh-acros))
46  (mh-require-cl)  (mh-require-cl)
47  (require 'mh-e)  (require 'mh-e)
48  (require 'mh-mime)  (require 'mh-mime)
# Line 66  Line 65 
65       mh-mairix-regexp-builder)       mh-mairix-regexp-builder)
66      (namazu      (namazu
67       mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil)       mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil)
     (glimpse  
      mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result nil)  
68      (pick      (pick
69       mh-pick-binary mh-pick-execute-search mh-pick-next-result       mh-pick-binary mh-pick-execute-search mh-pick-next-result
70       mh-pick-regexp-builder)       mh-pick-regexp-builder)
# Line 200  This function should only be called in t Line 197  This function should only be called in t
197             (call-process "rm" nil nil nil             (call-process "rm" nil nil nil
198                           (format "%s%s/%s" mh-user-path                           (format "%s%s/%s" mh-user-path
199                                   (substring mh-current-folder 1) msg))                                   (substring mh-current-folder 1) msg))
200             (remhash omsg (gethash ofolder mh-index-data))))             (when (gethash ofolder mh-index-data)
201                 (remhash omsg (gethash ofolder mh-index-data)))))
202          (t          (t
203           (setf (gethash msg mh-index-msg-checksum-map) checksum)           (setf (gethash msg mh-index-msg-checksum-map) checksum)
204           (when origin-map           (when origin-map
# Line 301  list of messages in that sequence." Line 299  list of messages in that sequence."
299               (pair (gethash checksum mh-index-checksum-origin-map))               (pair (gethash checksum mh-index-checksum-origin-map))
300               (ofolder (car pair))               (ofolder (car pair))
301               (omsg (cdr pair)))               (omsg (cdr pair)))
302          (loop for seq in (gethash omsg (gethash ofolder seq-hash))          (loop for seq in (ignore-errors
303                               (gethash omsg (gethash ofolder seq-hash)))
304                do (if (assoc seq seq-list)                do (if (assoc seq seq-list)
305                       (push msg (cdr (assoc seq seq-list)))                       (push msg (cdr (assoc seq seq-list)))
306                     (push (list seq msg) seq-list)))))                     (push (list seq msg) seq-list)))))
# Line 374  index for each program: Line 373  index for each program:
373      - `mh-swish-execute-search'      - `mh-swish-execute-search'
374      - `mh-mairix-execute-search'      - `mh-mairix-execute-search'
375      - `mh-namazu-execute-search'      - `mh-namazu-execute-search'
     - `mh-glimpse-execute-search'  
376    
377  If none of these programs are present then we use pick. If desired grep can be  If none of these programs are present then we use pick. If desired grep can be
378  used instead. Details about these methods can be found in:  used instead. Details about these methods can be found in:
# Line 436  This has the effect of renaming already Line 434  This has the effect of renaming already
434            (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))            (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
435            (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)            (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
436            (setq index-folder buffer-name))            (setq index-folder buffer-name))
437        (setq index-folder (mh-index-new-folder index-folder)))        (setq index-folder (mh-index-new-folder index-folder search-regexp)))
438    
439      (let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))      (let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
440            (folder-results-map (make-hash-table :test #'equal))            (folder-results-map (make-hash-table :test #'equal))
# Line 587  PROC is used to convert the value to act Line 585  PROC is used to convert the value to act
585                           mh-previous-window-config)                           mh-previous-window-config)
586        (error "No search terms"))))        (error "No search terms"))))
587    
 (defun mh-replace-string (old new)  
   "Replace all occurrences of OLD with NEW in the current buffer."  
   (goto-char (point-min))  
   (let ((case-fold-search t))  
     (while (search-forward old nil t)  
       (replace-match new t t))))  
   
588  ;;;###mh-autoload  ;;;###mh-autoload
589  (defun mh-index-parse-search-regexp (input-string)  (defun mh-index-parse-search-regexp (input-string)
590    "Construct parse tree for INPUT-STRING.    "Construct parse tree for INPUT-STRING.
# Line 739  results." Line 730  results."
730    "Check if MSG exists in FOLDER."    "Check if MSG exists in FOLDER."
731    (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg)))    (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg)))
732    
733  (defun mh-index-new-folder (name)  (defun mh-index-new-folder (name search-regexp)
734    "Create and return an MH folder name based on NAME.    "Return a folder name based on NAME for search results of SEARCH-REGEXP.
735  If the folder NAME already exists then check if NAME<2> exists. If it doesn't  
736  then it is created and returned. Otherwise try NAME<3>. This is repeated till  If folder NAME already exists and was generated for the same SEARCH-REGEXP
737  we find a new folder name."  then it is reused.
738    
739    Otherwise if the folder NAME was generated from a different search then check
740    if NAME<2> can be used. Otherwise try NAME<3>. This is repeated till we find a
741    new folder name.
742    
743    If the folder returned doesn't exist then it is created."
744    (unless (mh-folder-name-p name)    (unless (mh-folder-name-p name)
745      (error "The argument should be a valid MH folder name"))      (error "The argument should be a valid MH folder name"))
746    (let ((chosen-name name))    (let ((chosen-name
747      (block unique-name           (loop for i from 1
748        (unless (mh-folder-exists-p name)                 for candidate = (if (equal i 1) name (format "%s<%s>" name i))
749          (return-from unique-name))                 when (or (not (mh-folder-exists-p candidate))
750        (loop for index from 2                          (equal (mh-index-folder-search-regexp candidate)
751              do (let ((new-name (format "%s<%s>" name index)))                                 search-regexp))
752                   (unless (mh-folder-exists-p new-name)                 return candidate)))
753                     (setq chosen-name new-name)      ;; Do pending refiles/deletes...
754                     (return-from unique-name)))))      (when (get-buffer chosen-name)
755          (mh-process-or-undo-commands chosen-name))
756        ;; Recreate folder...
757        (save-excursion (mh-exec-cmd-quiet nil "rmf" chosen-name))
758      (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)      (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
759      (mh-remove-from-sub-folders-cache chosen-name)      (mh-remove-from-sub-folders-cache chosen-name)
760      (when (boundp 'mh-speed-folder-map)      (when (boundp 'mh-speed-folder-map)
761        (mh-speed-add-folder chosen-name))        (mh-speed-add-folder chosen-name))
762      chosen-name))      chosen-name))
763    
764    (defun mh-index-folder-search-regexp (folder)
765      "If FOLDER was created by a index search, return the search regexp.
766    Return nil if FOLDER doesn't exist or the .mhe_index file is garbled."
767      (ignore-errors
768        (with-temp-buffer
769          (insert-file-contents
770           (format "%s%s/%s" mh-user-path (substring folder 1) mh-index-data-file))
771          (goto-char (point-min))
772          (forward-list 3)
773          (cadr (read (current-buffer))))))
774    
775  ;;;###mh-autoload  ;;;###mh-autoload
776  (defun mh-index-insert-folder-headers ()  (defun mh-index-insert-folder-headers ()
777    "Annotate the search results with original folder names."    "Annotate the search results with original folder names."
# Line 777  we find a new folder name." Line 788  we find a new folder name."
788          (insert (if last-folder "\n" "") current-folder "\n")          (insert (if last-folder "\n" "") current-folder "\n")
789          (setq last-folder current-folder))          (setq last-folder current-folder))
790        (forward-line))        (forward-line))
791      (when cur-msg (mh-goto-msg cur-msg t))      (when cur-msg
792      (set-buffer-modified-p old-buffer-modified-flag)))        (mh-notate-cur)
793          (mh-goto-msg cur-msg t))
794        (set-buffer-modified-p old-buffer-modified-flag))
795      (mh-index-create-imenu-index))
796    
797    ;;;###mh-autoload
798    (defun mh-index-create-imenu-index ()
799      "Create alist of folder names and positions in index folder buffers."
800      (save-excursion
801        (setq which-func-mode t)
802        (let ((alist ()))
803          (goto-char (point-min))
804          (while (re-search-forward "^+" nil t)
805            (save-excursion
806              (beginning-of-line)
807              (push (cons (buffer-substring-no-properties
808                           (point) (line-end-position))
809                          (set-marker (make-marker) (point)))
810                    alist)))
811          (setq imenu--index-alist (nreverse alist)))))
812    
813  ;;;###mh-autoload  ;;;###mh-autoload
814  (defun mh-index-group-by-folder ()  (defun mh-index-group-by-folder ()
# Line 837  list of messages originally from that fo Line 867  list of messages originally from that fo
867         folder (loop for x being the hash-keys of (gethash folder mh-index-data)         folder (loop for x being the hash-keys of (gethash folder mh-index-data)
868                      when (mh-msg-exists-p x folder) collect x)))))                      when (mh-msg-exists-p x folder) collect x)))))
869    
 ;;;###mh-autoload  
 (defun mh-index-update-unseen (msg)  
   "Remove counterpart of MSG in source folder from `mh-unseen-seq'.  
 Also `mh-update-unseen' is called in the original folder, if we have it open."  
   (let* ((checksum (gethash msg mh-index-msg-checksum-map))  
          (folder-msg-pair (gethash checksum mh-index-checksum-origin-map))  
          (orig-folder (car folder-msg-pair))  
          (orig-msg (cdr folder-msg-pair)))  
     (when (mh-index-match-checksum orig-msg orig-folder checksum)  
       (when (get-buffer orig-folder)  
         (save-excursion  
           (set-buffer orig-folder)  
           (unless (member orig-msg mh-seen-list) (push orig-msg mh-seen-list))  
           (mh-update-unseen)))  
       (mh-exec-cmd-daemon "mark" #'ignore orig-folder (format "%s" orig-msg)  
                           "-sequence" (symbol-name mh-unseen-seq) "-del"))))  
   
870  (defun mh-index-match-checksum (msg folder checksum)  (defun mh-index-match-checksum (msg folder checksum)
871    "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."
872    (with-temp-buffer    (with-temp-buffer
# Line 973  update the source folder buffer if prese Line 986  update the source folder buffer if prese
986    
987    
988    
 ;; Glimpse interface  
   
 (defvar mh-glimpse-binary (executable-find "glimpse"))  
 (defvar mh-glimpse-directory ".glimpse")  
   
 ;;;###mh-autoload  
 (defun mh-glimpse-execute-search (folder-path search-regexp)  
   "Execute glimpse and read the results.  
   
 In the examples below, replace /home/user/Mail with the path to your MH  
 directory.  
   
 First create the directory /home/user/Mail/.glimpse. Then create the file  
 /home/user/Mail/.glimpse/.glimpse_exclude with the following contents:  
   
     */.*  
     */#*  
     */,*  
     */*~  
     ^/home/user/Mail/.glimpse  
     ^/home/user/Mail/mhe-index  
   
 If there are any directories you would like to ignore, append lines like the  
 following to .glimpse_exclude:  
   
     ^/home/user/Mail/scripts  
   
 You do not want to index the folders that hold the results of your searches  
 since they tend to be ephemeral and the original messages are indexed anyway.  
 The configuration file above assumes that the results are found in sub-folders  
 of `mh-index-folder' which is +mhe-index by default.  
   
 Use the following command line to generate the glimpse index. Run this  
 daily from cron:  
   
     glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail  
   
 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."  
   (set-buffer (get-buffer-create mh-index-temp-buffer))  
   (erase-buffer)  
   (call-process mh-glimpse-binary nil '(t nil) nil  
                                         ;(format "-%s" fuzz)  
                 "-i" "-y"  
                 "-H" (format "%s%s" mh-user-path mh-glimpse-directory)  
                 "-F" (format "^%s" folder-path)  
                 search-regexp)  
   (goto-char (point-min)))  
   
 (defun mh-glimpse-next-result ()  
   "Read the next result.  
 Parse it and return the message folder, message index and the match. If no  
 other matches left then return nil. If the current record is invalid return  
 'error."  
   (prog1  
       (block nil  
         (when (eobp)  
           (return nil))  
         (let ((eol-pos (line-end-position))  
               (bol-pos (line-beginning-position))  
               folder-start msg-end)  
           (goto-char bol-pos)  
           (unless (search-forward mh-user-path eol-pos t)  
             (return 'error))  
           (setq folder-start (point))  
           (unless (search-forward ": " eol-pos t)  
             (return 'error))  
           (let ((match (buffer-substring-no-properties (point) eol-pos)))  
             (forward-char -2)  
             (setq msg-end (point))  
             (unless (search-backward "/" folder-start t)  
               (return 'error))  
             (list (format "+%s" (buffer-substring-no-properties  
                                  folder-start (point)))  
                   (let ((val (ignore-errors (read-from-string  
                                              (buffer-substring-no-properties  
                                               (1+ (point)) msg-end)))))  
                     (if (and (consp val) (integerp (car val)))  
                         (car val)  
                       (return 'error)))  
                   match))))  
     (forward-line)))  
   
   
   
989  ;; Pick interface  ;; Pick interface
990    
991  (defvar mh-index-pick-folder)  (defvar mh-index-pick-folder)
# Line 1319  then the folders are searched recursivel Line 1248  then the folders are searched recursivel
1248  ;;;###mh-autoload  ;;;###mh-autoload
1249  (defun mh-index-sequenced-messages (folders sequence)  (defun mh-index-sequenced-messages (folders sequence)
1250    "Display messages from FOLDERS in SEQUENCE.    "Display messages from FOLDERS in SEQUENCE.
1251  By default the folders specified by `mh-index-new-messages-folders' are  All messages in the sequence you provide from the folders in
1252  searched. With a prefix argument, enter a space-separated list of folders, or  `mh-index-new-messages-folders' are listed. With a prefix argument, enter a
1253  nothing to search all folders.  space-separated list of folders, or nothing to search all folders."
   
 Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the  
 function searches for in each of the FOLDERS. With a prefix argument, enter a  
 sequence to use."  
1254    (interactive    (interactive
1255     (list (if current-prefix-arg     (list (if current-prefix-arg
1256               (split-string (read-string "Search folder(s) [all]? "))               (split-string (read-string "Search folder(s): [all] "))
1257             mh-index-new-messages-folders)             mh-index-new-messages-folders)
1258           (mh-read-seq-default "Search" nil)))           (mh-read-seq-default "Search" nil)))
1259    (unless sequence (setq sequence mh-unseen-seq))    (unless sequence (setq sequence mh-unseen-seq))
# Line 1367  sequence to use." Line 1292  sequence to use."
1292  ;;;###mh-autoload  ;;;###mh-autoload
1293  (defun mh-index-new-messages (folders)  (defun mh-index-new-messages (folders)
1294    "Display unseen messages.    "Display unseen messages.
1295  All messages in the `unseen' sequence from FOLDERS are displayed.  If you use a program such as `procmail' to use `rcvstore' to file your
1296  By default the folders specified by `mh-index-new-messages-folders'  incoming mail automatically, you can display new, unseen, messages using this
1297  are searched. With a prefix argument, enter a space-separated list of  command. All messages in the `unseen' sequence from the folders in
1298  folders, or nothing to search all folders."  `mh-index-new-messages-folders' are listed. With a prefix argument, enter a
1299    space-separated list of FOLDERS, or nothing to search all folders."
1300    (interactive    (interactive
1301     (list (if current-prefix-arg     (list (if current-prefix-arg
1302               (split-string (read-string "Search folder(s) [all]? "))               (split-string (read-string "Search folder(s): [all] "))
1303             mh-index-new-messages-folders)))             mh-index-new-messages-folders)))
1304    (mh-index-sequenced-messages folders mh-unseen-seq))    (mh-index-sequenced-messages folders mh-unseen-seq))
1305    
1306  ;;;###mh-autoload  ;;;###mh-autoload
1307  (defun mh-index-ticked-messages (folders)  (defun mh-index-ticked-messages (folders)
1308    "Display ticked messages.    "Display ticked messages.
1309  All messages in the `tick' sequence from FOLDERS are displayed.  All messages in `mh-tick-seq' from the folders in
1310  By default the folders specified by `mh-index-ticked-messages-folders'  `mh-index-ticked-messages-folders' are listed. With a prefix argument, enter a
1311  are searched. With a prefix argument, enter a space-separated list of  space-separated list of FOLDERS, or nothing to search all folders."
 folders, or nothing to search all folders."  
1312    (interactive    (interactive
1313     (list (if current-prefix-arg     (list (if current-prefix-arg
1314               (split-string (read-string "Search folder(s) [all]? "))               (split-string (read-string "Search folder(s): [all] "))
1315             mh-index-ticked-messages-folders)))             mh-index-ticked-messages-folders)))
1316    (mh-index-sequenced-messages folders mh-tick-seq))    (mh-index-sequenced-messages folders mh-tick-seq))
1317    

Legend:
Removed from v.1.3.4.3  
changed lines
  Added in v.1.3.4.4

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