-;;; mh-search --- MH-E search
+;;; mh-search --- MH-Search mode
-;; Copyright (C) 1993, 1995,
-;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Indexed search by Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
+;; Mode used to compose search criteria.
+
;; (1) The following search engines are supported:
;; swish++
;; swish-e
;; namazu
;; pick
;; grep
-;;
+
;; (2) To use this package, you first have to build an index. Please
;; read the documentation for `mh-search' to get started. That
;; documentation will direct you to the specific instructions for
;;; Code:
-;;(message "> mh-search")
-(eval-when-compile (require 'mh-acros))
+(require 'mh-e)
(mh-require-cl)
(require 'gnus-util)
-(require 'mh-buffers)
-(require 'mh-e)
-;;(message "< mh-search")
+(require 'imenu)
(defvar mh-searcher nil
"Cached value of chosen search program.")
\f
-;;; MH-Search mode
+;;; MH-Folder Commands
;;;###mh-autoload
-(defun* mh-search (folder search-regexp
- &optional redo-search-flag window-config)
+(defun mh-search (folder search-regexp
+ &optional redo-search-flag window-config)
"Search your MH mail.
This command helps you find messages in your entire corpus of
mh-search-regexp-builder)
(current-window-configuration)
nil)))
- ;; Redoing a sequence search?
- (when (and redo-search-flag mh-index-data mh-index-sequence-search-flag
- (not mh-flists-called-flag))
- (let ((mh-flists-called-flag t))
- (apply #'mh-index-sequenced-messages mh-index-previous-search))
- (return-from mh-search))
- ;; We have fancy query parsing.
- (when (symbolp search-regexp)
- (mh-search-folder folder window-config)
- (return-from mh-search))
- ;; Begin search proper.
- (mh-checksum-choose)
- (let ((result-count 0)
- (old-window-config (or window-config mh-previous-window-config))
- (previous-search mh-index-previous-search)
- (index-folder (format "%s/%s" mh-index-folder
- (mh-index-generate-pretty-name search-regexp))))
- ;; Create a new folder for the search results or recreate the old one...
- (if (and redo-search-flag mh-index-previous-search)
- (let ((buffer-name (buffer-name (current-buffer))))
- (mh-process-or-undo-commands buffer-name)
- (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
- (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
- (setq index-folder buffer-name))
- (setq index-folder (mh-index-new-folder index-folder search-regexp)))
-
- (let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
- (folder-results-map (make-hash-table :test #'equal))
- (origin-map (make-hash-table :test #'equal)))
- ;; Run search program...
- (message "Executing %s... " mh-searcher)
- (funcall mh-search-function folder-path search-regexp)
-
- ;; Parse searcher output.
- (message "Processing %s output... " mh-searcher)
- (goto-char (point-min))
- (loop for next-result = (funcall mh-search-next-result-function)
- while next-result
- do (unless (eq next-result 'error)
- (unless (gethash (car next-result) folder-results-map)
- (setf (gethash (car next-result) folder-results-map)
- (make-hash-table :test #'equal)))
- (setf (gethash (cadr next-result)
- (gethash (car next-result) folder-results-map))
- t)))
-
- ;; Copy the search results over.
- (maphash #'(lambda (folder msgs)
- (let ((cur (car (mh-translate-range folder "cur")))
- (msgs (sort (loop for msg being the hash-keys of msgs
- collect msg)
- #'<)))
- (mh-exec-cmd "refile" msgs "-src" folder
- "-link" index-folder)
- ;; Restore cur to old value, that refile changed
- (when cur
- (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
- "-sequence" "cur" (format "%s" cur)))
- (loop for msg in msgs
- do (incf result-count)
- (setf (gethash result-count origin-map)
- (cons folder msg)))))
- folder-results-map)
-
- ;; Vist the results folder.
- (mh-visit-folder index-folder () (list folder-results-map origin-map))
+ (block mh-search
+ ;; Redoing a sequence search?
+ (when (and redo-search-flag mh-index-data mh-index-sequence-search-flag
+ (not mh-flists-called-flag))
+ (let ((mh-flists-called-flag t))
+ (apply #'mh-index-sequenced-messages mh-index-previous-search))
+ (return-from mh-search))
+ ;; We have fancy query parsing.
+ (when (symbolp search-regexp)
+ (mh-search-folder folder window-config)
+ (return-from mh-search))
+ ;; Begin search proper.
+ (mh-checksum-choose)
+ (let ((result-count 0)
+ (old-window-config (or window-config mh-previous-window-config))
+ (previous-search mh-index-previous-search)
+ (index-folder (format "%s/%s" mh-index-folder
+ (mh-index-generate-pretty-name search-regexp))))
+ ;; Create a new folder for the search results or recreate the old one...
+ (if (and redo-search-flag mh-index-previous-search)
+ (let ((buffer-name (buffer-name (current-buffer))))
+ (mh-process-or-undo-commands buffer-name)
+ (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
+ (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
+ (setq index-folder buffer-name))
+ (setq index-folder (mh-index-new-folder index-folder search-regexp)))
+
+ (let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
+ (folder-results-map (make-hash-table :test #'equal))
+ (origin-map (make-hash-table :test #'equal)))
+ ;; Run search program...
+ (message "Executing %s... " mh-searcher)
+ (funcall mh-search-function folder-path search-regexp)
+
+ ;; Parse searcher output.
+ (message "Processing %s output... " mh-searcher)
+ (goto-char (point-min))
+ (loop for next-result = (funcall mh-search-next-result-function)
+ while next-result
+ do (unless (eq next-result 'error)
+ (unless (gethash (car next-result) folder-results-map)
+ (setf (gethash (car next-result) folder-results-map)
+ (make-hash-table :test #'equal)))
+ (setf (gethash (cadr next-result)
+ (gethash (car next-result) folder-results-map))
+ t)))
+
+ ;; Copy the search results over.
+ (maphash #'(lambda (folder msgs)
+ (let ((cur (car (mh-translate-range folder "cur")))
+ (msgs (sort (loop for msg being the hash-keys of msgs
+ collect msg)
+ #'<)))
+ (mh-exec-cmd "refile" msgs "-src" folder
+ "-link" index-folder)
+ ;; Restore cur to old value, that refile changed
+ (when cur
+ (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
+ "-sequence"
+ "cur" (format "%s" cur)))
+ (loop for msg in msgs
+ do (incf result-count)
+ (setf (gethash result-count origin-map)
+ (cons folder msg)))))
+ folder-results-map)
+
+ ;; Vist the results folder.
+ (mh-visit-folder index-folder () (list folder-results-map origin-map))
- (goto-char (point-min))
- (forward-line)
- (mh-update-sequences)
- (mh-recenter nil)
+ (goto-char (point-min))
+ (forward-line)
+ (mh-update-sequences)
+ (mh-recenter nil)
- ;; Update the speedbar, if needed.
- (when (mh-speed-flists-active-p)
- (mh-speed-flists t mh-current-folder))
+ ;; Update the speedbar, if needed.
+ (when (mh-speed-flists-active-p)
+ (mh-speed-flists t mh-current-folder))
- ;; Maintain history.
- (when (or (and redo-search-flag previous-search) window-config)
- (setq mh-previous-window-config old-window-config))
- (setq mh-index-previous-search (list folder mh-searcher search-regexp))
+ ;; Maintain history.
+ (when (or (and redo-search-flag previous-search) window-config)
+ (setq mh-previous-window-config old-window-config))
+ (setq mh-index-previous-search (list folder mh-searcher search-regexp))
- ;; Write out data to disk.
- (unless mh-flists-called-flag (mh-index-write-data))
+ ;; Write out data to disk.
+ (unless mh-flists-called-flag (mh-index-write-data))
- (message "%s found %s matches in %s folders"
- (upcase-initials (symbol-name mh-searcher))
- (loop for msg-hash being hash-values of mh-index-data
- sum (hash-table-count msg-hash))
- (loop for msg-hash being hash-values of mh-index-data
- count (> (hash-table-count msg-hash) 0))))))
+ (message "%s found %s matches in %s folders"
+ (upcase-initials (symbol-name mh-searcher))
+ (loop for msg-hash being the hash-values of mh-index-data
+ sum (hash-table-count msg-hash))
+ (loop for msg-hash being the hash-values of mh-index-data
+ count (> (hash-table-count msg-hash) 0)))))))
+
+;; Shush compiler.
+(mh-do-in-xemacs
+ (defvar pick-folder))
(defun mh-search-folder (folder window-config)
"Search FOLDER for messages matching a pattern.
(goto-char (point-min))
(dotimes (i 5)
(add-text-properties (point) (1+ (point)) '(front-sticky t))
- (add-text-properties (- (line-end-position) 2) (1- (line-end-position))
+ (add-text-properties (- (mh-line-end-position) 2)
+ (1- (mh-line-end-position))
'(rear-nonsticky t))
- (add-text-properties (point) (1- (line-end-position)) '(read-only t))
+ (add-text-properties (point) (1- (mh-line-end-position)) '(read-only t))
(forward-line))
(add-text-properties (point) (1+ (point)) '(front-sticky t))
- (add-text-properties (point) (1- (line-end-position)) '(read-only t))
+ (add-text-properties (point) (1- (mh-line-end-position)) '(read-only t))
(goto-char (point-max)))
-;;;###mh-autoload
-(defvar mh-search-mode-map (make-sparse-keymap)
- "Keymap for searching folder.")
-
-;;;###mh-autoload
-;; If this changes, modify mh-search-mode-help-messages accordingly, below.
-(gnus-define-keys mh-search-mode-map
- "\C-c?" mh-help
- "\C-c\C-c" mh-index-do-search
- "\C-c\C-p" mh-pick-do-search
- "\C-c\C-f\C-b" mh-to-field
- "\C-c\C-f\C-c" mh-to-field
- "\C-c\C-f\C-d" mh-to-field
- "\C-c\C-f\C-f" mh-to-field
- "\C-c\C-f\C-r" mh-to-field
- "\C-c\C-f\C-s" mh-to-field
- "\C-c\C-f\C-t" mh-to-field
- "\C-c\C-fb" mh-to-field
- "\C-c\C-fc" mh-to-field
- "\C-c\C-fd" mh-to-field
- "\C-c\C-ff" mh-to-field
- "\C-c\C-fr" mh-to-field
- "\C-c\C-fs" mh-to-field
- "\C-c\C-ft" mh-to-field)
-
-(easy-menu-define
- mh-pick-menu mh-search-mode-map "Menu for MH-E Search"
- '("Search"
- ["Perform Search" mh-index-do-search t]
- ["Search with pick" mh-pick-do-search t]))
-
-;; Group messages logically, more or less.
-(defvar mh-search-mode-help-messages
- '((nil
- "Perform search: \\[mh-index-do-search]\n"
- "Search with pick: \\[mh-pick-do-search]\n"
- "Move to a field by typing C-c C-f C-<field>\n"
- "where <field> is the first letter of the desired field\n"
- "(except for From: which uses \"m\")."))
- "Key binding cheat sheet.
-
-This is an associative array which is used to show the most common
-commands. The key is a prefix char. The value is one or more strings
-which are concatenated together and displayed in the minibuffer if ?
-is pressed after the prefix character. The special key nil is used to
-display the non-prefixed commands.
-
-The substitutions described in `substitute-command-keys' are performed
-as well.")
-
-(put 'mh-search-mode 'mode-class 'special)
-
-(define-derived-mode mh-search-mode fundamental-mode "MH-Search"
- "Mode for creating search templates in MH-E.\\<mh-search-mode-map>
-
-Edit this template by entering your search criteria in an
-appropriate header field that is already there, or create a new
-field yourself. If the string you're looking for could be
-anywhere in a message, then place the string underneath the row
-of dashes.
-
-To perform the search, type \\[mh-index-do-search].
-
-Sometimes you're searching for text that is either not indexed,
-or hasn't been indexed yet. In this case you can override the
-default method with the pick method by running the command
-\\[mh-pick-do-search].
-
-The hook `mh-search-mode-hook' is called upon entry to this mode.
-
-\\{mh-search-mode-map}"
-
- (make-local-variable 'mh-help-messages)
- (easy-menu-add mh-pick-menu)
- (setq mh-help-messages mh-search-mode-help-messages))
-
-;;;###mh-autoload
-(defun mh-index-do-search (&optional searcher)
- "Find messages using `mh-search-program'.
-If optional argument SEARCHER is present, use it instead of
-`mh-search-program'."
- (interactive)
- (unless (mh-search-choose searcher) (error "No search program found"))
- (let* ((regexp-list (mh-pick-parse-search-buffer))
- (pattern (funcall mh-search-regexp-builder regexp-list)))
- (if pattern
- (mh-search mh-current-folder pattern nil mh-previous-window-config)
- (error "No search terms"))))
-
-;;;###mh-autoload
-(defun mh-pick-do-search ()
- "Find messages using \"pick\".
-
-Uses the pick method described in `mh-pick-execute-search'."
- (interactive)
- (mh-index-do-search 'pick))
-
-(defun mh-pick-parse-search-buffer ()
- "Parse the search buffer contents.
-The function returns a alist. The car of each element is either
-the header name to search in or nil to search the whole message.
-The cdr of the element is the pattern to search."
- (save-excursion
- (let ((pattern-list ())
- (in-body-flag nil)
- start begin)
- (goto-char (point-min))
- (while (not (eobp))
- (if (search-forward "--------" (line-end-position) t)
- (setq in-body-flag t)
- (beginning-of-line)
- (setq begin (point))
- (setq start (if in-body-flag
- (point)
- (search-forward ":" (line-end-position) t)
- (point)))
- (push (cons (and (not in-body-flag)
- (intern (downcase
- (buffer-substring-no-properties
- begin (1- start)))))
- (mh-index-parse-search-regexp
- (buffer-substring-no-properties
- start (line-end-position))))
- pattern-list))
- (forward-line))
- pattern-list)))
-
-;;;###mh-autoload
-(defun mh-index-parse-search-regexp (input-string)
- "Construct parse tree for INPUT-STRING.
-All occurrences of &, |, ! and ~ in INPUT-STRING are replaced by
-AND, OR and NOT as appropriate. Then the resulting string is
-parsed."
- (let (input)
- (with-temp-buffer
- (insert input-string)
- ;; replace tabs
- (mh-replace-string "\t" " ")
- ;; synonyms of AND
- (mh-replace-string " AND " " and ")
- (mh-replace-string "&" " and ")
- (mh-replace-string " -and " " and ")
- ;; synonyms of OR
- (mh-replace-string " OR " " or ")
- (mh-replace-string "|" " or ")
- (mh-replace-string " -or " " or ")
- ;; synonyms of NOT
- (mh-replace-string " NOT " " not ")
- (mh-replace-string "!" " not ")
- (mh-replace-string "~" " not ")
- (mh-replace-string " -not " " not ")
- ;; synonyms of left brace
- (mh-replace-string "(" " ( ")
- (mh-replace-string " -lbrace " " ( ")
- ;; synonyms of right brace
- (mh-replace-string ")" " ) ")
- (mh-replace-string " -rbrace " " ) ")
- ;; get the normalized input
- (setq input (format "( %s )" (buffer-substring (point-min) (point-max)))))
-
- (let ((tokens (mh-index-add-implicit-ops (split-string input)))
- (op-stack ())
- (operand-stack ())
- oper1)
- (dolist (token tokens)
- (cond ((equal token "(") (push 'paren op-stack))
- ((equal token "not") (push 'not op-stack))
- ((equal token "or") (push 'or op-stack))
- ((equal token "and") (push 'and op-stack))
- ((equal token ")")
- (multiple-value-setq (op-stack operand-stack)
- (mh-index-evaluate op-stack operand-stack))
- (when (eq (car op-stack) 'not)
- (setq op-stack (cdr op-stack))
- (push `(not ,(pop operand-stack)) operand-stack))
- (when (eq (car op-stack) 'and)
- (setq op-stack (cdr op-stack))
- (setq oper1 (pop operand-stack))
- (push `(and ,(pop operand-stack) ,oper1) operand-stack)))
- ((eq (car op-stack) 'not)
- (setq op-stack (cdr op-stack))
- (push `(not ,token) operand-stack)
- (when (eq (car op-stack) 'and)
- (setq op-stack (cdr op-stack))
- (setq oper1 (pop operand-stack))
- (push `(and ,(pop operand-stack) ,oper1) operand-stack)))
- ((eq (car op-stack) 'and)
- (setq op-stack (cdr op-stack))
- (push `(and ,(pop operand-stack) ,token) operand-stack))
- (t (push token operand-stack))))
- (prog1 (pop operand-stack)
- (when (or op-stack operand-stack)
- (error "Invalid regexp: %s" input))))))
-
-(defun mh-index-add-implicit-ops (tokens)
- "Add implicit operators in the list TOKENS."
- (let ((result ())
- (literal-seen nil)
- current)
- (while tokens
- (setq current (pop tokens))
- (cond ((or (equal current ")") (equal current "and") (equal current "or"))
- (setq literal-seen nil)
- (push current result))
- ((and literal-seen
- (push "and" result)
- (setq literal-seen nil)
- nil))
- (t
- (push current result)
- (unless (or (equal current "(") (equal current "not"))
- (setq literal-seen t)))))
- (nreverse result)))
-
-(defun mh-index-evaluate (op-stack operand-stack)
- "Read expression till starting paren based on OP-STACK and OPERAND-STACK."
- (block mh-index-evaluate
- (let (op oper1)
- (while op-stack
- (setq op (pop op-stack))
- (cond ((eq op 'paren)
- (return-from mh-index-evaluate (values op-stack operand-stack)))
- ((eq op 'not)
- (push `(not ,(pop operand-stack)) operand-stack))
- ((or (eq op 'and) (eq op 'or))
- (setq oper1 (pop operand-stack))
- (push `(,op ,(pop operand-stack) ,oper1) operand-stack))))
- (error "Ran out of tokens"))))
-
-\f
-
-;;; Sequence browsing
+;; Sequence Searches
;;;###mh-autoload
(defun mh-index-new-messages (folders)
mh-ticked-messages-folders)))
(mh-index-sequenced-messages folders mh-tick-seq))
+;; Shush compiler.
+(mh-do-in-xemacs
+ (defvar mh-mairix-folder)
+ (defvar mh-flists-search-folders))
+
;;;###mh-autoload
(defun mh-index-sequenced-messages (folders sequence)
"Display messages in any sequence.
(defvar mh-flists-search-folders)
-(defun mh-flists-execute (&rest args)
+(defun mh-flists-execute (&rest ignored)
"Execute flists.
Search for messages belonging to `mh-flists-sequence' in the
folders specified by `mh-flists-search-folders'. If
`mh-recursive-folders-flag' is t, then the folders are searched
-recursively. All parameters ARGS are ignored."
+recursively. All arguments are IGNORED."
(set-buffer (get-buffer-create mh-temp-index-buffer))
(erase-buffer)
(unless (executable-find "sh")
(call-process-region
(point-min) (point-max) "sh" nil (get-buffer mh-temp-index-buffer))))
-\f
-
-;;; Folder navigation and utilities
-
-;;;###mh-autoload
-(defun mh-index-group-by-folder ()
- "Partition the messages based on source folder.
-Returns an alist with the the folder names in the car and the cdr
-being the list of messages originally from that folder."
- (save-excursion
- (goto-char (point-min))
- (let ((result-table (make-hash-table :test #'equal)))
- (loop for msg being hash-keys of mh-index-msg-checksum-map
- do (push msg (gethash (car (gethash
- (gethash msg mh-index-msg-checksum-map)
- mh-index-checksum-origin-map))
- result-table)))
- (loop for x being the hash-keys of result-table
- collect (cons x (nreverse (gethash x result-table)))))))
-
-;;;###mh-autoload
-(defun mh-index-insert-folder-headers ()
- "Annotate the search results with original folder names."
- (let ((cur-msg (mh-get-msg-num nil))
- (old-buffer-modified-flag (buffer-modified-p))
- (buffer-read-only nil)
- current-folder last-folder)
- (goto-char (point-min))
- (while (not (eobp))
- (setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
- mh-index-msg-checksum-map)
- mh-index-checksum-origin-map)))
- (when (and current-folder (not (equal current-folder last-folder)))
- (insert (if last-folder "\n" "") current-folder "\n")
- (setq last-folder current-folder))
- (forward-line))
- (when cur-msg
- (mh-notate-cur)
- (mh-goto-msg cur-msg t))
- (set-buffer-modified-p old-buffer-modified-flag))
- (mh-index-create-imenu-index))
-
-;;;###mh-autoload
-(defun mh-index-delete-folder-headers ()
- "Delete the folder headers."
- (let ((cur-msg (mh-get-msg-num nil))
- (old-buffer-modified-flag (buffer-modified-p))
- (buffer-read-only nil))
- (while (and (not cur-msg) (not (eobp)))
- (forward-line)
- (setq cur-msg (mh-get-msg-num nil)))
- (goto-char (point-min))
- (while (not (eobp))
- (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10))
- (delete-region (point) (progn (forward-line) (point)))
- (forward-line)))
- (when cur-msg (mh-goto-msg cur-msg t t))
- (set-buffer-modified-p old-buffer-modified-flag)))
-
-;;;###mh-autoload
-(defun mh-index-create-imenu-index ()
- "Create alist of folder names and positions in index folder buffers."
- (save-excursion
- (setq which-func-mode t)
- (let ((alist ()))
- (goto-char (point-min))
- (while (re-search-forward "^+" nil t)
- (save-excursion
- (beginning-of-line)
- (push (cons (buffer-substring-no-properties
- (point) (line-end-position))
- (set-marker (make-marker) (point)))
- alist)))
- (setq imenu--index-alist (nreverse alist)))))
+;; Navigation
;;;###mh-autoload
(defun mh-index-next-folder (&optional backward-flag)
(interactive)
(mh-index-next-folder t))
-;;;###mh-autoload
-(defun mh-index-visit-folder ()
- "Visit original folder from where the message at point was found."
- (interactive)
- (unless mh-index-data
- (error "Not in an index folder"))
- (let (folder msg)
- (save-excursion
- (cond ((and (bolp) (eolp))
- (ignore-errors (forward-line -1))
- (setq msg (mh-get-msg-num t)))
- ((equal (char-after (line-beginning-position)) ?+)
- (setq folder (buffer-substring-no-properties
- (line-beginning-position) (line-end-position))))
- (t (setq msg (mh-get-msg-num t)))))
- (when (not folder)
- (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
- mh-index-checksum-origin-map))))
- (when (or (not (get-buffer folder))
- (y-or-n-p (format "Reuse buffer displaying %s? " folder)))
- (mh-visit-folder
- folder (loop for x being the hash-keys of (gethash folder mh-index-data)
- when (mh-msg-exists-p x folder) collect x)))))
+;;;###mh-autoload
+(defun mh-index-visit-folder ()
+ "Visit original folder from where the message at point was found."
+ (interactive)
+ (unless mh-index-data
+ (error "Not in an index folder"))
+ (let (folder msg)
+ (save-excursion
+ (cond ((and (bolp) (eolp))
+ (ignore-errors (forward-line -1))
+ (setq msg (mh-get-msg-num t)))
+ ((equal (char-after (mh-line-beginning-position)) ?+)
+ (setq folder (buffer-substring-no-properties
+ (mh-line-beginning-position)
+ (mh-line-end-position))))
+ (t (setq msg (mh-get-msg-num t)))))
+ (when (not folder)
+ (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
+ mh-index-checksum-origin-map))))
+ (when (or (not (get-buffer folder))
+ (y-or-n-p (format "Reuse buffer displaying %s? " folder)))
+ (mh-visit-folder
+ folder (loop for x being the hash-keys of (gethash folder mh-index-data)
+ when (mh-msg-exists-p x folder) collect x)))))
+
+\f
+
+;;; Search Menu
+
+(easy-menu-define
+ mh-pick-menu mh-search-mode-map "Menu for MH-E Search"
+ '("Search"
+ ["Perform Search" mh-index-do-search t]
+ ["Search with pick" mh-pick-do-search t]))
+
+\f
+
+;;; MH-Search Keys
+
+;; If this changes, modify mh-search-mode-help-messages accordingly, below.
+(gnus-define-keys mh-search-mode-map
+ "\C-c?" mh-help
+ "\C-c\C-c" mh-index-do-search
+ "\C-c\C-p" mh-pick-do-search
+ "\C-c\C-f\C-b" mh-to-field
+ "\C-c\C-f\C-c" mh-to-field
+ "\C-c\C-f\C-m" mh-to-field
+ "\C-c\C-f\C-s" mh-to-field
+ "\C-c\C-f\C-t" mh-to-field
+ "\C-c\C-fb" mh-to-field
+ "\C-c\C-fc" mh-to-field
+ "\C-c\C-fm" mh-to-field
+ "\C-c\C-fs" mh-to-field
+ "\C-c\C-ft" mh-to-field)
+
+\f
+
+;;; MH-Search Help Messages
+
+;; Group messages logically, more or less.
+(defvar mh-search-mode-help-messages
+ '((nil
+ "Perform search: \\[mh-index-do-search]\n"
+ "Search with pick: \\[mh-pick-do-search]\n\n"
+ "Move to a field by typing C-c C-f C-<field>\n"
+ "where <field> is the first letter of the desired field\n"
+ "(except for From: which uses \"m\")."))
+ "Key binding cheat sheet.
+
+This is an associative array which is used to show the most common
+commands. The key is a prefix char. The value is one or more strings
+which are concatenated together and displayed in the minibuffer if ?
+is pressed after the prefix character. The special key nil is used to
+display the non-prefixed commands.
+
+The substitutions described in `substitute-command-keys' are performed
+as well.")
+
+\f
+
+;;; MH-Search Mode
+
+(put 'mh-search-mode 'mode-class 'special)
+
+(define-derived-mode mh-search-mode fundamental-mode "MH-Search"
+ "Mode for creating search templates in MH-E.\\<mh-search-mode-map>
+
+Edit this template by entering your search criteria in an
+appropriate header field that is already there, or create a new
+field yourself. If the string you're looking for could be
+anywhere in a message, then place the string underneath the row
+of dashes.
+
+To perform the search, type \\[mh-index-do-search].
+
+Sometimes you're searching for text that is either not indexed,
+or hasn't been indexed yet. In this case you can override the
+default method with the pick method by running the command
+\\[mh-pick-do-search].
+
+The hook `mh-search-mode-hook' is called upon entry to this mode.
+
+\\{mh-search-mode-map}"
+
+ (easy-menu-add mh-pick-menu)
+ (mh-set-help mh-search-mode-help-messages))
+
+\f
+
+;;; MH-Search Commands
+
+(defun mh-index-do-search (&optional searcher)
+ "Find messages using `mh-search-program'.
+If optional argument SEARCHER is present, use it instead of
+`mh-search-program'."
+ (interactive)
+ (unless (mh-search-choose searcher) (error "No search program found"))
+ (let* ((regexp-list (mh-pick-parse-search-buffer))
+ (pattern (funcall mh-search-regexp-builder regexp-list)))
+ (if pattern
+ (mh-search mh-current-folder pattern nil mh-previous-window-config)
+ (error "No search terms"))))
+
+(defun mh-pick-do-search ()
+ "Find messages using \"pick\".
+
+Uses the pick method described in `mh-pick-execute-search'."
+ (interactive)
+ (mh-index-do-search 'pick))
+
+(defun mh-pick-parse-search-buffer ()
+ "Parse the search buffer contents.
+The function returns an alist. The car of each element is either
+the header name to search in or nil to search the whole message.
+The cdr of the element is the pattern to search."
+ (save-excursion
+ (let ((pattern-list ())
+ (in-body-flag nil)
+ start begin)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (search-forward "--------" (mh-line-end-position) t)
+ (setq in-body-flag t)
+ (beginning-of-line)
+ (setq begin (point))
+ (setq start (if in-body-flag
+ (point)
+ (search-forward ":" (mh-line-end-position) t)
+ (point)))
+ (push (cons (and (not in-body-flag)
+ (intern (downcase
+ (buffer-substring-no-properties
+ begin (1- start)))))
+ (mh-index-parse-search-regexp
+ (buffer-substring-no-properties
+ start (mh-line-end-position))))
+ pattern-list))
+ (forward-line))
+ pattern-list)))
+
+(defun mh-index-parse-search-regexp (input-string)
+ "Construct parse tree for INPUT-STRING.
+All occurrences of &, |, ! and ~ in INPUT-STRING are replaced by
+AND, OR and NOT as appropriate. Then the resulting string is
+parsed."
+ (let (input)
+ (with-temp-buffer
+ (insert input-string)
+ ;; replace tabs
+ (mh-replace-string "\t" " ")
+ ;; synonyms of AND
+ (mh-replace-string " AND " " and ")
+ (mh-replace-string "&" " and ")
+ (mh-replace-string " -and " " and ")
+ ;; synonyms of OR
+ (mh-replace-string " OR " " or ")
+ (mh-replace-string "|" " or ")
+ (mh-replace-string " -or " " or ")
+ ;; synonyms of NOT
+ (mh-replace-string " NOT " " not ")
+ (mh-replace-string "!" " not ")
+ (mh-replace-string "~" " not ")
+ (mh-replace-string " -not " " not ")
+ ;; synonyms of left brace
+ (mh-replace-string "(" " ( ")
+ (mh-replace-string " -lbrace " " ( ")
+ ;; synonyms of right brace
+ (mh-replace-string ")" " ) ")
+ (mh-replace-string " -rbrace " " ) ")
+ ;; get the normalized input
+ (setq input (format "( %s )" (buffer-substring (point-min) (point-max)))))
+
+ (let ((tokens (mh-index-add-implicit-ops (split-string input)))
+ (op-stack ())
+ (operand-stack ())
+ oper1)
+ (dolist (token tokens)
+ (cond ((equal token "(") (push 'paren op-stack))
+ ((equal token "not") (push 'not op-stack))
+ ((equal token "or") (push 'or op-stack))
+ ((equal token "and") (push 'and op-stack))
+ ((equal token ")")
+ (multiple-value-setq (op-stack operand-stack)
+ (values-list (mh-index-evaluate op-stack operand-stack)))
+ (when (eq (car op-stack) 'not)
+ (setq op-stack (cdr op-stack))
+ (push `(not ,(pop operand-stack)) operand-stack))
+ (when (eq (car op-stack) 'and)
+ (setq op-stack (cdr op-stack))
+ (setq oper1 (pop operand-stack))
+ (push `(and ,(pop operand-stack) ,oper1) operand-stack)))
+ ((eq (car op-stack) 'not)
+ (setq op-stack (cdr op-stack))
+ (push `(not ,token) operand-stack)
+ (when (eq (car op-stack) 'and)
+ (setq op-stack (cdr op-stack))
+ (setq oper1 (pop operand-stack))
+ (push `(and ,(pop operand-stack) ,oper1) operand-stack)))
+ ((eq (car op-stack) 'and)
+ (setq op-stack (cdr op-stack))
+ (push `(and ,(pop operand-stack) ,token) operand-stack))
+ (t (push token operand-stack))))
+ (prog1 (pop operand-stack)
+ (when (or op-stack operand-stack)
+ (error "Invalid regexp: %s" input))))))
-;;;###mh-autoload
-(defun mh-search-p ()
- "Non-nil means that this folder was generated by searching."
- mh-index-data)
+(defun mh-index-add-implicit-ops (tokens)
+ "Add implicit operators in the list TOKENS."
+ (let ((result ())
+ (literal-seen nil)
+ current)
+ (while tokens
+ (setq current (pop tokens))
+ (cond ((or (equal current ")") (equal current "and") (equal current "or"))
+ (setq literal-seen nil)
+ (push current result))
+ ((and literal-seen
+ (push "and" result)
+ (setq literal-seen nil)
+ nil))
+ (t
+ (push current result)
+ (unless (or (equal current "(") (equal current "not"))
+ (setq literal-seen t)))))
+ (nreverse result)))
-;;;###mh-autoload
-(defun mh-index-execute-commands ()
- "Delete/refile the actual messages.
-The copies in the searched folder are then deleted/refiled to get
-the desired result. Before deleting the messages we make sure
-that the message being deleted is identical to the one that the
-user has marked in the index buffer."
- (save-excursion
- (let ((folders ())
- (mh-speed-flists-inhibit-flag t))
- (maphash
- (lambda (folder msgs)
- (push folder folders)
- (if (not (get-buffer folder))
- ;; If source folder not open, just delete the messages...
- (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs))
- ;; Otherwise delete the messages in the source buffer...
- (save-excursion
- (set-buffer folder)
- (let ((old-refile-list mh-refile-list)
- (old-delete-list mh-delete-list))
- (setq mh-refile-list nil
- mh-delete-list msgs)
- (unwind-protect (mh-execute-commands)
- (setq mh-refile-list
- (mapcar (lambda (x)
- (cons (car x)
- (loop for y in (cdr x)
- unless (memq y msgs) collect y)))
- old-refile-list)
- mh-delete-list
- (loop for x in old-delete-list
- unless (memq x msgs) collect x))
- (mh-set-folder-modified-p (mh-outstanding-commands-p))
- (when (mh-outstanding-commands-p)
- (mh-notate-deleted-and-refiled)))))))
- (mh-index-matching-source-msgs (append (loop for x in mh-refile-list
- append (cdr x))
- mh-delete-list)
- t))
- folders)))
+(defun mh-index-evaluate (op-stack operand-stack)
+ "Read expression till starting paren based on OP-STACK and OPERAND-STACK."
+ (block mh-index-evaluate
+ (let (op oper1)
+ (while op-stack
+ (setq op (pop op-stack))
+ (cond ((eq op 'paren)
+ (return-from mh-index-evaluate (list op-stack operand-stack)))
+ ((eq op 'not)
+ (push `(not ,(pop operand-stack)) operand-stack))
+ ((or (eq op 'and) (eq op 'or))
+ (setq oper1 (pop operand-stack))
+ (push `(,op ,(pop operand-stack) ,oper1) operand-stack))))
+ (error "Ran out of tokens"))))
\f
-;;; Indexing functions
+;;; Indexing Functions
;; Support different search programs
(defvar mh-search-choices
(return mh-searcher))))
nil)))
-;;; Swish++ interface
+;;; Swish++
(defvar mh-swish++-binary (or (executable-find "search++")
(executable-find "search")))
(defvar mh-swish++-directory ".swish++")
(defvar mh-swish-folder nil)
-;;;###mh-autoload
(defun mh-swish++-execute-search (folder-path search-regexp)
"Execute swish++.
(symbol-name (car expr))
(mh-swish++-print-regexp (caddr expr))))))
-;;; Swish interface
+;;; Swish
(defvar mh-swish-binary (executable-find "swish-e"))
(defvar mh-swish-directory ".swish")
-;;;###mh-autoload
(defun mh-swish-execute-search (folder-path search-regexp)
"Execute swish-e.
(return nil))
(when (equal (char-after (point)) ?#)
(return 'error))
- (let* ((start (search-forward " " (line-end-position) t))
- (end (search-forward " " (line-end-position) t)))
+ (let* ((start (search-forward " " (mh-line-end-position) t))
+ (end (search-forward " " (mh-line-end-position) t)))
(unless (and start end)
(return 'error))
(setq end (1- end))
(substring s (match-end 0) (1- (length s))))
(return 'error)))
(let* ((s (buffer-substring-no-properties (1+ (point)) end))
- (val (ignore-errors (read-from-string s))))
- (if (and (consp val) (numberp (car val)))
- (car val)
- (return 'error)))
+ (n (ignore-errors (string-to-number s))))
+ (if n n (return 'error)))
nil)))
(forward-line)))
-;;; Mairix interface
+;;; Mairix
(defvar mh-mairix-binary (executable-find "mairix"))
(defvar mh-mairix-directory ".mairix")
(defvar mh-mairix-folder nil)
-;;;###mh-autoload
(defun mh-mairix-execute-search (folder-path search-regexp-list)
"Execute mairix.
# are subfolders within the folder
mh=archive...:inbox:drafts:news:sent:trash
- vfolder_format=raw
- database=/home/user/Mail/mairix/database
+ vfolder_format=mh
+ database=/home/user/Mail/.mairix/database
Use the following command line to generate the mairix index. Run
this daily from cron:
(return 'error))
(let ((start (point))
end msg-start)
- (setq end (line-end-position))
+ (setq end (mh-line-end-position))
(unless (search-forward mh-mairix-folder end t)
(return 'error))
(goto-char (match-beginning 0))
(return 'error))
(list (format "+%s" (buffer-substring-no-properties
(point) (1- msg-start)))
- (car (read-from-string
- (buffer-substring-no-properties msg-start end)))
+ (string-to-number
+ (buffer-substring-no-properties msg-start end))
nil)))
(forward-line)))
(cond ((eq (car pair) 'to) "t:")
((eq (car pair) 'from) "f:")
((eq (car pair) 'cc) "c:")
+ ((eq (car pair) 'to-or-cc) "tc:")
+ ((eq (car pair) 'address) "a:")
((eq (car pair) 'subject) "s:")
+ ((eq (car pair) 'subject-or-body) "bs:")
((eq (car pair) 'date) "d:")
+ ((eq (car pair) 'message-id) "m:")
+ ((eq (car pair) 'message-body) "b:")
+ ((eq (car pair) 'message-size) "z:")
+ ((eq (car pair) 'message-attachment-name) "n:")
+ ((eq (car pair) 'message-flags) "F:")
(t ""))
(let ((sop (cdr (mh-mairix-convert-to-sop* (cdr pair))))
(final ""))
(cdadr expr)))))
(t (error "Unreachable: %s" expr))))
-;;; Namazu interface
+;;; Namazu
(defvar mh-namazu-binary (executable-find "namazu"))
(defvar mh-namazu-directory ".namazu")
(defvar mh-namazu-folder nil)
-;;;###mh-autoload
(defun mh-namazu-execute-search (folder-path search-regexp)
"Execute namazu.
daily from cron:
mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
- /home/user/Mail
+ -q /home/user/Mail
In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP
is used to search."
(block nil
(when (eobp) (return nil))
(let ((file-name (buffer-substring-no-properties
- (point) (line-end-position))))
+ (point) (mh-line-end-position))))
(unless (equal (string-match mh-namazu-folder file-name) 0)
(return 'error))
(unless (file-exists-p file-name)
(mark (mh-search-from-end ?/ folder/msg)))
(unless mark (return 'error))
(list (format "+%s" (substring folder/msg 0 mark))
- (let ((n (ignore-errors (read-from-string
+ (let ((n (ignore-errors (string-to-number
(substring folder/msg (1+ mark))))))
- (if (and (consp n) (numberp (car n)))
- (car n)
- (return 'error)))
+ (if n n (return 'error)))
nil))))
(forward-line)))
-;;; Pick interface
+;;; Pick
(defvar mh-index-pick-folder)
(defvar mh-pick-binary "pick")
(defconst mh-pick-single-dash '(cc date from subject to)
"Search components that are supported by single-dash option in pick.")
-;;;###mh-autoload
(defun mh-pick-execute-search (folder-path search-regexp)
"Execute pick.
(prog1
(block nil
(when (eobp) (return nil))
- (when (search-forward-regexp "^\+" (line-end-position) t)
+ (when (search-forward-regexp "^\+" (mh-line-end-position) t)
(setq mh-index-pick-folder
- (buffer-substring-no-properties (line-beginning-position)
- (line-end-position)))
+ (buffer-substring-no-properties (mh-line-beginning-position)
+ (mh-line-end-position)))
(return 'error))
- (unless (search-forward-regexp "^[1-9][0-9]*$" (line-end-position) t)
+ (unless (search-forward-regexp "^[1-9][0-9]*$" (mh-line-end-position) t)
(return 'error))
(list mh-index-pick-folder
(string-to-number
- (buffer-substring-no-properties (line-beginning-position)
- (line-end-position)))
+ (buffer-substring-no-properties (mh-line-beginning-position)
+ (mh-line-end-position)))
nil))
(forward-line)))
(when (cdr pattern)
(setq result `(,@result "-and" "-lbrace"
,@(mh-pick-construct-regexp
- (if (and (mh-variant-p 'mu-mh) (car pattern))
+ (if (and (mh-variant-p 'gnu-mh) (car pattern))
(format "--pattern=%s" (cdr pattern))
(cdr pattern))
(if (car pattern)
(cond
- ((mh-variant-p 'mu-mh)
+ ((mh-variant-p 'gnu-mh)
(format "--component=%s" (car pattern)))
((member (car pattern) mh-pick-single-dash)
(format "-%s" (car pattern)))
"-rbrace"))
(t (error "Unknown operator %s seen" (car expr)))))
-;;; Grep interface
+;;; Grep
(defvar mh-grep-binary (executable-find "grep"))
-;;;###mh-autoload
(defun mh-grep-execute-search (folder-path search-regexp)
"Execute grep.
(block nil
(when (eobp)
(return nil))
- (let ((eol-pos (line-end-position))
- (bol-pos (line-beginning-position))
+ (let ((eol-pos (mh-line-end-position))
+ (bol-pos (mh-line-beginning-position))
folder-start msg-end)
(goto-char bol-pos)
(unless (search-forward mh-user-path eol-pos 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)))
+ (let ((n (ignore-errors (string-to-number
+ (buffer-substring-no-properties
+ (1+ (point)) msg-end)))))
+ (if n n (return 'error)))
match))))
(forward-line)))
\f
-;;; Folder support
+;;; Folder Utilities
+
+;;;###mh-autoload
+(defun mh-index-group-by-folder ()
+ "Partition the messages based on source folder.
+Returns an alist with the folder names in the car and the cdr
+being the list of messages originally from that folder."
+ (save-excursion
+ (goto-char (point-min))
+ (let ((result-table (make-hash-table :test #'equal)))
+ (loop for msg being the hash-keys of mh-index-msg-checksum-map
+ do (push msg (gethash (car (gethash
+ (gethash msg mh-index-msg-checksum-map)
+ mh-index-checksum-origin-map))
+ result-table)))
+ (loop for x being the hash-keys of result-table
+ collect (cons x (nreverse (gethash x result-table)))))))
+
+;;;###mh-autoload
+(defun mh-index-insert-folder-headers ()
+ "Annotate the search results with original folder names."
+ (let ((cur-msg (mh-get-msg-num nil))
+ (old-buffer-modified-flag (buffer-modified-p))
+ (buffer-read-only nil)
+ current-folder last-folder)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
+ mh-index-msg-checksum-map)
+ mh-index-checksum-origin-map)))
+ (when (and current-folder (not (equal current-folder last-folder)))
+ (insert (if last-folder "\n" "") current-folder "\n")
+ (setq last-folder current-folder))
+ (forward-line))
+ (when cur-msg
+ (mh-notate-cur)
+ (mh-goto-msg cur-msg t))
+ (set-buffer-modified-p old-buffer-modified-flag))
+ (mh-index-create-imenu-index))
+
+;;;###mh-autoload
+(defun mh-index-delete-folder-headers ()
+ "Delete the folder headers."
+ (let ((cur-msg (mh-get-msg-num nil))
+ (old-buffer-modified-flag (buffer-modified-p))
+ (buffer-read-only nil))
+ (while (and (not cur-msg) (not (eobp)))
+ (forward-line)
+ (setq cur-msg (mh-get-msg-num nil)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10))
+ (delete-region (point) (progn (forward-line) (point)))
+ (forward-line)))
+ (when cur-msg (mh-goto-msg cur-msg t t))
+ (set-buffer-modified-p old-buffer-modified-flag)))
+
+(mh-require 'which-func nil t)
+
+;; Shush compiler.
+(defvar which-func-mode) ; < Emacs 22, XEmacs
+
+;;;###mh-autoload
+(defun mh-index-create-imenu-index ()
+ "Create alist of folder names and positions in index folder buffers."
+ (save-excursion
+ (if (boundp 'which-func-mode)
+ (setq which-func-mode t))
+ (let ((alist ()))
+ (goto-char (point-min))
+ (while (re-search-forward "^+" nil t)
+ (save-excursion
+ (beginning-of-line)
+ (push (cons (buffer-substring-no-properties
+ (point) (mh-line-end-position))
+ (set-marker (make-marker) (point)))
+ alist)))
+ (setq imenu--index-alist (nreverse alist)))))
+
+;;;###mh-autoload
+(defun mh-search-p ()
+ "Non-nil means that this folder was generated by searching."
+ mh-index-data)
+
+;; Shush compiler
+(mh-do-in-xemacs
+ (defvar mh-speed-flists-inhibit-flag))
+
+;;;###mh-autoload
+(defun mh-index-execute-commands ()
+ "Delete/refile the actual messages.
+The copies in the searched folder are then deleted/refiled to get
+the desired result. Before deleting the messages we make sure
+that the message being deleted is identical to the one that the
+user has marked in the index buffer."
+ (save-excursion
+ (let ((folders ())
+ (mh-speed-flists-inhibit-flag t))
+ (maphash
+ (lambda (folder msgs)
+ (push folder folders)
+ (if (not (get-buffer folder))
+ ;; If source folder not open, just delete the messages...
+ (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs))
+ ;; Otherwise delete the messages in the source buffer...
+ (with-current-buffer folder
+ (let ((old-refile-list mh-refile-list)
+ (old-delete-list mh-delete-list))
+ (setq mh-refile-list nil
+ mh-delete-list msgs)
+ (unwind-protect (mh-execute-commands)
+ (setq mh-refile-list
+ (mapcar (lambda (x)
+ (cons (car x)
+ (loop for y in (cdr x)
+ unless (memq y msgs) collect y)))
+ old-refile-list)
+ mh-delete-list
+ (loop for x in old-delete-list
+ unless (memq x msgs) collect x))
+ (mh-set-folder-modified-p (mh-outstanding-commands-p))
+ (when (mh-outstanding-commands-p)
+ (mh-notate-deleted-and-refiled)))))))
+ (mh-index-matching-source-msgs (append (loop for x in mh-refile-list
+ append (cdr x))
+ mh-delete-list)
+ t))
+ folders)))
(defun mh-index-generate-pretty-name (string)
"Given STRING generate a name which is suitable for use as a folder name.
(delete-char 1))
(goto-char (point-max))
(while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r ?_)))
- (delete-backward-char 1))
+ (delete-char -1))
(subst-char-in-region (point-min) (point-max) ? ?_ t)
(subst-char-in-region (point-min) (point-max) ?\t ?_ t)
(subst-char-in-region (point-min) (point-max) ?\n ?_ t)
(with-temp-buffer
(mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder)
(goto-char (point-min))
- (not (eobp))))))
+ ;; Strip + from folder; use optional + in regexp.
+ (looking-at (format "+?%s" (substring folder 1)))))))
(defun mh-msg-exists-p (msg folder)
"Check if MSG exists in FOLDER."
SEARCH-REGEXP then it is reused.
Otherwise if the folder NAME was generated from a different
-search then check if NAME<2> can be used. Otherwise try NAME<3>.
+search then check if NAME-2 can be used. Otherwise try NAME-3.
This is repeated till we find a new folder name.
If the folder returned doesn't exist then it is created."
(error "The argument should be a valid MH folder name"))
(let ((chosen-name
(loop for i from 1
- for candidate = (if (equal i 1) name (format "%s<%s>" name i))
+ for candidate = (if (equal i 1) name (format "%s-%s" name i))
when (or (not (mh-folder-exists-p candidate))
(equal (mh-index-folder-search-regexp candidate)
search-regexp))
\f
-;;; Sequence support
+;;; Sequence Support
;;;###mh-autoload
(defun mh-index-create-sequences ()
(mh-coalesce-msg-list msgs)))
;; Update source folder buffer if we have it open...
(when (get-buffer folder)
- (save-excursion
- (set-buffer folder)
+ (with-current-buffer folder
(mh-put-msg-in-seq msgs seq))))
(mh-index-matching-source-msgs msgs))
folders))))
(mh-coalesce-msg-list msgs)))
;; Update source folder buffer if we have it open...
(when (get-buffer folder)
- (save-excursion
- (set-buffer folder)
+ (with-current-buffer folder
(mh-delete-msg-from-seq msgs seq t))))
(mh-index-matching-source-msgs msgs))
folders))))
(mh-exec-cmd-output mh-scan-prog nil "-width" "80"
"-format" "%{x-mhe-checksum}\n" folder msg)
(goto-char (point-min))
- (string-equal (buffer-substring-no-properties (point) (line-end-position))
+ (string-equal (buffer-substring-no-properties
+ (point) (mh-line-end-position))
checksum)))
\f
-;;; Serialization of index data
+;;; Serialization of Index Data
(defun mh-index-write-data ()
"Write index data to file."
\f
-;;; Checksum routines
+;;; Checksum Routines
+
+;; A few different checksum programs are supported. The supported
+;; programs are:
-;; A few different checksum programs are supported. The supported programs
-;; are:
-;;
;; 1. md5sum
;; 2. md5
;; 3. openssl
-;;
-;; To add support for your favorite checksum program add a clause to the cond
-;; statement in mh-checksum-choose. This should set the variable
-;; mh-checksum-cmd to the command line needed to run the checsum program and
-;; should set mh-checksum-parser to a function which returns a cons cell
-;; containing the message number and checksum string.
+
+;; To add support for your favorite checksum program add a clause to
+;; the cond statement in mh-checksum-choose. This should set the
+;; variable mh-checksum-cmd to the command line needed to run the
+;; checksum program and should set mh-checksum-parser to a function
+;; which returns a cons cell containing the message number and
+;; checksum string.
(defvar mh-checksum-cmd)
(defvar mh-checksum-parser)
(defun mh-md5sum-parser ()
"Parse md5sum output."
- (let ((begin (line-beginning-position))
- (end (line-end-position))
+ (let ((begin (mh-line-beginning-position))
+ (end (mh-line-end-position))
first-space last-slash)
(setq first-space (search-forward " " end t))
(goto-char end)
(setq last-slash (search-backward "/" begin t))
(cond ((and first-space last-slash)
- (cons (car (read-from-string (buffer-substring-no-properties
- (1+ last-slash) end)))
+ (cons (string-to-number (buffer-substring-no-properties
+ (1+ last-slash) end))
(buffer-substring-no-properties begin (1- first-space))))
(t (cons nil nil)))))
(defun mh-openssl-parser ()
"Parse openssl output."
- (let ((begin (line-beginning-position))
- (end (line-end-position))
+ (let ((begin (mh-line-beginning-position))
+ (end (mh-line-end-position))
last-space last-slash)
(goto-char end)
(setq last-space (search-backward " " begin t))
(setq last-slash (search-backward "/" begin t))
(cond ((and last-slash last-space)
- (cons (car (read-from-string (buffer-substring-no-properties
- (1+ last-slash) (1- last-space))))
+ (cons (string-to-number (buffer-substring-no-properties
+ (1+ last-slash) (1- last-space)))
(buffer-substring-no-properties (1+ last-space) end))))))
(defalias 'mh-md5-parser 'mh-openssl-parser)
was copied. If present the checksum -> (origin-folder,
origin-index) map is updated too."
(clrhash mh-index-msg-checksum-map)
- (save-excursion
- ;; Clear temp buffer
- (set-buffer (get-buffer-create mh-temp-checksum-buffer))
+ ;; Clear temp buffer
+ (with-current-buffer (get-buffer-create mh-temp-checksum-buffer)
(erase-buffer)
;; Run scan to check if any messages needs MD5 annotations at all
(with-temp-buffer
(let (msg checksum)
(while (not (eobp))
(setq msg (buffer-substring-no-properties
- (point) (line-end-position)))
+ (point) (mh-line-end-position)))
(forward-line)
(save-excursion
(cond ((not (string-match "^[0-9]*$" msg)))
(t
;; update maps
(setq checksum (buffer-substring-no-properties
- (point) (line-end-position)))
- (let ((msg (car (read-from-string msg))))
+ (point) (mh-line-end-position)))
+ (let ((msg (string-to-number msg)))
(set-buffer folder)
(mh-index-update-single-msg msg checksum origin-map)))))
(forward-line))))
(mh-exec-cmd "anno" folder msg "-component" "X-MHE-Checksum"
"-nodate" "-text" checksum "-inplace")
;; update maps
- (save-excursion
- (set-buffer folder)
+ (with-current-buffer folder
(mh-index-update-single-msg msg checksum origin-map)))
(forward-line)))))
(mh-index-write-data))
This function should only be called in the appropriate index
folder buffer."
- (cond ((and origin-map (gethash checksum mh-index-checksum-origin-map))
- (let* ((intermediate (gethash msg origin-map))
- (ofolder (car intermediate))
- (omsg (cdr intermediate)))
- ;; This is most probably a duplicate. So eliminate it.
- (call-process "rm" nil nil nil
- (format "%s%s/%s" mh-user-path
- (substring mh-current-folder 1) msg))
- (when (gethash ofolder mh-index-data)
- (remhash omsg (gethash ofolder mh-index-data)))))
+ (cond ((gethash checksum mh-index-checksum-origin-map)
+ (when origin-map
+ (let* ((intermediate (gethash msg origin-map))
+ (ofolder (car intermediate))
+ (omsg (cdr intermediate)))
+ ;; This is most probably a duplicate. So eliminate it.
+ (call-process "rm" nil nil nil
+ (format "%s%s/%s" mh-user-path
+ (substring mh-current-folder 1) msg))
+ (when (gethash ofolder mh-index-data)
+ (remhash omsg (gethash ofolder mh-index-data))))))
(t
(setf (gethash msg mh-index-msg-checksum-map) checksum)
- (when origin-map
+ (when (and origin-map (gethash msg origin-map))
(setf (gethash checksum mh-index-checksum-origin-map)
(gethash msg origin-map))))))
+
(provide 'mh-search)
;; Local Variables:
;; sentence-end-double-space: nil
;; End:
-;; arch-tag: 607762ad-0dff-4fe1-a27e-6c0dde0dcc47
;;; mh-search ends here