diff --git a/toys/mm/mm-common.el b/toys/mm/mm-common.el index 209a04f5..0f845fbe 100644 --- a/toys/mm/mm-common.el +++ b/toys/mm/mm-common.el @@ -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 diff --git a/toys/mm/mm-hdrs.el b/toys/mm/mm-hdrs.el index cdb07f10..7efcae8f 100644 --- a/toys/mm/mm-hdrs.el +++ b/toys/mm/mm-hdrs.el @@ -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 "") 'mm/mark-for-trash) + (define-key map "D" 'mm/mark-for-delete) + (define-key map (kbd "") '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))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/toys/mm/mm-proc.el b/toys/mm/mm-proc.el index 26081c29..a1bdc959 100644 --- a/toys/mm/mm-proc.el +++ b/toys/mm/mm-proc.el @@ -72,6 +72,7 @@ for the format of .") "*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\376 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 () diff --git a/toys/mm/mm-send.el b/toys/mm/mm-send.el index 5068ef93..1b579133 100644 --- a/toys/mm/mm-send.el +++ b/toys/mm/mm-send.el @@ -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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/toys/mm/mm-view.el b/toys/mm/mm-view.el index 41987e9d..418c6eb5 100644 --- a/toys/mm/mm-view.el +++ b/toys/mm/mm-view.el @@ -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 "") + '(lambda () (interactive) (goto-char (point-min)))) + (define-key map (kbd "") + '(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 "") 'mm/mark-for-trash) + (define-key map "D" 'mm/view-mark-for-delete) + (define-key map (kbd "") '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." diff --git a/toys/mm/mm.el b/toys/mm/mm.el index 0cd82cb1..dc211826 100644 --- a/toys/mm/mm.el +++ b/toys/mm/mm.el @@ -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)