47 |
(require 'cl) |
(require 'cl) |
48 |
(require 'mh-e) |
(require 'mh-e) |
49 |
(require 'mh-mime) |
(require 'mh-mime) |
50 |
|
(require 'mh-pick) |
51 |
|
|
52 |
(autoload 'gnus-local-map-property "gnus-util") |
(autoload 'gnus-local-map-property "gnus-util") |
53 |
(autoload 'gnus-eval-format "gnus-spec") |
(autoload 'gnus-eval-format "gnus-spec") |
57 |
;; Support different indexing programs |
;; Support different indexing programs |
58 |
(defvar mh-indexer-choices |
(defvar mh-indexer-choices |
59 |
'((swish++ |
'((swish++ |
60 |
mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result) |
mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result |
61 |
|
mh-swish++-regexp-builder) |
62 |
(swish |
(swish |
63 |
mh-swish-binary mh-swish-execute-search mh-swish-next-result) |
mh-swish-binary mh-swish-execute-search mh-swish-next-result nil) |
64 |
|
(mairix |
65 |
|
mh-mairix-binary mh-mairix-execute-search mh-mairix-next-result |
66 |
|
mh-mairix-regexp-builder) |
67 |
(namazu |
(namazu |
68 |
mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result) |
mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil) |
69 |
(glimpse |
(glimpse |
70 |
mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result) |
mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result nil) |
71 |
|
(pick |
72 |
|
mh-pick-binary mh-pick-execute-search mh-pick-next-result |
73 |
|
mh-pick-regexp-builder) |
74 |
(grep |
(grep |
75 |
mh-grep-binary mh-grep-execute-search mh-grep-next-result)) |
mh-grep-binary mh-grep-execute-search mh-grep-next-result nil)) |
76 |
"List of possible indexer choices.") |
"List of possible indexer choices.") |
77 |
(defvar mh-indexer nil |
(defvar mh-indexer nil |
78 |
"Chosen index program.") |
"Chosen index program.") |
80 |
"Function which executes the search program.") |
"Function which executes the search program.") |
81 |
(defvar mh-index-next-result-function nil |
(defvar mh-index-next-result-function nil |
82 |
"Function to parse the next line of output.") |
"Function to parse the next line of output.") |
83 |
|
(defvar mh-index-regexp-builder nil |
84 |
|
"Function used to construct search regexp.") |
85 |
|
|
86 |
;; FIXME: This should be a defcustom... |
;; FIXME: This should be a defcustom... |
87 |
(defvar mh-index-folder "+mhe-index" |
(defvar mh-index-folder "+mhe-index" |
264 |
"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. |
265 |
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 |
266 |
replaced with underscores and all / are replaced with $. If STRING is longer |
replaced with underscores and all / are replaced with $. If STRING is longer |
267 |
than 20 it is truncated too." |
than 20 it is truncated too. STRING could be a list of strings in which case |
268 |
|
they are concatenated to construct the base name." |
269 |
(with-temp-buffer |
(with-temp-buffer |
270 |
(insert string) |
(if (stringp string) |
271 |
|
(insert string) |
272 |
|
(when (car string) (insert (car string))) |
273 |
|
(dolist (s (cdr string)) |
274 |
|
(insert "_" s))) |
275 |
|
(setq string (mh-replace-string "-lbrace" " ")) |
276 |
|
(setq string (mh-replace-string "-rbrace" " ")) |
277 |
|
(subst-char-in-region (point-min) (point-max) ?( ? t) |
278 |
|
(subst-char-in-region (point-min) (point-max) ?) ? t) |
279 |
|
(subst-char-in-region (point-min) (point-max) ?- ? t) |
280 |
(goto-char (point-min)) |
(goto-char (point-min)) |
281 |
(while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r))) |
(while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r ?_))) |
282 |
(delete-char 1)) |
(delete-char 1)) |
283 |
(goto-char (point-max)) |
(goto-char (point-max)) |
284 |
(while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r))) |
(while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r ?_))) |
285 |
(delete-backward-char 1)) |
(delete-backward-char 1)) |
286 |
(subst-char-in-region (point-min) (point-max) ? ?_ t) |
(subst-char-in-region (point-min) (point-max) ? ?_ t) |
287 |
(subst-char-in-region (point-min) (point-max) ?\t ?_ t) |
(subst-char-in-region (point-min) (point-max) ?\t ?_ t) |
288 |
(subst-char-in-region (point-min) (point-max) ?\n ?_ t) |
(subst-char-in-region (point-min) (point-max) ?\n ?_ t) |
289 |
(subst-char-in-region (point-min) (point-max) ?\r ?_ t) |
(subst-char-in-region (point-min) (point-max) ?\r ?_ t) |
291 |
(truncate-string-to-width (buffer-substring (point-min) (point-max)) 20))) |
(truncate-string-to-width (buffer-substring (point-min) (point-max)) 20))) |
292 |
|
|
293 |
;;;###mh-autoload |
;;;###mh-autoload |
294 |
(defun mh-index-search (redo-search-flag folder search-regexp) |
(defun* mh-index-search (redo-search-flag folder search-regexp |
295 |
|
&optional window-config) |
296 |
"Perform an indexed search in an MH mail folder. |
"Perform an indexed search in an MH mail folder. |
297 |
|
|
298 |
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 |
299 |
index search, then the search is repeated. Otherwise, FOLDER is searched with |
index search, then the search is repeated. Otherwise, FOLDER is searched with |
300 |
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 |
301 |
\"+\" then mail in all folders are searched. |
\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG |
302 |
|
stores the window configuration that will be restored after the user quits the |
303 |
|
folder containing the index search results. |
304 |
|
|
305 |
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 |
306 |
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 |
312 |
|
|
313 |
- `mh-swish++-execute-search' |
- `mh-swish++-execute-search' |
314 |
- `mh-swish-execute-search' |
- `mh-swish-execute-search' |
315 |
|
- `mh-mairix-execute-search' |
316 |
- `mh-namazu-execute-search' |
- `mh-namazu-execute-search' |
317 |
- `mh-glimpse-execute-search' |
- `mh-glimpse-execute-search' |
318 |
|
|
319 |
|
If none of these programs are present then we use pick. If desired grep can be |
320 |
|
used instead. Details about these methods can be found in: |
321 |
|
|
322 |
|
- `mh-pick-execute-search' |
323 |
|
- `mh-grep-execute-search' |
324 |
|
|
325 |
This and related functions use an X-MHE-Checksum header to cache the MD5 |
This and related functions use an X-MHE-Checksum header to cache the MD5 |
326 |
checksum of a message. This means that already present X-MHE-Checksum headers |
checksum of a message. This means that already present X-MHE-Checksum headers |
327 |
in the incoming email could result in messages not being found. The following |
in the incoming email could result in messages not being found. The following |
336 |
(progn |
(progn |
337 |
(unless mh-find-path-run (mh-find-path)) |
(unless mh-find-path-run (mh-find-path)) |
338 |
(or (and current-prefix-arg (car mh-index-previous-search)) |
(or (and current-prefix-arg (car mh-index-previous-search)) |
339 |
(mh-prompt-for-folder "Search" "+" nil "all"))) |
(mh-prompt-for-folder "Search" "+" nil "all" t))) |
340 |
(progn |
(progn |
341 |
;; 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 |
342 |
;; user has switched the indexer manually. |
;; user has switched the indexer manually. |
343 |
(unless (mh-index-choose) (error "No indexing program found")) |
(unless (mh-index-choose) (error "No indexing program found")) |
344 |
(or (and current-prefix-arg (cadr mh-index-previous-search)) |
(or (and current-prefix-arg (cadr mh-index-previous-search)) |
345 |
|
mh-index-regexp-builder |
346 |
(read-string (format "%s regexp: " |
(read-string (format "%s regexp: " |
347 |
(upcase-initials |
(upcase-initials |
348 |
(symbol-name mh-indexer)))))))) |
(symbol-name mh-indexer)))))) |
349 |
|
(if (and (not |
350 |
|
(and current-prefix-arg (cadr mh-index-previous-search))) |
351 |
|
mh-index-regexp-builder) |
352 |
|
(current-window-configuration) |
353 |
|
nil))) |
354 |
|
(when (symbolp search-regexp) |
355 |
|
(mh-search-folder folder window-config) |
356 |
|
(setq mh-searching-function 'mh-index-do-search) |
357 |
|
(return-from mh-index-search)) |
358 |
(mh-checksum-choose) |
(mh-checksum-choose) |
359 |
(let ((result-count 0) |
(let ((result-count 0) |
360 |
(old-window-config mh-previous-window-config) |
(old-window-config (or window-config mh-previous-window-config)) |
361 |
(previous-search mh-index-previous-search) |
(previous-search mh-index-previous-search) |
362 |
(index-folder (format "%s/%s" mh-index-folder |
(index-folder (format "%s/%s" mh-index-folder |
363 |
(mh-index-generate-pretty-name search-regexp)))) |
(mh-index-generate-pretty-name search-regexp)))) |
413 |
(mh-recenter nil) |
(mh-recenter nil) |
414 |
|
|
415 |
;; Maintain history |
;; Maintain history |
416 |
(when (and redo-search-flag previous-search) |
(when (or (and redo-search-flag previous-search) window-config) |
417 |
(setq mh-previous-window-config old-window-config)) |
(setq mh-previous-window-config old-window-config)) |
418 |
(setq mh-index-previous-search (list folder search-regexp)) |
(setq mh-index-previous-search (list folder search-regexp)) |
419 |
|
|
425 |
count (> (hash-table-count msg-hash) 0)))))) |
count (> (hash-table-count msg-hash) 0)))))) |
426 |
|
|
427 |
;;;###mh-autoload |
;;;###mh-autoload |
428 |
|
(defun mh-index-do-search () |
429 |
|
"Construct appropriate regexp and call `mh-index-search'." |
430 |
|
(interactive) |
431 |
|
(unless (mh-index-choose) (error "No indexing program found")) |
432 |
|
(let* ((regexp-list (mh-pick-parse-search-buffer)) |
433 |
|
(pattern (funcall mh-index-regexp-builder regexp-list))) |
434 |
|
(if pattern |
435 |
|
(mh-index-search nil mh-current-folder pattern |
436 |
|
mh-previous-window-config) |
437 |
|
(error "No search terms")))) |
438 |
|
|
439 |
|
(defun mh-replace-string (old new) |
440 |
|
"Replace all occurrences of OLD with NEW in the current buffer." |
441 |
|
(goto-char (point-min)) |
442 |
|
(while (search-forward old nil t) |
443 |
|
(replace-match new))) |
444 |
|
|
445 |
|
;;;###mh-autoload |
446 |
|
(defun mh-index-parse-search-regexp (input-string) |
447 |
|
"Construct parse tree for INPUT-STRING. |
448 |
|
All occurrences of &, |, ! and ~ in INPUT-STRING are replaced by AND, OR and |
449 |
|
NOT as appropriate. Then the resulting string is parsed." |
450 |
|
(let (input) |
451 |
|
(with-temp-buffer |
452 |
|
(insert input-string) |
453 |
|
(downcase-region (point-min) (point-max)) |
454 |
|
;; replace tabs |
455 |
|
(mh-replace-string "\t" " ") |
456 |
|
;; synonyms of AND |
457 |
|
(mh-replace-string "&" " and ") |
458 |
|
(mh-replace-string " -and " " and ") |
459 |
|
;; synonyms of OR |
460 |
|
(mh-replace-string "|" " or ") |
461 |
|
(mh-replace-string " -or " " or ") |
462 |
|
;; synonyms of NOT |
463 |
|
(mh-replace-string "!" " not ") |
464 |
|
(mh-replace-string "~" " not ") |
465 |
|
(mh-replace-string " -not " " not ") |
466 |
|
;; synonyms of left brace |
467 |
|
(mh-replace-string "(" " ( ") |
468 |
|
(mh-replace-string " -lbrace " " ( ") |
469 |
|
;; synonyms of right brace |
470 |
|
(mh-replace-string ")" " ) ") |
471 |
|
(mh-replace-string " -rbrace " " ) ") |
472 |
|
;; get the normalized input |
473 |
|
(setq input (format "( %s )" (buffer-substring (point-min) (point-max))))) |
474 |
|
|
475 |
|
(let ((tokens (mh-index-add-implicit-ops (split-string input))) |
476 |
|
(op-stack ()) |
477 |
|
(operand-stack ()) |
478 |
|
oper1) |
479 |
|
(dolist (token tokens) |
480 |
|
(cond ((equal token "(") (push 'paren op-stack)) |
481 |
|
((equal token "not") (push 'not op-stack)) |
482 |
|
((equal token "or") (push 'or op-stack)) |
483 |
|
((equal token "and") (push 'and op-stack)) |
484 |
|
((equal token ")") |
485 |
|
(multiple-value-setq (op-stack operand-stack) |
486 |
|
(mh-index-evaluate op-stack operand-stack)) |
487 |
|
(when (eq (car op-stack) 'not) |
488 |
|
(pop op-stack) |
489 |
|
(push `(not ,(pop operand-stack)) operand-stack)) |
490 |
|
(when (eq (car op-stack) 'and) |
491 |
|
(pop op-stack) |
492 |
|
(setq oper1 (pop operand-stack)) |
493 |
|
(push `(and ,(pop operand-stack) ,oper1) operand-stack))) |
494 |
|
((eq (car op-stack) 'not) |
495 |
|
(pop op-stack) |
496 |
|
(push `(not ,token) operand-stack) |
497 |
|
(when (eq (car op-stack) 'and) |
498 |
|
(pop op-stack) |
499 |
|
(setq oper1 (pop operand-stack)) |
500 |
|
(push `(and ,(pop operand-stack) ,oper1) operand-stack))) |
501 |
|
((eq (car op-stack) 'and) |
502 |
|
(pop op-stack) |
503 |
|
(push `(and ,(pop operand-stack) ,token) operand-stack)) |
504 |
|
(t (push token operand-stack)))) |
505 |
|
(prog1 (pop operand-stack) |
506 |
|
(when (or op-stack operand-stack) |
507 |
|
(error "Invalid regexp: %s" input)))))) |
508 |
|
|
509 |
|
(defun mh-index-add-implicit-ops (tokens) |
510 |
|
"Add implicit operators in the list TOKENS." |
511 |
|
(let ((result ()) |
512 |
|
(literal-seen nil) |
513 |
|
current) |
514 |
|
(while tokens |
515 |
|
(setq current (pop tokens)) |
516 |
|
(cond ((or (equal current ")") (equal current "and") (equal current "or")) |
517 |
|
(setq literal-seen nil) |
518 |
|
(push current result)) |
519 |
|
((and literal-seen |
520 |
|
(push "and" result) |
521 |
|
(setq literal-seen nil) |
522 |
|
nil)) |
523 |
|
(t |
524 |
|
(push current result) |
525 |
|
(unless (or (equal current "(") (equal current "not")) |
526 |
|
(setq literal-seen t))))) |
527 |
|
(nreverse result))) |
528 |
|
|
529 |
|
(defun mh-index-evaluate (op-stack operand-stack) |
530 |
|
"Read expression till starting paren based on OP-STACK and OPERAND-STACK." |
531 |
|
(block mh-index-evaluate |
532 |
|
(let (op oper1) |
533 |
|
(while op-stack |
534 |
|
(setq op (pop op-stack)) |
535 |
|
(cond ((eq op 'paren) |
536 |
|
(return-from mh-index-evaluate (values op-stack operand-stack))) |
537 |
|
((eq op 'not) |
538 |
|
(push `(not ,(pop operand-stack)) operand-stack)) |
539 |
|
((or (eq op 'and) (eq op 'or)) |
540 |
|
(setq oper1 (pop operand-stack)) |
541 |
|
(push `(,op ,(pop operand-stack) ,oper1) operand-stack)))) |
542 |
|
(error "Ran out of tokens")))) |
543 |
|
|
544 |
|
;;;###mh-autoload |
545 |
(defun mh-index-next-folder (&optional backward-flag) |
(defun mh-index-next-folder (&optional backward-flag) |
546 |
"Jump to the next folder marker. |
"Jump to the next folder marker. |
547 |
The function is only applicable to folders displaying index search results. |
The function is only applicable to folders displaying index search results. |
603 |
(setq chosen-name new-name) |
(setq chosen-name new-name) |
604 |
(return-from unique-name))))) |
(return-from unique-name))))) |
605 |
(mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name) |
(mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name) |
606 |
|
(mh-remove-from-sub-folders-cache chosen-name) |
607 |
(when (boundp 'mh-speed-folder-map) |
(when (boundp 'mh-speed-folder-map) |
608 |
(mh-speed-add-folder chosen-name)) |
(mh-speed-add-folder chosen-name)) |
|
(push (list chosen-name) mh-folder-list) |
|
609 |
chosen-name)) |
chosen-name)) |
610 |
|
|
611 |
;;;###mh-autoload |
;;;###mh-autoload |
633 |
(let ((cur-msg (mh-get-msg-num nil)) |
(let ((cur-msg (mh-get-msg-num nil)) |
634 |
(old-buffer-modified-flag (buffer-modified-p)) |
(old-buffer-modified-flag (buffer-modified-p)) |
635 |
(buffer-read-only nil)) |
(buffer-read-only nil)) |
636 |
|
(while (and (not cur-msg) (not (eobp))) |
637 |
|
(forward-line) |
638 |
|
(setq cur-msg (mh-get-msg-num nil))) |
639 |
(goto-char (point-min)) |
(goto-char (point-min)) |
640 |
(while (not (eobp)) |
(while (not (eobp)) |
641 |
(if (or (char-equal (char-after) ?+) (char-equal (char-after) 10)) |
(if (or (char-equal (char-after) ?+) (char-equal (char-after) 10)) |
780 |
|
|
781 |
|
|
782 |
|
|
783 |
|
;; Pick interface |
784 |
|
|
785 |
|
(defvar mh-index-pick-folder) |
786 |
|
(defvar mh-pick-binary "pick") |
787 |
|
|
788 |
|
(defun mh-pick-execute-search (folder-path search-regexp) |
789 |
|
"Execute pick. |
790 |
|
|
791 |
|
Unlike the other index search programs \"pick\" only searches messages present |
792 |
|
in the folder itself and does not descend into any sub-folders that may be |
793 |
|
present. |
794 |
|
|
795 |
|
FOLDER-PATH is the directory containing the mails to be searched and |
796 |
|
SEARCH-REGEXP is the pattern that pick gets." |
797 |
|
(set-buffer (get-buffer-create mh-index-temp-buffer)) |
798 |
|
(erase-buffer) |
799 |
|
(setq mh-index-pick-folder |
800 |
|
(concat "+" (substring folder-path (length mh-user-path)))) |
801 |
|
(apply #'call-process (expand-file-name "pick" mh-progs) nil '(t nil) nil |
802 |
|
mh-index-pick-folder "-list" search-regexp) |
803 |
|
(goto-char (point-min))) |
804 |
|
|
805 |
|
(defun mh-pick-next-result () |
806 |
|
"Return the next pick search result." |
807 |
|
(prog1 (block nil |
808 |
|
(when (eobp) (return nil)) |
809 |
|
(unless (re-search-forward "^[1-9][0-9]*$" (line-end-position) t) |
810 |
|
(return 'error)) |
811 |
|
(list mh-index-pick-folder |
812 |
|
(car (read-from-string (buffer-substring-no-properties |
813 |
|
(line-beginning-position) |
814 |
|
(line-end-position)))) |
815 |
|
nil)) |
816 |
|
(forward-line))) |
817 |
|
|
818 |
|
|
819 |
|
|
820 |
;; Grep interface |
;; Grep interface |
821 |
|
|
822 |
(defvar mh-grep-binary (executable-find "grep")) |
(defvar mh-grep-binary (executable-find "grep")) |
866 |
|
|
867 |
|
|
868 |
|
|
869 |
|
;; Mairix interface |
870 |
|
|
871 |
|
(defvar mh-mairix-binary (executable-find "mairix")) |
872 |
|
(defvar mh-mairix-directory ".mairix") |
873 |
|
(defvar mh-mairix-folder nil) |
874 |
|
|
875 |
|
(defun mh-mairix-execute-search (folder-path search-regexp-list) |
876 |
|
"Execute mairix and read the results. |
877 |
|
|
878 |
|
In the examples below replace /home/user/Mail with the path to your MH |
879 |
|
directory. |
880 |
|
|
881 |
|
First create the directory /home/user/Mail/.mairix. Then create the file |
882 |
|
/home/user/Mail/.mairix/config with the following contents: |
883 |
|
|
884 |
|
# This should contain the same thing as your `mh-user-path' |
885 |
|
base=/home/user/Mail |
886 |
|
|
887 |
|
# List of folders that should be indexed. 3 dots at the end means there are |
888 |
|
# subfolders within the folder |
889 |
|
mh_folders=archive...:inbox:drafts:news:sent:trash |
890 |
|
|
891 |
|
vfolder_format=raw |
892 |
|
database=/home/user/Mail/mairix/database |
893 |
|
|
894 |
|
Use the following command line to generate the mairix index. Run this daily |
895 |
|
from cron: |
896 |
|
|
897 |
|
mairix -f /home/user/Mail/.mairix/config |
898 |
|
|
899 |
|
FOLDER-PATH is the directory in which SEARCH-REGEXP-LIST is used to search." |
900 |
|
(set-buffer (get-buffer-create mh-index-temp-buffer)) |
901 |
|
(erase-buffer) |
902 |
|
(unless mh-mairix-binary |
903 |
|
(error "Set mh-mairix-binary appropriately")) |
904 |
|
(apply #'call-process mh-mairix-binary nil '(t nil) nil |
905 |
|
"-f" (format "%s%s/config" mh-user-path mh-mairix-directory) |
906 |
|
search-regexp-list) |
907 |
|
(goto-char (point-min)) |
908 |
|
(setq mh-mairix-folder |
909 |
|
(let ((last-char (substring folder-path (1- (length folder-path))))) |
910 |
|
(if (equal last-char "/") |
911 |
|
folder-path |
912 |
|
(format "%s/" folder-path))))) |
913 |
|
|
914 |
|
(defun mh-mairix-next-result () |
915 |
|
"Return next result from mairix output." |
916 |
|
(prog1 |
917 |
|
(block nil |
918 |
|
(when (or (eobp) (and (bolp) (eolp))) |
919 |
|
(return nil)) |
920 |
|
(unless (eq (char-after) ?/) |
921 |
|
(return error)) |
922 |
|
(let ((start (point)) |
923 |
|
end msg-start) |
924 |
|
(setq end (line-end-position)) |
925 |
|
(unless (search-forward mh-mairix-folder end t) |
926 |
|
(return 'error)) |
927 |
|
(goto-char (match-beginning 0)) |
928 |
|
(unless (equal (point) start) |
929 |
|
(return 'error)) |
930 |
|
(goto-char end) |
931 |
|
(unless (search-backward "/" start t) |
932 |
|
(return 'error)) |
933 |
|
(setq msg-start (1+ (point))) |
934 |
|
(goto-char start) |
935 |
|
(unless (search-forward mh-user-path end t) |
936 |
|
(return 'error)) |
937 |
|
(list (format "+%s" (buffer-substring-no-properties |
938 |
|
(point) (1- msg-start))) |
939 |
|
(car (read-from-string |
940 |
|
(buffer-substring-no-properties msg-start end))) |
941 |
|
()))) |
942 |
|
(forward-line))) |
943 |
|
|
944 |
|
(defun mh-mairix-regexp-builder (regexp-list) |
945 |
|
"Generate query for mairix. |
946 |
|
REGEXP-LIST is an alist of fields and values." |
947 |
|
(let ((result ())) |
948 |
|
(dolist (pair regexp-list) |
949 |
|
(when (cdr pair) |
950 |
|
(push |
951 |
|
(concat |
952 |
|
(cond ((eq (car pair) 'to) "t:") |
953 |
|
((eq (car pair) 'from) "f:") |
954 |
|
((eq (car pair) 'cc) "c:") |
955 |
|
((eq (car pair) 'subject) "s:") |
956 |
|
((eq (car pair) 'date) "d:") |
957 |
|
(t "")) |
958 |
|
(let ((sop (cdr (mh-mairix-convert-to-sop* (cdr pair)))) |
959 |
|
(final "")) |
960 |
|
(dolist (conjunct sop) |
961 |
|
(let ((expr-list (cdr conjunct)) |
962 |
|
(expr-string "")) |
963 |
|
(dolist (e expr-list) |
964 |
|
(setq expr-string (concat expr-string "+" |
965 |
|
(if (atom e) "" "~") |
966 |
|
(if (atom e) e (cadr e))))) |
967 |
|
(setq final (concat final "," (substring expr-string 1))))) |
968 |
|
(substring final 1))) |
969 |
|
result))) |
970 |
|
result)) |
971 |
|
|
972 |
|
(defun mh-mairix-convert-to-sop* (expr) |
973 |
|
"Convert EXPR to sum of product form." |
974 |
|
(cond ((atom expr) `(or (and ,expr))) |
975 |
|
((eq (car expr) 'or) |
976 |
|
(cons 'or |
977 |
|
(loop for e in (mapcar #'mh-mairix-convert-to-sop* (cdr expr)) |
978 |
|
append (cdr e)))) |
979 |
|
((eq (car expr) 'and) |
980 |
|
(let ((conjuncts (mapcar #'mh-mairix-convert-to-sop* (cdr expr))) |
981 |
|
result next-factor) |
982 |
|
(setq result (pop conjuncts)) |
983 |
|
(while conjuncts |
984 |
|
(setq next-factor (pop conjuncts)) |
985 |
|
(setq result (let ((res ())) |
986 |
|
(dolist (t1 (cdr result)) |
987 |
|
(dolist (t2 (cdr next-factor)) |
988 |
|
(push `(and ,@(cdr t1) ,@(cdr t2)) res))) |
989 |
|
(cons 'or res)))) |
990 |
|
result)) |
991 |
|
((atom (cadr expr)) `(or (and ,expr))) |
992 |
|
((eq (caadr expr) 'not) (mh-mairix-convert-to-sop* (cadadr expr))) |
993 |
|
((eq (caadr expr) 'and) (mh-mairix-convert-to-sop* |
994 |
|
`(or ,@(mapcar #'(lambda (x) `(not ,x)) |
995 |
|
(cdadr expr))))) |
996 |
|
((eq (caadr expr) 'or) (mh-mairix-convert-to-sop* |
997 |
|
`(and ,@(mapcar #'(lambda (x) `(not ,x)) |
998 |
|
(cdadr expr))))) |
999 |
|
(t (error "Unreachable: %s" expr)))) |
1000 |
|
|
1001 |
|
|
1002 |
|
|
1003 |
;; Swish interface |
;; Swish interface |
1004 |
|
|
1005 |
(defvar mh-swish-binary (executable-find "swish-e")) |
(defvar mh-swish-binary (executable-find "swish-e")) |
1035 |
FileRules pathname contains /home/user/Mail/.swish |
FileRules pathname contains /home/user/Mail/.swish |
1036 |
FileRules pathname contains /home/user/Mail/mhe-index |
FileRules pathname contains /home/user/Mail/mhe-index |
1037 |
FileRules filename is index |
FileRules filename is index |
1038 |
FileRules filename is \..* |
FileRules filename is \\..* |
1039 |
FileRules filename is #.* |
FileRules filename is #.* |
1040 |
FileRules filename is ,.* |
FileRules filename is ,.* |
1041 |
FileRules filename is .*~ |
FileRules filename is .*~ |
1160 |
|
|
1161 |
(defalias 'mh-swish++-next-result 'mh-swish-next-result) |
(defalias 'mh-swish++-next-result 'mh-swish-next-result) |
1162 |
|
|
1163 |
|
(defun mh-swish++-regexp-builder (regexp-list) |
1164 |
|
"Generate query for swish++. |
1165 |
|
REGEXP-LIST is an alist of fields and values." |
1166 |
|
(let ((regexp "") meta) |
1167 |
|
(dolist (elem regexp-list) |
1168 |
|
(when (cdr elem) |
1169 |
|
(setq regexp (concat regexp " and " |
1170 |
|
(if (car elem) "(" "") |
1171 |
|
(if (car elem) (symbol-name (car elem)) "") |
1172 |
|
(if (car elem) " = " "") |
1173 |
|
(mh-swish++-print-regexp (cdr elem)) |
1174 |
|
(if (car elem) ")" ""))))) |
1175 |
|
(substring regexp 4))) |
1176 |
|
|
1177 |
|
(defun mh-swish++-print-regexp (expr) |
1178 |
|
"Return infix expression corresponding to EXPR." |
1179 |
|
(cond ((atom expr) (format "%s" expr)) |
1180 |
|
((eq (car expr) 'not) |
1181 |
|
(format "(not %s)" (mh-swish++-print-regexp (cadr expr)))) |
1182 |
|
(t (format "(%s %s %s)" (mh-swish++-print-regexp (cadr expr)) |
1183 |
|
(symbol-name (car expr)) |
1184 |
|
(mh-swish++-print-regexp (caddr expr)))))) |
1185 |
|
|
1186 |
|
|
1187 |
|
|
1188 |
;; Namazu interface |
;; Namazu interface |
1285 |
(executable (symbol-value (cadr current)))) |
(executable (symbol-value (cadr current)))) |
1286 |
(when executable |
(when executable |
1287 |
(setq mh-indexer (car current)) |
(setq mh-indexer (car current)) |
1288 |
(setq mh-index-execute-search-function (caddr current)) |
(setq mh-index-execute-search-function (nth 2 current)) |
1289 |
(setq mh-index-next-result-function (cadddr current)) |
(setq mh-index-next-result-function (nth 3 current)) |
1290 |
|
(setq mh-index-regexp-builder (nth 4 current)) |
1291 |
(return mh-indexer)))) |
(return mh-indexer)))) |
1292 |
nil))) |
nil))) |
1293 |
|
|