X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b6bd159922608fa474026837771d63bf7eadcf97..0e963201d03d9229bb8ac4323291d2b0119526ed:/lisp/net/mairix.el diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index 8c4bbb4a78..c6e78235e2 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el @@ -1,6 +1,6 @@ ;;; mairix.el --- Mairix interface for Emacs -;; Copyright (C) 2008-2011 Free Software Foundation, Inc. +;; Copyright (C) 2008-2016 Free Software Foundation, Inc. ;; Author: David Engster ;; Keywords: mail searching @@ -51,7 +51,7 @@ ;; Currently, RMail, Gnus (with mbox files), and VM are supported as ;; mail programs, but it is pretty easy to interface it with other ;; ones as well. Please see the docs and the source for details. -;; In a nutshell: include your favourite mail program in +;; In a nutshell: include your favorite mail program in ;; `mairix-mail-program' and write functions for ;; `mairix-display-functions' and `mairix-get-mail-header-functions'. ;; If you have written such functions for your Emacs mail program of @@ -70,8 +70,6 @@ (require 'widget) (require 'cus-edit) -(eval-when-compile - (require 'cl)) ;;; Keymappings @@ -118,7 +116,7 @@ You can add further options here if you want to, but better use (defcustom mairix-update-options '("-F" "-Q") "Options when calling mairix for updating the database. -The default is '-F' and '-Q' for making updates faster. You +The default is \"-F\" and \"-Q\" for making updates faster. You should call mairix without these options from time to time (e.g. via cron job)." :type '(repeat string) @@ -126,7 +124,7 @@ time (e.g. via cron job)." (defcustom mairix-search-options '("-Q") "Options when calling mairix for searching. -The default is '-Q' for making searching faster." +The default is \"-Q\" for making searching faster." :type '(repeat string) :group 'mairix) @@ -213,7 +211,7 @@ nil for disabling this).") (defvar mairix-widget-other '(threads flags) "Other editable mairix commands when using customization widgets. -Currently there are 'threads and 'flags.") +Currently there are `threads' and `flags'.") ;;;; Internal variables @@ -224,14 +222,12 @@ Currently there are 'threads and 'flags.") ;;; RMail -;; Display function: -(autoload 'rmail "rmail") -(autoload 'rmail-summary-displayed "rmail") -(autoload 'rmail-summary "rmailsum") -(defvar rmail-buffer) +(declare-function rmail-summary-displayed "rmail" ()) +(declare-function rmail-summary "rmailsum" ()) ; autoloaded in rmail (defun mairix-rmail-display (folder) "Display mbox file FOLDER with RMail." + (require 'rmail) (let (show-summary) ;; If it exists, select existing RMail window (when (and (boundp 'rmail-buffer) @@ -251,6 +247,8 @@ Currently there are 'threads and 'flags.") (when show-summary (rmail-summary)))) +(defvar rmail-buffer) + ;; Fetching mail header field: (defun mairix-rmail-fetch-field (field) "Get mail header FIELD for current message using RMail." @@ -267,18 +265,22 @@ Currently there are 'threads and 'flags.") (mail-fetch-field field))))) ;;; Gnus -(eval-when-compile - (defvar gnus-article-buffer) - (autoload 'gnus-summary-toggle-header "gnus-sum") - (autoload 'gnus-buffer-exists-p "gnus-util") - (autoload 'message-field-value "message") - (autoload 'gnus-group-read-ephemeral-group "gnus-group") - (autoload 'gnus-alive-p "gnus-util")) + +;; For gnus-buffer-exists-p, although it seems that could be replaced by: +;; (and buffer (get-buffer buffer)) +(eval-when-compile (require 'gnus-util)) +(defvar gnus-article-buffer) +(declare-function gnus-group-read-ephemeral-group "gnus-group" + (group method &optional activate quit-config + request-only select-articles parameters number)) +(declare-function gnus-summary-toggle-header "gnus-sum" (&optional arg)) +(declare-function message-field-value "message" (header &optional not-all)) ;; Display function: (defun mairix-gnus-ephemeral-nndoc (folder) "Create ephemeral nndoc group for reading mbox file FOLDER in Gnus." - (unless (gnus-alive-p) + (unless (and (fboundp 'gnus-alive-p) + (gnus-alive-p)) (error "Gnus is not running")) (gnus-group-read-ephemeral-group ;; add randomness to group string to prevent Gnus from using a @@ -291,26 +293,29 @@ Currently there are 'threads and 'flags.") ;; Fetching mail header field: (defun mairix-gnus-fetch-field (field) "Get mail header FIELD for current message using Gnus." - (unless (gnus-alive-p) + (unless (and (fboundp 'gnus-alive-p) + (gnus-alive-p)) (error "Gnus is not running")) (unless (gnus-buffer-exists-p gnus-article-buffer) (error "No article buffer available")) (with-current-buffer gnus-article-buffer + ;; gnus-art requires gnus-sum and message. (gnus-summary-toggle-header 1) (message-field-value field))) ;;; VM ;;; written by Ulrich Mueller -(eval-when-compile - (autoload 'vm-quit "vm-folder") - (autoload 'vm-visit-folder "vm") - (autoload 'vm-select-folder-buffer "vm-macro") - (autoload 'vm-check-for-killed-summary "vm-misc") - (autoload 'vm-get-header-contents "vm-summary") - (autoload 'vm-check-for-killed-summary "vm-misc") - (autoload 'vm-error-if-folder-empty "vm-misc") - (autoload 'vm-select-marked-or-prefixed-messages "vm-folder")) +(declare-function vm-quit "ext:vm-folder" (&optional no-change)) +(declare-function vm-visit-folder "ext:vm-startup" + (folder &optional read-only)) +(declare-function vm-select-folder-buffer "ext:vm-macro" ()) ; defsubst +(declare-function vm-check-for-killed-summary "ext:vm-misc" ()) +(declare-function vm-error-if-folder-empty "ext:vm-misc" ()) +(declare-function vm-get-header-contents "ext:vm-summary" + (message header-name-regexp &optional clump-sep)) +(declare-function vm-select-marked-or-prefixed-messages "ext:vm-folder" + (prefix)) ;; Display function (defun mairix-vm-display (folder) @@ -393,7 +398,7 @@ Overwrite existing entry? ") (concat "\n\n" (make-string 65 ?=) "\nYou can now customize your saved Mairix searches by modifying\n\ the variable mairix-saved-searches. Don't forget to save your\nchanges \ -in your .emacs by pressing 'Save for Future Sessions'.\n" +in your .emacs by pressing `Save for Future Sessions'.\n" (make-string 65 ?=) "\n"))) (autoload 'mail-strip-quoted-names "mail-utils") @@ -570,10 +575,10 @@ whole threads. Function returns t if messages were found." mairix-output-buffer))) (zerop rval))) -(defun mairix-replace-illegal-chars (header) - "Replace illegal characters in HEADER for mairix query." +(defun mairix-replace-invalid-chars (header) + "Replace invalid characters in HEADER for mairix query." (when header - (while (string-match "[^-.@/,& [:alnum:]]" header) + (while (string-match "[^-.@/,^=~& [:alnum:]]" header) (setq header (replace-match "" t t header))) (while (string-match "[& ]" header) (setq header (replace-match "," t t header))) @@ -620,7 +625,7 @@ See %s for details" mairix-output-buffer))) (concat (nth 1 cur) ":" - (mairix-replace-illegal-chars + (mairix-replace-invalid-chars (widget-value (cadr (assoc (concat "e" (car (cddr cur))) widgets))))) query))) @@ -652,9 +657,18 @@ Fill in VALUES if based on an article." (kill-all-local-variables) (erase-buffer) (widget-insert - "Specify your query for Mairix (check boxes for activating fields):\n\n") + "Specify your query for Mairix using check boxes for activating fields.\n\n") (widget-insert - "(Whitespaces will be converted to ',' (i.e. AND). Use '/' for OR.)\n\n") + (concat "Use ~word to match messages " + (propertize "not" 'face 'italic) + " containing the word)\n" + " substring= to match words containing the substring\n" + " substring=N to match words containing the substring, allowing\n" + " up to N errors(missing/extra/different letters)\n" + " ^substring= to match the substring at the beginning of a word.\n")) + (widget-insert + (format-message + "Whitespace will be converted to `,' (i.e. AND). Use `/' for OR.\n\n")) (setq mairix-widgets (mairix-widget-build-editable-fields values)) (when (member 'flags mairix-widget-other) (widget-insert "\nFlags:\n Seen: ") @@ -749,33 +763,26 @@ VALUES may contain values for editable fields from current article." (define-key map [(d)] 'mairix-select-delete) (define-key map [(s)] 'mairix-select-save) map) - "'mairix-searches-mode' keymap.") - -(defvar mairix-searches-mode-font-lock-keywords) - -(defun mairix-searches-mode () + "`mairix-searches-mode' keymap.") + +(defvar mairix-searches-mode-font-lock-keywords + '(("^\\([0-9]+\\)" + (1 font-lock-constant-face)) + ("^[0-9 ]+\\(Name:\\) \\(.*\\)" + (1 font-lock-keyword-face) (2 font-lock-string-face)) + ("^[ ]+\\(Query:\\) \\(.*\\) , " + (1 font-lock-keyword-face) (2 font-lock-string-face)) + (", \\(Threads:\\) \\(.*\\)" + (1 font-lock-keyword-face) (2 font-lock-constant-face)) + ("^\\([A-Z].*\\)$" + (1 font-lock-comment-face)) + ("^[ ]+\\(Folder:\\) \\(.*\\)" + (1 font-lock-keyword-face) (2 font-lock-string-face)))) + +(define-derived-mode mairix-searches-mode fundamental-mode "mairix-searches" "Major mode for editing mairix searches." - (interactive) - (kill-all-local-variables) - (setq major-mode 'mairix-searches-mode) - (setq mode-name "mairix-searches") - (set-syntax-table text-mode-syntax-table) - (use-local-map mairix-searches-mode-map) - (make-local-variable 'font-lock-defaults) - (setq mairix-searches-mode-font-lock-keywords - (list (list "^\\([0-9]+\\)" - '(1 font-lock-constant-face)) - (list "^[0-9 ]+\\(Name:\\) \\(.*\\)" - '(1 font-lock-keyword-face) '(2 font-lock-string-face)) - (list "^[ ]+\\(Query:\\) \\(.*\\) , " - '(1 font-lock-keyword-face) '(2 font-lock-string-face)) - (list ", \\(Threads:\\) \\(.*\\)" - '(1 font-lock-keyword-face) '(2 font-lock-constant-face)) - (list "^\\([A-Z].*\\)$" - '(1 font-lock-comment-face)) - (list "^[ ]+\\(Folder:\\) \\(.*\\)" - '(1 font-lock-keyword-face) '(2 font-lock-string-face)))) - (setq font-lock-defaults '(mairix-searches-mode-font-lock-keywords))) + :syntax-table text-mode-syntax-table + (setq-local font-lock-defaults '(mairix-searches-mode-font-lock-keywords))) (defun mairix-build-search-list () "Display saved searches in current buffer." @@ -935,7 +942,7 @@ Use cursor keys or C-n,C-p to select next/previous search.\n\n") (lambda (field) (list (car (cddr field)) (if (car field) - (mairix-replace-illegal-chars + (mairix-replace-invalid-chars (funcall get-mail-header (car field))) nil)))) mairix-widget-fields-list))) @@ -945,4 +952,3 @@ Use cursor keys or C-n,C-p to select next/previous search.\n\n") (provide 'mairix) ;;; mairix.el ends here -