From ac6c5b45982d97d7a945584ca38b92ed7cc83d87 Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Mon, 10 Oct 2011 08:38:14 +0300 Subject: [PATCH] * mm updates --- toys/mm/mm-hdrs.el | 2 +- toys/mm/mm-proc.el | 13 ++++++++----- toys/mm/mm-send.el | 14 ++++++++------ toys/mm/mm-view.el | 25 ++++++++++++++++++++++--- toys/mm/mm.el | 18 ++++++++++++++++-- 5 files changed, 55 insertions(+), 17 deletions(-) diff --git a/toys/mm/mm-hdrs.el b/toys/mm/mm-hdrs.el index c0099429..6e260886 100644 --- a/toys/mm/mm-hdrs.el +++ b/toys/mm/mm-hdrs.el @@ -432,7 +432,7 @@ start editing it. COMPOSE-TYPE is either `reply', `forward' or (if (eq compose-type 'new) (mm/send-compose-handler 'new) (let ((docid (mm/hdrs-get-docid))) - (when (and (not docid) (not )) + (unless docid (error "No message at point.")) (cond ((member compose-type '(reply forward)) diff --git a/toys/mm/mm-proc.el b/toys/mm/mm-proc.el index 011cdcf9..c304cad1 100644 --- a/toys/mm/mm-proc.el +++ b/toys/mm/mm-proc.el @@ -119,9 +119,6 @@ process." (unless (file-executable-p 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) - (process-adaptive-read-buffering t) (args '("server")) (args (append args (when mm/mu-home (list (concat "--muhome=" mm/mu-home)))))) @@ -131,6 +128,7 @@ process." ;; register a function for (:info ...) sexps (setq mm/proc-info-func 'mm/proc-info-handler) (when mm/mu-proc + (set-process-coding-system mm/mu-proc 'utf-8-unix 'utf-8-unix) (set-process-filter mm/mu-proc 'mm/proc-filter) (set-process-sentinel mm/mu-proc 'mm/proc-sentinel)))) @@ -139,7 +137,10 @@ process." (let (buf (get-buffer mm/server-name)) (when buf (let ((delete-exited-processes t)) - (kill-buffer buf)) + ;; send SIGINT (C-c) to process, so it can exit gracefully + (signal-process (get-buffer-process buf) 'SIGINT) + ;; the mu server signal handler will make it quit after 'quit' + (mm/proc-send-command "quit")) (setq mm/mu-proc nil mm/buf nil)))) @@ -218,6 +219,7 @@ updated as well, with all processed sexp data removed." (:compose :action ) => the and either 'reply or 'forward will be passed `mm/proc-compose-func'." + (mm/proc-log "* Received %d byte(s)" (length str)) (setq mm/buf (concat mm/buf str)) ;; update our buffer (let ((sexp (mm/proc-eat-sexp-from-buf))) (while sexp @@ -295,7 +297,8 @@ terminates." (mm/start-proc)) (let ((cmd (apply 'format frm args))) (mm/proc-log (concat "-> " cmd)) - (process-send-string mm/mu-proc (concat cmd "\n")))) + (process-send-string mm/mu-proc (concat cmd "\n")) + (accept-process-output mm/mu-proc 0.5))) (defun mm/proc-remove-msg (docid) diff --git a/toys/mm/mm-send.el b/toys/mm/mm-send.el index ab65972d..945fa4ca 100644 --- a/toys/mm/mm-send.el +++ b/toys/mm/mm-send.el @@ -25,7 +25,7 @@ ;;; Commentary: ;; In this file, various functions to compose/send messages, piggybacking on -;; gnus +;; gnus' message mode ;; mm @@ -223,6 +223,8 @@ And finally, the cited body of MSG, as per `mm/msg-cite-original'." (concat mm/msg-reply-prefix (plist-get msg :subject))) (propertize mail-header-separator 'read-only t 'intangible t) '"\n" + + "\n\n" (mm/msg-cite-original msg)))) ;; TODO: attachments @@ -255,6 +257,7 @@ And finally, the cited body of MSG, as per `mm/msg-cite-original'." (concat mm/msg-forward-prefix (plist-get msg :subject))) (propertize mail-header-separator 'read-only t 'intangible t) "\n" + "\n\n" (mm/msg-cite-original msg))) (defun mm/msg-create-new () @@ -339,7 +342,7 @@ using Gnus' `message-mode'." (unless (file-readable-p draft) (error "Cannot read %s" path)) - + (find-file draft) (message-mode) @@ -358,7 +361,9 @@ using Gnus' `message-mode'." "^User-agent:"))) (message-hide-headers)) - (message-goto-body))) + (if (eq compose-type 'new) + (message-goto-to) + (message-goto-body)))) (defun mm/msg-save-to-sent () @@ -415,7 +420,4 @@ This is meant to be called from message mode's (when (and forwarded-from (string-match "<\\(.*\\)>" forwarded-from)) (mm/proc-flag (match-string 1 forwarded-from) "+P")))) - - - (provide 'mm-send) diff --git a/toys/mm/mm-view.el b/toys/mm/mm-view.el index 55780241..a2fb665f 100644 --- a/toys/mm/mm-view.el +++ b/toys/mm/mm-view.el @@ -272,18 +272,15 @@ Seen; if the message is not New/Unread, do nothing." removing '^M' etc." (let ((num 0)) (save-excursion - ;; remove the stupid CRs (goto-char (point-min)) (while (re-search-forward "[  ]" nil t) (replace-match "" nil t)) - ;; give the footer a different color... (goto-char (point-min)) (let ((p (search-forward "\n-- \n" nil t))) (when p (add-text-properties p (point-max) '(face mm/view-footer-face)))) - ;; this is fairly simplistic... (goto-char (point-min)) (while (re-search-forward "\\(https?://.*\\)\\>" nil t) @@ -296,6 +293,28 @@ removing '^M' etc." 'face 'mm/view-url-number-face)))))))) + + +;;;; raw view +;; (defun mm/view-raw-mode () +;; "Major mode for viewing of raw e-mail message." +;; (interactive) +;; (kill-all-local-variables) +;; (use-local-map mm/view-raw-mode-map) + +;; (setq major-mode 'mm/view-raw-mode +;; mode-name mm/view-raw-buffer-name) +;; (setq truncate-lines t buffer-read-only t)) + + + + + + + + + + ;; Interactive functions diff --git a/toys/mm/mm.el b/toys/mm/mm.el index 89b171e9..5d8b71da 100644 --- a/toys/mm/mm.el +++ b/toys/mm/mm.el @@ -273,7 +273,7 @@ be sure it no longer matches)." (define-key map "j" 'mm/jump-to-maildir) (define-key map "c" 'mm/compose-new) - (define-key map "r" 'mm/retrieve-mail) + (define-key map "m" 'mm/toggle-mail-sending-mode) (define-key map "u" 'mm/retrieve-mail-update-db) map) @@ -307,6 +307,10 @@ be sure it no longer matches)." "* " (propertize "mm - mail for emacs version " 'face 'mm/title-face) (propertize mm/version 'face 'mm/view-header-value-face) + " (send: " + (propertize (if smtpmail-queue-mail "queued" "direct") + 'face 'mm/view-header-key-face) + ")" "\n\n" " Watcha wanna do?\n\n" " * Show me some messages:\n" @@ -321,7 +325,10 @@ be sure it no longer matches)." "\n" " * " (propertize "c" 'face 'highlight) "ompose a new message\n" "\n" + "\n" + " * " (propertize "u" 'face 'highlight) "pdate email\n" + " * toggle " (propertize "m" 'face 'highlight) "ail sending mode " "\n" " * " (propertize "q" 'face 'highlight) "uit mm\n") @@ -374,6 +381,14 @@ be sure it no longer matches)." (interactive) (mm/proc-retrieve-mail-update-db)) +(defun mm/toggle-mail-sending-mode () + "Toggle sending mail mode, either queued or direct." + (interactive) + (setq smtpmail-queue-mail (not smtpmail-queue-mail)) + (mm)) + + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -385,5 +400,4 @@ be sure it no longer matches)." (mm/kill-proc) (kill-buffer))) - (provide 'mm)