mirror of https://github.com/djcb/mu.git
* many updates to `mm', the mu-based MUA for emacs
This commit is contained in:
Dirk-Jan C. Binnema
parent
462f5f5247
commit
288a5763a6
|
|
@ -30,56 +30,6 @@
|
|||
(require 'ido)
|
||||
|
||||
|
||||
(defun mm/eval-msg-string (str)
|
||||
"Get the plist describing an email message, from STR containing
|
||||
a message sexp.
|
||||
|
||||
a message sexp looks something like:
|
||||
\(
|
||||
:from ((\"Donald Duck\" . \"donald@example.com\"))
|
||||
:to ((\"Mickey Mouse\" . \"mickey@example.com\"))
|
||||
:subject \"Wicked stuff\"
|
||||
:date (20023 26572 0)
|
||||
:size 15165
|
||||
:references (\"200208121222.g7CCMdb80690@msg.id\")
|
||||
:in-reply-to \"200208121222.g7CCMdb80690@msg.id\"
|
||||
:message-id \"foobar32423847ef23@pluto.net\"
|
||||
:maildir: \"/archive\"
|
||||
:path \"/home/mickey/Maildir/inbox/cur/1312254065_3.32282.pluto,4cd5bd4e9:2,\"
|
||||
:priority high
|
||||
:flags (new unread)
|
||||
:attachments ((2 \"hello.jpg\" \"image/jpeg\") (3 \"laah.mp3\" \"audio/mp3\"))
|
||||
:body-txt \" <message body>\"
|
||||
\)
|
||||
other fields are :cc, :bcc, :body-html
|
||||
|
||||
When the s-expression comes from the database ('mu find'), the
|
||||
fields :attachments, :body-txt, :body-html, :references, :in-reply-to
|
||||
are missing (because that information is not stored in the
|
||||
database -- at least not in a usable way."
|
||||
(condition-case nil
|
||||
(car (read-from-string str));; read-from-string returns a cons
|
||||
(error "Failed to parse message")))
|
||||
|
||||
|
||||
(defun mm/msg-field (msg field)
|
||||
"Get a field from this message, or nil. The fields are the
|
||||
fields of the message, which are the various items of the plist
|
||||
as described in `mm/eval-msg-string'
|
||||
|
||||
There is also the special field :body (which is either :body-txt,
|
||||
or if not available, :body-html converted to text)."
|
||||
(case field
|
||||
(:body
|
||||
(let* ((body (mm/msg-field msg :body-txt))
|
||||
(body (or body (with-temp-buffer
|
||||
(mm/msg-field msg :body-html)
|
||||
(html2text)
|
||||
(buffer-string)))))))
|
||||
(t (plist-get msg field))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -203,176 +153,29 @@ nil.
|
|||
(mm/db-update-execute)
|
||||
t))))
|
||||
|
||||
;;; some functions for *asyncronously* updating the database
|
||||
|
||||
(defvar mm/db-update-proc nil
|
||||
"*internal* Process for async db updates.")
|
||||
(defvar mm/db-update-name "*mm-db-update*"
|
||||
"*internal* name of the db-update process")
|
||||
(defvar mm/db-add-paths nil
|
||||
"*internal* List of message paths to add to the database.")
|
||||
(defvar mm/db-remove-paths nil
|
||||
"*internal* List of message paths to remove from the database.")
|
||||
|
||||
|
||||
(defun mm/db-update-proc-sentinel (proc msg)
|
||||
"Check the database update process upon completion."
|
||||
(let ((procbuf (process-buffer proc))
|
||||
(status (process-status proc))
|
||||
(exit-status (process-exit-status proc)))
|
||||
(when (and (buffer-live-p procbuf) (memq status '(exit signal)))
|
||||
(case status
|
||||
('signal (mm/log "Process killed"))
|
||||
('exit
|
||||
(case exit-status
|
||||
(mm/log "Result: %s" (mm/error-string exit-status))))))
|
||||
;; try to update again, maybe there are some new updates
|
||||
(mm/db-update-execute)))
|
||||
|
||||
|
||||
(defun mm/db-update-execute ()
|
||||
"Update the database; remove paths in `mm/db-remove-paths',
|
||||
and add paths in `mm/db-add-paths'. Updating is ansynchronous."
|
||||
|
||||
;; when it's already running, do nothing
|
||||
(unless (and mm/db-update-proc (eq (process-status mm/db-update-proc) 'run))
|
||||
(when mm/db-remove-paths
|
||||
(let ((remove-paths (copy-list mm/db-remove-paths)))
|
||||
(mm/log (concat mm/mu-binary " remove "
|
||||
(mapconcat 'identity remove-paths " ")))
|
||||
(setq mm/db-remove-paths nil) ;; clear the old list
|
||||
(setq mm/db-update-proc
|
||||
(apply 'start-process mm/db-update-name mm/db-update-name mm/mu-binary
|
||||
"remove" remove-paths))
|
||||
(set-process-sentinel mm/db-update-proc 'mm/db-update-proc-sentinel)))))
|
||||
|
||||
;; when it's already running, do nothing
|
||||
(unless (and mm/db-update-proc (eq (process-status mm/db-update-proc) 'run))
|
||||
(when mm/db-add-paths
|
||||
(let ((add-paths (copy-list mm/db-add-paths)))
|
||||
(mm/log (concat mm/mu-binary " add " (mapconcat 'identity add-paths " ")))
|
||||
(setq mm/db-add-paths nil) ;; clear the old list
|
||||
(setq mm/db-update-proc
|
||||
(apply 'start-process mm/db-update-name mm/db-update-name mm/mu-binary
|
||||
"add" add-paths))
|
||||
(set-process-sentinel mm/db-update-proc 'mm/db-update-proc-sentinel))))
|
||||
|
||||
(defun mm/db-add-async (path-or-paths)
|
||||
"Asynchronously add msg at PATH-OR-PATHS to
|
||||
database. PATH-OR-PATHS is either a single path or a list of them."
|
||||
(setq mm/db-add-paths
|
||||
(append mm/db-add-paths
|
||||
(if (listp path-or-paths) path-or-paths `(,path-or-paths)))))
|
||||
;; (mm/db-update-execute))
|
||||
|
||||
(defun mm/db-remove-async (path-or-paths)
|
||||
"Asynchronously remove msg at PATH-OR-PATHS from
|
||||
database. PATH-OR-PATHS is either a single path or a list of
|
||||
them."
|
||||
(setq mm/db-remove-paths
|
||||
(append mm/db-remove-paths
|
||||
(if (listp path-or-paths) path-or-paths `(,path-or-paths)))))
|
||||
;; (mm/db-update-execute))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; error codes / names ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; generated with:
|
||||
;; cat mu-util.h | sed 's/\([A-Z_]\+\).*=\(.*\),/(defconst \L\1 \2)/' < "$<" \
|
||||
;; | sed 's/_/-/g' > mu-errors.el
|
||||
(defconst mm/err 1)
|
||||
(defconst mm/err-in-parameters 2)
|
||||
(defconst mm/err-internal 3)
|
||||
(defconst mm/err-no-matches 4)
|
||||
(defconst mm/err-xapian 11)
|
||||
(defconst mm/err-xapian-query 13)
|
||||
(defconst mm/err-xapian-dir-not-accessible 14)
|
||||
(defconst mm/err-xapian-not-up-to-date 15)
|
||||
(defconst mm/err-xapian-missing-data 16)
|
||||
(defconst mm/err-xapian-corruption 17)
|
||||
(defconst mm/err-xapian-cannot-get-writelock 18)
|
||||
(defconst mm/err-gmime 30)
|
||||
(defconst mm/err-contacts 50)
|
||||
(defconst mm/err-contacts-cannot-retrieve 51)
|
||||
(defconst mm/err-file 70)
|
||||
(defconst mm/err-file-invalid-name 71)
|
||||
(defconst mm/err-file-cannot-link 72)
|
||||
(defconst mm/err-file-cannot-open 73)
|
||||
(defconst mm/err-file-cannot-read 74)
|
||||
(defconst mm/err-file-cannot-create 75)
|
||||
(defconst mm/err-file-cannot-mkdir 76)
|
||||
(defconst mm/err-file-stat-failed 77)
|
||||
(defconst mm/err-file-readdir-failed 78)
|
||||
(defconst mm/err-file-invalid-source 79)
|
||||
(defconst mm/err-file-target-equals-source 80)
|
||||
|
||||
;; TODO: use 'case' instead...
|
||||
(defun mm/error-string (err)
|
||||
"Convert an exit code from mu into a string."
|
||||
(cond
|
||||
((eql err mm/err) "General error")
|
||||
((eql err mm/err-in-parameters) "Error in parameters")
|
||||
((eql err mm/err-internal) "Internal error")
|
||||
((eql err mm/err-no-matches) "No matches")
|
||||
((eql err mm/err-xapian) "Xapian error")
|
||||
((eql err mm/err-xapian-query) "Error in query")
|
||||
((eql err mm/err-xapian-dir-not-accessible) "Database dir not accessible")
|
||||
((eql err mm/err-xapian-not-up-to-date) "Database is not up-to-date")
|
||||
((eql err mm/err-xapian-missing-data) "Missing data")
|
||||
((eql err mm/err-xapian-corruption) "Database seems to be corrupted")
|
||||
((eql err mm/err-xapian-cannot-get-writelock)"Database is locked")
|
||||
((eql err mm/err-gmime) "GMime-related error")
|
||||
((eql err mm/err-contacts) "Contacts-related error")
|
||||
((eql err mm/err-contacts-cannot-retrieve) "Failed to retrieve contacts")
|
||||
((eql err mm/err-file) "File error")
|
||||
((eql err mm/err-file-invalid-name) "Invalid file name")
|
||||
((eql err mm/err-file-cannot-link) "Failed to link file")
|
||||
((eql err mm/err-file-cannot-open) "Cannot open file")
|
||||
((eql err mm/err-file-cannot-read) "Cannot read file")
|
||||
((eql err mm/err-file-cannot-create) "Cannot create file")
|
||||
((eql err mm/err-file-cannot-mkdir) "mu-mkdir failed")
|
||||
((eql err mm/err-file-stat-failed) "stat(2) failed")
|
||||
((eql err mm/err-file-readdir-failed) "readdir failed")
|
||||
((eql err mm/err-file-invalid-source) "Invalid source file")
|
||||
((eql err mm/err-file-target-equals-source) "Source is same as target")
|
||||
(t (format "Unknown error (%d)" err))))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; other helper function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(defun mm/mu-run (&rest args)
|
||||
"Run 'mu' synchronously with ARGS as command-line argument;,
|
||||
where <exit-code> is the exit code of the program, or 1 if the
|
||||
process was killed. <str> contains whatever the command wrote on
|
||||
standard output/error, or nil if there was none or in case of
|
||||
error. `mm/mu-run' is like `shell-command-to-string', but with
|
||||
better possibilities for error handling. The --muhome= parameter is
|
||||
added automatically if `mm/mu-home' is non-nil."
|
||||
(let* ((rv)
|
||||
(allargs (remove-if 'not
|
||||
(append args (when mm/mu-home (concat "--muhome=" mm/mu-home)))))
|
||||
(cmdstr (concat mm/mu-binary " " (mapconcat 'identity allargs " ")))
|
||||
(str (with-output-to-string
|
||||
(with-current-buffer standard-output ;; but we also get stderr...
|
||||
(setq rv (apply 'call-process mm/mu-binary nil t nil
|
||||
args))))))
|
||||
(mm/log "%s %s => %S" mm/mu-binary (mapconcat 'identity args " ") rv)
|
||||
(when (and (numberp rv) (/= 0 rv))
|
||||
(error (mm/error-string rv)))
|
||||
`(,(if (numberp rv) rv 1) . ,str)))
|
||||
;; TODO: make this recursive
|
||||
(defun mm/get-sub-maildirs (maildir)
|
||||
"Get all readable sub-maildirs under MAILDIR."
|
||||
(let ((maildirs (remove-if
|
||||
(lambda (dentry)
|
||||
(let ((path (concat maildir "/" dentry)))
|
||||
(or
|
||||
(string= dentry ".")
|
||||
(string= dentry "..")
|
||||
(not (file-directory-p path))
|
||||
(not (file-readable-p path))
|
||||
(file-exists-p (concat path "/.noindex")))))
|
||||
(directory-files maildir))))
|
||||
(map 'list (lambda (dir) (concat "/" dir)) maildirs)))
|
||||
|
||||
|
||||
(defun mm/ask-maildir (prompt &optional fullpath)
|
||||
(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
|
||||
chosen folder)."
|
||||
|
|
@ -381,11 +184,7 @@ chosen folder)."
|
|||
`mm/sent-folder' must be set"))
|
||||
(unless mm/maildir (error "`mm/maildir' must be set"))
|
||||
(interactive)
|
||||
(let* ((showfolders
|
||||
(append (list mm/inbox-folder mm/drafts-folder mm/sent-folder)
|
||||
mm/working-folders))
|
||||
(chosen (ido-completing-read prompt showfolders)))
|
||||
(concat (if fullpath mm/maildir "") chosen)))
|
||||
(ido-completing-read prompt (mm/get-sub-maildirs mm/maildir)))
|
||||
|
||||
|
||||
(defun mm/new-buffer (bufname)
|
||||
|
|
@ -398,15 +197,6 @@ old one first."
|
|||
(get-buffer-create bufname))
|
||||
|
||||
|
||||
(defconst mm/log-buffer-name "*mm-log*"
|
||||
"*internal* Name of the logging buffer.")
|
||||
|
||||
(defun mm/log (frm &rest args)
|
||||
"Write something in the *mm-log* buffer - mainly useful for debugging."
|
||||
(with-current-buffer (get-buffer-create mm/log-buffer-name)
|
||||
(goto-char (point-max))
|
||||
(insert (apply 'format (concat (format-time-string "%x %X " (current-time))
|
||||
frm "\n") args))))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@
|
|||
;; descriptions of emails, aka 'headers' (not to be confused with headers like
|
||||
;; 'To:' or 'Subject:')
|
||||
|
||||
;; mu
|
||||
;; mm
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -53,7 +53,7 @@
|
|||
"*internal Whether to sort in descending order")
|
||||
|
||||
|
||||
(defconst mm/hdrs-buffer-name "*headers*"
|
||||
(defconst mm/hdrs-buffer-name "*mm-headers*"
|
||||
"*internal* Name of the buffer for message headers.")
|
||||
|
||||
(defvar mm/hdrs-buffer nil
|
||||
|
|
@ -63,62 +63,101 @@
|
|||
"Search in the mu database for EXPR, and switch to the output
|
||||
buffer for the results."
|
||||
(interactive "s[mu] search for: ")
|
||||
;; make sure we get a brand new buffer
|
||||
(setq mm/hdrs-buffer (mm/new-buffer mm/hdrs-buffer-name))
|
||||
(let ((buf (get-buffer-create mm/hdrs-buffer-name))
|
||||
(inhibit-read-only t))
|
||||
(with-current-buffer buf
|
||||
(erase-buffer)
|
||||
(mm/hdrs-mode)
|
||||
(setq mm/msg-map nil mm/mm/marks-map nil)
|
||||
(mm/msg-map-init)
|
||||
(setq
|
||||
mode-name expr
|
||||
mm/last-expr expr
|
||||
mm/hdrs-buffer buf)))
|
||||
(switch-to-buffer mm/hdrs-buffer)
|
||||
(mm/hdrs-mode)
|
||||
(setq mm/last-expr expr)
|
||||
(mm/msg-map-init)
|
||||
(let ((inhibit-read-only t)) (erase-buffer)) ;; FIXME -- why is this needed?!
|
||||
|
||||
;; all set -- now execute the search
|
||||
(mm/proc-find expr))
|
||||
|
||||
(defun mm/hdrs-message-handler (msg)
|
||||
(message "Received message %d (%s)"
|
||||
(plist-get msg :docid)
|
||||
(plist-get msg :subject)))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; handler functions
|
||||
;;
|
||||
;; next are a bunch of handler functions; those will be called from mm-proc in
|
||||
;; response to output from the server process
|
||||
|
||||
|
||||
(defun mm/hdrs-view-handler (msg)
|
||||
"Handler function for displaying a message."
|
||||
(mm/view msg mm/hdrs-buffer))
|
||||
|
||||
(defun mm/hdrs-error-handler (err)
|
||||
(message "Error %d: %s"
|
||||
(plist-get err :error)
|
||||
(plist-get err :error-message)))
|
||||
"Handler function for showing an error."
|
||||
(let ((errcode (plist-get err :error))
|
||||
(errmsg (plist-get err :error-message)))
|
||||
(case errcode
|
||||
(4 (message "No matches for this search query."))
|
||||
(t (message (format "Error %d: %s" errcode errmsg))))))
|
||||
|
||||
(defun mm/hdrs-update-handler (update)
|
||||
"Update handler, will be called when we get '(:update ... )' from
|
||||
the mu server process. This function will update the current list
|
||||
of headers."
|
||||
(message "We received a database update: %S" update)
|
||||
(let* ((type (plist-get update :update)) (docid (plist-get update :docid))
|
||||
(marker (mm/msg-map-get-marker docid)))
|
||||
(unless docid (error "Invalid update %S" update))
|
||||
(unless marker (error "Message %d not found" docid))
|
||||
(defun mm/hdrs-update-handler (msg is-move)
|
||||
"Update handler, will be called when a message has been updated
|
||||
in the database. This function will update the current list of
|
||||
headers."
|
||||
(when (buffer-live-p mm/hdrs-buffer)
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(let* ((docid (plist-get msg :docid))
|
||||
(marker (mm/msg-map-get-marker docid)))
|
||||
(unless docid (error "Invalid update %S" update))
|
||||
(unless marker (error "Message %d not found" docid))
|
||||
(save-excursion
|
||||
(goto-char (marker-position marker))
|
||||
;; sanity check
|
||||
(unless (eq docid (get-text-property (point) 'docid))
|
||||
(error "Unexpected docid"))
|
||||
;; if it's marked, unmark it now
|
||||
(when (mm/hdrs-docid-is-marked docid)
|
||||
(mm/hdrs-mark 'unmark))
|
||||
(let ((inhibit-read-only t) (bol (line-beginning-position))
|
||||
(eol (line-beginning-position 2)))
|
||||
;; hide the old line (removing it causes some problems)
|
||||
(put-text-property bol eol 'invisible t)
|
||||
;; 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 bol))))))))
|
||||
|
||||
(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 (mm/msg-map-get-marker docid)))
|
||||
(unless marker (error "Message %d not found" docid))
|
||||
(save-excursion
|
||||
(goto-char (marker-position marker))
|
||||
;; sanity check
|
||||
(unless (eq docid (get-text-property (point) 'docid))
|
||||
(error "Unexpected docid"))
|
||||
(mm/hdrs-mark 'unmark)
|
||||
;; if it's marked, unmark it now
|
||||
(when (mm/hdrs-docid-is-marked docid)
|
||||
(mm/hdrs-mark 'unmark))
|
||||
(let ((inhibit-read-only t) (bol (line-beginning-position))
|
||||
(eol (line-beginning-position 2)))
|
||||
(case type
|
||||
(remove (put-text-property bol eol 'invisible t))
|
||||
(move (put-text-property bol eol 'face 'mm/moved-face))
|
||||
(t (error "Invalid update %S" update))))))))
|
||||
;; hide the message
|
||||
(set-text-properties bol eol '(invisible t)))))))
|
||||
|
||||
|
||||
(defun mm/hdrs-header-handler (msg)
|
||||
"Function to insert a line for a message. This will be called by
|
||||
(defun mm/hdrs-header-handler (msg &optional point)
|
||||
"Function to add a line for a message. This will be called by
|
||||
`mm/proc-find'. Function expects to be in the output buffer
|
||||
already."
|
||||
(let* ((docid (mm/msg-field msg :docid))
|
||||
already. Normally, msg is appended to the end of the buffer, but if
|
||||
POINT is given, message is insert at POINT."
|
||||
(let* ((docid (plist-get msg :docid))
|
||||
(line (propertize (concat " " (mm/hdrs-line msg) "\n")
|
||||
'docid docid)))
|
||||
;; add message to the docid=>path map, see `mm/msg-map'.
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
;; append to end, or insert at POINT if that was provided
|
||||
(goto-char (if point point (point-max)))
|
||||
(mm/msg-map-add msg (point-marker))
|
||||
(let ((inhibit-read-only t))
|
||||
(insert line))))))
|
||||
|
|
@ -126,11 +165,11 @@ already."
|
|||
(defun mm/hdrs-line (msg)
|
||||
"Get the one-line description of MSG (as per `mm/hdrs-raw-line'), and
|
||||
apply text-properties based on the message flags."
|
||||
(let ((line (mm/hdrs-raw-line msg))
|
||||
(flags (plist-get msg :flags)))
|
||||
(let ((line (mm/hdrs-raw-line msg)) (flags (plist-get msg :flags)))
|
||||
(cond
|
||||
((member 'unread flags) (propertize line 'face 'mm/unread-face))
|
||||
(t (propertize line 'face 'mm/header-face)))))
|
||||
((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)))))
|
||||
|
||||
(defun mm/hdrs-raw-line (msg)
|
||||
"Create a one line description of MSG in this buffer at
|
||||
|
|
@ -189,9 +228,9 @@ point. Line does not include a newline or any text-properties."
|
|||
(define-key map "x" 'mm/execute-marks)
|
||||
|
||||
;; message composition
|
||||
;; (define-key map "r" 'mua/hdrs-reply)
|
||||
;; (define-key map "f" 'mua/hdrs-forward)
|
||||
;; (define-key map "c" 'mua/hdrs-compose)
|
||||
(define-key map "r" 'mm/compose-reply)
|
||||
(define-key map "f" 'mm/compose-forward)
|
||||
(define-key map "c" 'mm/compose-new)
|
||||
|
||||
(define-key map (kbd "RET") 'mm/view-message)
|
||||
map)
|
||||
|
|
@ -205,7 +244,6 @@ point. Line does not include a newline or any text-properties."
|
|||
(kill-all-local-variables)
|
||||
(use-local-map mm/hdrs-mode-map)
|
||||
|
||||
(make-local-variable 'mm/buf)
|
||||
(make-local-variable 'mm/last-expr)
|
||||
(make-local-variable 'mm/hdrs-proc)
|
||||
(make-local-variable 'mm/marks-map)
|
||||
|
|
@ -215,7 +253,10 @@ point. Line does not include a newline or any text-properties."
|
|||
(setq mm/proc-error-func 'mm/hdrs-error-handler)
|
||||
(setq mm/proc-update-func 'mm/hdrs-update-handler)
|
||||
(setq mm/proc-header-func 'mm/hdrs-header-handler)
|
||||
(setq mm/proc-message-func 'mm/hdrs-message-handler)
|
||||
(setq mm/proc-view-func 'mm/hdrs-view-handler)
|
||||
(setq mm/proc-remove-func 'mm/hdrs-remove-handler)
|
||||
;; this last one is defined in mm-send.el
|
||||
(setq mm/proc-compose-func 'mm/send-compose-handler)
|
||||
|
||||
(setq
|
||||
mm/marks-map (make-hash-table :size 16 :rehash-size 2)
|
||||
|
|
@ -317,9 +358,6 @@ The following marks are available, and the corresponding props:
|
|||
(delete-char 2)
|
||||
(insert (propertize (concat markkar " ") 'docid docid))))))
|
||||
|
||||
|
||||
|
||||
|
||||
(defun mm/hdrs-marks-execute ()
|
||||
"Execute the actions for all marked messages in this
|
||||
buffer.
|
||||
|
|
@ -332,31 +370,21 @@ we need to rerun the search, but we don't want to do that
|
|||
automatically, as it may be too slow and/or break the users
|
||||
flow. Therefore, we hide the message, which in practice seems to
|
||||
work well."
|
||||
(unless (/= 0 (hash-table-count mm/marks-map))
|
||||
(error "Nothing is marked"))
|
||||
(maphash
|
||||
(lambda (docid val)
|
||||
(let* ((marker (nth 0 val)) (mark (nth 1 val)) (target (nth 2 val))
|
||||
(ok (case mark
|
||||
(move
|
||||
(mm/proc-move-msg docid target))
|
||||
(trash
|
||||
(unless mm/maildir "`mm/maildir' not set")
|
||||
(unless mm/trash-folder "`mm/trash-folder' not set")
|
||||
(mm/proc-move-msg docid (concat mm/maildir "/" mm/trash-folder) "+T"))
|
||||
(delete
|
||||
(mm/proc-remove-msg docid)))))
|
||||
;; (when ok
|
||||
;; (save-excursion
|
||||
;; (goto-char (marker-position marker))
|
||||
;; (mm/hdrs-mark 'unmark)
|
||||
;; ;; hide the line
|
||||
;; (let ((inhibit-read-only t))
|
||||
;; (put-text-property (line-beginning-position) (line-beginning-position 2)
|
||||
;; 'invisible t))))))
|
||||
))
|
||||
mm/marks-map))
|
||||
|
||||
(if (= 0 (hash-table-count mm/marks-map))
|
||||
(message "Nothing is marked")
|
||||
(maphash
|
||||
(lambda (docid val)
|
||||
(let*
|
||||
((marker (nth 0 val)) (mark (nth 1 val)) (target (nth 2 val))
|
||||
(ok (case mark
|
||||
(move
|
||||
(mm/proc-move-msg docid target))
|
||||
(trash
|
||||
(unless mm/trash-folder "`mm/trash-folder' not set")
|
||||
(mm/proc-move-msg docid mm/trash-folder "+T"))
|
||||
(delete
|
||||
(mm/proc-remove-msg docid)))))))
|
||||
mm/marks-map)) )
|
||||
|
||||
(defun mm/hdrs-unmark-all ()
|
||||
"Unmark all marked messages."
|
||||
|
|
@ -370,13 +398,22 @@ work well."
|
|||
mm/marks-map))
|
||||
|
||||
(defun mm/hdrs-view ()
|
||||
"View message at point"
|
||||
"View message at point."
|
||||
(let ((docid (get-text-property (point) 'docid)))
|
||||
(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."
|
||||
(let ((docid (get-text-property (point) 'docid)))
|
||||
(unless docid (error "No message at point."))
|
||||
(mm/proc-compose-msg docid reply-or-forward)))
|
||||
|
||||
|
||||
(defun mm/hdrs-docid-is-marked (docid)
|
||||
"Is the given docid marked?"
|
||||
(when (gethash docid mm/marks-map) t))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
|
@ -384,19 +421,29 @@ work well."
|
|||
|
||||
|
||||
;;; interactive functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(defun mm/ignore-marks ()
|
||||
(let*
|
||||
((num
|
||||
(hash-table-count mm/marks-map))
|
||||
(unmark (or (= 0 num)
|
||||
(y-or-n-p
|
||||
(format "Sure you want to unmark %d message(s)?" num)))))
|
||||
(message nil)
|
||||
unmark))
|
||||
|
||||
;; TODO warn if marks exist
|
||||
(defun mm/search ()
|
||||
"Start a new mu search."
|
||||
(interactive)
|
||||
(call-interactively 'mm/hdrs-search))
|
||||
(when (mm/ignore-marks)
|
||||
(call-interactively 'mm/hdrs-search)))
|
||||
|
||||
;; TODO warn if marks exist
|
||||
;; TODO: return to previous buffer
|
||||
(defun mm/quit-buffer ()
|
||||
"Quit the current buffer."
|
||||
(interactive)
|
||||
(kill-buffer (current-buffer)))
|
||||
(when (mm/ignore-marks)
|
||||
(mm/kill-proc) ;; hmmm...
|
||||
(kill-buffer)
|
||||
(mm)))
|
||||
|
||||
;; TODO implement
|
||||
(defun mm/change-sort ()
|
||||
|
|
@ -409,9 +456,10 @@ work well."
|
|||
"Rerun the search for the last search expression; if none exists,
|
||||
do a new search."
|
||||
(interactive)
|
||||
(if mm/last-expr
|
||||
(mm/hdrs-search mm/last-expr)
|
||||
(mm/search)))
|
||||
(when (mm/ignore-marks)
|
||||
(if mm/last-expr
|
||||
(mm/hdrs-search mm/last-expr)
|
||||
(mm/search))))
|
||||
|
||||
(defun mm/view-message ()
|
||||
"View the message at point."
|
||||
|
|
@ -419,16 +467,28 @@ do a new search."
|
|||
(mm/hdrs-view))
|
||||
|
||||
(defun mm/next-header ()
|
||||
"Move point to the next header."
|
||||
"Move point to the next message header. If this succeeds, return
|
||||
the new docid. Otherwise, return nil."
|
||||
(interactive)
|
||||
(when (or (/= 0 (forward-line 1)) (not (get-text-property (point) 'docid)))
|
||||
(error "No header after this one")))
|
||||
(if (= 0 (forward-line 1))
|
||||
(let ((docid (get-text-property (point) 'docid)))
|
||||
(if docid
|
||||
docid
|
||||
(mm/next-header))) ;; skip non-headers
|
||||
(progn (message "No next message available") nil)))
|
||||
|
||||
|
||||
(defun mm/prev-header ()
|
||||
"Move point to the previous header."
|
||||
"Move point to the previous message header. If this succeeds,
|
||||
return the new docid. Otherwise, return nil."
|
||||
(interactive)
|
||||
(when (or (/= 0 (forward-line -1)) (not (get-text-property (point) 'docid)))
|
||||
(error "No header before this one")))
|
||||
(if (= 0 (forward-line -1))
|
||||
(let ((docid (get-text-property (point) 'docid)))
|
||||
(if docid
|
||||
docid
|
||||
(mm/prev-header))) ;; skip non-headers
|
||||
(progn (message "No previous message available") nil)))
|
||||
|
||||
|
||||
(defun mm/jump-to-maildir ()
|
||||
"Show the messages in one of the standard folders."
|
||||
|
|
@ -436,14 +496,16 @@ do a new search."
|
|||
(let ((fld (mm/ask-maildir "Jump to maildir: ")))
|
||||
(mm/hdrs-search (concat "maildir:" fld))))
|
||||
|
||||
|
||||
(defun mm/mark-for-move ()
|
||||
"Mark message at point for moving to a maildir."
|
||||
(interactive)
|
||||
(let ((target (mm/ask-maildir "Target maildir for move: ")))
|
||||
(when (or (file-directory-p target)
|
||||
(let* ((target (mm/ask-maildir "Target maildir for move: "))
|
||||
(fulltarget (concat mm/maildir target)))
|
||||
(when (or (file-directory-p fulltarget)
|
||||
(and (yes-or-no-p
|
||||
(format "%s does not exist. Create now?" target))
|
||||
(mm/proc-mkdir target)))
|
||||
(format "%s does not exist. Create now?" fulltarget))
|
||||
(mm/proc-mkdir fulltarget)))
|
||||
(mm/hdrs-mark 'move target)
|
||||
(mm/next-header))))
|
||||
|
||||
|
|
@ -470,24 +532,34 @@ folder (`mm/trash-folder')."
|
|||
(defun mm/unmark-all ()
|
||||
"Unmark all messages."
|
||||
(interactive)
|
||||
(unless (/= 0 (hash-table-count mm/marks-map))
|
||||
(error "Nothing is marked"))
|
||||
(when (y-or-n-p (format "Sure you want to unmark %d message(s)?"
|
||||
(hash-table-count mm/marks-map)))
|
||||
(mm/hdrs-unmark-all)))
|
||||
(if (= 0 (hash-table-count mm/marks-map))
|
||||
(message "Nothing is marked")
|
||||
(when (mm/ignore-marks)
|
||||
(mm/hdrs-unmark-all))))
|
||||
|
||||
(defun mm/execute-marks ()
|
||||
"Execute the actions for the marked messages."
|
||||
(interactive)
|
||||
(unless (/= 0 (hash-table-count mm/marks-map))
|
||||
(error "Nothing is marked"))
|
||||
(when (y-or-n-p (format "Sure you want to execute marks on %d message(s)?"
|
||||
(hash-table-count mm/marks-map)))
|
||||
(mm/hdrs-marks-execute)))
|
||||
(if (= 0 (hash-table-count mm/marks-map))
|
||||
(message "Nothing is marked")
|
||||
(when (y-or-n-p (format "Sure you want to execute marks on %d message(s)?"
|
||||
(hash-table-count mm/marks-map)))
|
||||
(mm/hdrs-marks-execute)
|
||||
(message nil))))
|
||||
|
||||
(defun mm/compose-reply ()
|
||||
"Start composing a reply to the current message."
|
||||
(interactive)
|
||||
(mm/hdrs-compose 'reply))
|
||||
|
||||
|
||||
(defun mm/compose-forward ()
|
||||
"Start composing a forward to the current message."
|
||||
(interactive)
|
||||
(mm/hdrs-compose 'forward))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
||||
(provide 'mm-hdrs)
|
||||
|
||||
|
|
|
|||
|
|
@ -35,33 +35,64 @@
|
|||
(defvar mm/mu-proc nil
|
||||
"*internal* The mu-server process")
|
||||
|
||||
(defvar mm/proc-header-func nil
|
||||
"*internal* A function called for each message returned from the
|
||||
server process; the function is passed a msg plist as argument. See
|
||||
`mm/proc-eval-server-output' for the format.")
|
||||
|
||||
(defvar mm/proc-error-func nil
|
||||
"*internal* A function called for each error returned from the
|
||||
server process; the function is passed an error plist as
|
||||
argument. See `mm/proc-eval-server-output' for the format.")
|
||||
argument. See `mm/proc-filter' for the format.")
|
||||
|
||||
(defvar mm/proc-update-func nil
|
||||
"*internal* A function called for each update sexp returned from
|
||||
the server process; the function is passed an update plist as
|
||||
argument. See `mm/proc-eval-server-output' for the format.")
|
||||
"*internal* A function called for each :update sexp returned from
|
||||
the server process; the function is passed a msg sexp as
|
||||
argument. See `mm/proc-filter' for the format.")
|
||||
|
||||
(defvar mm/proc-message-func nil
|
||||
"*internal* A function called for each message sexp returned from
|
||||
the server process. This is designed for viewing a message. See
|
||||
`mm/proc-eval-server-output' for the format.")
|
||||
(defvar mm/proc-remove-func nil
|
||||
"*internal* A function called for each :remove sexp returned from
|
||||
the server process, when some message has been deleted. The
|
||||
function is passed the docid of the removed message.")
|
||||
|
||||
(defvar mm/proc-view-func nil
|
||||
"*internal* A function called for each single message sexp
|
||||
returned from the server process. The function is passed a message
|
||||
sexp as argument. See `mm/proc-filter' for the
|
||||
format.")
|
||||
|
||||
(defvar mm/proc-header-func nil
|
||||
"*internal* A function called for each message returned from the
|
||||
server process; the function is passed a msg plist as argument. See
|
||||
`mm/proc-filter' for the format.")
|
||||
|
||||
(defvar mm/proc-compose-func nil
|
||||
"*internal* A function called for each message returned from the
|
||||
server process that is used as basis for composing a new
|
||||
message (ie., either a reply or a forward); the function is passed
|
||||
msg and a symbol (either reply or forward). See `mm/proc-filter'
|
||||
for the format of <msg-plist>.")
|
||||
|
||||
(defvar mm/proc-info-func nil
|
||||
"*internal* A function called for each (:info type ....) sexp
|
||||
received from the server process.")
|
||||
|
||||
|
||||
(defconst mm/eox-mark "\n;;eox\n"
|
||||
"*internal* Marker for the end of a sexp")
|
||||
|
||||
(defvar mm/buf ""
|
||||
(defvar mm/buf nil
|
||||
"*internal* Buffer for results data.")
|
||||
|
||||
(defun mm/proc-info-handler (info)
|
||||
"Handler function for (:info ...) sexps received from the server
|
||||
process."
|
||||
(let ((type (plist-get info :info)))
|
||||
(cond
|
||||
;; (:info :version "3.1")
|
||||
((eq type 'version) (setq mm/mu-version (plist-get info :version)))
|
||||
((eq type 'index)
|
||||
(if (eq (plist-get info :status) 'running)
|
||||
(message (format "Indexing... processed %d, updated %d"
|
||||
(plist-get info :processed) (plist-get info :updated)))
|
||||
(message
|
||||
(format "Indexing completed; processed %d, updated %d, cleaned-up %d"
|
||||
(plist-get info :processed) (plist-get info :updated)
|
||||
(plist-get info :cleaned-up))))))))
|
||||
|
||||
|
||||
(defun mm/start-proc ()
|
||||
"Start the mu server process."
|
||||
;; TODO: add version check
|
||||
|
|
@ -71,8 +102,11 @@ the server process. This is designed for viewing a message. See
|
|||
(args '("server"))
|
||||
(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*"
|
||||
mm/mu-binary args))
|
||||
;; register a function for (:info ...) sexps
|
||||
(setq mm/proc-info-func 'mm/proc-info-handler)
|
||||
(when mm/mu-proc
|
||||
(set-process-filter mm/mu-proc 'mm/proc-filter)
|
||||
(set-process-sentinel mm/mu-proc 'mm/proc-sentinel))))
|
||||
|
|
@ -82,66 +116,44 @@ the server process. This is designed for viewing a message. See
|
|||
(when (mm/proc-is-running)
|
||||
(let ((delete-exited-processes t))
|
||||
(kill-process mm/mu-proc)
|
||||
(setq mm/mu-proc nil))))
|
||||
(setq
|
||||
mm/mu-proc nil
|
||||
mm/buf nil))))
|
||||
|
||||
(defun mm/proc-is-running ()
|
||||
(and mm/mu-proc (eq (process-status mm/mu-proc) 'run)))
|
||||
|
||||
(defun mm/proc-eat-sexp-from-buf ()
|
||||
"'Eat' the next s-expression from `mm/buf'. `mm/buf gets its
|
||||
contents from the mu-servers in the following form:
|
||||
\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)))))
|
||||
|
||||
|
||||
(defun mm/proc-filter (proc str)
|
||||
"A process-filter for the 'mu server' output; it accumulates the
|
||||
strings into valid sexps by checking of the ';;eox' end-of-msg
|
||||
marker, and then evaluating them."
|
||||
(setq mm/buf (concat mm/buf str)) ;; update our buffer
|
||||
(let ((eox (string-match mm/eox-mark mm/buf)))
|
||||
(while eox
|
||||
;; Process the sexp in `mm/buf', and remove it if it worked and return
|
||||
;; t. If no complete sexp is found, return nil."
|
||||
(let ( (after-eox (match-end 0))
|
||||
(sexp (mm/proc-eval-server-output (substring mm/buf 0 eox))))
|
||||
;; the sexp we get can either be a message or an error
|
||||
(message "[%S]" sexp)
|
||||
(cond
|
||||
((plist-get sexp :error) (funcall mm/proc-error-func sexp))
|
||||
;; if it has :docid, it's a message; if it's dbonly prop is `t', it's
|
||||
;; a header, otherwise it's a message (for viewing)
|
||||
((eq (plist-get sexp :msgtype) 'header)
|
||||
(funcall mm/proc-header-func sexp))
|
||||
((eq (plist-get sexp :msgtype) 'view)
|
||||
(funcall mm/proc-message-func sexp))
|
||||
((plist-get sexp :update) (funcall mm/proc-update-func sexp))
|
||||
(t (message "%S" sexp)))
|
||||
;;(t (error "Unexpected data from server"))))
|
||||
(setq mm/buf (substring mm/buf after-eox)))
|
||||
(setq eox (string-match mm/eox-mark mm/buf)))))
|
||||
strings into valid sexps by checking of the ';;eox' end-of-sexp
|
||||
marker, and then evaluating them.
|
||||
|
||||
(defun mm/proc-sentinel (proc msg)
|
||||
"Function that will be called when the mu-server process
|
||||
terminates."
|
||||
(let ((status (process-status proc)) (code (process-exit-status proc)))
|
||||
(setq mm/mu-proc nil)
|
||||
(setq mm/buf "") ;; clear any half-received sexps
|
||||
(cond
|
||||
((eq status 'signal)
|
||||
(message (format "mu server process received signal %d" code)))
|
||||
((eq status 'exit)
|
||||
(cond
|
||||
((eq code 11) (message "Database is locked by another process"))
|
||||
(t (message (format "mu server process ended with exit code %d" code)))))
|
||||
(t
|
||||
(message "something bad happened to the mu server process")))))
|
||||
The server output is as follows:
|
||||
|
||||
(defun mm/proc-eval-server-output (str)
|
||||
"Evaluate a blob of server output; the output describe either a
|
||||
message, a database update or an error.
|
||||
|
||||
An error sexp looks something like:
|
||||
|
||||
(:error 2 :error-message \"unknown command\")
|
||||
;; eox
|
||||
|
||||
a message sexp looks something like:
|
||||
1. an error
|
||||
(:error 2 :error-message \"unknown command\")
|
||||
;; eox
|
||||
=> this will be passed to `mm/proc-error-func'.
|
||||
|
||||
2. a message sexp looks something like:
|
||||
\(
|
||||
:docid 1585
|
||||
:from ((\"Donald Duck\" . \"donald@example.com\"))
|
||||
|
|
@ -160,34 +172,96 @@ a message sexp looks something like:
|
|||
:body-txt \" <message body>\"
|
||||
\)
|
||||
;; eox
|
||||
=> this will be passed to `mm/proc-header-func'.
|
||||
|
||||
a database update looks like:
|
||||
\(:update 1585 :path \"/home/user/Maildir/foo/cur/12323213:,R\")
|
||||
when a message has been moved to a new location, or
|
||||
\(:update 1585 :path \"/dev/null\")
|
||||
when it has been removed.
|
||||
3. a view looks like:
|
||||
(:view <msg-sexp>)
|
||||
=> the <msg-sexp> (see 2.) will be passed to `mm/proc-view-func'.
|
||||
|
||||
other fields are :cc, :bcc, :body-html
|
||||
4. a database update looks like:
|
||||
(:update <msg-sexp> :move <nil-or-t>)
|
||||
|
||||
When the s-expression comes from the database ('mu find'), the
|
||||
fields :attachments, :body-txt, :body-html, :references, :in-reply-to
|
||||
are missing (because that information is not stored in the
|
||||
database).
|
||||
=> the <msg-sexp> (see 2.) will be passed to
|
||||
`mm/proc-update-func', :move tells us whether this is a move to
|
||||
another maildir, or merely a flag change.
|
||||
|
||||
On the other hand, if the information comes from the message file,
|
||||
there won't be a :docid field."
|
||||
(condition-case nil
|
||||
(car (read-from-string str));; read-from-string returns a cons
|
||||
(error "Failed to parse sexp [%S]" str)))
|
||||
5. a remove looks like:
|
||||
(:remove <docid>)
|
||||
=> the docid will be passed to `mm/proc-remove-func'
|
||||
|
||||
6. a compose looks like:
|
||||
(:compose <msg-sexp> :action <reply|forward>) => the <msg-sexp>
|
||||
and either 'reply or 'forward will be passed
|
||||
`mm/proc-compose-func'."
|
||||
(setq mm/buf (concat mm/buf str)) ;; update our buffer
|
||||
(let ((sexp (mm/proc-eat-sexp-from-buf)))
|
||||
(while sexp
|
||||
(mm/proc-log "%S" sexp)
|
||||
(cond
|
||||
((eq (plist-get sexp :msgtype) 'header)
|
||||
(funcall mm/proc-header-func sexp))
|
||||
((plist-get sexp :view)
|
||||
(funcall mm/proc-view-func (plist-get sexp :view)))
|
||||
((plist-get sexp :update)
|
||||
(funcall mm/proc-update-func
|
||||
(plist-get sexp :update) (plist-get sexp :move)))
|
||||
((plist-get sexp :remove)
|
||||
(funcall mm/proc-remove-func (plist-get sexp :remove)))
|
||||
((plist-get sexp :compose)
|
||||
(funcall mm/proc-compose-func
|
||||
(plist-get sexp :compose)
|
||||
(plist-get sexp :action)))
|
||||
((plist-get sexp :info)
|
||||
(funcall mm/proc-info-func sexp))
|
||||
((plist-get sexp :error)
|
||||
(funcall mm/proc-error-func sexp))
|
||||
(t (message "Unexpected data from server [%S]" sexp)))
|
||||
(setq sexp (mm/proc-eat-sexp-from-buf)))))
|
||||
|
||||
|
||||
(defun mm/proc-sentinel (proc msg)
|
||||
"Function that will be called when the mu-server process
|
||||
terminates."
|
||||
(let ((status (process-status proc)) (code (process-exit-status proc)))
|
||||
(setq mm/mu-proc nil)
|
||||
(setq mm/buf "") ;; clear any half-received sexps
|
||||
(cond
|
||||
((eq status 'signal)
|
||||
(cond
|
||||
((eq code 9) (message "the mu server process has been stopped"))
|
||||
(t (message (format "mu server process received signal %d" code)))))
|
||||
((eq status 'exit)
|
||||
(cond
|
||||
((eq code 11) (message "Database is locked by another process"))
|
||||
(t (message (format "mu server process ended with exit code %d" code)))))
|
||||
(t
|
||||
(message "something bad happened to the mu server process")))))
|
||||
|
||||
|
||||
(defconst mm/proc-log-buffer-name "*mm-log*"
|
||||
"*internal* Name of the logging buffer.")
|
||||
|
||||
(defun mm/proc-log (frm &rest args)
|
||||
"Write something in the *mm-log* buffer - mainly useful for debugging."
|
||||
(with-current-buffer (get-buffer-create mm/proc-log-buffer-name)
|
||||
(goto-char (point-max))
|
||||
(insert (apply 'format (concat (format-time-string "%Y-%m-%d %T "
|
||||
(current-time)) frm "\n") args))))
|
||||
|
||||
(defun mm/proc-send-command (frm &rest args)
|
||||
"Send as command to the mu server process; start the process if needed."
|
||||
(unless (mm/proc-is-running)
|
||||
(mm/start-proc))
|
||||
(let ((cmd (apply 'format frm args)))
|
||||
(mm/proc-log cmd)
|
||||
(process-send-string mm/mu-proc (concat cmd "\n"))))
|
||||
|
||||
|
||||
(defun mm/proc-remove-msg (docid)
|
||||
"Remove message identified by DOCID. The results are reporter
|
||||
through either (:update ... ) or (:error ) sexp, which are handled
|
||||
my `mm/proc-update-func' and `mm/proc-error-func', respectively."
|
||||
(unless (mm/proc-is-running) (mm/start-proc))
|
||||
(when mm/mu-proc
|
||||
(process-send-string mm/mu-proc (format "remove %d\n" docid))))
|
||||
(mm/proc-send-command "remove %d" docid))
|
||||
|
||||
|
||||
(defun mm/proc-find (expr)
|
||||
|
|
@ -196,17 +270,16 @@ function is called, depending on the kind of result. The variables
|
|||
`mm/proc-header-func' and `mm/proc-error-func' contain the function
|
||||
that will be called for, resp., a message (header row) or an
|
||||
error."
|
||||
(unless (mm/proc-is-running) (mm/start-proc))
|
||||
(when mm/mu-proc
|
||||
(process-send-string mm/mu-proc (format "find %s\n" expr))))
|
||||
(mm/proc-send-command "find \"%s\"" expr))
|
||||
|
||||
|
||||
(defun mm/proc-move-msg (docid targetdir flags)
|
||||
"Move message identified by DOCID to TARGETDIR, setting FLAGS in
|
||||
the process.
|
||||
(defun mm/proc-move-msg (docid targetmdir &optional flags)
|
||||
"Move message identified by DOCID to TARGETMDIR, optionally
|
||||
setting FLAGS in the process.
|
||||
|
||||
TARGETDIR must be a maildir, that is, the part _without_ cur/ or
|
||||
new/.
|
||||
new/ or the root-maildir-prefix. E.g. \"/archive\". This directory
|
||||
must already exist.
|
||||
|
||||
The FLAGS parameter can have the following forms:
|
||||
1. a list of flags such as '(passed replied seen)
|
||||
|
|
@ -225,32 +298,38 @@ The results are reported through either (:update ... )
|
|||
or (:error ) sexp, which are handled my `mm/proc-update-func' and
|
||||
`mm/proc-error-func', respectively."
|
||||
(let
|
||||
((flagstr (if (stringp flags) flags (mm/flags-to-string flags))))
|
||||
(unless (and (file-directory-p targetdir) (file-writable-p targetdir))
|
||||
(error "Not a writable directory: %s" targetdir))
|
||||
|
||||
(unless (mm/proc-is-running) (mm/start-proc))
|
||||
(when mm/mu-proc
|
||||
(process-send-string mm/mu-proc
|
||||
(format "move %d %s %s\n" docid targetdir flagstr)))))
|
||||
((flagstr (if (stringp flags) flags (mm/flags-to-string flags)))
|
||||
(fullpath (concat mm/maildir targetmdir)))
|
||||
(unless (and (file-directory-p fullpath) (file-writable-p fullpath))
|
||||
(error "Not a writable directory: %s" fullpath))
|
||||
(mm/proc-send-command "move %d %s %s" docid targetmdir flagstr)))
|
||||
|
||||
|
||||
(defun mm/proc-flag-msg (docid flags)
|
||||
"Set FLAGS for the message identified by DOCID."
|
||||
(let ((flagstr (if (stringp flags) flags (mm/flags-to-string flags))))
|
||||
(unless (mm/proc-is-running) (mm/start-proc))
|
||||
(when mm/mu-proc
|
||||
(process-send-string mm/mu-proc
|
||||
(format "flag %d %s\n" docid flagstr)))))
|
||||
(mm/proc-send-command "flag %d %s" docid flagstr)))
|
||||
|
||||
(defun mm/proc-index (maildir)
|
||||
"Update the message database."
|
||||
(mm/proc-send-command "index %s" maildir))
|
||||
|
||||
(defun mm/proc-view-msg (docid)
|
||||
"Get one particular message based on its DOCID. The result will
|
||||
be delivered to the function registered as `mm/proc-message-func'."
|
||||
(unless (mm/proc-is-running) (mm/start-proc))
|
||||
(when mm/mu-proc
|
||||
(process-send-string mm/mu-proc
|
||||
(format "view %d\n" docid))))
|
||||
(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.
|
||||
|
||||
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)))
|
||||
|
||||
|
||||
(provide 'mm-proc)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,436 @@
|
|||
;; mm-send.el -- part of mm, the mu mail user agent
|
||||
;;
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; In this file, various functions to compose/send messages, piggybacking on
|
||||
;; gnus
|
||||
|
||||
;; mm
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
;; we use some stuff from gnus...
|
||||
(require 'message)
|
||||
(require 'mail-parse)
|
||||
|
||||
|
||||
;; internal variables / constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(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
|
||||
(defun mm/mu-binary-version () "0.98pre")
|
||||
|
||||
|
||||
(defun mm/msg-user-agent ()
|
||||
"Return the User-Agent string for mm. This is either the value
|
||||
of `mm/user-agent', or, if not set, a string based on the
|
||||
version of mm and emacs."
|
||||
(or mm/user-agent
|
||||
(format "mu %s; emacs %s" (mm/mu-binary-version) emacs-version)))
|
||||
|
||||
(defun mm/view-body (msg)
|
||||
"Get the body for this message, which is either :body-txt,
|
||||
or if not available, :body-html converted to text)."
|
||||
(or (plist-get msg :body-txt)
|
||||
(with-temp-buffer
|
||||
(plist-get msg :body-html)
|
||||
(html2text)
|
||||
(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
|
||||
or e-mail address of its sender (or 'someone' if nothing
|
||||
else)), followed of the quoted body of MSG, constructed by by
|
||||
prepending `mm/msg-citation-prefix' to each line. If there is
|
||||
no body in MSG, return nil."
|
||||
(let* ((from (plist-get msg :from))
|
||||
;; first try plain-text, then html
|
||||
(body (or (plist-get msg :body-txt)
|
||||
(with-temp-buffer
|
||||
(plist-get msg :body-html)
|
||||
(html2text)
|
||||
(buffer-string)))))
|
||||
(when body
|
||||
(concat
|
||||
(format "On %s, %s wrote:"
|
||||
(format-time-string "%c" (plist-get msg :date))
|
||||
(if (and from (car from)) ;; a list ((<name> . <email>))
|
||||
(or (caar from) (cdar from) "someone")
|
||||
"someone"))
|
||||
"\n\n"
|
||||
(replace-regexp-in-string "^" " > " body)))))
|
||||
|
||||
(defun mm/msg-recipients-remove (lst email-to-remove)
|
||||
"Remove the recipient with EMAIL from the recipient list (of form
|
||||
'( (\"A\" . \"a@example.com\") (\"B\" . \"B@example.com\"))."
|
||||
(remove-if
|
||||
(lambda (name-email)
|
||||
(let ((email (cdr name-email)))
|
||||
(when email (string= email-to-remove (downcase email))))) lst))
|
||||
|
||||
(defun mm/msg-recipients-to-string (lst)
|
||||
"Convert a recipient list (of form '( (\"A\"
|
||||
. \"a@example.com\") (\"B\" . \"B@example.com\") (nil
|
||||
. \"c@example.com\")) into a string of form \"A <@aexample.com>, B
|
||||
<b@example.com>, c@example.com\."
|
||||
(mapconcat
|
||||
(lambda (recip)
|
||||
(let ((name (car recip)) (email (cdr recip)))
|
||||
(if name
|
||||
(format "%s <%s>" name email)
|
||||
(format "%s" email)))) lst ", "))
|
||||
|
||||
(defun mm/msg-hidden-header (hdr val)
|
||||
"Return user-invisible header to the message (HDR: VAL\n)."
|
||||
;; (format "%s: %s\n" hdr val))
|
||||
(propertize (format "%s: %s\n" hdr val) 'invisible t))
|
||||
|
||||
(defun mm/msg-header (hdr val)
|
||||
"Return a header line of the form HDR: VAL\n. If VAL is nil,
|
||||
return nil."
|
||||
(when val (format "%s: %s\n" hdr val)))
|
||||
|
||||
(defun mm/msg-references-create (msg)
|
||||
"Construct the value of the References: header based on MSG as a
|
||||
comma-separated string. Normally, this the concatenation of the
|
||||
existing References (which may be empty) and the message-id. If the
|
||||
message-id is empty, returns the old References. If both are empty,
|
||||
return nil."
|
||||
(let ((refs (plist-get msg :references))
|
||||
(msgid (plist-get msg :message-id)))
|
||||
(if msgid ;; every received message should have one...
|
||||
(mapconcat 'identity (append refs (list msgid)) ",")
|
||||
(mapconcat 'identity refs ","))))
|
||||
|
||||
(defun mm/msg-to-create (msg reply-all)
|
||||
"Construct the To: header for a reply-message based on some
|
||||
message MSG. If REPLY-ALL is nil, this the the Reply-To addresss of
|
||||
MSG if it exist, or the From:-address othewise. If reply-all is
|
||||
non-nil, the To: is what was in the old To: with either the
|
||||
Reply-To: or From: appended, and then the
|
||||
receiver (i.e. `user-mail-address') removed.
|
||||
|
||||
So:
|
||||
reply-all nil: Reply-To: or From: of MSG
|
||||
reply-all t : Reply-To: or From: of MSG + To: of MSG - `user-mail-address'
|
||||
|
||||
The result is either nil or a string which can be used for the To:-field."
|
||||
(let ((to-lst (plist-get msg :to))
|
||||
(reply-to (plist-get msg :reply-to))
|
||||
(from (plist-get msg :from)))
|
||||
(if reply-all
|
||||
(progn ;; reply-all
|
||||
(setq to-lst ;; append Reply-To:, or if not set, From: if set
|
||||
(if reply-to (cons `(nil . ,reply-to) to-lst)
|
||||
(if from (append to-lst from)
|
||||
to-lst)))
|
||||
|
||||
;; and remove myself from To:
|
||||
(setq to-lst (mm/msg-recipients-remove to-lst user-mail-address))
|
||||
(mm/msg-recipients-to-string to-lst))
|
||||
|
||||
;; reply single
|
||||
(progn
|
||||
(or reply-to (mm/msg-recipients-to-string from))))))
|
||||
|
||||
|
||||
(defun mm/msg-cc-create (msg reply-all)
|
||||
"Get the list of Cc-addresses for the reply to MSG. If REPLY-ALL
|
||||
is nil this is simply empty, otherwise it is the same list as the
|
||||
one in MSG, minus `user-mail-address'. The result of this function
|
||||
is either nil or a string to be used for the Cc: field."
|
||||
(let ((cc-lst (plist-get msg :cc)))
|
||||
(when (and reply-all cc-lst)
|
||||
(mm/msg-recipients-to-string
|
||||
(mm/msg-recipients-remove cc-lst
|
||||
user-mail-address)))))
|
||||
|
||||
(defun mm/msg-from-create ()
|
||||
"Construct a value for the From:-field of the reply to MSG,
|
||||
based on `user-full-name' and `user-mail-address'; if the latter is
|
||||
nil, function returns nil."
|
||||
(when user-mail-address
|
||||
(if user-full-name
|
||||
(format "%s <%s>" user-full-name user-mail-address)
|
||||
(format "%s" user-mail-address))))
|
||||
|
||||
(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.
|
||||
|
||||
A reply message has fields:
|
||||
From: - see `mu-msg-from-create'
|
||||
To: - see `mm/msg-to-create'
|
||||
Cc: - see `mm/msg-cc-create'
|
||||
Subject: - `mm/msg-reply-prefix' + subject of MSG
|
||||
|
||||
then, the following fields, normally hidden from user:
|
||||
Reply-To: - if `mail-reply-to' has been set
|
||||
References: - see `mm/msg-references-create'
|
||||
In-Reply-To: - message-id of MSG
|
||||
User-Agent - see `mm/msg-user-agent'
|
||||
|
||||
Then follows `mm/msg-separator' (for `message-mode' to separate
|
||||
body from headers)
|
||||
|
||||
And finally, the cited body of MSG, as per `mm/msg-cite-original'."
|
||||
(concat
|
||||
(mm/msg-header "From" (or (mm/msg-from-create) ""))
|
||||
(when (boundp 'mail-reply-to)
|
||||
(mm/msg-header "Reply-To" mail-reply-to))
|
||||
|
||||
(mm/msg-header "To" (or (mm/msg-to-create msg reply-all) ""))
|
||||
(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 "References" (mm/msg-references-create msg))
|
||||
|
||||
(mm/msg-hidden-header "In-reply-to" (plist-get msg :message-id))
|
||||
|
||||
(mm/msg-header"Subject"
|
||||
(concat mm/msg-reply-prefix (plist-get msg :subject)))
|
||||
|
||||
mm/msg-separator
|
||||
|
||||
(mm/msg-cite-original msg)))
|
||||
|
||||
;; TODO: attachments
|
||||
(defun mm/msg-create-forward (msg)
|
||||
"Create a draft forward message for MSG.
|
||||
|
||||
A forward message has fields:
|
||||
From: - see `mm/msg-from-create'
|
||||
To: - empty
|
||||
Subject: - `mm/msg-forward-prefix' + subject of MSG
|
||||
|
||||
then, the following fields, normally hidden from user:
|
||||
Reply-To: - if `mail-reply-to' has been set
|
||||
References: - see `mm/msg-references-create'
|
||||
User-Agent - see `mm/msg-user-agent'
|
||||
|
||||
Then follows `mm/msg-separator' (for `message-mode' to separate
|
||||
body from headers)
|
||||
|
||||
And finally, the cited body of MSG, as per `mm/msg-cite-original'."
|
||||
(concat
|
||||
(mm/msg-header "From" (or (mm/msg-from-for-new) ""))
|
||||
(when (boundp 'mail-reply-to)
|
||||
(mm/msg-header "Reply-To" mail-reply-to))
|
||||
|
||||
(mm/msg-header "To" "")
|
||||
(mm/msg-hidden-header "User-agent" (mm/msg-user-agent))
|
||||
(mm/msg-hidden-header "References" (mm/msg-references-for-reply msg))
|
||||
(mm/msg-header"Subject"
|
||||
(concat mm/msg-forward-prefix (plist-get msg :subject)))
|
||||
|
||||
mm/msg-separator
|
||||
|
||||
(mm/msg-cite-original msg)))
|
||||
|
||||
(defun mm/msg-create-new ()
|
||||
"Create a new message.
|
||||
|
||||
A new draft message has fields:
|
||||
From: - see `mu-msg-from-create'
|
||||
To: - empty
|
||||
Subject: - empty
|
||||
|
||||
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
|
||||
body from headers)."
|
||||
(concat
|
||||
(mm/msg-header "From" (or (mm/msg-from-create) ""))
|
||||
(when (boundp 'mail-reply-to)
|
||||
(mm/msg-header "Reply-To" mail-reply-to))
|
||||
|
||||
(mm/msg-header "To" "")
|
||||
(mm/msg-hidden-header "User-agent" (mm/msg-user-agent))
|
||||
(mm/msg-header "Subject" "")
|
||||
mm/msg-separator))
|
||||
|
||||
(defconst mm/msg-prefix "mm" "prefix for mm-generated
|
||||
mail files; we use this to ensure that our hooks don't mess
|
||||
with non-mm-generated messages")
|
||||
|
||||
(defun mm/msg-draft-file-name ()
|
||||
"Create a Maildir-compatible[1], unique file name for a draft
|
||||
message.
|
||||
[1]: see http://cr.yp.to/proto/maildir.html"
|
||||
(format "%s-%s-%x.%s:2,D" ;; 'D': rarely used, but hey, it's available
|
||||
mm/msg-prefix
|
||||
(format-time-string "%Y%m%d" (current-time))
|
||||
(emacs-pid)
|
||||
(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.")
|
||||
|
||||
(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.
|
||||
|
||||
For replies/forewards, you can specify PARENT-DOCID so the
|
||||
corresponding message can get its Passed or Replied flag set when
|
||||
this one is sent. If PARENT-DOCID is specified, also
|
||||
reply-or-forward should be specified, which is a symbol, either
|
||||
'reply or 'forward.
|
||||
|
||||
The name of the draft folder is constructed from the concatenation of
|
||||
`mm/maildir' and `mm/drafts-folder' (therefore, these must be set).
|
||||
|
||||
The message file name is a unique name determined by
|
||||
`mm/msg-draft-file-name'.
|
||||
|
||||
The initial STR would be created from either `mm/msg-create-reply',
|
||||
`mm/msg-create-forward' or `mm/msg-create-new'. The editing buffer is
|
||||
using Gnus' `message-mode'."
|
||||
(unless mm/maildir (error "mm/maildir not set"))
|
||||
(unless mm/drafts-folder (error "mm/drafts-folder not set"))
|
||||
|
||||
;; write our draft message to the the drafts folder
|
||||
(let ((draftfile (concat mm/maildir "/" mm/drafts-folder "/cur/"
|
||||
(mm/msg-draft-file-name))))
|
||||
(with-temp-file draftfile (insert str))
|
||||
(find-file draftfile) (rename-buffer mm/msg-draft-name t)
|
||||
|
||||
(message-mode)
|
||||
|
||||
(make-local-variable 'mm/send-reply-docid)
|
||||
(make-local-variable 'mm/send-forward-docid)
|
||||
|
||||
(if (eq reply-or-forward 'reply)
|
||||
(setq mm/send-reply-docid parent-docid)
|
||||
(setq mm/send-forward-docid parent-docid))
|
||||
|
||||
(message-goto-body)))
|
||||
|
||||
|
||||
(defun mm/send-compose-handler (msg reply-or-forward)
|
||||
"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.
|
||||
|
||||
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
|
||||
(let* ((recipnum (+ (length (plist-get msg :to))
|
||||
(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)? "
|
||||
(+ recipnum))))))
|
||||
;; exact num depends on some more things
|
||||
(when (mm/msg-compose (mm/msg-create-reply msg replyall) parent-docid 'reply)
|
||||
(message-goto-body))))))
|
||||
|
||||
|
||||
|
||||
(defun mm/msg-save-to-sent ()
|
||||
"Move the message in this buffer to the sent folder. This is
|
||||
meant to be called from message mode's `message-sent-hook'."
|
||||
(when (mm/msg-is-mm-message) ;; only if we are mm
|
||||
(unless mm/sent-folder (error "mm/sent-folder not set"))
|
||||
;; we don't know the draft message is already in the database...
|
||||
;;
|
||||
;; ;; TODO: remove duplicate flags
|
||||
;; ((newflags ;; remove Draft; maybe set 'Seen' as well?
|
||||
;; (delq 'draft (mm/msg-flags-from-path (buffer-file-name))))
|
||||
;; ;; so, we register path => uid, then we move uid, then check the name
|
||||
;; ;; uid is referring to
|
||||
;; (uid (mm/msg-register (buffer-file-name)))
|
||||
;; (if (mm/msg-move uid
|
||||
;; (concat mm/maildir mm/sent-folder)
|
||||
;; (mm/msg-flags-to-string newflags))
|
||||
;; (set-visited-file-name (mm/msg-get-path uid) t t)
|
||||
;; (error "Failed to save message to the Sent-folder"))))))
|
||||
))
|
||||
|
||||
(defun mm/send-set-parent-flag ()
|
||||
"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.
|
||||
|
||||
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")))
|
||||
|
||||
|
||||
;; hook our functions up with sending of the message
|
||||
;;(add-hook 'message-sent-hook 'mm/msg-save-to-sent)
|
||||
(add-hook 'message-sent-hook 'mm/send-set-parent-flag)
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; some interactive function
|
||||
|
||||
(defun mm/compose-new ()
|
||||
"Create a draft message, and switch to an edit buffer with the
|
||||
draft message."
|
||||
(interactive)
|
||||
(when (mm/msg-compose (mm/msg-create-new))
|
||||
(message-goto-to)))
|
||||
|
||||
|
||||
(provide 'mm-send)
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,253 @@
|
|||
;; mm-view.el -- part of mm, the mu mail user agent
|
||||
;;
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; 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:')
|
||||
|
||||
;; mm
|
||||
|
||||
;;; Code:
|
||||
(eval-when-compile (require 'cl))
|
||||
(require 'mm-common)
|
||||
(require 'html2text)
|
||||
|
||||
(defconst mm/view-buffer-name "*mm-view*"
|
||||
"*internal* Name for the message view buffer")
|
||||
|
||||
;; some buffer-local variables
|
||||
(defvar mm/hdrs-buffer nil
|
||||
"*internal* Headers buffer connected to this view.")
|
||||
|
||||
(defvar mm/current-msg nil
|
||||
"*internal* The plist describing the current message.")
|
||||
|
||||
(defun mm/view (msg hdrsbuf)
|
||||
"Display the message MSG in a new buffer, and keep in sync with HDRSBUF.
|
||||
'In sync' here means that moving to the next/previous message in
|
||||
the the message view affects HDRSBUF, as does marking etc.
|
||||
|
||||
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))
|
||||
(with-current-buffer buf
|
||||
(erase-buffer)
|
||||
(insert
|
||||
(mapconcat
|
||||
(lambda (field)
|
||||
(case field
|
||||
(:subject (mm/view-header "Subject" (plist-get msg :subject)))
|
||||
(:path (mm/view-header "Path" (plist-get msg :path)))
|
||||
(:to (mm/view-contacts msg field))
|
||||
(:from (mm/view-contacts msg field))
|
||||
(:cc (mm/view-contacts msg field))
|
||||
(:bcc (mm/view-contacts msg field))
|
||||
(:date
|
||||
(let* ((date (plist-get msg :date))
|
||||
(datestr (when date (format-time-string "%c" date))))
|
||||
(if datestr (mm/view-header "Date" datestr) "")))
|
||||
|
||||
(:flags "") ;; TODO
|
||||
(:maildir (mm/view-header "Maildir" (plist-get msg :maildir)))
|
||||
(:size (mm/view-size msg)
|
||||
(let* ((size (plist-get msg :size))
|
||||
(sizestr (when size (format "%d bytes"))))
|
||||
(if sizestr (mm/view-header "Size" sizestr))))
|
||||
|
||||
(:attachments "") ;; TODO
|
||||
(t (error "Unsupported field: %S" field))))
|
||||
mm/view-headers "")
|
||||
"\n"
|
||||
(mm/view-body msg))
|
||||
(mm/view-mode)
|
||||
(setq
|
||||
mode-name (format "%s" mm/view-buffer-name (plist-get msg :docid))
|
||||
;; these are buffer-local
|
||||
mm/current-msg msg
|
||||
mm/hdrs-buffer hdrsbuf)
|
||||
(switch-to-buffer buf)
|
||||
(goto-char (point-min)))))
|
||||
|
||||
|
||||
(defun mm/view-body (msg)
|
||||
"Get the body for this message, which is either :body-txt,
|
||||
or if not available, :body-html converted to text)."
|
||||
(or (plist-get msg :body-txt)
|
||||
(with-temp-buffer
|
||||
(plist-get msg :body-html)
|
||||
(html2text)
|
||||
(buffer-string))
|
||||
"No body found"))
|
||||
|
||||
|
||||
(defun mm/view-header (key val)
|
||||
"Show header FIELD for MSG with KEY. ie. <KEY>: value-of-FIELD\n."
|
||||
(if val
|
||||
(concat
|
||||
(propertize key 'face 'mm/view-header-key-face) ": "
|
||||
(propertize val 'face 'mm/view-header-value-face) "\n")
|
||||
""))
|
||||
|
||||
|
||||
(defun mm/view-contacts (msg field)
|
||||
(unless (member field '(:to :from :bcc :cc)) (error "Wrong type"))
|
||||
(let* ((lst (plist-get msg field))
|
||||
(contacts
|
||||
(when lst
|
||||
(mapconcat
|
||||
(lambda(c)
|
||||
(let ((name (car c)) (email (cdr c)))
|
||||
(if name
|
||||
(format "%s <%s>" name email)
|
||||
(format "%s" email)))) lst ", "))))
|
||||
(if contacts
|
||||
(mm/view-header
|
||||
(case field (:to "To") (:from "From") (:bcc "Bcc") (:cc "Cc"))
|
||||
contacts)
|
||||
"")))
|
||||
|
||||
|
||||
(defvar mm/view-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "q" 'mm/view-quit-buffer)
|
||||
|
||||
(define-key map "s" 'mm/search)
|
||||
(define-key map "j" 'mm/jump-to-maildir)
|
||||
|
||||
;; (define-key map "f" 'mua/view-forward)
|
||||
;; (define-key map "r" 'mua/view-reply)
|
||||
;; (define-key map "c" 'mua/view-compose)
|
||||
|
||||
;; navigation between messages
|
||||
(define-key map "n" 'mm/view-next)
|
||||
(define-key map "p" 'mm/view-prev)
|
||||
|
||||
;; marking/unmarking
|
||||
(define-key map "d" 'mm/view-mark-for-trash)
|
||||
(define-key map "D" 'mm/view-mark-for-delete)
|
||||
(define-key map "m" 'mm/view-mark-for-move)
|
||||
|
||||
;; next two only warn user
|
||||
(define-key map "u" 'mm/view-unmark)
|
||||
(define-key map "U" 'mm/view-unmark)
|
||||
|
||||
(define-key map "x" 'mm/view-marked-execute)
|
||||
map)
|
||||
"Keymap for \"*mm-view*\" buffers.")
|
||||
(fset 'mm/view-mode-map mm/view-mode-map)
|
||||
|
||||
|
||||
(defun mm/view-mode ()
|
||||
"Major mode for viewing an e-mail message."
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(use-local-map mm/view-mode-map)
|
||||
|
||||
(make-local-variable 'mm/hdrs-buffer)
|
||||
(make-local-variable 'mm/current-msg)
|
||||
|
||||
(setq major-mode 'mm/view-mode mode-name mm/view-buffer-name)
|
||||
(setq truncate-lines t buffer-read-only t))
|
||||
|
||||
|
||||
;;;;;;
|
||||
|
||||
|
||||
;; we mark messages are as read when we leave the message; ie., when skipping to
|
||||
;; the next/previous one, or leaving the view buffer altogether.
|
||||
|
||||
(defun mm/view-mark-as-read-maybe ()
|
||||
"Clear the current message's New/Unread status and set it to
|
||||
Seen; if the message is not New/Unread, do nothing."
|
||||
(when mm/current-msg
|
||||
(let ((flags (plist-get mm/current-msg :flags))
|
||||
(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")))))
|
||||
|
||||
;; Interactive functions
|
||||
|
||||
(defun mm/view-quit-buffer ()
|
||||
"Quit the message view and return to the headers."
|
||||
(interactive)
|
||||
(mm/view-mark-as-read-maybe)
|
||||
(let ((inhibit-read-only t))
|
||||
(kill-buffer)
|
||||
(switch-to-buffer mm/hdrs-buffer)))
|
||||
|
||||
(defun mm/view-next ()
|
||||
"View the next message."
|
||||
(interactive)
|
||||
(mm/view-mark-as-read-maybe)
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(when (mm/next-header)
|
||||
(mm/hdrs-view))))
|
||||
|
||||
(defun mm/view-prev ()
|
||||
"View the previous message."
|
||||
(interactive)
|
||||
(mm/view-mark-as-read-maybe)
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(when (mm/prev-header)
|
||||
(mm/hdrs-view))))
|
||||
|
||||
(defun mm/view-mark-for-trash ()
|
||||
"Mark the viewed message to be moved to the trash folder."
|
||||
(interactive)
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(when (mm/mark-for-trash)
|
||||
(mm/hdrs-view))))
|
||||
|
||||
(defun mm/view-mark-for-delete ()
|
||||
"Mark the viewed message to be deleted."
|
||||
(interactive)
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(when (mm/mark-for-trash)
|
||||
(mm/hdrs-view))))
|
||||
|
||||
(defun mm/view-mark-for-move ()
|
||||
"Mark the viewed message to be moved to some folder."
|
||||
(interactive)
|
||||
(with-current-buffer mm/hdrs-buffer
|
||||
(when (mm/mark-for-move)
|
||||
(mm/view-next))))
|
||||
|
||||
(defun mm/view-unmark ()
|
||||
"Warn user that unmarking only works in the header list."
|
||||
(interactive)
|
||||
(message "Unmarking needs to be done in the header list view"))
|
||||
|
||||
|
||||
(defun mm/view-marked-execute ()
|
||||
"Warn user that execution can only take place in n the header
|
||||
list."
|
||||
(interactive)
|
||||
(message "Execution needs to be done in the header list view"))
|
||||
|
||||
|
||||
(provide 'mm-view)
|
||||
233
toys/mm/mm.el
233
toys/mm/mm.el
|
|
@ -1,4 +1,4 @@
|
|||
;;; mm.el -- part of mm, the mu mail user agent
|
||||
|
||||
;;
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
|
|
@ -28,9 +28,9 @@
|
|||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(add-to-list 'load-path "/home/djcb/Sources/mu/toys/mm")
|
||||
|
||||
(require 'mm-hdrs)
|
||||
(require 'mm-view)
|
||||
(require 'mm-send)
|
||||
(require 'mm-common)
|
||||
(require 'mm-proc)
|
||||
|
||||
|
|
@ -60,6 +60,15 @@ PATH, you can specifiy the full path."
|
|||
:group 'mm)
|
||||
|
||||
|
||||
(defcustom mm/get-mail-command nil
|
||||
"Shell command to run to retrieve new mail; e.g. 'offlineimap' or
|
||||
'fetchmail'."
|
||||
:type 'string
|
||||
:group 'mm
|
||||
:safe 'stringp)
|
||||
|
||||
|
||||
|
||||
;; Folders
|
||||
|
||||
(defgroup mm/folders nil
|
||||
|
|
@ -97,6 +106,47 @@ PATH, you can specifiy the full path."
|
|||
:safe 'stringp
|
||||
:group 'mm/folders)
|
||||
|
||||
|
||||
(defgroup mm/view nil
|
||||
"Settings for the message view."
|
||||
:group 'mm)
|
||||
|
||||
;; the message view
|
||||
|
||||
(defcustom mm/view-headers
|
||||
'(:from :to :cc :subject :flags :date :maildir :path :attachments)
|
||||
"Header fields to display in the message view buffer."
|
||||
:type (list 'symbol)
|
||||
:group 'mm/view)
|
||||
|
||||
|
||||
;; Composing / Sending messages
|
||||
(defgroup mm/compose nil
|
||||
"Customizations for composing/sending messages."
|
||||
:group 'mm)
|
||||
|
||||
(defcustom mm/msg-citation-prefix "> "
|
||||
"String to prefix cited message parts with."
|
||||
:type 'string
|
||||
:group 'mm/compose)
|
||||
|
||||
(defcustom mm/msg-reply-prefix "Re: "
|
||||
"String to prefix the subject of replied messages with."
|
||||
:type 'string
|
||||
:group 'mm/compose)
|
||||
|
||||
(defcustom mm/msg-forward-prefix "Fwd: "
|
||||
"String to prefix the subject of forwarded messages with."
|
||||
:type 'string
|
||||
:group 'mm/compose)
|
||||
|
||||
(defcustom mm/user-agent nil
|
||||
"The user-agent string; leave at `nil' for the default."
|
||||
:type 'string
|
||||
:group 'mm/compose)
|
||||
|
||||
|
||||
|
||||
;; Faces
|
||||
|
||||
(defgroup mm/faces nil
|
||||
|
|
@ -110,43 +160,170 @@ PATH, you can specifiy the full path."
|
|||
:group 'mm/faces)
|
||||
|
||||
(defface mm/moved-face
|
||||
'((t :inherit font-lock-comment-face :italic t))
|
||||
"Face for an mm message header that has been moved from the
|
||||
search results."
|
||||
'((t :inherit font-lock-comment-face :slant italic))
|
||||
"Face for an mm message header that has been moved to some
|
||||
folder (it's still visible in the search results, since we cannot
|
||||
be sure it no longer matches)."
|
||||
:group 'mm/faces)
|
||||
|
||||
(defface mm/trashed-face
|
||||
'((t :inherit font-lock-comment-face :strike-though t))
|
||||
"Face for an message header in the trash folder."
|
||||
:group 'mm/faces)
|
||||
|
||||
(defface mm/header-face
|
||||
'((t :inherit default))
|
||||
"Face for an mm header without any special flags."
|
||||
:group 'deft-faces)
|
||||
:group 'mm/faces)
|
||||
|
||||
(defface mm/title-face
|
||||
'((t :inherit font-lock-type-face))
|
||||
"Face for an mm title."
|
||||
:group 'mm/faces)
|
||||
|
||||
(defface mm/view-header-key-face
|
||||
'((t :inherit font-lock-builtin-face))
|
||||
"Face for the header title (such as \"Subject\" in the message view)."
|
||||
:group 'mm/faces)
|
||||
|
||||
(defface mm/view-header-value-face
|
||||
'((t :inherit font-lock-doc-face))
|
||||
"Face for the header value (such as \"Re: Hello!\" in the message view)."
|
||||
:group 'mm/faces)
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; FIXME
|
||||
(setq
|
||||
mm/maildir "/home/djcb/Maildir"
|
||||
mm/inbox-folder "/inbox"
|
||||
mm/outbox-folder "/outbox"
|
||||
mm/sent-folder "/sent"
|
||||
mm/drafts-folder "/drafts"
|
||||
mm/trash-folder "/trash")
|
||||
|
||||
(defvar mm/working-folders nil)
|
||||
|
||||
(setq mm/working-folders
|
||||
'("/bulk" "/archive" "/bulkarchive" "/todo"))
|
||||
|
||||
(setq mm/header-fields
|
||||
'( (:date . 25)
|
||||
(:flags . 6)
|
||||
(:from . 22)
|
||||
(:subject . 40)))
|
||||
|
||||
;;; my stuff
|
||||
(setq mm/mu-binary "/home/djcb/Sources/mu/src/mu")
|
||||
(setq mm/mu-home "/home/djcb/.mu")
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; internal variables / constant
|
||||
(defconst mm/mm-buffer-name "*mm*"
|
||||
"*internal* Name of the mm main buffer.")
|
||||
|
||||
(defvar mm/mu-version nil
|
||||
"*interal* version of the mu binary")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; mm mode + keybindings
|
||||
(defvar mm/mm-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
|
||||
(define-key map "I" 'mm/jump-to-inbox)
|
||||
(define-key map "S" 'mm/search-today)
|
||||
(define-key map "W" 'mm/search-last-7-days)
|
||||
(define-key map "U" 'mm/search-unread)
|
||||
|
||||
(define-key map "s" 'mm/search)
|
||||
(define-key map "q" 'mm/quit-mm)
|
||||
(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 "u" 'mm/update-database)
|
||||
|
||||
map)
|
||||
"Keymap for the *mm* buffer.")
|
||||
(fset 'mm/mm-mode-map mm/mm-mode-map)
|
||||
|
||||
(defun mm/mm-mode ()
|
||||
"Major mode for the mm main screen."
|
||||
(interactive)
|
||||
|
||||
(kill-all-local-variables)
|
||||
(use-local-map mm/mm-mode-map)
|
||||
|
||||
(setq
|
||||
mm/marks-map (make-hash-table :size 16 :rehash-size 2)
|
||||
major-mode 'mm/mm-mode
|
||||
mode-name "*mm*"
|
||||
truncate-lines t
|
||||
buffer-read-only t
|
||||
overwrite-mode 'overwrite-mode-binary))
|
||||
|
||||
(defun mm()
|
||||
"Start mm."
|
||||
(interactive)
|
||||
(let ((buf (get-buffer-create mm/mm-buffer-name))
|
||||
(inhibit-read-only t))
|
||||
(with-current-buffer buf
|
||||
(erase-buffer)
|
||||
(insert
|
||||
"* "
|
||||
(propertize "mm - mail for emacs\n" 'face 'mm/title-face)
|
||||
"\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"
|
||||
" - Received " (propertize "T" 'face 'highlight) "oday\n"
|
||||
" - Received this " (propertize "W" 'face 'highlight) "eek\n"
|
||||
"\n"
|
||||
" * " (propertize "j" 'face 'highlight) "ump to a folder\n"
|
||||
" * " (propertize "s" 'face 'highlight) "earch for a specific message\n"
|
||||
"\n"
|
||||
" * " (propertize "c" 'face 'highlight) "ompose a new message\n"
|
||||
"\n"
|
||||
" * " (propertize "r" 'face 'highlight) "etrieve new mail\n"
|
||||
" * " (propertize "u" 'face 'highlight) "update the message database\n"
|
||||
"\n"
|
||||
" * " (propertize "q" 'face 'highlight) "uit mm\n")
|
||||
|
||||
(mm/mm-mode)
|
||||
(switch-to-buffer buf))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; interactive functions
|
||||
|
||||
(defun mm/jump-to-inbox ()
|
||||
"Jump to your Inbox folder (as specified in `mm/inbox-folder')."
|
||||
(interactive)
|
||||
(mm/hdrs-search (concat "maildir:" mm/inbox-folder)))
|
||||
|
||||
(defun mm/search-unread ()
|
||||
"List all your unread messages."
|
||||
(interactive)
|
||||
(mm/hdrs-search "flag:unread AND NOT flag:trashed"))
|
||||
|
||||
(defun mm/search-today ()
|
||||
"List messages received today."
|
||||
(interactive)
|
||||
(mm/hdrs-search "date:today..now"))
|
||||
|
||||
(defun mm/search-last-7-days ()
|
||||
"List messages received in the last 7 days."
|
||||
(interactive)
|
||||
(mm/hdrs-search "flag:7d..now"))
|
||||
|
||||
(defun mm/retrieve-mail ()
|
||||
"Get new mail."
|
||||
(interactive)
|
||||
(unless mm/get-mail-command
|
||||
(error "`mm/get-mail-command' is not set"))
|
||||
(when (y-or-n-p "Sure you want to retrieve new mail?")
|
||||
(shell-command mm/get-mail-command)))
|
||||
|
||||
(defun mm/update-database ()
|
||||
"Update the database (ie., 'mu index')."
|
||||
(interactive)
|
||||
(unless mm/maildir (error "`mm/maildir' not set"))
|
||||
(when (y-or-n-p "Sure you want to update the database?")
|
||||
(mm/proc-index mm/maildir)))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
||||
(defun mm/quit-mm()
|
||||
"Quit the mm session."
|
||||
(interactive)
|
||||
(when (y-or-n-p "Are you sure you want to quit mm? ")
|
||||
(message nil)
|
||||
(mm/kill-proc)
|
||||
(kill-buffer)))
|
||||
|
||||
|
||||
(provide 'mm)
|
||||
|
|
|
|||
Loading…
Reference in New Issue