* emacs updates
This commit is contained in:
Dirk-Jan C. Binnema
@ -1,7 +1,7 @@
|
|||||||
VERSION=$(shell git describe --tags --dirty)
|
VERSION=$(shell git describe --tags --dirty)
|
||||||
EMACS=emacs
|
EMACS=emacs
|
||||||
PREFIX=/usr/local
|
PREFIX=/usr/local
|
||||||
ELS=mu.el mu-common.el mu-view.el mu-find.el
|
ELS=mu.el mu-common.el mu-view.el mu-headers.el
|
||||||
ELCS=$(ELS:.el=.elc)
|
ELCS=$(ELS:.el=.elc)
|
||||||
|
|
||||||
.PHONY=install
|
.PHONY=install
|
||||||
|
|||||||
@ -53,19 +53,16 @@ notation) for the mail view and in replied/forwarded message quotations")
|
|||||||
(defface mu-body-face '((t (:foreground "#8cd0d3"))) "")
|
(defface mu-body-face '((t (:foreground "#8cd0d3"))) "")
|
||||||
(defface mu-header-face '((t (:foreground "#7f9f7f"))) "")
|
(defface mu-header-face '((t (:foreground "#7f9f7f"))) "")
|
||||||
(defface mu-size-face '((t (:foreground "#889f7f"))) "")
|
(defface mu-size-face '((t (:foreground "#889f7f"))) "")
|
||||||
(defface mu-body-face '((t (:foreground "#dcdccc"))) "")
|
|
||||||
(defface mu-flag-face '((t (:foreground "#dc56cc"))) "")
|
(defface mu-flag-face '((t (:foreground "#dc56cc"))) "")
|
||||||
(defface mu-flag-face '((t (:foreground "#7f6677"))) "")
|
(defface mu-path-face '((t (:foreground "#dc56cc"))) "")
|
||||||
|
|
||||||
|
|
||||||
(defface mu-unread-face '((t (:bold t))) "")
|
(defface mu-unread-face '((t (:bold t))) "")
|
||||||
(defface mu-face '((t (:foreground "Gray" :italic t))) "")
|
(defface mu-face '((t (:foreground "Gray" :italic t))) "")
|
||||||
|
|
||||||
(defvar mu-own-address "djcb" "regexp matching my own address")
|
(defvar mu-own-address "djcb" "regexp matching my own address")
|
||||||
|
|
||||||
|
|
||||||
;;; internal stuff
|
;;; internal stuff
|
||||||
(defvar mu-parent-buf nil "the parent buffer for a
|
(defvar mu-parent-buffer nil "the parent buffer for a
|
||||||
buffer (buffer-local), i.e., the buffer we'll return to when this
|
buffer (buffer-local), i.e., the buffer we'll return to when this
|
||||||
buffer is killed")
|
buffer is killed")
|
||||||
|
|
||||||
@ -89,14 +86,14 @@ buffer is killed")
|
|||||||
etc.)"
|
etc.)"
|
||||||
(propertize str 'face 'mu-face 'intangible t))
|
(propertize str 'face 'mu-face 'intangible t))
|
||||||
|
|
||||||
(setq mu-find-fields
|
(setq mu-headers-fields
|
||||||
'(
|
'(
|
||||||
(:date . 20)
|
(:date . 20)
|
||||||
(:flags . 4)
|
(:flags . 4)
|
||||||
(:from-or-to . 22)
|
(:from-or-to . 22)
|
||||||
(:size . 8)
|
(:size . 8)
|
||||||
(:subject . 40)))
|
(:subject . 40)))
|
||||||
(setq mu-find-date-format "%x %X")
|
(setq mu-headers-date-format "%x %X")
|
||||||
|
|
||||||
(setq mu-header-fields
|
(setq mu-header-fields
|
||||||
'( :from
|
'( :from
|
||||||
@ -176,102 +173,16 @@ Lisp data as a plist. Returns nil in case of error"
|
|||||||
(defun mu-quit-buffer ()
|
(defun mu-quit-buffer ()
|
||||||
"kill this buffer, and switch to it's parentbuf if it is alive"
|
"kill this buffer, and switch to it's parentbuf if it is alive"
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((parentbuf (mu-parent-buf)))
|
(let ((parentbuf mu-parent-buffer))
|
||||||
(kill-buffer)
|
(kill-buffer)
|
||||||
(when (buffer-live-p parentbuf)
|
(when (and parentbuf (buffer-live-p parentbuf))
|
||||||
(switch-to-buffer parentbuf))))
|
(switch-to-buffer parentbuf))))
|
||||||
|
|
||||||
(defun mu-get-marked ()
|
(defun mu-get-new-buffer (bufname)
|
||||||
"get all marked messages as a list; each element is a cell;
|
"return a new buffer BUFNAME; if such already exists, kill the
|
||||||
with 'action', 'source' , 'target'). ie one of three:
|
old one first"
|
||||||
('delete <path>)
|
(when (get-buffer bufname)
|
||||||
('trash <path> <target>)
|
(kill-buffer bufname))
|
||||||
('move <path> <target>)"
|
(get-buffer-create bufname))
|
||||||
(let ((lst))
|
|
||||||
(with-current-buffer mu-find-buffer-name
|
|
||||||
(save-excursion
|
|
||||||
(goto-char (point-min))
|
|
||||||
(while (re-search-forward "^." nil t)
|
|
||||||
(let* ((char0 (match-string 0))
|
|
||||||
(action (get-text-property 0 'action char0))
|
|
||||||
(path (get-text-property 0 'path char0))
|
|
||||||
(target (get-text-property 0 'target char0)))
|
|
||||||
(cond
|
|
||||||
((eq action 'trash)
|
|
||||||
(setq lst (cons (list 'trash path target) lst)))
|
|
||||||
((eq action 'delete)
|
|
||||||
(setq lst (cons (list 'delete path) lst)))
|
|
||||||
((eq action 'move)
|
|
||||||
(setq lst (cons (list 'move path target) lst))))))))
|
|
||||||
lst))
|
|
||||||
|
|
||||||
(defun mu-execute ()
|
|
||||||
"execute marked actions on messages"
|
|
||||||
(interactive)
|
|
||||||
(let* ((markedcount (mu-count-marked))
|
|
||||||
(movenum (nth 0 markedcount)) (trashnum (nth 1 markedcount))
|
|
||||||
(deletenum (nth 2 markedcount)))
|
|
||||||
(if (= 0 (apply '+ markedcount))
|
|
||||||
(message "No messages are marked")
|
|
||||||
(if (and (< 0 movenum)
|
|
||||||
(y-or-n-p (format "Do you want to move %d message(s)?" movenum)))
|
|
||||||
(message "Moving message(s)"))
|
|
||||||
(if (and (< 0 trashnum)
|
|
||||||
(y-or-n-p (format "Do you want to move %d message(s) to trash?" trashnum)))
|
|
||||||
(message "Trashing message(s)"))
|
|
||||||
(if (and (< 0 deletenum)
|
|
||||||
(yes-or-no-p (format "Do you want to permanently delete %d message(s)?"
|
|
||||||
deletenum)))
|
|
||||||
(message "Deleting message(s)"))
|
|
||||||
(mu-find-refresh))))
|
|
||||||
|
|
||||||
|
|
||||||
(defun mu-foreach-marked (func)
|
|
||||||
"call FUNC for each marked message; the argument to FUNC is a list, either:
|
|
||||||
with 'action', 'source' , 'target'). ie one of three:
|
|
||||||
('delete <path>)
|
|
||||||
('trash <path> <target>)
|
|
||||||
('move <path> <target>)"
|
|
||||||
(with-current-buffer mu-find-buffer-name
|
|
||||||
(save-excursion
|
|
||||||
(goto-char (point-min))
|
|
||||||
(while (re-search-forward "^." nil t)
|
|
||||||
(move-beginning-of-line 1)
|
|
||||||
(let* ((char0 (match-string 0))
|
|
||||||
(action (get-text-property 0 'action char0))
|
|
||||||
(path (get-text-property 0 'path char0))
|
|
||||||
(target (get-text-property 0 'target char0)))
|
|
||||||
(cond
|
|
||||||
((eq action 'trash) (funcall func (list 'trash path target)))
|
|
||||||
((eq action 'delete) (funcall func (list 'delete path)))
|
|
||||||
((eq action 'move) (funcall func (list 'move path target)))))
|
|
||||||
(move-end-of-line 1)))))
|
|
||||||
|
|
||||||
(defun mu-count-marked ()
|
|
||||||
"return a vector with three items (marked-move marked-trash
|
|
||||||
marked-delete) which are the number of messages marked for each
|
|
||||||
of those"
|
|
||||||
(let ((result (make-vector 3 0)))
|
|
||||||
(mu-foreach-marked
|
|
||||||
(lambda (cell)
|
|
||||||
(case (car cell)
|
|
||||||
('move (aset result 0 (+ 1 (aref result 0))))
|
|
||||||
('trash (aset result 1 (+ 1 (aref result 1))))
|
|
||||||
('delete (aset result 2 (+ 1 (aref result 2)))))))
|
|
||||||
(append result nil))) ;; convert to list
|
|
||||||
|
|
||||||
(defun mu-unmark-all ()
|
|
||||||
"unmark all messages"
|
|
||||||
(interactive)
|
|
||||||
(let ((marked 0))
|
|
||||||
(mu-foreach-marked (lambda(cell) (setq marked (+ 1 marked))))
|
|
||||||
(if (= 0 marked)
|
|
||||||
(message "No messages are marked")
|
|
||||||
(when (y-or-n-p (format "Unmark %d message(s)?" marked))
|
|
||||||
(mu-foreach-marked
|
|
||||||
(lambda(cell)
|
|
||||||
(let ((inhibit-read-only t))
|
|
||||||
(delete-char 1)
|
|
||||||
(insert-and-inherit " "))))))))
|
|
||||||
|
|
||||||
(provide 'mu-common)
|
(provide 'mu-common)
|
||||||
|
|||||||
349
emacs/mu-find.el
349
emacs/mu-find.el
@ -1,349 +0,0 @@
|
|||||||
;;; mu-find.el -- use `mu' from emacs
|
|
||||||
;; 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:
|
|
||||||
|
|
||||||
;;; Code:
|
|
||||||
|
|
||||||
(require 'mu-common)
|
|
||||||
|
|
||||||
(defvar mu-find-fields
|
|
||||||
'( (:date . 25)
|
|
||||||
(:from-or-to . 22)
|
|
||||||
(:subject . 40))
|
|
||||||
"a list of fields and their widths")
|
|
||||||
|
|
||||||
(defvar mu-find-sort-field "date"
|
|
||||||
"shortcut of the field to sort on (see mu-find (1))")
|
|
||||||
(defvar mu-find-sort-descending nil
|
|
||||||
"whether to sort in descending order")
|
|
||||||
|
|
||||||
;; internal stuff
|
|
||||||
(defconst mu-find-buffer-name " *mu-find*" "name of the mu
|
|
||||||
results buffer; name should start with a space")
|
|
||||||
(defvar mu-find-process nil "the possibly running find process")
|
|
||||||
(defconst mu-find-process-name "*<mu-find-process>*" "name of the mu
|
|
||||||
results buffer; name should start with a space")
|
|
||||||
(defconst mu-eom "\n;;eom\n" "marker for the end of message in
|
|
||||||
the mu find output")
|
|
||||||
(defvar mu-find-expression nil
|
|
||||||
"search expression for the current find buffer")
|
|
||||||
|
|
||||||
(defvar mu-buf "" "buffer for results data")
|
|
||||||
(defun mu-find-process-filter (proc str)
|
|
||||||
"process-filter for the 'mu find --format=sexp output; it
|
|
||||||
accumulates the strings into valid sexps by checking of the
|
|
||||||
';;eom' end-of-msg marker, and then evaluating them"
|
|
||||||
(with-current-buffer mu-find-buffer-name
|
|
||||||
(save-excursion
|
|
||||||
(setq mu-buf (concat mu-buf str))
|
|
||||||
(let ((eom (string-match mu-eom mu-buf)))
|
|
||||||
(while (numberp eom)
|
|
||||||
(let* ((msg (car (read-from-string (substring mu-buf 0 eom))))
|
|
||||||
(inhibit-read-only t))
|
|
||||||
(goto-char (point-max))
|
|
||||||
(save-match-data (insert (mu-find-header msg) ?\n)))
|
|
||||||
(setq mu-buf (substring mu-buf (match-end 0)))
|
|
||||||
(setq eom (string-match mu-eom mu-buf)))))))
|
|
||||||
|
|
||||||
|
|
||||||
(defun mu-find-process-sentinel (proc msg)
|
|
||||||
"Check the mu-find process upon completion"
|
|
||||||
(let ((status (process-status proc))
|
|
||||||
(exit-status (process-exit-status proc)))
|
|
||||||
(if (memq status '(exit signal))
|
|
||||||
(let ((inhibit-read-only t)
|
|
||||||
(text
|
|
||||||
(cond
|
|
||||||
((eq status 'signal)
|
|
||||||
"Search process killed (results incomplete)")
|
|
||||||
((eq status 'exit)
|
|
||||||
(cond
|
|
||||||
((= 0 exit-status) "End of search results")
|
|
||||||
((= 2 exit-status) "No matches found")
|
|
||||||
((= 4 exit-status) "Database problem; try running 'mu index'")
|
|
||||||
(t (format "Some error occured; mu-find returned %d"
|
|
||||||
exit-status))))
|
|
||||||
(t "Unknown status")))) ;; shouldn't happen
|
|
||||||
(when (get-buffer mu-find-buffer-name)
|
|
||||||
(with-current-buffer mu-find-buffer-name
|
|
||||||
(save-excursion
|
|
||||||
(goto-char (point-max))
|
|
||||||
(insert (mu-str text)))))))))
|
|
||||||
|
|
||||||
|
|
||||||
;; Note, the 'mu find --format=sexp' sexp is almost the same as the ones that
|
|
||||||
;; 'mu view --format=sexp' produces (see mu-get-message), with the difference
|
|
||||||
;; that former may give more than one result, and that mu-find output comes from
|
|
||||||
;; the database rather than file, and does _not_ contain the message body
|
|
||||||
(defun mu-find (expr)
|
|
||||||
"search in the mu database"
|
|
||||||
(interactive "s[mu] match expr: ")
|
|
||||||
(let* ((output (get-buffer mu-find-buffer-name)))
|
|
||||||
(when output (kill-buffer output))
|
|
||||||
(setq output (get-buffer-create mu-find-buffer-name) mu-buf "")
|
|
||||||
(let* ((dummy-arg "--fields=\"dummy\"") ;; ignored
|
|
||||||
(proc
|
|
||||||
(start-process mu-find-process-name mu-find-process-name
|
|
||||||
mu-binary
|
|
||||||
"find"
|
|
||||||
(if mu-home
|
|
||||||
(concat "--muhome=" mu-home) dummy-arg)
|
|
||||||
(if mu-find-sort-field
|
|
||||||
(concat "--sortfield=" mu-find-sort-field) dummy-arg)
|
|
||||||
(if mu-find-sort-descending "--descending" dummy-arg)
|
|
||||||
"--format=sexp"
|
|
||||||
"--quiet"
|
|
||||||
expr)))
|
|
||||||
(set-process-filter proc 'mu-find-process-filter)
|
|
||||||
(set-process-sentinel proc 'mu-find-process-sentinel)
|
|
||||||
(setq mu-find-process proc)
|
|
||||||
(switch-to-buffer output)
|
|
||||||
(setq mu-find-expression expr)
|
|
||||||
;; (make-variable-buffer-local mu-find-expression)
|
|
||||||
(mu-find-mode))))
|
|
||||||
|
|
||||||
(defun mu-find-display-contact (lst width face)
|
|
||||||
"display a list of contacts, truncated for fitting in WIDTH"
|
|
||||||
(if lst
|
|
||||||
(let* ((len (length lst))
|
|
||||||
(str (if (= len 0) "<none>"
|
|
||||||
;; try name -> email -> ?
|
|
||||||
(or (car(car lst)) (cdr(car lst)) "?")))
|
|
||||||
(others (if (> len 1) (mu-str (format " [+%d]" (- len 1))) "")))
|
|
||||||
(truncate-string-to-width
|
|
||||||
(concat(propertize (truncate-string-to-width str
|
|
||||||
(- width (length others)) 0 ?\s "...") 'face face) others)
|
|
||||||
width 0 ?\s))
|
|
||||||
(make-string width ?\s)))
|
|
||||||
|
|
||||||
|
|
||||||
(defun mu-find-display-from-or-to (fromlst tolst width from-face to-face)
|
|
||||||
"return a propertized string for FROM unless TO matches
|
|
||||||
mu-own-address, in which case it returns TO, prefixed with To:"
|
|
||||||
(if (and fromlst tolst)
|
|
||||||
(let ((fromaddr (cdr(car fromlst))))
|
|
||||||
(if (and fromaddr (string-match mu-own-address fromaddr))
|
|
||||||
(concat (mu-str "To ") (mu-find-display-contact tolst (- width 3) to-face))
|
|
||||||
(mu-find-display-contact fromlst width from-face)))
|
|
||||||
(make-string width ?\s)))
|
|
||||||
|
|
||||||
(defun mu-find-display-size (size width face)
|
|
||||||
"return a string for SIZE of WIDTH with FACE"
|
|
||||||
(let* ((str
|
|
||||||
(cond
|
|
||||||
((>= size 1000000) (format "%2.1fM" (/ size 1000000.0)))
|
|
||||||
((and (>= size 1000) (< size 1000000)) (format "%2.1fK" (/ size 1000.0)))
|
|
||||||
((< size 1000) (format "%d" size)))))
|
|
||||||
(propertize (truncate-string-to-width str width 0 ?\s) 'face face)))
|
|
||||||
|
|
||||||
|
|
||||||
(defun mu-find-display-str (str width face)
|
|
||||||
"print a STR, at WIDTH (truncate or ' '-pad) with FACE"
|
|
||||||
(let ((str (if str str "")))
|
|
||||||
(propertize (truncate-string-to-width str width 0 ?\s t) 'face face)))
|
|
||||||
|
|
||||||
(defun mu-find-display-flags (flags width face)
|
|
||||||
(let ((str
|
|
||||||
(mapconcat
|
|
||||||
(lambda(flag)
|
|
||||||
(let ((flagname (symbol-name flag)))
|
|
||||||
(cond
|
|
||||||
((string= flagname "unread") "U")
|
|
||||||
((string= flagname "seen") "S")
|
|
||||||
((string= flagname "replied") "R")
|
|
||||||
((string= flagname "attach") "a")
|
|
||||||
((string= flagname "encrypted") "x")
|
|
||||||
((string= flagname "signed") "s")))) flags "")))
|
|
||||||
(propertize (truncate-string-to-width str width 0 ?\s) 'face face)))
|
|
||||||
|
|
||||||
(defun mu-find-header (msg)
|
|
||||||
"convert a message s-expression into a header for display"
|
|
||||||
(let ((hdr (concat " " (mapconcat
|
|
||||||
(lambda (fieldinfo)
|
|
||||||
(let ((field (car fieldinfo)) (width (cdr fieldinfo)))
|
|
||||||
(case field
|
|
||||||
(:date
|
|
||||||
(mu-find-display-str (format-time-string mu-date-format-short
|
|
||||||
(plist-get msg :date)) width 'mu-date-face))
|
|
||||||
(:from
|
|
||||||
(mu-find-display-contact (plist-get msg :from) width 'mu-from-face))
|
|
||||||
(:to
|
|
||||||
(mu-find-display-contact (plist-get msg :to) width 'mu-to-face))
|
|
||||||
(:cc
|
|
||||||
(mu-find-display-contact (plist-get msg :cc) width 'mu-cc-face))
|
|
||||||
(:bcc
|
|
||||||
(mu-find-display-contact (plist-get msg :bcc) width 'mu-bcc-face))
|
|
||||||
(:flags
|
|
||||||
(mu-find-display-flags (plist-get msg :flags) width 'mu-flag-face))
|
|
||||||
(:size
|
|
||||||
(mu-find-display-size (plist-get msg :size) width 'mu-size-face))
|
|
||||||
(:from-or-to
|
|
||||||
(mu-find-display-from-or-to (plist-get msg :from)
|
|
||||||
(plist-get msg :to) width 'mu-from-face 'mu-to-face))
|
|
||||||
(:subject
|
|
||||||
(mu-find-display-str (plist-get msg :subject) width
|
|
||||||
'mu-subject-face)))))
|
|
||||||
mu-find-fields " "))))
|
|
||||||
(setq hdr (mu-find-set-props-for-flags hdr (plist-get msg :flags)))
|
|
||||||
(propertize hdr 'path (plist-get msg :path) 'front-sticky t)))
|
|
||||||
|
|
||||||
(defun mu-find-set-props-for-flags (hdr flags)
|
|
||||||
"set text properties/faces based on flags"
|
|
||||||
(if (memq 'unread flags)
|
|
||||||
(add-text-properties 0 (- (length hdr) 1) '(face (:weight bold)) hdr))
|
|
||||||
hdr)
|
|
||||||
|
|
||||||
|
|
||||||
(defun mu-find-mode ()
|
|
||||||
"major mode for displaying search results"
|
|
||||||
(interactive)
|
|
||||||
(kill-all-local-variables)
|
|
||||||
(use-local-map mu-find-mode-map)
|
|
||||||
(setq
|
|
||||||
major-mode 'mu-find-mode mode-name "*headers*"
|
|
||||||
truncate-lines t buffer-read-only t
|
|
||||||
overwrite-mode 'overwrite-mode-binary))
|
|
||||||
|
|
||||||
(defvar mu-find-mode-map
|
|
||||||
(let ((map (make-sparse-keymap)))
|
|
||||||
(define-key map "q" 'mu-quit-buffer)
|
|
||||||
(define-key map "s" 'mu-find-change-sort)
|
|
||||||
(define-key map "g" 'mu-find-refresh)
|
|
||||||
|
|
||||||
;; marking/unmarking
|
|
||||||
(define-key map "m" 'mu-find-mark-for-move)
|
|
||||||
(define-key map "d" 'mu-find-mark-for-trash)
|
|
||||||
(define-key map "D" 'mu-find-mark-for-deletion)
|
|
||||||
(define-key map "u" 'mu-find-unmark)
|
|
||||||
|
|
||||||
;; message composition
|
|
||||||
(define-key map "r" 'mu-reply)
|
|
||||||
(define-key map "f" 'mu-forward)
|
|
||||||
(define-key map (kbd "RET") 'mu-find-view)
|
|
||||||
map)
|
|
||||||
"Keymap for \"mu-find\" buffers.")
|
|
||||||
(fset 'mu-find-mode-map mu-find-mode-map)
|
|
||||||
|
|
||||||
(defun mu-find-view ()
|
|
||||||
"display the message at the current line"
|
|
||||||
(interactive)
|
|
||||||
(let ((path (mu-get-path)))
|
|
||||||
(when path (mu-view path))))
|
|
||||||
|
|
||||||
(defun mu-find-next ()
|
|
||||||
"go to the next line; t if it worked, nil otherwise"
|
|
||||||
(interactive)
|
|
||||||
(if (or (/= 0 (forward-line 1)) (not (mu-get-path)))
|
|
||||||
(progn (message "No message after this one") nil)
|
|
||||||
t))
|
|
||||||
|
|
||||||
(defun mu-find-prev ()
|
|
||||||
"go to the next line; t if it worked, nil otherwise"
|
|
||||||
(interactive)
|
|
||||||
(if (/= 0 (forward-line -1))
|
|
||||||
(progn (message "No message before this one") nil)
|
|
||||||
t))
|
|
||||||
|
|
||||||
(defun mu-find-refresh ()
|
|
||||||
"re-run the query for the current search expression"
|
|
||||||
(interactive)
|
|
||||||
(unless (and mu-find-process
|
|
||||||
(eq (process-status mu-find-process) 'run))
|
|
||||||
(when mu-find-expression
|
|
||||||
(mu-find mu-find-expression))))
|
|
||||||
|
|
||||||
(defun mu-find-change-sort-order (fieldchar)
|
|
||||||
"change the sortfield to FIELDCHAR"
|
|
||||||
(interactive"cField to sort by ('d', 's', etc.; see mu-find(1)):\n")
|
|
||||||
(let
|
|
||||||
((field
|
|
||||||
(case fieldchar
|
|
||||||
(?b "bcc")
|
|
||||||
(?c "cc")
|
|
||||||
(?d "date")
|
|
||||||
(?f "from")
|
|
||||||
(?i "msgid")
|
|
||||||
(?m "maildir")
|
|
||||||
(?p "prio")
|
|
||||||
(?s "subject")
|
|
||||||
(?t "to")
|
|
||||||
(?z "size"))))
|
|
||||||
(if field
|
|
||||||
(setq mu-find-sort-field field)
|
|
||||||
(message "Invalid sort-field; use one of bcdfimpstz (see mu-find(1)"))
|
|
||||||
field))
|
|
||||||
|
|
||||||
(defun mu-find-change-sort-direction (dirchar)
|
|
||||||
"change the sort direction, either [a]scending or [d]escending"
|
|
||||||
(interactive
|
|
||||||
"cSorting direction ([a]scending or [d]escending):")
|
|
||||||
(cond
|
|
||||||
(?d (setq mu-find-sort-descending t) t)
|
|
||||||
(?a (setq mu-find-sort-descending nil) t)
|
|
||||||
(t (message
|
|
||||||
"Invalid sort-direction; choose either [a]scending or [d]escending") nil)))
|
|
||||||
|
|
||||||
(defun mu-find-mark (what)
|
|
||||||
"mark the current msg for 'trash, 'move, 'none"
|
|
||||||
(when (mu-get-path)
|
|
||||||
(move-beginning-of-line 1)
|
|
||||||
(let ((inhibit-read-only t) (overwrite-mode nil))
|
|
||||||
(if (and (not (eq what 'none)) (get-text-property (point) 'action))
|
|
||||||
(message "Message at pooint is already marked")
|
|
||||||
(progn
|
|
||||||
(delete-char 1)
|
|
||||||
(case what
|
|
||||||
('trash (insert-and-inherit
|
|
||||||
(mu-str (propertize "d" 'action what 'target "/foo/bar"))))
|
|
||||||
('delete (insert-and-inherit
|
|
||||||
(mu-str (propertize "D" 'action what 'target "/foo/bar"))))
|
|
||||||
('move (insert-and-inherit
|
|
||||||
(mu-str (propertize "m" 'action what 'target "/foo/bar"))))
|
|
||||||
('none (insert-and-inherit " ")))
|
|
||||||
(forward-line))))))
|
|
||||||
|
|
||||||
(defun mu-find-mark-for-trash ()
|
|
||||||
(interactive)
|
|
||||||
(mu-find-mark 'trash))
|
|
||||||
|
|
||||||
(defun mu-find-mark-for-deletion ()
|
|
||||||
(interactive)
|
|
||||||
(mu-find-mark 'delete))
|
|
||||||
|
|
||||||
(defun mu-find-mark-for-move ()
|
|
||||||
(interactive)
|
|
||||||
(mu-find-mark 'move))
|
|
||||||
|
|
||||||
(defun mu-find-unmark ()
|
|
||||||
(interactive)
|
|
||||||
(mu-find-mark 'none))
|
|
||||||
|
|
||||||
(defun mu-find-change-sort ()
|
|
||||||
"change sort field and direction"
|
|
||||||
(interactive)
|
|
||||||
(and (call-interactively 'mu-find-change-sort-order)
|
|
||||||
(call-interactively 'mu-find-change-sort-direction)))
|
|
||||||
|
|
||||||
(provide 'mu-find)
|
|
||||||
|
|
||||||
465
emacs/mu-headers.el
Normal file
465
emacs/mu-headers.el
Normal file
@ -0,0 +1,465 @@
|
|||||||
|
;;; mu-headers.el -- use `mu' from emacs
|
||||||
|
;; 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:
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'mu-common)
|
||||||
|
|
||||||
|
|
||||||
|
;;; mu-headers has functions for displaying/manipulating a list of headers (ie.,
|
||||||
|
;;; one line descriptions of an e-mail message), based on the output of 'mu
|
||||||
|
;;; find'.
|
||||||
|
|
||||||
|
(defvar mu-headers-fields
|
||||||
|
'( (:date . 25)
|
||||||
|
(:from-or-to . 22)
|
||||||
|
(:subject . 40))
|
||||||
|
"a list of fields and their widths")
|
||||||
|
|
||||||
|
(defvar mu-headers-sort-field "date"
|
||||||
|
"shortcut of the field to sort on (see mu-headers (1))")
|
||||||
|
(defvar mu-headers-sort-descending nil
|
||||||
|
"whether to sort in descending order")
|
||||||
|
|
||||||
|
;; internal stuff
|
||||||
|
(defconst mu-headers-buffer-name " *mu-headers*" "name of the mu
|
||||||
|
results buffer; name should start with a space")
|
||||||
|
|
||||||
|
(defvar mu-headers-process nil "the possibly running find process")
|
||||||
|
|
||||||
|
(defconst mu-eom "\n;;eom\n" "marker for the end of message in
|
||||||
|
the mu find output")
|
||||||
|
|
||||||
|
(defvar mu-headers-expression nil
|
||||||
|
"search expression for the current find buffer")
|
||||||
|
|
||||||
|
(defvar mu-buf "" "buffer for results data")
|
||||||
|
(defun mu-headers-process-filter (proc str)
|
||||||
|
"process-filter for the 'mu find --format=sexp output; it
|
||||||
|
accumulates the strings into valid sexps by checking of the
|
||||||
|
';;eom' end-of-msg marker, and then evaluating them"
|
||||||
|
(save-excursion
|
||||||
|
(setq mu-buf (concat mu-buf str))
|
||||||
|
(let ((eom (string-match mu-eom mu-buf)))
|
||||||
|
(while (numberp eom)
|
||||||
|
(let* ((msg (car (read-from-string (substring mu-buf 0 eom))))
|
||||||
|
(inhibit-read-only t))
|
||||||
|
(goto-char (point-max))
|
||||||
|
(save-match-data (insert (mu-headers-header msg) ?\n)))
|
||||||
|
(setq mu-buf (substring mu-buf (match-end 0)))
|
||||||
|
(setq eom (string-match mu-eom mu-buf))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(defun mu-headers-process-sentinel (proc msg)
|
||||||
|
"Check the mu-headers process upon completion"
|
||||||
|
(let ((status (process-status proc))
|
||||||
|
(exit-status (process-exit-status proc)))
|
||||||
|
(if (memq status '(exit signal))
|
||||||
|
(let ((inhibit-read-only t)
|
||||||
|
(text
|
||||||
|
(cond
|
||||||
|
((eq status 'signal)
|
||||||
|
"Search process killed (results incomplete)")
|
||||||
|
((eq status 'exit)
|
||||||
|
(cond
|
||||||
|
((= 0 exit-status) "End of search results")
|
||||||
|
((= 2 exit-status) "No matches found")
|
||||||
|
((= 4 exit-status) "Database problem; try running 'mu index'")
|
||||||
|
(t (format "Some error occured; mu-headers returned %d"
|
||||||
|
exit-status))))
|
||||||
|
(t "Unknown status")))) ;; shouldn't happen
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-max))
|
||||||
|
(insert (mu-str text)))))))
|
||||||
|
|
||||||
|
|
||||||
|
;; Note, the 'mu find --format=sexp' sexp is almost the same as the ones that
|
||||||
|
;; 'mu view --format=sexp' produces (see mu-get-message), with the difference
|
||||||
|
;; that former may give more than one result, and that mu-headers output comes from
|
||||||
|
;; the database rather than file, and does _not_ contain the message body
|
||||||
|
(defun mu-headers (expr)
|
||||||
|
"search in the mu database"
|
||||||
|
(interactive "s[mu] messages to find: ")
|
||||||
|
(let* ((buf (mu-get-new-buffer mu-headers-buffer-name))
|
||||||
|
(dummy-arg "--fields=\"dummy\"") ;; ignored
|
||||||
|
(proc (start-process mu-headers-buffer-name buf
|
||||||
|
mu-binary
|
||||||
|
"find"
|
||||||
|
(if mu-home
|
||||||
|
(concat "--muhome=" mu-home) dummy-arg)
|
||||||
|
(if mu-headers-sort-field
|
||||||
|
(concat "--sortfield=" mu-headers-sort-field) dummy-arg)
|
||||||
|
(if mu-headers-sort-descending "--descending" dummy-arg)
|
||||||
|
"--format=sexp"
|
||||||
|
"--quiet"
|
||||||
|
expr)))
|
||||||
|
(switch-to-buffer buf)
|
||||||
|
(set-process-filter proc 'mu-headers-process-filter)
|
||||||
|
(set-process-sentinel proc 'mu-headers-process-sentinel)
|
||||||
|
(setq mu-headers-process proc)
|
||||||
|
(set (make-local-variable 'mu-headers-expression) expr)
|
||||||
|
(mu-headers-mode)))
|
||||||
|
|
||||||
|
(defun mu-headers-display-contact (lst width face)
|
||||||
|
"display a list of contacts, truncated for fitting in WIDTH"
|
||||||
|
(if lst
|
||||||
|
(let* ((len (length lst))
|
||||||
|
(str (if (= len 0) "<none>"
|
||||||
|
;; try name -> email -> ?
|
||||||
|
(or (car(car lst)) (cdr(car lst)) "?")))
|
||||||
|
(others (if (> len 1) (mu-str (format " [+%d]" (- len 1))) "")))
|
||||||
|
(truncate-string-to-width
|
||||||
|
(concat(propertize (truncate-string-to-width str
|
||||||
|
(- width (length others)) 0 ?\s "...") 'face face) others)
|
||||||
|
width 0 ?\s))
|
||||||
|
(make-string width ?\s)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun mu-headers-display-from-or-to (fromlst tolst width from-face to-face)
|
||||||
|
"return a propertized string for FROM unless TO matches
|
||||||
|
mu-own-address, in which case it returns TO, prefixed with To:"
|
||||||
|
(if (and fromlst tolst)
|
||||||
|
(let ((fromaddr (cdr(car fromlst))))
|
||||||
|
(if (and fromaddr (string-match mu-own-address fromaddr))
|
||||||
|
(concat (mu-str "To ") (mu-headers-display-contact tolst (- width 3) to-face))
|
||||||
|
(mu-headers-display-contact fromlst width from-face)))
|
||||||
|
(make-string width ?\s)))
|
||||||
|
|
||||||
|
(defun mu-headers-display-size (size width face)
|
||||||
|
"return a string for SIZE of WIDTH with FACE"
|
||||||
|
(let* ((str
|
||||||
|
(cond
|
||||||
|
((>= size 1000000) (format "%2.1fM" (/ size 1000000.0)))
|
||||||
|
((and (>= size 1000) (< size 1000000)) (format "%2.1fK" (/ size 1000.0)))
|
||||||
|
((< size 1000) (format "%d" size)))))
|
||||||
|
(propertize (truncate-string-to-width str width 0 ?\s) 'face face)))
|
||||||
|
|
||||||
|
(defun mu-headers-display-str (str width face)
|
||||||
|
"print a STR, at WIDTH (truncate or ' '-pad) with FACE"
|
||||||
|
(let ((str (if str str "")))
|
||||||
|
(propertize (truncate-string-to-width str width 0 ?\s t) 'face face)))
|
||||||
|
|
||||||
|
(defun mu-headers-display-flags (flags width face)
|
||||||
|
(let ((str
|
||||||
|
(mapconcat
|
||||||
|
(lambda(flag)
|
||||||
|
(let ((flagname (symbol-name flag)))
|
||||||
|
(cond
|
||||||
|
((string= flagname "unread") "U")
|
||||||
|
((string= flagname "seen") "S")
|
||||||
|
((string= flagname "replied") "R")
|
||||||
|
((string= flagname "attach") "a")
|
||||||
|
((string= flagname "encrypted") "x")
|
||||||
|
((string= flagname "signed") "s")))) flags "")))
|
||||||
|
(propertize (truncate-string-to-width str width 0 ?\s) 'face face)))
|
||||||
|
|
||||||
|
(defun mu-headers-header (msg)
|
||||||
|
"convert a message s-expression into a header for display"
|
||||||
|
(let
|
||||||
|
((hdr
|
||||||
|
(concat " "
|
||||||
|
(mapconcat
|
||||||
|
(lambda (fieldinfo)
|
||||||
|
(let ((field (car fieldinfo)) (width (cdr fieldinfo)))
|
||||||
|
(case field
|
||||||
|
(:date
|
||||||
|
(mu-headers-display-str (format-time-string mu-date-format-short
|
||||||
|
(plist-get msg :date)) width 'mu-date-face))
|
||||||
|
(:from
|
||||||
|
(mu-headers-display-contact (plist-get msg :from) width 'mu-from-face))
|
||||||
|
(:to
|
||||||
|
(mu-headers-display-contact (plist-get msg :to) width 'mu-to-face))
|
||||||
|
(:cc
|
||||||
|
(mu-headers-display-contact (plist-get msg :cc) width 'mu-cc-face))
|
||||||
|
(:bcc
|
||||||
|
(mu-headers-display-contact (plist-get msg :bcc) width 'mu-bcc-face))
|
||||||
|
(:flags
|
||||||
|
(mu-headers-display-flags (plist-get msg :flags) width 'mu-flag-face))
|
||||||
|
(:size
|
||||||
|
(mu-headers-display-size (plist-get msg :size) width 'mu-size-face))
|
||||||
|
(:from-or-to
|
||||||
|
(mu-headers-display-from-or-to (plist-get msg :from)
|
||||||
|
(plist-get msg :to) width 'mu-from-face 'mu-to-face))
|
||||||
|
(:subject
|
||||||
|
(mu-headers-display-str (plist-get msg :subject) width
|
||||||
|
'mu-subject-face)))))
|
||||||
|
mu-headers-fields " "))))
|
||||||
|
(setq hdr (mu-headers-set-props-for-flags hdr (plist-get msg :flags)))
|
||||||
|
(propertize hdr 'path (plist-get msg :path) 'front-sticky t)))
|
||||||
|
|
||||||
|
(defun mu-headers-set-props-for-flags (hdr flags)
|
||||||
|
"set text properties/faces based on flags"
|
||||||
|
(if (memq 'unread flags)
|
||||||
|
(add-text-properties 0 (- (length hdr) 1) '(face (:weight bold)) hdr))
|
||||||
|
hdr)
|
||||||
|
|
||||||
|
(defun mu-headers-mode ()
|
||||||
|
"major mode for displaying search results"
|
||||||
|
(interactive)
|
||||||
|
(kill-all-local-variables)
|
||||||
|
(use-local-map mu-headers-mode-map)
|
||||||
|
(make-variable-buffer-local 'mu-parent-buffer)
|
||||||
|
(make-variable-buffer-local 'mu-headers-expression)
|
||||||
|
(make-variable-buffer-local 'mu-headers-process)
|
||||||
|
(setq
|
||||||
|
major-mode 'mu-headers-mode mode-name "*headers*"
|
||||||
|
truncate-lines t buffer-read-only t
|
||||||
|
overwrite-mode 'overwrite-mode-binary))
|
||||||
|
|
||||||
|
(defvar mu-headers-mode-map
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
(define-key map "q" 'mu-quit-buffer)
|
||||||
|
(define-key map "s" 'mu-headers-change-sort)
|
||||||
|
(define-key map "g" 'mu-headers-refresh)
|
||||||
|
|
||||||
|
;; marking/unmarking/executing
|
||||||
|
(define-key map "m" 'mu-headers-mark-for-move)
|
||||||
|
(define-key map "d" 'mu-headers-mark-for-trash)
|
||||||
|
(define-key map "D" 'mu-headers-mark-for-deletion)
|
||||||
|
(define-key map "u" 'mu-headers-unmark)
|
||||||
|
(define-key map "x" 'mu-headers-mark-execute)
|
||||||
|
|
||||||
|
;; message composition
|
||||||
|
(define-key map "r" 'mu-reply)
|
||||||
|
(define-key map "f" 'mu-forward)
|
||||||
|
(define-key map (kbd "RET") 'mu-headers-view)
|
||||||
|
map)
|
||||||
|
"Keymap for \"mu-headers\" buffers.")
|
||||||
|
(fset 'mu-headers-mode-map mu-headers-mode-map)
|
||||||
|
|
||||||
|
(defun mu-headers-view ()
|
||||||
|
"display the message at the current line"
|
||||||
|
(interactive)
|
||||||
|
(let ((path (mu-get-path)))
|
||||||
|
(when path (mu-view path (current-buffer)))))
|
||||||
|
|
||||||
|
(defun mu-headers-next ()
|
||||||
|
"go to the next line; t if it worked, nil otherwise"
|
||||||
|
(interactive)
|
||||||
|
(if (or (/= 0 (forward-line 1)) (not (mu-get-path)))
|
||||||
|
(progn (message "No message after this one") nil)
|
||||||
|
t))
|
||||||
|
|
||||||
|
(defun mu-headers-prev ()
|
||||||
|
"go to the next line; t if it worked, nil otherwise"
|
||||||
|
(interactive)
|
||||||
|
(if (/= 0 (forward-line -1))
|
||||||
|
(progn (message "No message before this one") nil)
|
||||||
|
t))
|
||||||
|
|
||||||
|
(defun mu-headers-refresh ()
|
||||||
|
"re-run the query for the current search expression"
|
||||||
|
(interactive)
|
||||||
|
(unless (and mu-headers-process
|
||||||
|
(eq (process-status mu-headers-process) 'run))
|
||||||
|
(when mu-headers-expression
|
||||||
|
(mu-headers mu-headers-expression))))
|
||||||
|
|
||||||
|
;; create a new query based on the old one, but with a changed sort order
|
||||||
|
|
||||||
|
(defun mu-headers-change-sort-order (fieldchar)
|
||||||
|
"change the sortfield to FIELDCHAR"
|
||||||
|
(interactive"cField to sort by ('d', 's', etc.; see mu-headers(1)):\n")
|
||||||
|
(let
|
||||||
|
((field
|
||||||
|
(case fieldchar
|
||||||
|
(?b "bcc")
|
||||||
|
(?c "cc")
|
||||||
|
(?d "date")
|
||||||
|
(?f "from")
|
||||||
|
(?i "msgid")
|
||||||
|
(?m "maildir")
|
||||||
|
(?p "prio")
|
||||||
|
(?s "subject")
|
||||||
|
(?t "to")
|
||||||
|
(?z "size"))))
|
||||||
|
(if field
|
||||||
|
(setq mu-headers-sort-field field)
|
||||||
|
(message "Invalid sort-field; use one of bcdfimpstz (see mu-headers(1)"))
|
||||||
|
field))
|
||||||
|
|
||||||
|
(defun mu-headers-change-sort-direction (dirchar)
|
||||||
|
"change the sort direction, either [a]scending or [d]escending"
|
||||||
|
(interactive
|
||||||
|
"cSorting direction ([a]scending or [d]escending):")
|
||||||
|
(cond
|
||||||
|
(?d (setq mu-headers-sort-descending t) t)
|
||||||
|
(?a (setq mu-headers-sort-descending nil) t)
|
||||||
|
(t (message
|
||||||
|
"Invalid sort-direction; choose either [a]scending or [d]escending") nil)))
|
||||||
|
|
||||||
|
(defun mu-headers-change-sort ()
|
||||||
|
"change sort field and direction"
|
||||||
|
(interactive)
|
||||||
|
(and (call-interactively 'mu-headers-change-sort-order)
|
||||||
|
(call-interactively 'mu-headers-change-sort-direction)))
|
||||||
|
|
||||||
|
|
||||||
|
;; message are 'marked' for moving, deletion etc. by have a special propertized
|
||||||
|
;; character at the start of the line; this propertized character holds an
|
||||||
|
;; 'action property, which tells what to do with this one (e.g.,'d'-> trash,
|
||||||
|
;; 'D'->delete, 'm'->'move'). 'u' (unmark) removes this mark, 'U' removes
|
||||||
|
;; all-marks. 'x'->mu-headers-execute removes all marks
|
||||||
|
|
||||||
|
|
||||||
|
(defun mu-headers-mark (what)
|
||||||
|
"mark the current msg for 'trash, 'move, 'none; return t if it
|
||||||
|
worked, nil otherwise"
|
||||||
|
(when (mu-get-path)
|
||||||
|
(move-beginning-of-line 1)
|
||||||
|
(let ((inhibit-read-only t) (overwrite-mode nil))
|
||||||
|
(if (and (not (eq what 'none)) (get-text-property (point) 'action))
|
||||||
|
(progn (message "Message at point is already marked") nil)
|
||||||
|
(progn
|
||||||
|
(delete-char 1)
|
||||||
|
(case what
|
||||||
|
('trash (insert-and-inherit
|
||||||
|
(mu-str (propertize "d" 'action what 'target "/foo/bar"))))
|
||||||
|
('delete (insert-and-inherit
|
||||||
|
(mu-str (propertize "D" 'action what 'target "/foo/bar"))))
|
||||||
|
('move (insert-and-inherit
|
||||||
|
(mu-str (propertize "m" 'action what 'target "/foo/bar"))))
|
||||||
|
('none (insert-and-inherit " ")))
|
||||||
|
(forward-line)
|
||||||
|
t)))))
|
||||||
|
|
||||||
|
|
||||||
|
(defun mu-headers-get-marked ()
|
||||||
|
"get all marked messages in the current buffer as a list; each
|
||||||
|
element is a cell; with 'action', 'source' , 'target'). ie one of
|
||||||
|
three:
|
||||||
|
('delete <path>)
|
||||||
|
('trash <path> <target>)
|
||||||
|
('move <path> <target>)"
|
||||||
|
(let ((lst))
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(while (re-search-forward "^." nil t)
|
||||||
|
(let* ((char0 (match-string 0))
|
||||||
|
(action (get-text-property 0 'action char0))
|
||||||
|
(path (get-text-property 0 'path char0))
|
||||||
|
(target (get-text-property 0 'target char0)))
|
||||||
|
(cond
|
||||||
|
((eq action 'trash)
|
||||||
|
(setq lst (cons (list 'trash path target) lst)))
|
||||||
|
((eq action 'delete)
|
||||||
|
(setq lst (cons (list 'delete path) lst)))
|
||||||
|
((eq action 'move)
|
||||||
|
(setq lst (cons (list 'move path target) lst)))))))
|
||||||
|
lst))
|
||||||
|
|
||||||
|
(defun mu-headers-marks-execute ()
|
||||||
|
"execute marked actions on messages in the current buffer"
|
||||||
|
(interactive)
|
||||||
|
(let* ((markedcount (mu-headers-count-marked))
|
||||||
|
(movenum (nth 0 markedcount)) (trashnum (nth 1 markedcount))
|
||||||
|
(deletenum (nth 2 markedcount)))
|
||||||
|
(if (= 0 (apply '+ markedcount))
|
||||||
|
(message "No messages are marked")
|
||||||
|
(if (and (< 0 movenum)
|
||||||
|
(y-or-n-p (format "Do you want to move %d message(s)?" movenum)))
|
||||||
|
(message "Moving message(s)"))
|
||||||
|
(if (and (< 0 trashnum)
|
||||||
|
(y-or-n-p (format "Do you want to move %d message(s) to trash?" trashnum)))
|
||||||
|
(message "Trashing message(s)"))
|
||||||
|
(if (and (< 0 deletenum)
|
||||||
|
(yes-or-no-p (format "Do you want to permanently delete %d message(s)?"
|
||||||
|
deletenum)))
|
||||||
|
(message "Deleting message(s)")))))
|
||||||
|
|
||||||
|
(defun mu-headers-foreach-marked (func)
|
||||||
|
"call FUNC for each marked message in BUFFER; the argument
|
||||||
|
to FUNC is a list, either: with 'action', 'source' ,
|
||||||
|
'target'). ie one of three:
|
||||||
|
('delete <path>)
|
||||||
|
('trash <path> <target>)
|
||||||
|
('move <path> <target>)"
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(while (re-search-forward "^." nil t)
|
||||||
|
(move-beginning-of-line 1)
|
||||||
|
(let* ((char0 (match-string 0))
|
||||||
|
(action (get-text-property 0 'action char0))
|
||||||
|
(path (get-text-property 0 'path char0))
|
||||||
|
(target (get-text-property 0 'target char0)))
|
||||||
|
(cond
|
||||||
|
((eq action 'trash) (funcall func (list 'trash path target)))
|
||||||
|
((eq action 'delete) (funcall func (list 'delete path)))
|
||||||
|
((eq action 'move) (funcall func (list 'move path target)))))
|
||||||
|
(move-end-of-line 1))))
|
||||||
|
|
||||||
|
(defun mu-headers-count-marked ()
|
||||||
|
"return a vector with three items (marked-move marked-trash
|
||||||
|
marked-delete) which are the number of messages marked for each
|
||||||
|
of those in the current buffer"
|
||||||
|
(let ((result (make-vector 3 0)))
|
||||||
|
(mu-foreach-marked
|
||||||
|
(lambda (cell)
|
||||||
|
(case (car cell)
|
||||||
|
('move (aset result 0 (+ 1 (aref result 0))))
|
||||||
|
('trash (aset result 1 (+ 1 (aref result 1))))
|
||||||
|
('delete (aset result 2 (+ 1 (aref result 2)))))))
|
||||||
|
(append result nil))) ;; convert to list
|
||||||
|
|
||||||
|
(defun mu-headers-unmark-all ()
|
||||||
|
"unmark all messages in the current buffer"
|
||||||
|
(interactive)
|
||||||
|
(let ((marked 0))
|
||||||
|
(mu-foreach-marked
|
||||||
|
(lambda(cell) (setq marked (+ 1 marked))))
|
||||||
|
(if (= 0 marked)
|
||||||
|
(message "No messages are marked")
|
||||||
|
(when (y-or-n-p (format "Unmark %d message(s)?" marked))
|
||||||
|
(mu-foreach-marked
|
||||||
|
(lambda(cell)
|
||||||
|
(let ((inhibit-read-only t))
|
||||||
|
(delete-char 1)
|
||||||
|
(insert-and-inherit " "))))))))
|
||||||
|
|
||||||
|
(defun mu-headers-mark-for-trash ()
|
||||||
|
(interactive)
|
||||||
|
(when (mu-headers-mark 'trash)
|
||||||
|
(message "Message marked for trashing")))
|
||||||
|
|
||||||
|
(defun mu-headers-mark-for-deletion ()
|
||||||
|
(interactive)
|
||||||
|
(when (mu-headers-mark 'delete)
|
||||||
|
(message "Message marked for deletion")))
|
||||||
|
|
||||||
|
(defun mu-headers-mark-for-move ()
|
||||||
|
(interactive)
|
||||||
|
(when (mu-headers-mark 'move)
|
||||||
|
(message "Message marked for moving")))
|
||||||
|
|
||||||
|
(defun mu-headers-unmark ()
|
||||||
|
(interactive)
|
||||||
|
(when (mu-headers-mark 'none)
|
||||||
|
(message "Message unmarked")))
|
||||||
|
|
||||||
|
|
||||||
|
(provide 'mu-headers)
|
||||||
|
|
||||||
108
emacs/mu-view.el
108
emacs/mu-view.el
@ -23,7 +23,7 @@
|
|||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
|
||||||
;; mu message has functions to display a message
|
;; mu message has functions to display a single message
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
@ -38,6 +38,8 @@
|
|||||||
"list of header fields to display in the message view")
|
"list of header fields to display in the message view")
|
||||||
|
|
||||||
(defconst mu-view-buffer-name " *mu-view*")
|
(defconst mu-view-buffer-name " *mu-view*")
|
||||||
|
(defvar mu-view-headers-buffer nil "the headers buffer (if any)
|
||||||
|
from which this buffer was invoked (buffer local)")
|
||||||
|
|
||||||
(defun mu-view-header (field val val-face)
|
(defun mu-view-header (field val val-face)
|
||||||
"get a header string (like 'Subject: foo')"
|
"get a header string (like 'Subject: foo')"
|
||||||
@ -94,32 +96,53 @@
|
|||||||
(mu-view-body msg 'mu-body-face)
|
(mu-view-body msg 'mu-body-face)
|
||||||
))))
|
))))
|
||||||
|
|
||||||
(defun mu-view (path)
|
;; note: mu-view sets path as a text-property ('path) for the whole buffer, just
|
||||||
|
;; like mu-headers does it per-header
|
||||||
|
(defun mu-view (path parentbuf)
|
||||||
"display message at PATH in a new buffer; note that the action
|
"display message at PATH in a new buffer; note that the action
|
||||||
of viewing a message may cause it to be moved/renamed; this
|
of viewing a message may cause it to be moved/renamed; this
|
||||||
function returns the resulting name"
|
function returns the resulting name. PARENTBUF refers to the
|
||||||
(interactive)
|
buffer who invoked this view; this allows us to return there when
|
||||||
|
we quit from this view. Also, if PARENTBUF is a find buffer (ie.,
|
||||||
|
has mu-headers-mode as its major mode), this allows various
|
||||||
|
commands (navigation, marking etc.) to be applied to this
|
||||||
|
buffer."
|
||||||
(let ((str (mu-view-message path))
|
(let ((str (mu-view-message path))
|
||||||
(buf (get-buffer mu-view-buffer-name)))
|
(buf (mu-get-new-buffer mu-view-buffer-name)))
|
||||||
(when str
|
(when str
|
||||||
(when buf (kill-buffer buf))
|
(with-current-buffer buf
|
||||||
(get-buffer-create mu-view-buffer-name)
|
|
||||||
(with-current-buffer mu-view-buffer-name
|
|
||||||
(let ((inhibit-read-only t))
|
(let ((inhibit-read-only t))
|
||||||
;; note, we set the path as a text-property
|
;; note, we set the path as a text-property
|
||||||
(insert (propertize str 'path path)))
|
(insert (propertize str 'path path))))
|
||||||
(switch-to-buffer mu-view-buffer-name)
|
|
||||||
(mu-view-mode)
|
(switch-to-buffer buf)
|
||||||
(goto-char (point-min))))))
|
(mu-view-mode)
|
||||||
|
|
||||||
|
;; these are buffer-local
|
||||||
|
(setq mu-parent-buffer parentbuf)
|
||||||
|
(setq mu-view-headers-buffer parentbuf)
|
||||||
|
|
||||||
|
(goto-char (point-min)))))
|
||||||
|
|
||||||
(defvar mu-view-mode-map
|
(defvar mu-view-mode-map
|
||||||
(let ((map (make-sparse-keymap)))
|
(let ((map (make-sparse-keymap)))
|
||||||
(define-key map "q" 'mu-quit-buffer)
|
(define-key map "q" 'mu-quit-buffer)
|
||||||
(define-key map "s" 'mu-find)
|
(define-key map "s" 'mu-headers)
|
||||||
(define-key map "f" 'mu-forward)
|
(define-key map "f" 'mu-forward)
|
||||||
(define-key map "r" 'mu-reply)
|
(define-key map "r" 'mu-reply)
|
||||||
|
|
||||||
|
;; navigation between messages
|
||||||
(define-key map "n" 'mu-view-next)
|
(define-key map "n" 'mu-view-next)
|
||||||
(define-key map "p" 'mu-view-prev)
|
(define-key map "p" 'mu-view-prev)
|
||||||
|
|
||||||
|
;; marking/unmarking
|
||||||
|
(define-key map "d" 'mu-view-mark-for-trash)
|
||||||
|
(define-key map "D" 'mu-view-mark-for-deletion)
|
||||||
|
(define-key map "m" 'mu-view-mark-for-move)
|
||||||
|
(define-key map "u" 'mu-view-unmark)
|
||||||
|
(define-key map "x" 'mu-view-marks-execute)
|
||||||
|
|
||||||
map)
|
map)
|
||||||
"Keymap for \"mu-view\" buffers.")
|
"Keymap for \"mu-view\" buffers.")
|
||||||
(fset 'mu-view-mode-map mu-view-mode-map)
|
(fset 'mu-view-mode-map mu-view-mode-map)
|
||||||
@ -129,19 +152,66 @@ function returns the resulting name"
|
|||||||
(interactive)
|
(interactive)
|
||||||
(kill-all-local-variables)
|
(kill-all-local-variables)
|
||||||
(use-local-map mu-view-mode-map)
|
(use-local-map mu-view-mode-map)
|
||||||
|
(make-variable-buffer-local 'mu-parent-buffer)
|
||||||
|
(make-variable-buffer-local 'mu-headers-buffer)
|
||||||
(setq major-mode 'mu-view-mode mode-name "*mu-view*")
|
(setq major-mode 'mu-view-mode mode-name "*mu-view*")
|
||||||
(setq truncate-lines t buffer-read-only t))
|
(setq truncate-lines t buffer-read-only t))
|
||||||
|
|
||||||
|
(defmacro with-current-headers-buffer (&rest body)
|
||||||
|
"Execute the forms in BODY with BUFFER-OR-NAME temporarily current.
|
||||||
|
BUFFER-OR-NAME must be a buffer or the name of an existing buffer.
|
||||||
|
The value returned is the value of the last form in BODY. See
|
||||||
|
also `with-temp-buffer'."
|
||||||
|
(declare (indent 1) (debug t))
|
||||||
|
`(if (and mu-view-headers-buffer (buffer-live-p mu-view-headers-buffer))
|
||||||
|
(save-current-buffer
|
||||||
|
(set-buffer mu-view-headers-buffer)
|
||||||
|
,@body)
|
||||||
|
(message "No headers-buffer connected")))
|
||||||
|
|
||||||
(defun mu-view-next ()
|
(defun mu-view-next ()
|
||||||
|
"move to the next message"
|
||||||
(interactive)
|
(interactive)
|
||||||
(with-current-buffer mu-find-buffer-name
|
(with-current-headers-buffer
|
||||||
(when (mu-find-next)
|
(when (mu-headers-next)
|
||||||
(mu-view (mu-get-path)))))
|
(mu-view (mu-get-path) (current-buffer)))))
|
||||||
|
|
||||||
(defun mu-view-prev ()
|
(defun mu-view-prev ()
|
||||||
|
"move to the previous message"
|
||||||
(interactive)
|
(interactive)
|
||||||
(with-current-buffer mu-find-buffer-name
|
(with-current-headers-buffer
|
||||||
(when (mu-find-prev)
|
(when (mu-headers-prev)
|
||||||
(mu-view (mu-get-path)))))
|
(mu-view (mu-get-path) (current-buffer)))))
|
||||||
|
|
||||||
|
(defun mu-view-mark-for-trash ()
|
||||||
|
"mark for thrashing"
|
||||||
|
(interactive)
|
||||||
|
(with-current-headers-buffer
|
||||||
|
(mu-headers-mark 'trash)))
|
||||||
|
|
||||||
|
(defun mu-view-mark-for-deletion ()
|
||||||
|
"mark for deletion"
|
||||||
|
(interactive)
|
||||||
|
(with-current-headers-buffer
|
||||||
|
(mu-headers-mark 'delete)))
|
||||||
|
|
||||||
|
(defun mu-view-mark-for-move ()
|
||||||
|
"mark for moving"
|
||||||
|
(interactive)
|
||||||
|
(with-current-headers-buffer
|
||||||
|
(mu-headers-mark 'move)))
|
||||||
|
|
||||||
|
(defun mu-view-unmark ()
|
||||||
|
"unmark this message"
|
||||||
|
(interactive)
|
||||||
|
(with-current-headers-buffer
|
||||||
|
(mu-headers-mark 'none)))
|
||||||
|
|
||||||
|
;; we don't allow executing marks from the view buffer, to protect user from
|
||||||
|
;; accidentally deleting stuff...
|
||||||
|
(defun mu-view-marks-execute ()
|
||||||
|
"give user a warning"
|
||||||
|
(interactive)
|
||||||
|
(message "Please go back to the headers list to execute your marks"))
|
||||||
|
|
||||||
(provide 'mu-view)
|
(provide 'mu-view)
|
||||||
|
|||||||
43
emacs/mu.el
43
emacs/mu.el
@ -28,23 +28,23 @@
|
|||||||
(require 'mu-view)
|
(require 'mu-view)
|
||||||
(require 'mu-message)
|
(require 'mu-message)
|
||||||
|
|
||||||
(define-key mu-find-mode-map "q" 'mu-quit-buffer)
|
(define-key mu-headers-mode-map "q" 'mu-quit-buffer)
|
||||||
(define-key mu-find-mode-map "f" 'mu-find)
|
(define-key mu-headers-mode-map "f" 'mu-headers)
|
||||||
(define-key mu-find-mode-map (kbd "<up>") 'mu-find-prev)
|
(define-key mu-headers-mode-map (kbd "<up>") 'mu-headers-prev)
|
||||||
(define-key mu-find-mode-map (kbd "<down>") 'mu-find-next)
|
(define-key mu-headers-mode-map (kbd "<down>") 'mu-headers-next)
|
||||||
(define-key mu-find-mode-map (kbd "RET") 'mu-find-view)
|
(define-key mu-headers-mode-map (kbd "RET") 'mu-headers-view)
|
||||||
(define-key mu-find-mode-map "n" 'mu-find-next)
|
(define-key mu-headers-mode-map "n" 'mu-headers-next)
|
||||||
(define-key mu-find-mode-map "p" 'mu-find-prev)
|
(define-key mu-headers-mode-map "p" 'mu-headers-prev)
|
||||||
(define-key mu-find-mode-map "o" 'mu-find-change-sort)
|
(define-key mu-headers-mode-map "o" 'mu-headers-change-sort)
|
||||||
(define-key mu-find-mode-map "g" 'mu-find-refresh)
|
(define-key mu-headers-mode-map "g" 'mu-headers-refresh)
|
||||||
(define-key mu-find-mode-map "m" 'mu-find-mark-for-move)
|
(define-key mu-headers-mode-map "m" 'mu-headers-mark-for-move)
|
||||||
(define-key mu-find-mode-map "d" 'mu-find-mark-for-trash)
|
(define-key mu-headers-mode-map "d" 'mu-headers-mark-for-trash)
|
||||||
(define-key mu-find-mode-map "D" 'mu-find-mark-for-deletion)
|
(define-key mu-headers-mode-map "D" 'mu-headers-mark-for-deletion)
|
||||||
(define-key mu-find-mode-map "u" 'mu-find-unmark)
|
(define-key mu-headers-mode-map "u" 'mu-headers-unmark)
|
||||||
(define-key mu-find-mode-map "U" 'mu-unmark-all)
|
(define-key mu-headers-mode-map "U" 'mu-headers-unmark-all)
|
||||||
(define-key mu-find-mode-map "r" 'mu-reply)
|
(define-key mu-headers-mode-map "r" 'mu-headers-reply)
|
||||||
(define-key mu-find-mode-map "f" 'mu-forward)
|
(define-key mu-headers-mode-map "f" 'mu-headers-forward)
|
||||||
(define-key mu-find-mode-map "x" 'mu-execute)
|
(define-key mu-headers-mode-map "x" 'mu-headers-execute)
|
||||||
|
|
||||||
|
|
||||||
(define-key mu-view-mode-map "q" 'mu-quit-buffer)
|
(define-key mu-view-mode-map "q" 'mu-quit-buffer)
|
||||||
@ -54,6 +54,15 @@
|
|||||||
(define-key mu-view-mode-map "r" 'mu-reply)
|
(define-key mu-view-mode-map "r" 'mu-reply)
|
||||||
(define-key mu-view-mode-map "f" 'mu-forward)
|
(define-key mu-view-mode-map "f" 'mu-forward)
|
||||||
(define-key mu-view-mode-map "x" 'mu-execute)
|
(define-key mu-view-mode-map "x" 'mu-execute)
|
||||||
|
(define-key mu-view-mode-map "m" 'mu-view-mark-for-move)
|
||||||
|
(define-key mu-view-mode-map "d" 'mu-view-mark-for-trash)
|
||||||
|
(define-key mu-view-mode-map "D" 'mu-view-mark-for-deletion)
|
||||||
|
(define-key mu-view-mode-map "u" 'mu-view-unmark)
|
||||||
|
(define-key mu-view-mode-map "U" 'mu-view-unmark-all)
|
||||||
|
(define-key mu-view-mode-map "r" 'mu-view-reply)
|
||||||
|
(define-key mu-view-mode-map "f" 'mu-view-forward)
|
||||||
|
(define-key mu-view-mode-map "x" 'mu-view-execute)
|
||||||
|
|
||||||
|
|
||||||
(provide 'mu)
|
(provide 'mu)
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user