From c344fe23563498969d5c05bb1fc1b8a30bb50463 Mon Sep 17 00:00:00 2001 From: djcb Date: Wed, 7 Dec 2011 08:50:03 +0200 Subject: [PATCH] * mm: support limited search 's' and full search 'S' --- toys/mm/mm-hdrs.el | 43 +++++++++++++++++++++++++++++-------------- toys/mm/mm-main.el | 1 + toys/mm/mm-proc.el | 22 +++++++++++----------- toys/mm/mm-view.el | 2 ++ 4 files changed, 43 insertions(+), 25 deletions(-) diff --git a/toys/mm/mm-hdrs.el b/toys/mm/mm-hdrs.el index 21dab8f4..99c37b95 100644 --- a/toys/mm/mm-hdrs.el +++ b/toys/mm/mm-hdrs.el @@ -51,10 +51,11 @@ (defvar mm/hdrs-buffer nil "*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 -buffer for the results." - (interactive "s[mu] search for: ") +buffer for the results. If FULL-SEARCH is non-nil return all +results, otherwise, limit number of results to +`mm/search-results-limit'." (let ((buf (get-buffer-create mm/hdrs-buffer-name)) (inhibit-read-only t)) (with-current-buffer buf @@ -67,7 +68,8 @@ buffer for the results." mm/last-expr expr mm/hdrs-buffer buf))) (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 @@ -132,7 +134,8 @@ the current list of headers." (docid-at-pos (and pos (mm/hdrs-get-docid pos)))) (unless marker (error "Message %d not found" docid)) (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)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -180,12 +183,13 @@ if provided, or at the end of the buffer otherwise." (:subject (concat (mm/thread-prefix thread-info) val)) ((:maildir :path) val) ((:to :from :cc :bcc) (mm/hdrs-contact-str val)) - ;; if we (ie. `user-mail-address' is the 'From', show 'To', otherwise - ;; show From + ;; if we (ie. `user-mail-address' is the 'From', show + ;; 'To', otherwise show From (:from-or-to (let* ((from-lst (plist-get msg :from)) (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 " (mm/hdrs-contact-str (plist-get msg :to))) (mm/hdrs-contact-str from-lst)))) @@ -247,8 +251,10 @@ after the end of the search results." (let ((map (make-sparse-keymap))) (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 "o" 'mm/change-sort) (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 [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 [sepa3] '("--")) @@ -608,11 +616,18 @@ start editing it. COMPOSE-TYPE is either `reply', `forward' or (message nil) unmark)) -(defun mm/search () - "Start a new mu search." - (interactive) +(defun mm/search (expr) + "Start a new mu search, limited to `mm/search-results-limit' +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) - (call-interactively 'mm/hdrs-search))) + (mm/hdrs-search expr t))) + (defun mm/search-bookmark () "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: "))) (when query (mm/hdrs-search query)))) - + (defun mm/quit-buffer () "Quit the current buffer." diff --git a/toys/mm/mm-main.el b/toys/mm/mm-main.el index 0f285307..795744e5 100644 --- a/toys/mm/mm-main.el +++ b/toys/mm/mm-main.el @@ -34,6 +34,7 @@ (define-key map "b" 'mm/search-bookmark) (define-key map "s" 'mm/search) + (define-key map "S" 'mm/search-full) (define-key map "q" 'mm/quit-mm) (define-key map "j" 'mm/jump-to-maildir) (define-key map "c" 'mm/compose-new) diff --git a/toys/mm/mm-proc.el b/toys/mm/mm-proc.el index 4bc85e86..6c1c7b96 100644 --- a/toys/mm/mm-proc.el +++ b/toys/mm/mm-proc.el @@ -138,13 +138,13 @@ process." (defun mm/kill-proc () "Kill the mu server process." (let* ((buf (get-buffer mm/server-name)) - (proc (and buf (get-buffer-process buf)))) + (proc (and buf (get-buffer-process buf)))) (when proc (let ((delete-exited-processes t)) ;; the mu server signal handler will make it quit after 'quit' (mm/proc-send-command "quit")) ;; try sending SIGINT (C-c) to process, so it can exit gracefully - (ignore-errors + (ignore-errors (signal-process proc 'SIGINT)))) (setq mm/mu-proc nil @@ -296,7 +296,7 @@ terminates." ((eq status 'exit) (cond ((eq code 0) - (message nil)) ;; don't do anything + (message nil)) ;; don't do anything ((eq code 11) (message "Database is locked by another process")) ((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)) -(defun mm/proc-find (expr) - "Start a database query for EXPR. For each result found, a -function is called, depending on the kind of result. The variables +(defun mm/proc-find (expr &optional maxnum) + "Start a database query for EXPR, getting up to MAXNUM +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 that will be called for, resp., a message (header row) or an 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) @@ -358,10 +360,8 @@ The FLAGS parameter can have the following forms: The flags are any of `deleted', `flagged', `new', `passed', `replied' `seen' or `trashed', or the corresponding \"DFNPRST\" as defined in [1]. See `mm/string-to-flags' and `mm/flags-to-string'. - The server reports the results for the operation through `mm/proc-update-func'. - The results are reported through either (:update ... ) or (:error ) sexp, which are handled my `mm/proc-update-func' and `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)) (error "Not a writable directory: %s" fullpath)) ;; 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) "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")) (mm/proc-send-command "compose %s %d" (symbol-name compose-type) docid)) - (defconst mm/update-buffer-name "*update*" "*internal* Name of the buffer to download mail") diff --git a/toys/mm/mm-view.el b/toys/mm/mm-view.el index bf931210..bed315ed 100644 --- a/toys/mm/mm-view.el +++ b/toys/mm/mm-view.el @@ -204,6 +204,8 @@ or if not available, :body-html converted to text)." (define-key map "q" 'mm/view-quit-buffer) (define-key map "s" 'mm/search) + (define-key map "S" 'mm/search-full) + (define-key map "b" 'mm/search-bookmark) (define-key map "j" 'mm/jump-to-maildir)