* mua updates

This commit is contained in:
Dirk-Jan C. Binnema 2011-08-29 23:39:25 +03:00
parent ff7a40b3d9
commit 3692fc1b39
4 changed files with 146 additions and 218 deletions

View File

@ -24,6 +24,10 @@
;;; Commentary:
;; In this file are function related to creating the list of one-line
;; descriptions of emails, aka 'headers' (not to be confused with headers like
;; 'To:' or 'Subject:')
;; mu
;;; Code:
@ -34,29 +38,26 @@
(require 'mua-msg)
;; note: these next two are *not* buffer-local, so they persist during a session
(defvar mua/hdrs-sortfield nil "field to sort headers by")
(defvar mua/hdrs-sort-descending nil "whether to sort in descending order")
(defvar mua/hdrs-sortfield nil
"*internal* Field to sort headers by")
(defvar mua/hdrs-sort-descending nil
"*internal Whether to sort in descending order")
(defvar mua/header-fields
(defvar mua/hdrs-fields
'( (:date . 25)
(:from-or-to . 22)
(:subject . 40))
"a list of fields and their widths")
"A list of header fields and their character widths")
;; internal stuff
(defvar mua/buf ""
"*internal* Buffer for results data.")
(defvar mua/last-expression nil
"*internal* The most recent search expression.")
(defvar mua/hdrs-process nil
(defvar mua/hdrs-proc nil
"*internal* The mu-find process.")
(defvar mua/hdrs-hash nil
"*internal* The bol->uid hash.")
(defconst mua/eom "\n;;eom\n"
(defconst mua/eom-mark "\n;;eom\n"
"*internal* Marker for the end of message in the mu find
output.")
(defconst mua/hdrs-buffer-name "*mua-headers*"
@ -66,20 +67,24 @@
"A process-filter for the 'mu find --format=sexp output; it
accumulates the strings into valid sexps by checking of the
';;eom' end-of-msg marker, and then evaluating them."
(let ((procbuf (process-buffer proc)))
(when (buffer-live-p procbuf)
(with-current-buffer procbuf
(save-excursion
(setq mua/buf (concat mua/buf str))
(let ((eom (string-match mua/eom mua/buf)))
(while (numberp eom)
(let* ((msg (mua/msg-from-string(substring mua/buf 0 eom))))
(save-match-data (mua/hdrs-append-message msg))
(setq mua/buf (substring mua/buf (match-end 0)))
(setq eom (string-match mua/eom mua/buf))))))))))
(setq mua/buf (concat mua/buf str)) ;; update our buffer
(let ((buf (process-buffer proc))) ;; check the buffer
(unless (buffer-live-p buf)
(error "No live buffer for process filter"))
(while ;; for-each-sex
;; Process the sexp in `mua/buf', and remove it if it worked and return
;; t. If no complete sexp is found, return nil."
(let ((eom (string-match mua/eom-mark mua/buf))
(after-eom (match-end 0)) (inhibit-read-only t))
(when (numberp eom) ;; was the marker found?
(with-current-buffer buf
(mua/hdrs-append-message (mua/msg-from-string
(substring mua/buf 0 eom))))
(setq mua/buf (substring mua/buf after-eom)) t)))))
(defun mua/hdrs-proc-sentinel (proc msg)
"Check the process upon completion."
"Sentinel funtion for the mu-find process -- ie., will be called upon its ."
(let ((procbuf (process-buffer proc))
(status (process-status proc))
(exit-status (process-exit-status proc)))
@ -90,93 +95,86 @@
('exit
(if (= 0 exit-status)
"End of search results"
(mua/mu-error exit-status))))))
(mua/mu-error exit-status))))))
(with-current-buffer procbuf
(save-excursion
(goto-char (point-max))
(mua/message "%s" msg)))))))
(defun mua/hdrs-search-execute (expr buf)
"search in the mu database; output the results in buffer BUF"
(let ((args `("find" "--format=sexp" ,expr)))
(when mua/mu-home
(add-to-list args (concat "--muhome=" mua/mu-home)))
(when mua/hdrs-sortfield
(add-to-list args (concat "--sortfield=" mua/hdrs-sortfield)))
(when mua/hdrs-sort-descending
(add-to-list args "--descending"))
(mua/log (concat mua/mu-binary " " (mapconcat 'identity args " ")))
;; now, do it!
(let ((proc (apply 'start-process "*mua-headers*" buf mua/mu-binary args)))
(setq
mua/buf ""
mua/hdrs-process proc)
(set-process-filter proc 'mua/hdrs-proc-filter)
(set-process-sentinel proc 'mua/hdrs-proc-sentinel))))
(defun mua/hdrs-search-execute (expr)
"Search in the mu database, and output the results in the current
buffer."
(let* ((argl
(remove-if 'not
(list "find" "--format=sexp" "--threads"
(when mua/mu-home (concat "--muhome=" mua/mu-home))
(when mua/hdrs-sortfield
(concat "--sortfield=" mua/hdrs-sortfield))
(when mua/hdrs-sort-descending "--descending")
expr)))
(mua/buf "")
;; start the process
(proc (apply 'start-process
mua/hdrs-buffer-name (current-buffer) mua/mu-binary argl)))
(setq mua/hdrs-proc proc)
(set-process-filter proc 'mua/hdrs-proc-filter)
(set-process-sentinel proc 'mua/hdrs-proc-sentinel)
(mua/log (concat mua/mu-binary " " (mapconcat 'identity argl " ")))))
;; Note, the 'mu find --format=sexp' sexp is almost the same as the ones that
;; 'mu view --format=sexp' produces (see mu-get-message), with the difference
;; that former may give more than one result, and that mu-headers output comes
;; from the database rather than file, and does _not_ contain the message body
(defun mua/hdrs-search (expr)
"search in the mu database"
"Search in the mu database for EXPR, and switch to the output
buffer for the results."
(interactive "s[mu] search for: ")
(setq debug-on-error t)
;; kill running process if needed
(when (and mua/hdrs-process
(eq (process-status mua/hdrs-process) 'run))
(kill-process mua/hdrs-process))
;; kill a running process if needed
(when (and mua/hdrs-proc (eq (process-status mua/hdrs-proc) 'run))
(kill-process mua/hdrs-proc))
(let ((buf (mua/new-buffer mua/hdrs-buffer-name)))
(switch-to-buffer buf)
(mua/hdrs-mode)
(setq
mua/last-expression expr
mua/hdrs-hash (make-hash-table :size 256 :rehash-size 2)
mua/hdrs-marks-hash (make-hash-table :size 16 :rehash-size 2))
(mua/hdrs-search-execute expr buf)))
(mua/hdrs-search-execute expr)))
(defun mua/hdrs-mode ()
"major mode for displaying mua search results"
"Major mode for displaying mua search results."
(interactive)
(kill-all-local-variables)
(use-local-map mua/hdrs-mode-map)
(make-local-variable 'mua/buf)
(make-local-variable 'mua/last-expression)
(make-local-variable 'mua/hdrs-process)
(make-local-variable 'mua/hdrs-proc)
(make-local-variable 'mua/hdrs-hash)
(make-local-variable 'mua/hdrs-marks-hash)
(setq
mua/last-expression expr
mua/hdrs-marks-hash (make-hash-table :size 16 :rehash-size 2)
major-mode 'mua/mua/hdrs-mode mode-name "*mua-headers*"
truncate-lines t buffer-read-only t
truncate-lines t
buffer-read-only t
overwrite-mode 'overwrite-mode-binary))
(defun mua/hdrs-line (msg)
"return line describing a message (ie., a header line)"
(let
((hdr
(mapconcat
(lambda(fieldpair)
(let ((field (car fieldpair)) (width (cdr fieldpair)))
(case field
(:subject (mua/hdrs-header msg :subject width))
(:to (mua/hdrs-contact msg field width))
(:from (mua/hdrs-contact msg field width))
;;(:from-or-to (mua/msg-header-header-from-or-to msg width 'mua/header-face))
(:cc (mua/hdrs-contact msg field width))
(:bcc (mua/hdrs-contact msg field width))
(:date (mua/hdrs-date msg width))
(:flags (mua/hdrs-flags msg width))
(:size (mua/hdrs-size msg width))
(t (error "Unsupported field: %S" field))
)))
mua/header-fields " ")))
hdr))
"Return line describing a message (ie., a header line)."
(mapconcat
(lambda(fieldpair)
(let ((field (car fieldpair)) (width (cdr fieldpair)))
(case field
(:subject (mua/hdrs-header msg :subject width))
(:to (mua/hdrs-contact msg field width))
(:from (mua/hdrs-contact msg field width))
;;(:from-or-to (mua/msg-header-header-from-or-to msg width 'mua/header-face))
(:cc (mua/hdrs-contact msg field width))
(:bcc (mua/hdrs-contact msg field width))
(:date (mua/hdrs-date msg width))
(:flags (mua/hdrs-flags msg width))
(:size (mua/hdrs-size msg width))
(t (error "Unsupported field: %S" field)))))
mua/header-fields " "))
;;
;; Note: we maintain a hash table to remember what message-path corresponds to a
@ -188,37 +186,33 @@
;;
;; point-of-bol -> path
;;
(defun mua/hdrs-set-path (path)
"Map the bol of the current header to an entry in
`mua/msg-map', and return the uid."
(let ((uid (mua/msg-map-add path)))
(puthash (line-beginning-position 1) uid mua/hdrs-hash)
uid))
(defun mua/hdrs-get-uid ()
"Get the uid for the message header at point."
(gethash (line-beginning-position 1) mua/hdrs-hash))
(get-text-property (point) 'uid))
(defun mua/hdrs-get-path ()
"Get the current path for the header at point."
(mua/msg-map-get-path (mua/hdrs-get-uid)))
(defun mua/hdrs-append-message (msg)
"append a message line to the buffer and register the message"
(let ((line (mua/hdrs-line msg)) (inhibit-read-only t))
"Append a one-line description of MSG to the buffer, and register
it with `mua/msg-map-add' to `mua/msg-map'; add the uid for this
message as a text-property `uid'."
(let* ((uid (mua/msg-map-add (mua/msg-field msg :path)))
(line (propertize (concat " " (mua/hdrs-line msg) "\n") 'uid uid))
(inhibit-read-only t))
(save-excursion
(goto-char (point-max))
(mua/hdrs-set-path (mua/msg-field msg :path))
(insert " " line "\n"))))
(insert line))))
;; Now follow a bunch of function to turn some message field in a
;; string for display
(defun mua/hdrs-header (msg field width)
"get a string at WIDTH (truncate or ' '-pad) for display as a
header"
"Get a string at WIDTH (truncate or ' '-pad) for display as a
header."
(let* ((str (mua/msg-field msg field)) (str (if str str "")))
(propertize (truncate-string-to-width str width 0 ?\s t)
'face 'mua/header-face)))
@ -250,24 +244,15 @@ fitting in WIDTH"
(defun mua/hdrs-date (msg width)
"return a string for the date of MSG of WIDTH"
"Return a string for the date of MSG of WIDTH."
(let* ((date (mua/msg-field msg :date)))
(if date
(propertize (truncate-string-to-width (format-time-string "%x %X" date)
width 0 ?\s) 'face 'mua/date-face))))
(defun mua/hdrs-flags (msg width)
(let* ((flags (mua/msg-field msg :flags))
(flagstr
(mapconcat
(lambda(flag)
(case flag
('unread "U")
('seen "S")
('replied "R")
('attach "a")
('encrypted "x")
('signed "s"))) flags "")))
"Return a string describing the flags of MSG at WIDTH."
(let ((flagstr (mua/msg-flags-to-string (mua/msg-field msg :flags))))
(propertize (truncate-string-to-width flagstr width 0 ?\s)
'face 'mua/header-face)))
@ -312,12 +297,14 @@ fitting in WIDTH"
(mua/warn "No message after this one")
t))
(defun mua/hdrs-prev ()
"go to the previous line; t if it worked, nil otherwise"
(interactive)
(if (or (/= 0 (forward-line -1)) (not (mua/hdrs-get-path)))
(mua/warn "No message before this one")
t))
(defun mua/hdrs-prev ()
"Go to the previous line; t if it worked, nil otherwise."
(when (buffer-live-p mua/hdrs-buffer)
(with-current-buffer mua/hdrs-buffer
(if (or (/= 0 (forward-line -1)) (not (mua/hdrs-get-uid)))
(mua/warn "No message before this one")))
(when mua/view-uid ;; are we in view buffer?
(mua/view (mua/hdrs-get-uid) mua/hdrs-buffer))))
(defun mua/hdrs-view ()
(interactive)
@ -336,7 +323,8 @@ fitting in WIDTH"
"Re-run the query for the current search expression, but only
if the search process is not already running"
(interactive)
(when mua/last-expression (mua/hdrs-search mua/last-expression)))
(when mua/last-expression
(mua/hdrs-search mua/last-expression)))
;;; functions for sorting
@ -483,7 +471,7 @@ latter two are pseudo-markings."
(mua/msg-reply msg uid)
(mua/warn "No message at point"))))
(defun mua/hdrs-for ()
(defun mua/hdrs-for-reply ()
"Forward the message at point."
(interactive)
(let* ((uid (mua/hdrs-get-uid))

View File

@ -170,9 +170,8 @@ determined, return `nil'."
(defun mua/msg-flags-to-string (flags)
"Remove duplicates and sort the output of `mua/msg-flags-to-string-1'."
(concat
(sort
(remove-duplicates
(append (mua/msg-flags-to-string-1 flags) nil)) '>)))
(sort (remove-duplicates
(append (mua/msg-flags-to-string-1 flags) nil)) '>)))
(defun mua/msg-flags-to-string-1 (flags)
"Convert a list of flags into a string as seen in Maildir
@ -185,14 +184,17 @@ Also see `mua/msg-string-to-flags'.
\[1\]: http://cr.yp.to/proto/maildir.html"
(when flags
(let ((kar
(case (car flags)
('draft ?D)
('flagged ?F)
('passed ?P)
('replied ?R)
('seen ?S)
('trashed ?T))))
(let ((kar (case (car flags)
('draft ?D)
('flagged ?F)
('new ?N)
('passed ?P)
('replied ?R)
('seen ?S)
('trashed ?T)
('encrypted ?x)
('signed ?s)
('unread ?u))))
(concat (and kar (string kar))
(mua/msg-flags-to-string-1 (cdr flags))))))

View File

@ -141,67 +141,4 @@ them."
(mua/mu-db-update-execute))
;; generated with:
;; cat mu-util.h | sed 's/\([A-Z_]\+\).*=\(.*\),/(defconst \L\1 \2)/' < "$<" \
;; | sed 's/_/-/g' > mu-errors.el
(defconst mu-error 1)
(defconst mu-error-in-parameters 2)
(defconst mu-error-internal 3)
(defconst mu-error-no-matches 4)
(defconst mu-error-xapian 11)
(defconst mu-error-xapian-query 13)
(defconst mu-error-xapian-dir-not-accessible 14)
(defconst mu-error-xapian-not-up-to-date 15)
(defconst mu-error-xapian-missing-data 16)
(defconst mu-error-xapian-corruption 17)
(defconst mu-error-xapian-cannot-get-writelock 18)
(defconst mu-error-gmime 30)
(defconst mu-error-contacts 50)
(defconst mu-error-contacts-cannot-retrieve 51)
(defconst mu-error-file 70)
(defconst mu-error-file-invalid-name 71)
(defconst mu-error-file-cannot-link 72)
(defconst mu-error-file-cannot-open 73)
(defconst mu-error-file-cannot-read 74)
(defconst mu-error-file-cannot-create 75)
(defconst mu-error-file-cannot-mkdir 76)
(defconst mu-error-file-stat-failed 77)
(defconst mu-error-file-readdir-failed 78)
(defconst mu-error-file-invalid-source 79)
(defconst mu-error-file-target-equals-source 80)
(defun mua/mu-error (err)
"Convert an exit code from mu into a string."
(cond
((eql err mu-error) "General error")
((eql err mu-error-in-parameters) "Error in parameters")
((eql err mu-error-internal) "Internal error")
((eql err mu-error-no-matches) "No matches")
((eql err mu-error-xapian) "Xapian error")
((eql err mu-error-xapian-query) "Error in query")
((eql err mu-error-xapian-dir-not-accessible) "Database dir not accessible")
((eql err mu-error-xapian-not-up-to-date) "Database is not up-to-date")
((eql err mu-error-xapian-missing-data) "Missing data")
((eql err mu-error-xapian-corruption) "Database seems to be corrupted")
((eql err mu-error-xapian-cannot-get-writelock) "Database is locked")
((eql err mu-error-gmime) "GMime-related error")
((eql err mu-error-contacts) "Contacts-related error")
((eql err mu-error-contacts-cannot-retrieve) "Failed to retrieve contacts")
((eql err mu-error-file) "File error")
((eql err mu-error-file-invalid-name) "Invalid file name")
((eql err mu-error-file-cannot-link) "Failed to link file")
((eql err mu-error-file-cannot-open) "Cannot open file")
((eql err mu-error-file-cannot-read) "Cannot read file")
((eql err mu-error-file-cannot-create) "Cannot create file")
((eql err mu-error-file-cannot-mkdir) "mu-mkdir failed")
((eql err mu-error-file-stat-failed) "stat(2) failed")
((eql err mu-error-file-readdir-failed) "readdir failed")
((eql err mu-error-file-invalid-source) "Invalid source file")
((eql err mu-error-file-target-equals-source) "Source is same as target")
(t (format "Unknown error (%d)" err))))
(provide 'mua-mu)

View File

@ -42,45 +42,46 @@
"Fields to display in the message view buffer.")
(defvar mua/hdrs-buffer nil
"Headers buffer for the view in this buffer.")
"*internal* Headers buffer for the view in this buffer.")
(defvar mua/view-uid nil
"The UID for the message being viewed in this buffer.")
"*internal* The UID for the message being viewed in this buffer.")
(defun mua/view (uid headersbuf)
"display message identified by UID in a new buffer. Note that
the action of viewing a message may cause it to be moved/renamed;
this function returns the resulting name. PARENTBUF refers to the
buffer who invoked this view; this allows us to return there when
we quit from this view. Also, if PARENTBUF is a find buffer (ie.,
has mu-headers-mode as its major mode), this allows various
commands (navigation, marking etc.) to be applied to this
buffer.
(defun mua/view (uid hdrsbuf)
"Display the message identified by UID in a new buffer, and mark
is as no longer unread, -- note that the action of viewing a
message may cause it to be moved/renamed; this function returns the
resulting name. PARENTBUF refers to the buffer who invoked this
view; this allows us to return there when we quit from this
view. Also, if PARENTBUF is a find buffer (ie., has mu-headers-mode
as its major mode), this allows various commands (navigation,
marking etc.) to be applied to this buffer.
For the reasoning to use UID here instead of just the path, see
`mua/msg-map'.
"
(let* ((path (mua/msg-map-get-path uid))
(sexp (and path (mua/mu-view-sexp path)))
(msg (and sexp (mua/msg-from-string sexp))))
(if (not msg)
(mua/warn "Cannot view message %S %S" uid path)
(progn
(switch-to-buffer (get-buffer-create mua/view-buffer-name))
(let ((inhibit-read-only t))
(erase-buffer)
(insert (mua/view-message msg)))
`mua/msg-map'."
(condition-case err
(let* ((path (mua/msg-map-get-path uid))
(sexp (mua/mu-view-sexp path))
(msg (and sexp (mua/msg-from-string sexp))))
(unless (buffer-live-p hdrsbuf) (error "Headers buffer is dead"))
(unless msg (error "Cannot view message %S" path))
(let ((buf (get-buffer-create mua/view-buffer-name))
(inhibit-read-only t))
;; fill buffer with the message
(erase-buffer)
(insert (mua/view-message msg))
(mua/view-mode)
(goto-char (point-min))
(setq ;; these are buffer-local
mua/view-uid uid
mua/hdrs-buffer headersbuf
mua/parent-buffer headersbuf)
;; mark as read
(unless (mua/msg-move uid nil "+S-N" t)
(mua/warn "Failed to mark message as read"))))))
mua/hdrs-buffer hdrsbuf
mua/parent-buffer hdrsbuf)
(unless (mua/msg-move uid nil "+S-N" t) ;; mark as read
(error "Failed to mark message as read"))))
(debug (error))));; (mua/warn "error: %s" (error-message-string err)))))
@ -228,7 +229,7 @@ own safety)."
"move to the next message; note, this will replace the current
buffer"
(interactive)
(mua/with-hdrs-buffer
(with-current-buffer mua/hdrs-buffer
(when (mua/hdrs-next) (mua/hdrs-view))))
(defun mua/view-prev ()