* mm updates

This commit is contained in:
Dirk-Jan C. Binnema
2011-10-10 08:38:14 +03:00
parent 0eac659575
commit ac6c5b4598
5 changed files with 55 additions and 17 deletions

View File

@ -432,7 +432,7 @@ start editing it. COMPOSE-TYPE is either `reply', `forward' or
(if (eq compose-type 'new) (if (eq compose-type 'new)
(mm/send-compose-handler 'new) (mm/send-compose-handler 'new)
(let ((docid (mm/hdrs-get-docid))) (let ((docid (mm/hdrs-get-docid)))
(when (and (not docid) (not )) (unless docid
(error "No message at point.")) (error "No message at point."))
(cond (cond
((member compose-type '(reply forward)) ((member compose-type '(reply forward))

View File

@ -119,9 +119,6 @@ process."
(unless (file-executable-p mm/mu-binary) (unless (file-executable-p mm/mu-binary)
(error (format "%S not found" mm/mu-binary))) (error (format "%S not found" mm/mu-binary)))
(let* ((process-connection-type nil) ;; use a pipe (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 '("server"))
(args (append args (when mm/mu-home (args (append args (when mm/mu-home
(list (concat "--muhome=" mm/mu-home)))))) (list (concat "--muhome=" mm/mu-home))))))
@ -131,6 +128,7 @@ process."
;; register a function for (:info ...) sexps ;; register a function for (:info ...) sexps
(setq mm/proc-info-func 'mm/proc-info-handler) (setq mm/proc-info-func 'mm/proc-info-handler)
(when mm/mu-proc (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-filter mm/mu-proc 'mm/proc-filter)
(set-process-sentinel mm/mu-proc 'mm/proc-sentinel)))) (set-process-sentinel mm/mu-proc 'mm/proc-sentinel))))
@ -139,7 +137,10 @@ process."
(let (buf (get-buffer mm/server-name)) (let (buf (get-buffer mm/server-name))
(when buf (when buf
(let ((delete-exited-processes t)) (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 (setq
mm/mu-proc nil mm/mu-proc nil
mm/buf nil)))) mm/buf nil))))
@ -218,6 +219,7 @@ updated as well, with all processed sexp data removed."
(:compose <msg-sexp> :action <reply|forward>) => the <msg-sexp> (:compose <msg-sexp> :action <reply|forward>) => the <msg-sexp>
and either 'reply or 'forward will be passed and either 'reply or 'forward will be passed
`mm/proc-compose-func'." `mm/proc-compose-func'."
(mm/proc-log "* Received %d byte(s)" (length str))
(setq mm/buf (concat mm/buf str)) ;; update our buffer (setq mm/buf (concat mm/buf str)) ;; update our buffer
(let ((sexp (mm/proc-eat-sexp-from-buf))) (let ((sexp (mm/proc-eat-sexp-from-buf)))
(while sexp (while sexp
@ -295,7 +297,8 @@ terminates."
(mm/start-proc)) (mm/start-proc))
(let ((cmd (apply 'format frm args))) (let ((cmd (apply 'format frm args)))
(mm/proc-log (concat "-> " cmd)) (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) (defun mm/proc-remove-msg (docid)

View File

@ -25,7 +25,7 @@
;;; Commentary: ;;; Commentary:
;; In this file, various functions to compose/send messages, piggybacking on ;; In this file, various functions to compose/send messages, piggybacking on
;; gnus ;; gnus' message mode
;; mm ;; 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))) (concat mm/msg-reply-prefix (plist-get msg :subject)))
(propertize mail-header-separator 'read-only t 'intangible t) '"\n" (propertize mail-header-separator 'read-only t 'intangible t) '"\n"
"\n\n"
(mm/msg-cite-original msg)))) (mm/msg-cite-original msg))))
;; TODO: attachments ;; 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))) (concat mm/msg-forward-prefix (plist-get msg :subject)))
(propertize mail-header-separator 'read-only t 'intangible t) "\n" (propertize mail-header-separator 'read-only t 'intangible t) "\n"
"\n\n"
(mm/msg-cite-original msg))) (mm/msg-cite-original msg)))
(defun mm/msg-create-new () (defun mm/msg-create-new ()
@ -358,7 +361,9 @@ using Gnus' `message-mode'."
"^User-agent:"))) "^User-agent:")))
(message-hide-headers)) (message-hide-headers))
(message-goto-body))) (if (eq compose-type 'new)
(message-goto-to)
(message-goto-body))))
(defun mm/msg-save-to-sent () (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)) (when (and forwarded-from (string-match "<\\(.*\\)>" forwarded-from))
(mm/proc-flag (match-string 1 forwarded-from) "+P")))) (mm/proc-flag (match-string 1 forwarded-from) "+P"))))
(provide 'mm-send) (provide 'mm-send)

View File

@ -272,18 +272,15 @@ Seen; if the message is not New/Unread, do nothing."
removing '^M' etc." removing '^M' etc."
(let ((num 0)) (let ((num 0))
(save-excursion (save-excursion
;; remove the stupid CRs ;; remove the stupid CRs
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "[ (while (re-search-forward "[
 ]" nil t)  ]" nil t)
(replace-match "" nil t))
(replace-match "" nil t)) (replace-match "" nil t))
;; give the footer a different color... ;; give the footer a different color...
(goto-char (point-min)) (goto-char (point-min))
(let ((p (search-forward "\n-- \n" nil t))) (let ((p (search-forward "\n-- \n" nil t)))
(when p (when p
(add-text-properties p (point-max) '(face mm/view-footer-face))))
(add-text-properties p (point-max) '(face mm/view-footer-face)))) (add-text-properties p (point-max) '(face mm/view-footer-face))))
;; this is fairly simplistic... ;; this is fairly simplistic...
(goto-char (point-min)) (goto-char (point-min))
@ -296,6 +293,28 @@ removing '^M' etc."
(propertize (format "[%d]" num) (propertize (format "[%d]" num)
'face 'mm/view-url-number-face)))))))) '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 ;; Interactive functions

View File

@ -273,7 +273,7 @@ be sure it no longer matches)."
(define-key map "j" 'mm/jump-to-maildir) (define-key map "j" 'mm/jump-to-maildir)
(define-key map "c" 'mm/compose-new) (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) (define-key map "u" 'mm/retrieve-mail-update-db)
map) map)
@ -307,6 +307,10 @@ be sure it no longer matches)."
"* " "* "
(propertize "mm - mail for emacs version " 'face 'mm/title-face) (propertize "mm - mail for emacs version " 'face 'mm/title-face)
(propertize mm/version 'face 'mm/view-header-value-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" "\n\n"
" Watcha wanna do?\n\n" " Watcha wanna do?\n\n"
" * Show me some messages:\n" " * Show me some messages:\n"
@ -321,7 +325,10 @@ be sure it no longer matches)."
"\n" "\n"
" * " (propertize "c" 'face 'highlight) "ompose a new message\n" " * " (propertize "c" 'face 'highlight) "ompose a new message\n"
"\n" "\n"
"\n"
" * " (propertize "u" 'face 'highlight) "pdate email\n" " * " (propertize "u" 'face 'highlight) "pdate email\n"
" * toggle " (propertize "m" 'face 'highlight) "ail sending mode "
"\n" "\n"
" * " (propertize "q" 'face 'highlight) "uit mm\n") " * " (propertize "q" 'face 'highlight) "uit mm\n")
@ -374,6 +381,14 @@ be sure it no longer matches)."
(interactive) (interactive)
(mm/proc-retrieve-mail-update-db)) (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) (mm/kill-proc)
(kill-buffer))) (kill-buffer)))
(provide 'mm) (provide 'mm)