From ef086db2a78ef04cff0e6541bcd3cd4b59eec5ff Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Wed, 3 Aug 2011 08:18:11 +0300 Subject: [PATCH] * emacs updates --- emacs/Makefile | 2 +- emacs/mu-common.el | 115 ++--------- emacs/mu-find.el | 349 --------------------------------- emacs/mu-headers.el | 465 ++++++++++++++++++++++++++++++++++++++++++++ emacs/mu-view.el | 110 +++++++++-- emacs/mu.el | 43 ++-- 6 files changed, 595 insertions(+), 489 deletions(-) delete mode 100644 emacs/mu-find.el create mode 100644 emacs/mu-headers.el diff --git a/emacs/Makefile b/emacs/Makefile index 4c524745..a9a4a816 100644 --- a/emacs/Makefile +++ b/emacs/Makefile @@ -1,7 +1,7 @@ VERSION=$(shell git describe --tags --dirty) EMACS=emacs 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) .PHONY=install diff --git a/emacs/mu-common.el b/emacs/mu-common.el index 1f8d9269..c33c283f 100644 --- a/emacs/mu-common.el +++ b/emacs/mu-common.el @@ -53,19 +53,16 @@ notation) for the mail view and in replied/forwarded message quotations") (defface mu-body-face '((t (:foreground "#8cd0d3"))) "") (defface mu-header-face '((t (:foreground "#7f9f7f"))) "") (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 "#7f6677"))) "") - +(defface mu-path-face '((t (:foreground "#dc56cc"))) "") (defface mu-unread-face '((t (:bold t))) "") (defface mu-face '((t (:foreground "Gray" :italic t))) "") (defvar mu-own-address "djcb" "regexp matching my own address") - ;;; 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 is killed") @@ -89,14 +86,14 @@ buffer is killed") etc.)" (propertize str 'face 'mu-face 'intangible t)) -(setq mu-find-fields +(setq mu-headers-fields '( (:date . 20) (:flags . 4) (:from-or-to . 22) (:size . 8) (:subject . 40))) -(setq mu-find-date-format "%x %X") +(setq mu-headers-date-format "%x %X") (setq mu-header-fields '( :from @@ -175,103 +172,17 @@ Lisp data as a plist. Returns nil in case of error" (defun mu-quit-buffer () "kill this buffer, and switch to it's parentbuf if it is alive" - (interactive) - (let ((parentbuf (mu-parent-buf))) + (interactive) + (let ((parentbuf mu-parent-buffer)) (kill-buffer) - (when (buffer-live-p parentbuf) + (when (and parentbuf (buffer-live-p parentbuf)) (switch-to-buffer parentbuf)))) -(defun mu-get-marked () - "get all marked messages as a list; each element is a cell; -with 'action', 'source' , 'target'). ie one of three: - ('delete ) - ('trash ) - ('move )" - (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 ) - ('trash ) - ('move )" - (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 " ")))))))) +(defun mu-get-new-buffer (bufname) + "return a new buffer BUFNAME; if such already exists, kill the +old one first" + (when (get-buffer bufname) + (kill-buffer bufname)) + (get-buffer-create bufname)) (provide 'mu-common) diff --git a/emacs/mu-find.el b/emacs/mu-find.el deleted file mode 100644 index 5fc533c1..00000000 --- a/emacs/mu-find.el +++ /dev/null @@ -1,349 +0,0 @@ -;;; mu-find.el -- use `mu' from emacs -;; Copyright (C) 2011 Dirk-Jan C. Binnema - -;; Author: Dirk-Jan C. Binnema -;; Maintainer: Dirk-Jan C. Binnema -;; 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 . - -;;; 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 "**" "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) "" - ;; 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) - diff --git a/emacs/mu-headers.el b/emacs/mu-headers.el new file mode 100644 index 00000000..6467de78 --- /dev/null +++ b/emacs/mu-headers.el @@ -0,0 +1,465 @@ +;;; mu-headers.el -- use `mu' from emacs +;; Copyright (C) 2011 Dirk-Jan C. Binnema + +;; Author: Dirk-Jan C. Binnema +;; Maintainer: Dirk-Jan C. Binnema +;; 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 . + +;;; 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) "" + ;; 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 ) + ('trash ) + ('move )" + (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 ) + ('trash ) + ('move )" + (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) + diff --git a/emacs/mu-view.el b/emacs/mu-view.el index a788a9ed..a7b80114 100644 --- a/emacs/mu-view.el +++ b/emacs/mu-view.el @@ -23,7 +23,7 @@ ;;; Commentary: -;; mu message has functions to display a message +;; mu message has functions to display a single message ;;; Code: @@ -38,6 +38,8 @@ "list of header fields to display in the message 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) "get a header string (like 'Subject: foo')" @@ -94,32 +96,53 @@ (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 of viewing a message may cause it to be moved/renamed; this -function returns the resulting name" - (interactive) +function returns the resulting name. PARENTBUF refers to the +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)) - (buf (get-buffer mu-view-buffer-name))) + (buf (mu-get-new-buffer mu-view-buffer-name))) (when str - (when buf (kill-buffer buf)) - (get-buffer-create mu-view-buffer-name) - (with-current-buffer mu-view-buffer-name + (with-current-buffer buf + (let ((inhibit-read-only t)) ;; note, we set the path as a text-property - (insert (propertize str 'path path))) - (switch-to-buffer mu-view-buffer-name) - (mu-view-mode) - (goto-char (point-min)))))) + (insert (propertize str 'path path)))) + + (switch-to-buffer buf) + (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 (let ((map (make-sparse-keymap))) (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 "r" 'mu-reply) + + ;; navigation between messages (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) "Keymap for \"mu-view\" buffers.") (fset 'mu-view-mode-map mu-view-mode-map) @@ -129,19 +152,66 @@ function returns the resulting name" (interactive) (kill-all-local-variables) (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 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 () + "move to the next message" (interactive) - (with-current-buffer mu-find-buffer-name - (when (mu-find-next) - (mu-view (mu-get-path))))) + (with-current-headers-buffer + (when (mu-headers-next) + (mu-view (mu-get-path) (current-buffer))))) (defun mu-view-prev () + "move to the previous message" (interactive) - (with-current-buffer mu-find-buffer-name - (when (mu-find-prev) - (mu-view (mu-get-path))))) + (with-current-headers-buffer + (when (mu-headers-prev) + (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) diff --git a/emacs/mu.el b/emacs/mu.el index 423bdfc7..ddeb938a 100644 --- a/emacs/mu.el +++ b/emacs/mu.el @@ -28,23 +28,23 @@ (require 'mu-view) (require 'mu-message) -(define-key mu-find-mode-map "q" 'mu-quit-buffer) -(define-key mu-find-mode-map "f" 'mu-find) -(define-key mu-find-mode-map (kbd "") 'mu-find-prev) -(define-key mu-find-mode-map (kbd "") 'mu-find-next) -(define-key mu-find-mode-map (kbd "RET") 'mu-find-view) -(define-key mu-find-mode-map "n" 'mu-find-next) -(define-key mu-find-mode-map "p" 'mu-find-prev) -(define-key mu-find-mode-map "o" 'mu-find-change-sort) -(define-key mu-find-mode-map "g" 'mu-find-refresh) -(define-key mu-find-mode-map "m" 'mu-find-mark-for-move) -(define-key mu-find-mode-map "d" 'mu-find-mark-for-trash) -(define-key mu-find-mode-map "D" 'mu-find-mark-for-deletion) -(define-key mu-find-mode-map "u" 'mu-find-unmark) -(define-key mu-find-mode-map "U" 'mu-unmark-all) -(define-key mu-find-mode-map "r" 'mu-reply) -(define-key mu-find-mode-map "f" 'mu-forward) -(define-key mu-find-mode-map "x" 'mu-execute) +(define-key mu-headers-mode-map "q" 'mu-quit-buffer) +(define-key mu-headers-mode-map "f" 'mu-headers) +(define-key mu-headers-mode-map (kbd "") 'mu-headers-prev) +(define-key mu-headers-mode-map (kbd "") 'mu-headers-next) +(define-key mu-headers-mode-map (kbd "RET") 'mu-headers-view) +(define-key mu-headers-mode-map "n" 'mu-headers-next) +(define-key mu-headers-mode-map "p" 'mu-headers-prev) +(define-key mu-headers-mode-map "o" 'mu-headers-change-sort) +(define-key mu-headers-mode-map "g" 'mu-headers-refresh) +(define-key mu-headers-mode-map "m" 'mu-headers-mark-for-move) +(define-key mu-headers-mode-map "d" 'mu-headers-mark-for-trash) +(define-key mu-headers-mode-map "D" 'mu-headers-mark-for-deletion) +(define-key mu-headers-mode-map "u" 'mu-headers-unmark) +(define-key mu-headers-mode-map "U" 'mu-headers-unmark-all) +(define-key mu-headers-mode-map "r" 'mu-headers-reply) +(define-key mu-headers-mode-map "f" 'mu-headers-forward) +(define-key mu-headers-mode-map "x" 'mu-headers-execute) (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 "f" 'mu-forward) (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)