* mm: support limited search 's' and full search 'S'

This commit is contained in:
djcb
2011-12-07 08:50:03 +02:00
parent 50ff744d36
commit c344fe2356
4 changed files with 43 additions and 25 deletions

View File

@ -51,10 +51,11 @@
(defvar mm/hdrs-buffer nil (defvar mm/hdrs-buffer nil
"*internal* Buffer for message headers") "*internal* Buffer for message headers")
(defun mm/hdrs-search (expr) (defun mm/hdrs-search (expr &optional full-search)
"Search in the mu database for EXPR, and switch to the output "Search in the mu database for EXPR, and switch to the output
buffer for the results." buffer for the results. If FULL-SEARCH is non-nil return all
(interactive "s[mu] search for: ") results, otherwise, limit number of results to
`mm/search-results-limit'."
(let ((buf (get-buffer-create mm/hdrs-buffer-name)) (let ((buf (get-buffer-create mm/hdrs-buffer-name))
(inhibit-read-only t)) (inhibit-read-only t))
(with-current-buffer buf (with-current-buffer buf
@ -67,7 +68,8 @@ buffer for the results."
mm/last-expr expr mm/last-expr expr
mm/hdrs-buffer buf))) mm/hdrs-buffer buf)))
(switch-to-buffer mm/hdrs-buffer) (switch-to-buffer mm/hdrs-buffer)
(mm/proc-find expr)) (mm/proc-find expr ;; '-1' means 'unlimited search'
(if full-search -1 mm/search-results-limit)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; handler functions ;; handler functions
@ -132,7 +134,8 @@ the current list of headers."
(docid-at-pos (and pos (mm/hdrs-get-docid pos)))) (docid-at-pos (and pos (mm/hdrs-get-docid pos))))
(unless marker (error "Message %d not found" docid)) (unless marker (error "Message %d not found" docid))
(unless (eq docid docid-at-pos) (unless (eq docid docid-at-pos)
(error "At point %d, expected docid %d, but got %d" pos docid docid-at-pos)) (error "At point %d, expected docid %d, but got %d"
pos docid docid-at-pos))
(mm/hdrs-remove-header docid pos)))) (mm/hdrs-remove-header docid pos))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -180,12 +183,13 @@ if provided, or at the end of the buffer otherwise."
(:subject (concat (mm/thread-prefix thread-info) val)) (:subject (concat (mm/thread-prefix thread-info) val))
((:maildir :path) val) ((:maildir :path) val)
((:to :from :cc :bcc) (mm/hdrs-contact-str val)) ((:to :from :cc :bcc) (mm/hdrs-contact-str val))
;; if we (ie. `user-mail-address' is the 'From', show 'To', otherwise ;; if we (ie. `user-mail-address' is the 'From', show
;; show From ;; 'To', otherwise show From
(:from-or-to (:from-or-to
(let* ((from-lst (plist-get msg :from)) (let* ((from-lst (plist-get msg :from))
(from (and from-lst (cdar from-lst)))) (from (and from-lst (cdar from-lst))))
(if (and from (string-match mm/user-mail-address-regexp from)) (if (and from (string-match
mm/user-mail-address-regexp from))
(concat "To " (concat "To "
(mm/hdrs-contact-str (plist-get msg :to))) (mm/hdrs-contact-str (plist-get msg :to)))
(mm/hdrs-contact-str from-lst)))) (mm/hdrs-contact-str from-lst))))
@ -247,8 +251,10 @@ after the end of the search results."
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map "s" 'mm/search) (define-key map "s" 'mm/search)
(define-key map "b" 'mm/search-bookmark) (define-key map "S" 'mm/search-full)
(define-key map "b" 'mm/search-bookmark)
(define-key map "q" 'mm/quit-buffer) (define-key map "q" 'mm/quit-buffer)
;; (define-key map "o" 'mm/change-sort) ;; (define-key map "o" 'mm/change-sort)
(define-key map "g" 'mm/rerun-search) (define-key map "g" 'mm/rerun-search)
@ -303,6 +309,8 @@ after the end of the search results."
(define-key menumap [refresh] '("Refresh" . mm/rerun-search)) (define-key menumap [refresh] '("Refresh" . mm/rerun-search))
(define-key menumap [search] '("Search" . mm/search)) (define-key menumap [search] '("Search" . mm/search))
(define-key menumap [search-full] '("Search full" . mm/search-full))
(define-key menumap [jump] '("Jump to maildir" . mm/jump-to-maildir)) (define-key menumap [jump] '("Jump to maildir" . mm/jump-to-maildir))
(define-key menumap [sepa3] '("--")) (define-key menumap [sepa3] '("--"))
@ -608,11 +616,18 @@ start editing it. COMPOSE-TYPE is either `reply', `forward' or
(message nil) (message nil)
unmark)) unmark))
(defun mm/search () (defun mm/search (expr)
"Start a new mu search." "Start a new mu search, limited to `mm/search-results-limit'
(interactive) results."
(interactive "s[mu] search for: ")
(when (mm/ignore-marks) (mm/hdrs-search expr)))
(defun mm/search-full (expr)
"Start a new mu search; resturn *all* results."
(interactive "s[mu] full search for: ")
(when (mm/ignore-marks) (when (mm/ignore-marks)
(call-interactively 'mm/hdrs-search))) (mm/hdrs-search expr t)))
(defun mm/search-bookmark () (defun mm/search-bookmark ()
"Search using some bookmarked query." "Search using some bookmarked query."
@ -620,7 +635,7 @@ start editing it. COMPOSE-TYPE is either `reply', `forward' or
(let ((query (mm/ask-bookmark "Bookmark: "))) (let ((query (mm/ask-bookmark "Bookmark: ")))
(when query (when query
(mm/hdrs-search query)))) (mm/hdrs-search query))))
(defun mm/quit-buffer () (defun mm/quit-buffer ()
"Quit the current buffer." "Quit the current buffer."

View File

@ -34,6 +34,7 @@
(define-key map "b" 'mm/search-bookmark) (define-key map "b" 'mm/search-bookmark)
(define-key map "s" 'mm/search) (define-key map "s" 'mm/search)
(define-key map "S" 'mm/search-full)
(define-key map "q" 'mm/quit-mm) (define-key map "q" 'mm/quit-mm)
(define-key map "j" 'mm/jump-to-maildir) (define-key map "j" 'mm/jump-to-maildir)
(define-key map "c" 'mm/compose-new) (define-key map "c" 'mm/compose-new)

View File

@ -138,13 +138,13 @@ process."
(defun mm/kill-proc () (defun mm/kill-proc ()
"Kill the mu server process." "Kill the mu server process."
(let* ((buf (get-buffer mm/server-name)) (let* ((buf (get-buffer mm/server-name))
(proc (and buf (get-buffer-process buf)))) (proc (and buf (get-buffer-process buf))))
(when proc (when proc
(let ((delete-exited-processes t)) (let ((delete-exited-processes t))
;; the mu server signal handler will make it quit after 'quit' ;; the mu server signal handler will make it quit after 'quit'
(mm/proc-send-command "quit")) (mm/proc-send-command "quit"))
;; try sending SIGINT (C-c) to process, so it can exit gracefully ;; try sending SIGINT (C-c) to process, so it can exit gracefully
(ignore-errors (ignore-errors
(signal-process proc 'SIGINT)))) (signal-process proc 'SIGINT))))
(setq (setq
mm/mu-proc nil mm/mu-proc nil
@ -296,7 +296,7 @@ terminates."
((eq status 'exit) ((eq status 'exit)
(cond (cond
((eq code 0) ((eq code 0)
(message nil)) ;; don't do anything (message nil)) ;; don't do anything
((eq code 11) ((eq code 11)
(message "Database is locked by another process")) (message "Database is locked by another process"))
((eq code 19) ((eq code 19)
@ -332,13 +332,15 @@ my `mm/proc-update-func' and `mm/proc-error-func', respectively."
(mm/proc-send-command "remove %d" docid)) (mm/proc-send-command "remove %d" docid))
(defun mm/proc-find (expr) (defun mm/proc-find (expr &optional maxnum)
"Start a database query for EXPR. For each result found, a "Start a database query for EXPR, getting up to MAXNUM
function is called, depending on the kind of result. The variables results (or -1 for unlimited). For each result found, a function is
called, depending on the kind of result. The variables
`mm/proc-header-func' and `mm/proc-error-func' contain the function `mm/proc-header-func' and `mm/proc-error-func' contain the function
that will be called for, resp., a message (header row) or an that will be called for, resp., a message (header row) or an
error." error."
(mm/proc-send-command "find \"%s\"" expr)) (mm/proc-send-command "find \"%s\" %d"
expr (if maxnum maxnum -1)))
(defun mm/proc-move-msg (docid targetmdir &optional flags) (defun mm/proc-move-msg (docid targetmdir &optional flags)
@ -358,10 +360,8 @@ The FLAGS parameter can have the following forms:
The flags are any of `deleted', `flagged', `new', `passed', `replied' `seen' or The flags are any of `deleted', `flagged', `new', `passed', `replied' `seen' or
`trashed', or the corresponding \"DFNPRST\" as defined in [1]. See `trashed', or the corresponding \"DFNPRST\" as defined in [1]. See
`mm/string-to-flags' and `mm/flags-to-string'. `mm/string-to-flags' and `mm/flags-to-string'.
The server reports the results for the operation through The server reports the results for the operation through
`mm/proc-update-func'. `mm/proc-update-func'.
The results are reported through either (:update ... ) The results are reported through either (:update ... )
or (:error ) sexp, which are handled my `mm/proc-update-func' and or (:error ) sexp, which are handled my `mm/proc-update-func' and
`mm/proc-error-func', respectively." `mm/proc-error-func', respectively."
@ -371,7 +371,8 @@ or (:error ) sexp, which are handled my `mm/proc-update-func' and
(unless (and (file-directory-p fullpath) (file-writable-p fullpath)) (unless (and (file-directory-p fullpath) (file-writable-p fullpath))
(error "Not a writable directory: %s" fullpath)) (error "Not a writable directory: %s" fullpath))
;; note, we send the maildir, *not* the full path ;; note, we send the maildir, *not* the full path
(mm/proc-send-command "move %d \"%s\" \"%s\"" docid targetmdir flagstr))) (mm/proc-send-command "move %d \"%s\" %s" docid
targetmdir flagstr)))
(defun mm/proc-flag (docid-or-msgid flags) (defun mm/proc-flag (docid-or-msgid flags)
"Set FLAGS for the message identified by either DOCID-OR-MSGID." "Set FLAGS for the message identified by either DOCID-OR-MSGID."
@ -410,7 +411,6 @@ The result will be delivered to the function registered as
(error "Unsupported compose-type")) (error "Unsupported compose-type"))
(mm/proc-send-command "compose %s %d" (symbol-name compose-type) docid)) (mm/proc-send-command "compose %s %d" (symbol-name compose-type) docid))
(defconst mm/update-buffer-name "*update*" (defconst mm/update-buffer-name "*update*"
"*internal* Name of the buffer to download mail") "*internal* Name of the buffer to download mail")

View File

@ -204,6 +204,8 @@ or if not available, :body-html converted to text)."
(define-key map "q" 'mm/view-quit-buffer) (define-key map "q" 'mm/view-quit-buffer)
(define-key map "s" 'mm/search) (define-key map "s" 'mm/search)
(define-key map "S" 'mm/search-full)
(define-key map "b" 'mm/search-bookmark) (define-key map "b" 'mm/search-bookmark)
(define-key map "j" 'mm/jump-to-maildir) (define-key map "j" 'mm/jump-to-maildir)