mirror of https://github.com/djcb/mu.git
* mm: updates
This commit is contained in:
Dirk-Jan C. Binnema
parent
658b34d5b4
commit
311c3b6847
|
|
@ -116,6 +116,7 @@ Also see `mu/flags-to-string'.
|
|||
(map 'list (lambda (dir) (concat "/" dir)) maildirs)))
|
||||
|
||||
|
||||
|
||||
(defun mm/ask-maildir (prompt)
|
||||
"Ask user with PROMPT for a maildir name, if fullpath is
|
||||
non-nill, return the fulpath (i.e., `mm/maildir' prepended to the
|
||||
|
|
|
|||
|
|
@ -99,43 +99,38 @@ headers."
|
|||
(let* ((docid (plist-get msg :docid))
|
||||
(marker (gethash docid mm/msg-map))
|
||||
(point (when marker (marker-position marker))))
|
||||
(unless docid (error "Invalid update %S" update))
|
||||
(when point ;; is the message present in this list?
|
||||
(save-excursion
|
||||
(goto-char point)
|
||||
;; sanity check
|
||||
(unless (eq docid (mm/hdrs-get-docid))
|
||||
(error "Unexpected docid: %S <=> %S" docid (mm/hdrs-get-docid)))
|
||||
;; if it's marked, unmark it now
|
||||
(when (mm/hdrs-docid-is-marked docid) (mm/hdrs-mark 'unmark))
|
||||
;; first, remove the old one (otherwise, we'd have to headers with
|
||||
;; the same docid...
|
||||
(mm/hdrs-remove-handler docid)
|
||||
;; now, if this update was about *moving* a message, we don't show it
|
||||
;; anymore (of course, we cannot be sure if the message really no
|
||||
;; longer matches the query, but this seem a good heuristic.
|
||||
;; if it was only a flag-change, show the message with its updated flags.
|
||||
(unless is-move
|
||||
(mm/hdrs-header-handler msg point)))))))
|
||||
|
||||
;; if it's marked, unmark it now
|
||||
(when (mm/hdrs-docid-is-marked docid)
|
||||
(mm/hdrs-mark 'unmark))
|
||||
|
||||
;; first, remove the old one (otherwise, we'd have to headers with
|
||||
;; the same docid...
|
||||
(mm/hdrs-remove-header docid point)
|
||||
|
||||
;; now, if this update was about *moving* a message, we don't show it
|
||||
;; anymore (of course, we cannot be sure if the message really no
|
||||
;; longer matches the query, but this seem a good heuristic.
|
||||
;; if it was only a flag-change, show the message with its updated flags.
|
||||
(when (not is-move)
|
||||
(mm/hdrs-header-handler msg point))))))))
|
||||
|
||||
(defun mm/hdrs-remove-handler (docid)
|
||||
"Remove handler, will be called when a message has been removed
|
||||
from the database. This function will hide the remove message in
|
||||
the current list of headers."
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(let ((marker (gethash docid mm/msg-map)))
|
||||
(let* ((marker (gethash docid mm/msg-map))
|
||||
(pos (and marker (marker-position marker)))
|
||||
(docid-at-pos (and pos (mm/hdrs-get-docid pos))))
|
||||
(unless marker (error "Message %d not found" docid))
|
||||
(mm/hdrs-remove-header docid (marker-position marker)))))
|
||||
(unless (eq 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))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun mm/hdrs-header-handler (msg &optional point)
|
||||
"Create a one line description of MSG in this buffer at
|
||||
point. Line does not include a newline or any text-properties."
|
||||
"Create a one line description of MSG in this buffer, at POINT,
|
||||
if provided, or at the end of the buffer otherwise."
|
||||
(let* ((line (mapconcat
|
||||
(lambda (f-w)
|
||||
(let* ((field (car f-w)) (width (cdr f-w))
|
||||
|
|
@ -167,7 +162,8 @@ point. Line does not include a newline or any text-properties."
|
|||
((member 'trashed flags) (propertize line 'face 'mm/trashed-face))
|
||||
((member 'unread flags) (propertize line 'face 'mm/unread-face))
|
||||
(t (propertize line 'face 'mm/header-face)))))
|
||||
(mm/hdrs-add-header line (plist-get msg :docid) point)))
|
||||
(mm/hdrs-add-header line (plist-get msg :docid)
|
||||
(if point point (point-max)))))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
|
@ -189,23 +185,30 @@ point. Line does not include a newline or any text-properties."
|
|||
(define-key map "j" 'mm/jump-to-maildir)
|
||||
|
||||
|
||||
|
||||
|
||||
;; marking/unmarking/executing
|
||||
(define-key map "m" 'mm/mark-for-move)
|
||||
|
||||
(define-key map "d" 'mm/mark-for-trash)
|
||||
(define-key map (kbd "<backspace>") 'mm/mark-for-trash)
|
||||
|
||||
(define-key map "D" 'mm/mark-for-delete)
|
||||
(define-key map (kbd "<delete>") 'mm/mark-for-delete)
|
||||
|
||||
(define-key map "u" 'mm/unmark)
|
||||
(define-key map "U" 'mm/unmark-all)
|
||||
(define-key map "x" 'mm/execute-marks)
|
||||
|
||||
(define-key map " " 'mm/select)
|
||||
(define-key map "*" 'mm/select)
|
||||
|
||||
|
||||
|
||||
|
||||
;; message composition
|
||||
(define-key map "r" 'mm/compose-reply)
|
||||
(define-key map "f" 'mm/compose-forward)
|
||||
(define-key map "c" 'mm/compose-new)
|
||||
(define-key map "e" 'mm/edit-draft)
|
||||
|
||||
|
||||
(define-key map (kbd "RET") 'mm/view-message)
|
||||
map)
|
||||
|
|
@ -261,27 +264,27 @@ provided, put it at the end of the buffer."
|
|||
(unless docid (error "Invalid message"))
|
||||
(when (buffer-live-p mm/hdrs-buffer)
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(let ((inhibit-read-only t)
|
||||
(bol (line-beginning-position))
|
||||
(eol (line-beginning-position 2))
|
||||
(point (if point point (point-max))))
|
||||
(let ((inhibit-read-only t))
|
||||
(save-excursion
|
||||
(goto-char point)
|
||||
;; Update `mm/msg-map' with MSG, and MARKER pointing to the buffer
|
||||
;; position for the message header."
|
||||
(puthash docid (copy-marker point) mm/msg-map)
|
||||
(insert (propertize (concat " " str "\n") 'docid docid)))))))
|
||||
(insert (propertize (concat " " str "\n") 'docid docid))
|
||||
(puthash docid (copy-marker point t) mm/msg-map))))))
|
||||
|
||||
(defun mm/hdrs-remove-header (docid point)
|
||||
"Remove header with DOCID at POINT."
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(save-excursion
|
||||
(goto-char point)
|
||||
;; sanity check
|
||||
(unless (eq docid (mm/hdrs-get-docid)) (error "Unexpected docid"))
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region (line-beginning-position) (line-beginning-position 2)))
|
||||
(remhash docid mm/msg-map))))
|
||||
(goto-char point)
|
||||
;; sanity check
|
||||
(unless (eq docid (mm/hdrs-get-docid))
|
||||
(error "%d: Expected %d, but got %d"
|
||||
(line-number-at-pos) docid (mm/hdrs-get-docid)))
|
||||
(let ((inhibit-read-only t))
|
||||
;; (put-text-property (line-beginning-position line-beginning-positio 2)
|
||||
;; 'invisible t))
|
||||
(delete-region (line-beginning-position) (line-beginning-position 2)))
|
||||
(remhash docid mm/msg-map)))
|
||||
|
||||
(defun mm/hdrs-mark-header (docid mark)
|
||||
"(Visually) mark the header for DOCID with character MARK."
|
||||
|
|
@ -295,13 +298,26 @@ provided, put it at the end of the buffer."
|
|||
(delete-char 2)
|
||||
(insert mark " ")
|
||||
(put-text-property pos
|
||||
(line-beginning-position 2) 'docid docid)))))))
|
||||
|
||||
|
||||
(defun mm/hdrs-get-docid ()
|
||||
"Get the docid for the message at point, or nil if there is none"
|
||||
(line-beginning-position 2) 'docid docid)
|
||||
;; update the msg-map, ie., move it back to the start of the line
|
||||
(puthash docid
|
||||
(copy-marker (line-beginning-position) t)
|
||||
mm/msg-map)))))))
|
||||
|
||||
|
||||
(defun mm/hdrs-get-docid (&optional point)
|
||||
"Get the docid for the message at POINT, if provided, or (point), otherwise."
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(get-text-property (point) 'docid)))
|
||||
(get-text-property (if point point (point)) 'docid)))
|
||||
|
||||
(defun mm/dump-msg-map ()
|
||||
"*internal* dump the message map (for debugging)."
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(message "msg-map (%d)" (hash-table-count mm/msg-map))
|
||||
(maphash
|
||||
(lambda (k v)
|
||||
(message "%s => %s" k v))
|
||||
mm/msg-map)))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
|
@ -317,8 +333,8 @@ where
|
|||
MARK is the type of mark (move, trash, delete)
|
||||
TARGET (optional) is the target directory (for 'move')")
|
||||
|
||||
(defun mm/hdrs-mark (mark &optional target)
|
||||
"Mark (or unmark) header line at point. MARK specifies the
|
||||
(defun mm/hdrs-mark-message (mark &optional target)
|
||||
"Mark (or unmark) message at point. MARK specifies the
|
||||
mark-type. For `move'-marks there is also the TARGET argument,
|
||||
which specifies to which maildir the message is to be moved.
|
||||
|
||||
|
|
@ -349,6 +365,24 @@ The following marks are available, and the corresponding props:
|
|||
(puthash docid (list (point-marker) mark target) mm/marks-map)))))
|
||||
|
||||
|
||||
(defun mm/hdrs-mark (mark &optional target)
|
||||
"Mark the header at point, or, if
|
||||
region is active, mark all headers in the region. Als see
|
||||
`mm/hdrs-mark-message'."
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(if (use-region-p)
|
||||
;; mark all messages in the region.
|
||||
(save-excursion
|
||||
(let ((b (region-beginning)) (e (region-end)))
|
||||
(goto-char b)
|
||||
(while (<= (line-beginning-position) e)
|
||||
(mm/hdrs-mark-message mark target)
|
||||
(forward-line 1))))
|
||||
;; just a single message
|
||||
(mm/hdrs-mark-message mark target))))
|
||||
|
||||
|
||||
|
||||
(defun mm/hdrs-marks-execute ()
|
||||
"Execute the actions for all marked messages in this
|
||||
buffer. After the actions have been executed succesfully, the
|
||||
|
|
@ -393,12 +427,13 @@ work well."
|
|||
(unless docid (error "No message at point."))
|
||||
(mm/proc-view-msg docid)))
|
||||
|
||||
(defun mm/hdrs-compose (reply-or-forward)
|
||||
"Compose either a reply or a forward based on the message at
|
||||
point."
|
||||
(defun mm/hdrs-compose (compose-type)
|
||||
"Compose either a reply/forward based on the message at point. or
|
||||
start editing it. COMPOSE-TYPE is either `reply', `forward' or
|
||||
`draft'."
|
||||
(let ((docid (mm/hdrs-get-docid)))
|
||||
(unless docid (error "No message at point."))
|
||||
(mm/proc-compose-msg docid reply-or-forward)))
|
||||
(mm/proc-compose-msg docid compose-type)))
|
||||
|
||||
|
||||
(defun mm/hdrs-docid-is-marked (docid)
|
||||
|
|
@ -460,17 +495,16 @@ do a new search."
|
|||
the new docid. Otherwise, return nil."
|
||||
(interactive)
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(let ((old (line-number-at-pos)))
|
||||
(if (= 0 (forward-line 1))
|
||||
(let ((docid (mm/hdrs-get-docid)))
|
||||
(if docid docid (mm/next-header)))))))
|
||||
(when (= 0 (forward-line 1))
|
||||
(let ((docid (mm/hdrs-get-docid)))
|
||||
(if docid docid (mm/next-header))))))
|
||||
|
||||
(defun mm/prev-header ()
|
||||
"Move point to the previous message header. If this succeeds,
|
||||
return the new docid. Otherwise, return nil."
|
||||
(interactive)
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(if (= 0 (forward-line -1))
|
||||
(when (= 0 (forward-line -1))
|
||||
(let ((docid (mm/hdrs-get-docid)))
|
||||
(if docid docid (mm/prev-header)))))) ;; skip non-headers
|
||||
|
||||
|
|
@ -498,11 +532,14 @@ return the new docid. Otherwise, return nil."
|
|||
;; (when (eq (car val) 'select)
|
||||
;; (setq selected t)
|
||||
;; (case marktype
|
||||
|
||||
|
||||
;; mm/marks-map
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(defun mm/mark-for-move ()
|
||||
"Mark message at point for moving to a maildir."
|
||||
(interactive)
|
||||
|
|
@ -572,6 +609,12 @@ folder (`mm/trash-folder')."
|
|||
(with-current-buffer mm/hdrs-buffer
|
||||
(mm/hdrs-compose 'forward)))
|
||||
|
||||
(defun mm/edit-draft ()
|
||||
"Start editing the existing draft message at point."
|
||||
(interactive)
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(mm/hdrs-compose 'draft)))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
|
|||
|
|
@ -72,6 +72,7 @@ for the format of <msg-plist>.")
|
|||
"*internal* A function called for each (:info type ....) sexp
|
||||
received from the server process.")
|
||||
|
||||
|
||||
(defvar mm/buf nil
|
||||
"*internal* Buffer for results data.")
|
||||
|
||||
|
|
@ -92,7 +93,10 @@ process."
|
|||
;; add draft messages to the db, so when we're sending them, we can move
|
||||
;; to the sent folder using the `mm/proc-move'.
|
||||
(puthash (plist-get info :path) (plist-get info :docid) mm/path-docid-map))
|
||||
((eq type 'version) (setq mm/mu-version (plist-get info :version)))
|
||||
((eq type 'version)
|
||||
(setq
|
||||
mm/version (plist-get info :version)
|
||||
mm/doccount (plist-get-info :doccount)))
|
||||
((eq type 'index)
|
||||
(if (eq (plist-get info :status) 'running)
|
||||
(message (format "Indexing... processed %d, updated %d"
|
||||
|
|
@ -104,11 +108,16 @@ process."
|
|||
((plist-get info :message) (message "%s" (plist-get info :message))))))
|
||||
|
||||
|
||||
(defconst mm/server-name "*mm-server"
|
||||
"*internal* Name of the server process, buffer.")
|
||||
|
||||
|
||||
|
||||
(defun mm/start-proc ()
|
||||
"Start the mu server process."
|
||||
;; TODO: add version check
|
||||
(unless (file-executable-p mm/mu-binary)
|
||||
(error (format "%S is not executable" mm/mu-binary)))
|
||||
(error (format "%S not found" mm/mu-binary)))
|
||||
(let* ((process-connection-type nil) ;; use a pipe
|
||||
(coding-system-for-read 'utf-8)
|
||||
(coding-system-for-write 'no-conversion)
|
||||
|
|
@ -116,7 +125,7 @@ process."
|
|||
(args (append args (when mm/mu-home
|
||||
(list (concat "--muhome=" mm/mu-home))))))
|
||||
(setq mm/buf "")
|
||||
(setq mm/mu-proc (apply 'start-process "*mu-server*" "*mu-server*"
|
||||
(setq mm/mu-proc (apply 'start-process mm/server-name mm/server-name
|
||||
mm/mu-binary args))
|
||||
;; register a function for (:info ...) sexps
|
||||
(setq mm/proc-info-func 'mm/proc-info-handler)
|
||||
|
|
@ -126,9 +135,10 @@ process."
|
|||
|
||||
(defun mm/kill-proc ()
|
||||
"Kill the mu server process."
|
||||
(when (mm/proc-is-running)
|
||||
(let ((delete-exited-processes t))
|
||||
(kill-process mm/mu-proc)
|
||||
(let (buf (get-buffer mm/server-name))
|
||||
(when buf
|
||||
(let ((delete-exited-processes t))
|
||||
(kill-buffer buf))
|
||||
(setq
|
||||
mm/mu-proc nil
|
||||
mm/buf nil))))
|
||||
|
|
@ -142,16 +152,17 @@ process."
|
|||
\376<len-of-sexp>\376<sexp>
|
||||
Function returns this sexp, or nil if there was none. `mm/buf' is
|
||||
updated as well, with all processed sexp data removed."
|
||||
(let* ((b (string-match "\376\\([0-9]+\\)\376" mm/buf))
|
||||
(sexp-len
|
||||
(when b (string-to-number (match-string 1 mm/buf)))))
|
||||
;; does mm/buf contain the full sexp?
|
||||
(when (and b (>= (length mm/buf) (+ sexp-len (match-end 0))))
|
||||
;; clear-up start
|
||||
(setq mm/buf (substring mm/buf (match-end 0)))
|
||||
(let ((objcons (read-from-string mm/buf)))
|
||||
(setq mm/buf (substring mm/buf sexp-len))
|
||||
(car objcons)))))
|
||||
(when mm/buf
|
||||
(let* ((b (string-match "\376\\([0-9]+\\)\376" mm/buf))
|
||||
(sexp-len
|
||||
(when b (string-to-number (match-string 1 mm/buf)))))
|
||||
;; does mm/buf contain the full sexp?
|
||||
(when (and b (>= (length mm/buf) (+ sexp-len (match-end 0))))
|
||||
;; clear-up start
|
||||
(setq mm/buf (substring mm/buf (match-end 0)))
|
||||
(let ((objcons (read-from-string mm/buf)))
|
||||
(setq mm/buf (substring mm/buf sexp-len))
|
||||
(car objcons))))))
|
||||
|
||||
|
||||
(defun mm/proc-filter (proc str)
|
||||
|
|
@ -252,7 +263,8 @@ terminates."
|
|||
(cond
|
||||
((eq status 'signal)
|
||||
(cond
|
||||
((eq code 9) (message "the mu server process has been stopped"))
|
||||
((eq code 9) (message nil))
|
||||
;;(message "the mu server process has been stopped"))
|
||||
(t (message (format "mu server process received signal %d" code)))))
|
||||
((eq status 'exit)
|
||||
(cond
|
||||
|
|
@ -361,18 +373,14 @@ set to e.g. '/drafts'; if this works, we will receive (:info :path
|
|||
be delivered to the function registered as `mm/proc-message-func'."
|
||||
(mm/proc-send-command "view %d" docid))
|
||||
|
||||
(defun mm/proc-compose-msg (docid reply-or-forward)
|
||||
"Start composing a message as either a forward or reply to
|
||||
message with DOCID. REPLY-OR-FORWARD is either 'reply or 'forward.
|
||||
|
||||
(defun mm/proc-compose-msg (docid compose-type)
|
||||
"Start composing a message with DOCID and COMPOSE-TYPE (a symbol,
|
||||
either `forward', `reply' or `draft'.
|
||||
The result will be delivered to the function registered as
|
||||
`mm/proc-compose-func'."
|
||||
(let ((action (cond
|
||||
((eq reply-or-forward 'forward) "forward")
|
||||
((eq reply-or-forward 'reply) "reply")
|
||||
(t (error "symbol must be eiter 'reply or 'forward")))))
|
||||
(mm/proc-send-command "compose %s %d" action docid)))
|
||||
|
||||
(unless (member compose-type '(forward reply draft))
|
||||
(error "Unsupported compose-type"))
|
||||
(mm/proc-send-command "compose %s %d" (symbol-name compose-type) docid))
|
||||
|
||||
|
||||
(defun mm/proc-retrieve-mail-update-db ()
|
||||
|
|
|
|||
|
|
@ -42,9 +42,6 @@
|
|||
(defconst mm/msg-draft-name "*mm-draft*"
|
||||
"Name for draft messages.")
|
||||
|
||||
(defconst mm/msg-separator "--text follows this line--\n\n"
|
||||
"separator between headers and body, needed for `message-mode'")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; FIXME
|
||||
|
|
@ -68,8 +65,6 @@ or if not available, :body-html converted to text)."
|
|||
(buffer-string))
|
||||
"No body found"))
|
||||
|
||||
|
||||
|
||||
(defun mm/msg-cite-original (msg)
|
||||
"Cite the body text of MSG, with a \"On %s, %s wrote:\"
|
||||
line (with the %s's replaced with the date of MSG and the name
|
||||
|
|
@ -188,6 +183,9 @@ nil, function returns nil."
|
|||
(format "%s <%s>" user-full-name user-mail-address)
|
||||
(format "%s" user-mail-address))))
|
||||
|
||||
(defconst mm/reply-docid-header "Reply-docid"
|
||||
"*internal* The reply-to-docid header.")
|
||||
|
||||
(defun mm/msg-create-reply (msg reply-all)
|
||||
"Create a draft message as a reply to MSG; if REPLY-ALL is
|
||||
non-nil, reply to all recipients.
|
||||
|
|
@ -204,7 +202,7 @@ A reply message has fields:
|
|||
In-Reply-To: - message-id of MSG
|
||||
User-Agent - see `mm/msg-user-agent'
|
||||
|
||||
Then follows `mm/msg-separator' (for `message-mode' to separate
|
||||
Then follows `mail-header-separator' (for `message-mode' to separate
|
||||
body from headers)
|
||||
|
||||
And finally, the cited body of MSG, as per `mm/msg-cite-original'."
|
||||
|
|
@ -217,16 +215,21 @@ And finally, the cited body of MSG, as per `mm/msg-cite-original'."
|
|||
(mm/msg-header "Cc" (mm/msg-cc-create msg reply-all))
|
||||
|
||||
(mm/msg-hidden-header "User-agent" (mm/msg-user-agent))
|
||||
(mm/msg-hidden-header mm/reply-docid-header (plist-get msg :docid))
|
||||
(mm/msg-hidden-header "References" (mm/msg-references-create msg))
|
||||
|
||||
(mm/msg-hidden-header "In-reply-to" (plist-get msg :message-id))
|
||||
|
||||
(mm/msg-header"Subject"
|
||||
(mm/msg-header "Subject"
|
||||
(concat mm/msg-reply-prefix (plist-get msg :subject)))
|
||||
|
||||
mm/msg-separator
|
||||
(propertize mail-header-separator 'read-only t 'intangible t) '"\n"
|
||||
(mm/msg-cite-original msg)))
|
||||
|
||||
|
||||
(defconst mm/forward-docid-header "Forward-docid"
|
||||
"*internal* The reply-to-docid header.")
|
||||
|
||||
;; TODO: attachments
|
||||
(defun mm/msg-create-forward (msg)
|
||||
"Create a draft forward message for MSG.
|
||||
|
|
@ -241,7 +244,7 @@ then, the following fields, normally hidden from user:
|
|||
References: - see `mm/msg-references-create'
|
||||
User-Agent - see `mm/msg-user-agent'
|
||||
|
||||
Then follows `mm/msg-separator' (for `message-mode' to separate
|
||||
Then follows `mail-header-separator' (for `message-mode' to separate
|
||||
body from headers)
|
||||
|
||||
And finally, the cited body of MSG, as per `mm/msg-cite-original'."
|
||||
|
|
@ -253,10 +256,12 @@ And finally, the cited body of MSG, as per `mm/msg-cite-original'."
|
|||
(mm/msg-header "To" "")
|
||||
(mm/msg-hidden-header "User-agent" (mm/msg-user-agent))
|
||||
(mm/msg-hidden-header "References" (mm/msg-references-create msg))
|
||||
(mm/msg-header"Subject"
|
||||
(mm/msg-hidden-header mm/forward-docid-header (plist-get msg :docid))
|
||||
|
||||
(mm/msg-header"Subject"
|
||||
(concat mm/msg-forward-prefix (plist-get msg :subject)))
|
||||
|
||||
mm/msg-separator
|
||||
(propertize mail-header-separator 'read-only t 'intangible t) "\n"
|
||||
|
||||
(mm/msg-cite-original msg)))
|
||||
|
||||
|
|
@ -272,7 +277,7 @@ then, the following fields, normally hidden from user:
|
|||
Reply-To: - if `mail-reply-to' has been set
|
||||
User-Agent - see `mm/msg-user-agent'
|
||||
|
||||
Then follows `mm/msg-separator' (for `message-mode' to separate
|
||||
Then follows `mail-header-separator' (for `message-mode' to separate
|
||||
body from headers)."
|
||||
(concat
|
||||
(mm/msg-header "From" (or (mm/msg-from-create) ""))
|
||||
|
|
@ -282,7 +287,7 @@ body from headers)."
|
|||
(mm/msg-header "To" "")
|
||||
(mm/msg-hidden-header "User-agent" (mm/msg-user-agent))
|
||||
(mm/msg-header "Subject" "")
|
||||
mm/msg-separator))
|
||||
(propertize mail-header-separator 'read-only t 'intangible t) "\n"))
|
||||
|
||||
(defconst mm/msg-prefix "mm" "prefix for mm-generated
|
||||
mail files; we use this to ensure that our hooks don't mess
|
||||
|
|
@ -298,12 +303,6 @@ message.
|
|||
(random t)))
|
||||
;;; (replace-regexp-in-string "[:/]" "_" (system-name))))
|
||||
|
||||
|
||||
(defvar mm/send-reply-docid nil "Docid of the message this is a reply to.")
|
||||
(defvar mm/send-forward-docid nil "Docid of the message being forwarded.")
|
||||
|
||||
(defvar mm/mm-msg nil "Whether the current message is an mm msg.")
|
||||
|
||||
(defun mm/msg-compose (str &optional parent-docid reply-or-forward)
|
||||
"Create a new draft message in the drafts folder with STR as
|
||||
its contents, and open this message file for editing.
|
||||
|
|
@ -337,58 +336,62 @@ using Gnus' `message-mode'."
|
|||
;; the new docid from `mm/path-docid-map'.
|
||||
(write-file draftfile)
|
||||
(mm/proc-add draftfile mm/drafts-folder)
|
||||
|
||||
(message-mode)
|
||||
|
||||
(make-local-variable 'mm/send-reply-docid)
|
||||
(make-local-variable 'mm/send-forward-docid)
|
||||
(make-local-variable 'mm/mm-msg)
|
||||
(make-local-variable 'write-file-functions)
|
||||
|
||||
;; update the db when the file is saved...]
|
||||
(add-to-list 'write-file-functions
|
||||
(lambda() (mm/proc-add (buffer-file-name) mm/drafts-folder)))
|
||||
|
||||
;; hook our functions up with sending of the message
|
||||
(add-hook 'message-sent-hook 'mm/msg-save-to-sent nil t)
|
||||
(add-hook 'message-sent-hook 'mm/send-set-parent-flag nil t)
|
||||
|
||||
(setq mm/mm-msg t)
|
||||
|
||||
(if (eq reply-or-forward 'reply)
|
||||
(setq mm/send-reply-docid parent-docid)
|
||||
(setq mm/send-forward-docid parent-docid))
|
||||
(let ((message-hidden-headers
|
||||
`("^References:" "^Face:" "^X-Face:" "^X-Draft-From:"
|
||||
,(concat mm/reply-docid-header ":")
|
||||
,(concat mm/forward-docid-header ":")
|
||||
"^User-agent:")))
|
||||
(message-hide-headers))
|
||||
|
||||
(message-goto-body)))
|
||||
|
||||
|
||||
(defun mm/send-compose-handler (msg reply-or-forward)
|
||||
(defun mm/send-compose-handler (msg compose-type)
|
||||
"This function is registered as the compose handler in
|
||||
`mm/proc-compose-func', and will be called when a new message is to
|
||||
be composed, based on some existing one. MSG is a message sexp,
|
||||
while REPLY-OR-FORWARD is a symbol, either 'reply or 'forward.
|
||||
while COMPOSE-TYPE is a symbol, either 'reply or 'forward.
|
||||
|
||||
In case of 'forward, create a draft forward for MSG, and switch to
|
||||
an edit buffer with the draft message.
|
||||
|
||||
In case of 'reply, create a draft reply to MSG, and swith to an
|
||||
edit buffer with the draft message"
|
||||
|
||||
(unless (member reply-or-forward '(reply forward))
|
||||
(error "unexpected type in compose handler"))
|
||||
(let ((parent-docid (plist-get msg :docid)))
|
||||
|
||||
(if (eq reply-or-forward 'forward)
|
||||
|
||||
;; forward
|
||||
(when (mm/msg-compose (mm/msg-create-forward msg) parent-docid 'forward)
|
||||
(message-goto-to))
|
||||
|
||||
;; reply
|
||||
(cond
|
||||
((eq compose-type 'forward) ;; forward
|
||||
(when (mm/msg-compose (mm/msg-create-forward msg)
|
||||
(plist-get msg :docid) 'forward)
|
||||
(message-goto-to)))
|
||||
((eq compose-type 'reply) ;; reply
|
||||
(let* ((recipnum (+ (length (plist-get msg :to))
|
||||
(length (plist-get msg :cc))))
|
||||
(length (plist-get msg :cc))))
|
||||
(replyall (when (> recipnum 1)
|
||||
(yes-or-no-p
|
||||
(format "Reply to all ~%d recipients (y) or only the sender (n)? "
|
||||
(format "Reply to all ~%d recipients? "
|
||||
(+ recipnum))))))
|
||||
;; exact num depends on some more things
|
||||
(when (mm/msg-compose (mm/msg-create-reply msg replyall) parent-docid 'reply)
|
||||
(message-goto-body))))))
|
||||
(when (mm/msg-compose (mm/msg-create-reply msg replyall)
|
||||
(plist-get msg :docid) 'reply)
|
||||
(message-goto-body))))
|
||||
((eq compose-type 'draft)
|
||||
(unless (member 'draft (plist-get msg :flags))
|
||||
(error "Cannot edit a non-draft message"))
|
||||
(mm/edit-draft (plist-get msg :docid) (plist-get msg :path)))
|
||||
|
||||
(t (error "unexpected type %S in compose handler" compose-type))))
|
||||
|
||||
|
||||
|
||||
(defun mm/msg-save-to-sent ()
|
||||
|
|
@ -413,15 +416,46 @@ edit buffer with the draft message"
|
|||
"Set the 'replied' flag on messages we replied to, and the
|
||||
'passed' flag on message we have forwarded.
|
||||
|
||||
NOTE: This does not handle the case yet of message which are
|
||||
edited from drafts. That case could be solved by searching for
|
||||
the In-Reply-To message-id for replies.
|
||||
We do this by checking for our special header, either
|
||||
`mm/reply-docid-header' or `mm/forward-docid-header'. Doing it this
|
||||
way ensure that we know the parent-docid even when re-editing
|
||||
drafts (alternatively, we could try to the 'parent' message
|
||||
using "In-reply-to"/"References", but since that is not necessarily
|
||||
accurate, doing it the way we do, is better.
|
||||
|
||||
TODO: remove this header again, before really sending.
|
||||
|
||||
This is meant to be called from message mode's
|
||||
`message-sent-hook'."
|
||||
;; handle the replied-to message
|
||||
(when mm/send-reply-docid (mm/proc-flag-msg mm/send-reply-docid "+R"))
|
||||
(when mm/send-forward-docid (mm/proc-flag-msg mm/send-forward-docid "+P")))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let ((eoh (when (search-forward mail-header-separator nil t)
|
||||
(point))) (reply-docid) (forward-docid))
|
||||
(when eoh ;; end-of-headers
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward
|
||||
(concat "^" mm/reply-docid-header ":[:blank:]*\\([0-9]+\\)") eoh t)
|
||||
(setq reply-docid (string-to-int (match-string 1)))
|
||||
(when (re-search-forward
|
||||
(concat "^" mm/forward-docid-header ":[:blank:]*\\([0-9]+\\)") eoh t)
|
||||
(setq forward-docid (string-to-int (match-string 1))))))
|
||||
|
||||
(when reply-docid (mm/proc-flag-msg reply-docid "+R"))
|
||||
(when forward-docid (mm/proc-flag-msg forward-docid "+P")))))
|
||||
|
||||
(defun mm/edit-draft (docid path)
|
||||
"Edit a draft message."
|
||||
|
||||
(unless (file-readable-p path) (error "Cannot read %s" path))
|
||||
(find-file path)
|
||||
(message-mode)
|
||||
|
||||
;; hook our functions up with sending of the message
|
||||
(add-hook 'message-sent-hook 'mm/msg-save-to-sent nil t)
|
||||
(add-hook 'message-sent-hook 'mm/send-set-parent-flag nil t)
|
||||
|
||||
(message-goto-body))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
|||
|
|
@ -54,7 +54,8 @@ UPDATE is non-nil, the current message will be (visually) updated.
|
|||
|
||||
As a side-effect, a message that is being viewed loses its 'unread'
|
||||
marking if it still had that."
|
||||
(let ((buf (get-buffer-create mm/view-buffer-name)) (inhibit-read-only t))
|
||||
(let ((buf (get-buffer-create mm/view-buffer-name))
|
||||
(inhibit-read-only t))
|
||||
(with-current-buffer buf
|
||||
(erase-buffer)
|
||||
(insert
|
||||
|
|
@ -88,11 +89,13 @@ marking if it still had that."
|
|||
;; initialize view-mode
|
||||
(mm/view-mode)
|
||||
(setq ;; these are buffer-local
|
||||
mode-name (format "%s %d" mm/view-buffer-name (plist-get msg :docid))
|
||||
mode-name (if (plist-get msg :subject)
|
||||
(truncate-string-to-width (plist-get msg :subject) 16 0 nil t)
|
||||
"No subject")
|
||||
mm/current-msg msg
|
||||
mm/hdrs-buffer hdrsbuf
|
||||
mm/link-map (make-hash-table :size 32 :rehash-size 2 :weakness nil))
|
||||
|
||||
|
||||
(switch-to-buffer buf)
|
||||
(goto-char (point-min))
|
||||
(mm/view-beautify)
|
||||
|
|
@ -174,6 +177,15 @@ or if not available, :body-html converted to text)."
|
|||
(define-key map "f" 'mm/compose-forward)
|
||||
(define-key map "r" 'mm/compose-reply)
|
||||
(define-key map "c" 'mm/compose-new)
|
||||
(define-key map "e" 'mm/edit-draft)
|
||||
|
||||
;; intra-message navigation
|
||||
(define-key map (kbd "SPC") 'scroll-up)
|
||||
(define-key map (kbd "<home>")
|
||||
'(lambda () (interactive) (goto-char (point-min))))
|
||||
(define-key map (kbd "<end>")
|
||||
'(lambda () (interactive) (goto-char (point-max))))
|
||||
|
||||
|
||||
;; navigation between messages
|
||||
(define-key map "n" 'mm/view-next-header)
|
||||
|
|
@ -185,13 +197,20 @@ or if not available, :body-html converted to text)."
|
|||
|
||||
;; marking/unmarking
|
||||
(define-key map "d" 'mm/view-mark-for-trash)
|
||||
(define-key map (kbd "<backspace>") 'mm/mark-for-trash)
|
||||
|
||||
(define-key map "D" 'mm/view-mark-for-delete)
|
||||
(define-key map (kbd "<delete>") 'mm/view-mark-for-delete)
|
||||
|
||||
(define-key map "m" 'mm/view-mark-for-move)
|
||||
|
||||
;; misc
|
||||
(define-key map "w" 'mm/view-toggle-wrap-lines)
|
||||
(define-key map "h" 'mm/view-toggle-hide-quoted)
|
||||
(define-key map "g" 'mm/view-refresh)
|
||||
|
||||
;; next 3 only warn user
|
||||
|
||||
;; next 3 only warn user when attempt in the message view
|
||||
(define-key map "u" 'mm/view-unmark)
|
||||
(define-key map "U" 'mm/view-unmark)
|
||||
(define-key map "x" 'mm/view-marked-execute)
|
||||
|
|
@ -200,6 +219,15 @@ or if not available, :body-html converted to text)."
|
|||
(fset 'mm/view-mode-map mm/view-mode-map)
|
||||
|
||||
|
||||
(defvar mm/wrap-lines nil
|
||||
"*internal* Whether to wrap lines or not (variable controlled by
|
||||
`mm/view-toggle-wrap-lines').")
|
||||
|
||||
(defvar mm/hide-cited nil
|
||||
"*internal* Whether to hide cited lines or not (the variable can
|
||||
be changed with `mm/view-toggle-hide-cited').")
|
||||
|
||||
|
||||
(defun mm/view-mode ()
|
||||
"Major mode for viewing an e-mail message."
|
||||
(interactive)
|
||||
|
|
@ -209,12 +237,13 @@ or if not available, :body-html converted to text)."
|
|||
(make-local-variable 'mm/hdrs-buffer)
|
||||
(make-local-variable 'mm/current-msg)
|
||||
(make-local-variable 'mm/link-map)
|
||||
|
||||
(make-local-variable 'mm/wrap-lines)
|
||||
(make-local-variable 'mm/hide-cited)
|
||||
|
||||
(setq major-mode 'mm/view-mode mode-name mm/view-buffer-name)
|
||||
(setq truncate-lines t buffer-read-only t))
|
||||
|
||||
|
||||
;;;;;;
|
||||
|
||||
|
||||
|
|
@ -229,7 +258,6 @@ Seen; if the message is not New/Unread, do nothing."
|
|||
(docid (plist-get mm/current-msg :docid)))
|
||||
;; is it a new message?
|
||||
(when (or (member 'unread flags) (member 'new flags))
|
||||
;; if so, mark it as non-new and read
|
||||
(mm/proc-flag-msg docid "+S-u-N")))))
|
||||
|
||||
|
||||
|
|
@ -263,11 +291,7 @@ removing '^M' etc."
|
|||
(replace-match (concat subst
|
||||
(propertize (format "[%d]" num)
|
||||
'face 'mm/view-url-number-face))))))))
|
||||
|
||||
|
||||
(defvar mm/wrap-lines nil
|
||||
"*internal* Whether to wrap lines or not (variable controlled by
|
||||
`mm/view-toggle-wrap-lines').")
|
||||
|
||||
|
||||
;; Interactive functions
|
||||
|
|
@ -275,17 +299,36 @@ removing '^M' etc."
|
|||
(defun mm/view-toggle-wrap-lines ()
|
||||
"Toggle line wrap in the message body."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(if mm/wrap-lines
|
||||
(progn
|
||||
(setq mm/wrap-lines nil)
|
||||
(mm/view mm/current-msg mm/hdrs-buffer t)) ;; back to normal
|
||||
(if mm/wrap-lines
|
||||
(progn
|
||||
(setq mm/wrap-lines nil)
|
||||
(mm/view-refresh)) ;; back to normal
|
||||
(save-excursion
|
||||
(let ((inhibit-read-only t))
|
||||
(setq mm/wrap-lines t)
|
||||
(goto-char (point-min))
|
||||
(when (search-forward "\n\n") ;; search for the message body
|
||||
(fill-region (point) (point-max)))))))
|
||||
|
||||
(defun mm/view-toggle-hide-cited ()
|
||||
"Toggle hiding of cited lines in the message body."
|
||||
(interactive)
|
||||
(if mm/hide-cited
|
||||
(progn
|
||||
(setq mm/hide-cited nil)
|
||||
(mm/view-refresh))
|
||||
(save-excursion
|
||||
(let ((inhibit-read-only t))
|
||||
(goto-char (point-min))
|
||||
(flush-lines "^[:blank:]*>")
|
||||
(setq mm/hide-cited t)))))
|
||||
|
||||
|
||||
(defun mm/view-refresh ()
|
||||
"Redisplay the current message."
|
||||
(interactive)
|
||||
(mm/view mm/current-msg mm/hdrs-buffer t))
|
||||
|
||||
|
||||
(defun mm/view-quit-buffer ()
|
||||
"Quit the message view and return to the headers."
|
||||
|
|
|
|||
|
|
@ -34,6 +34,11 @@
|
|||
(require 'mm-common)
|
||||
(require 'mm-proc)
|
||||
|
||||
|
||||
;; TODO: get this version through to Makefile magic
|
||||
(defconst mm/version "0.9.8pre"
|
||||
"*internal* my version")
|
||||
|
||||
;; Customization
|
||||
|
||||
(defgroup mm nil
|
||||
|
|
@ -73,6 +78,8 @@ PATH, you can specifiy the full path."
|
|||
:group 'mm
|
||||
:safe 'stringp)
|
||||
|
||||
|
||||
|
||||
(defvar mm/debug nil
|
||||
"When set to non-nil, log debug information to the *mm-log* buffer.")
|
||||
|
||||
|
|
@ -112,12 +119,12 @@ PATH, you can specifiy the full path."
|
|||
:group 'mm/folders)
|
||||
|
||||
|
||||
|
||||
;; the headers view
|
||||
(defgroup mm/headers nil
|
||||
"Settings for the headers view."
|
||||
:group 'mm)
|
||||
|
||||
|
||||
(defcustom mm/header-fields
|
||||
'( (:date . 25)
|
||||
(:flags . 6)
|
||||
|
|
@ -128,6 +135,10 @@ PATH, you can specifiy the full path."
|
|||
'unrestricted', and this is best reserved fo the rightmost (last)
|
||||
field.")
|
||||
|
||||
(defcustom mm/hdrs-on-top t
|
||||
"If non-nil, display headers above the message view; otherwise, display the headers on the left of the message view"
|
||||
)
|
||||
|
||||
;; the message view
|
||||
(defgroup mm/view nil
|
||||
"Settings for the message view."
|
||||
|
|
@ -250,6 +261,7 @@ be sure it no longer matches)."
|
|||
(define-key map "T" 'mm/search-today)
|
||||
(define-key map "W" 'mm/search-last-7-days)
|
||||
(define-key map "U" 'mm/search-unread)
|
||||
(define-key map "D" 'mm/search-drafts)
|
||||
|
||||
(define-key map "s" 'mm/search)
|
||||
(define-key map "q" 'mm/quit-mm)
|
||||
|
|
@ -278,21 +290,24 @@ be sure it no longer matches)."
|
|||
buffer-read-only t
|
||||
overwrite-mode 'overwrite-mode-binary))
|
||||
|
||||
|
||||
(defun mm()
|
||||
"Start mm."
|
||||
"Start mm; should not be called directly, instead, use `mm'"
|
||||
(interactive)
|
||||
(let ((buf (get-buffer-create mm/mm-buffer-name))
|
||||
(inhibit-read-only t))
|
||||
(with-current-buffer buf
|
||||
(with-current-buffer buf
|
||||
(erase-buffer)
|
||||
(insert
|
||||
"* "
|
||||
(propertize "mm - mail for emacs\n" 'face 'mm/title-face)
|
||||
"\n"
|
||||
(propertize "mm - mail for emacs version " 'face 'mm/title-face)
|
||||
(propertize mm/version 'face 'mm/view-header-value-face)
|
||||
"\n\n"
|
||||
" Watcha wanna do?\n\n"
|
||||
" * Show me some messages:\n"
|
||||
" - In your " (propertize "I" 'face 'highlight) "nbox\n"
|
||||
" - " (propertize "U" 'face 'highlight) "nread messages\n"
|
||||
" - " (propertize "D" 'face 'highlight) "raft messages\n"
|
||||
" - Received " (propertize "T" 'face 'highlight) "oday\n"
|
||||
" - Received this " (propertize "W" 'face 'highlight) "eek\n"
|
||||
"\n"
|
||||
|
|
@ -309,6 +324,18 @@ be sure it no longer matches)."
|
|||
(switch-to-buffer buf))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; window management
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; interactive functions
|
||||
|
||||
|
|
@ -317,6 +344,11 @@ be sure it no longer matches)."
|
|||
(interactive)
|
||||
(mm/hdrs-search (concat "maildir:" mm/inbox-folder)))
|
||||
|
||||
(defun mm/search-drafts ()
|
||||
"Jump to your Drafts folder (as specified in `mm/draft-folder')."
|
||||
(interactive)
|
||||
(mm/hdrs-search (concat "maildir:" mm/drafts-folder " OR ;; flag:draft")))
|
||||
|
||||
(defun mm/search-unread ()
|
||||
"List all your unread messages."
|
||||
(interactive)
|
||||
|
|
@ -340,7 +372,6 @@ be sure it no longer matches)."
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
||||
(defun mm/quit-mm()
|
||||
"Quit the mm session."
|
||||
(interactive)
|
||||
|
|
|
|||
Loading…
Reference in New Issue