From 61ab894ab493b5039d7121c16050342e87f03d0a Mon Sep 17 00:00:00 2001
From: "Dirk-Jan C. Binnema" <djcb@djcbsoftware.nl>
Date: Fri, 5 Aug 2011 08:19:19 +0300
Subject: [PATCH] * emacs updates

---
 emacs/Makefile      |   2 +-
 emacs/mu-common.el  |  45 ++++++-
 emacs/mu-headers.el | 296 ++++++++++++++++++--------------------------
 emacs/mu-message.el |  35 ++++--
 emacs/mu-view.el    |  33 +++--
 emacs/mu.el         |   2 +-
 6 files changed, 205 insertions(+), 208 deletions(-)

diff --git a/emacs/Makefile b/emacs/Makefile
index a9a4a816..5f7bc075 100644
--- a/emacs/Makefile
+++ b/emacs/Makefile
@@ -14,7 +14,7 @@ BATCH=$(EMACS) -batch -q -no-site-file -eval \
 
 all: $(ELCS)
 
-docs: mu.info
+docs: mu.infogg
 
 install_lisp:
 	mkdir -p $(DESTDIR)/$(PREFIX)/share/emacs/site-lisp
diff --git a/emacs/mu-common.el b/emacs/mu-common.el
index c33c283f..0f8aa812 100644
--- a/emacs/mu-common.el
+++ b/emacs/mu-common.el
@@ -104,6 +104,41 @@ etc.)"
 
 (setq mu-own-address-regexp "djcb\\|diggler\\|bulkmeel")
 
+(defvar mu-maildir nil "our maildir")
+(defvar mu-folder nil "our list of special folders for jumping,
+moving")
+
+
+(defvar mu-maildir nil "location of your maildir, typically ~/Maildir")
+(defvar mu-inbox-folder  nil  "location of your inbox folder")
+(defvar mu-outbox-folder nil "location of your outbox folder")
+(defvar mu-sent-folder   nil "location of your sent folder")
+(defvar mu-trash-folder  nil "location of your trash-folder folder")
+
+(setq
+  mu-maildir "/home/djcb/Maildir"
+  mu-inbox-folder  "/inbox"
+  mu-outbox-folder "/outbox"
+  mu-sent-folder   "/sent"
+  mu-trash-folder  "/trash")
+
+(defvar mu-quick-folders nil)
+
+(setq mu-quick-folders
+  '("/archive" "/bulkarchive" "/todo"))
+
+(defun mu-ask-folder (prompt)
+  "ask user with PROMPT for a folder name, return the full path
+the folder"
+  (interactive)
+  (let*
+    ((showfolders
+       (delete-dups
+  	 (append (list mu-inbox-folder mu-sent-folder) mu-quick-folders)))
+      (chosen (ido-completing-read prompt showfolders)))
+    (concat mu-maildir chosen)))
+     
+
 (defun mu-ask-key (prompt)
   "Get a char from user, only accepting characters marked with [x] in prompt,
 e.g. 'Reply to [a]ll or [s]ender only; returns the character chosen"
@@ -165,11 +200,6 @@ Lisp data as a plist.  Returns nil in case of error"
 	(progn (message "Failed to parse message") nil)))))
 
 
-(defun mu-move-to-updated-path (path newflags)
-  "move msg to an updated path based on newflags"
-  ;; TODO  
-  )
-
 (defun mu-quit-buffer ()
   "kill this buffer, and switch to it's parentbuf if it is alive"
   (interactive)  
@@ -185,4 +215,9 @@ old one first"
     (kill-buffer bufname))
   (get-buffer-create bufname))
 
+(defun mu-log (frm &rest args)
+  (with-current-buffer (get-buffer-create "*mu-log*")
+    (insert (apply 'format (concat frm "\n") args))))
+
+
 (provide 'mu-common)
diff --git a/emacs/mu-headers.el b/emacs/mu-headers.el
index b2b9ed60..2a3234b2 100644
--- a/emacs/mu-headers.el
+++ b/emacs/mu-headers.el
@@ -32,6 +32,35 @@
 ;;; one line descriptions of an e-mail message), based on the output of 'mu
 ;;; find'.
 
+;; data is stored like the following: for each header-line, we take the (point)
+;; at beginning-of-line (bol) and use that as the key in the mu-headers-hash
+;; hash, which does
+;;
+;;    point-of-bol -> path
+;;
+;; then, marks are stored in a seperate hash 'mu-headers-marks-hash, using
+;;
+;;   point-of-bol -> (src . target)
+;;
+;;  and note both 'delete' (target=/dev/null), trash (target=trash-folder), and
+;;  move can be expressed by that
+;;
+;; after the marks have been 'executed', the lines will be marked a *invisible*
+;; instead of deleting them; that way, the 'point-of-bol' stays valid.
+
+(defvar mu-headers-hash nil "internal: buffer-local hash table
+which maps bol->path")
+(defvar mu-headers-marks-hash nil "internal: buffer-local hash table
+which maps bol->(src . target) for marked lines")
+  
+(defun mu-headers-set-path (path)
+  "map the bol of the current header to a path"
+  (puthash (line-beginning-position 1) path mu-headers-hash))
+  
+(defun mu-headers-get-path ()
+  "get the path for the header at point"
+  (gethash (line-beginning-position 1) mu-headers-hash))
+
 (defvar mu-headers-fields
   '( (:date          .  25)
      (:from-or-to    .  22)
@@ -55,7 +84,7 @@ the mu find output")
 (defvar mu-headers-expression nil
   "search expression for the current find buffer")
 
-(defvar mu-buf "" "buffer for results data")
+(defvar mu-buf "" "internal: 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
@@ -63,10 +92,11 @@ the mu find output")
   (save-excursion
     (setq mu-buf (concat mu-buf str))
     (let ((eom (string-match mu-eom mu-buf)))
-      (while (numberp eom)
+       (while (numberp eom)
 	(let* ((msg (car (read-from-string (substring mu-buf 0 eom))))
 		(inhibit-read-only t))
-	    (goto-char (point-max))
+	  (goto-char (point-max))
+	  (mu-headers-set-path (plist-get msg :path))
 	  (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))))))
@@ -116,14 +146,18 @@ the mu find output")
 		  "--quiet"
 		  expr)))
     (switch-to-buffer buf)
+    (mu-headers-mode)
+    
     (setq
       mu-buf "" ;; if the last query went wrong... 
       mu-headers-expression expr
-      mu-headers-process proc)
-            
+      mu-headers-process proc
+
+      mu-headers-hash       (make-hash-table :size 256 :rehash-size 2)
+      mu-headers-marks-hash (make-hash-table :size 16  :rehash-size 2))
+    
     (set-process-filter   proc 'mu-headers-process-filter)
-    (set-process-sentinel proc 'mu-headers-process-sentinel)    
-    (mu-headers-mode)))
+    (set-process-sentinel proc 'mu-headers-process-sentinel)))
 
 (defun mu-headers-field-contact (lst width face)
   "display a list of contacts, truncated for fitting in WIDTH"
@@ -201,11 +235,10 @@ the mu find output")
 (defun mu-headers-header (msg)
   "convert a message s-expression into a header for display, and
 set text property 'path"
-  (let ((fields (mapconcat
-		  (lambda (fieldinfo)
-		    (mu-headers-field msg fieldinfo)) mu-headers-fields " ")))	  
-    (propertize (concat "  " fields) 'front-sticky t
-      'path (plist-get msg :path))))
+  (concat "  "
+    (mapconcat
+      (lambda (fieldinfo)
+	(mu-headers-field msg fieldinfo)) mu-headers-fields " ")))
 
 
 (defun mu-headers-mode ()
@@ -213,11 +246,17 @@ set text property 'path"
   (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) 
+
+  (make-local-variable 'mu-buf)
+  (make-local-variable 'mu-parent-buffer)
+  (make-local-variable 'mu-headers-expression)
+  (make-local-variable 'mu-headers-process)
+  (make-local-variable 'mu-headers-hash)
+  (make-local-variable 'mu-headers-marks-hash)
+
   (setq
     major-mode 'mu-headers-mode mode-name "*headers*"
+    mu-buf ""
     truncate-lines t buffer-read-only t
     overwrite-mode 'overwrite-mode-binary))
 
@@ -245,13 +284,13 @@ set text property 'path"
 (defun mu-headers-view ()
   "display the message at the current line"
   (interactive)
-  (let ((path (mu-get-path)))
+  (let ((path (mu-headers-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)))    
+  (if (or (/= 0 (forward-line 1)) (not (mu-headers-get-path)))    
     (progn (message "No message after this one") nil)
     t))
 
@@ -310,171 +349,76 @@ if the search process is not already running"
   (and (call-interactively 'mu-headers-change-sort-order)
     (call-interactively 'mu-headers-change-sort-direction)))
 
+(defun mu-headers-add-marked (src dst)
+  (let ((bol (line-beginning-position 1)))
+    (if (gethash bol mu-headers-marks-hash)
+      (progn (message "Message is already marked") nil)
+      (progn (puthash bol (cons src dst) mu-headers-marks-hash) t))))
 
-;; 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 " ")))
-	  t)))))
+(defun mu-headers-remove-marked ()
+  (let ((bol (line-beginning-position 1)))
+    (if (not (gethash bol mu-headers-marks-hash))
+      (progn (message "Message is not marked") nil)
+      (progn (remhash bol mu-headers-marks-hash) 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-set-marker (kar)
+  "set the marker at the beginning of this line"
+  (beginning-of-line 1)
+  (let ((inhibit-read-only t))
+    (delete-char 2)
+    (insert (if kar kar " ") " ")))
 
-(defun mu-headers-marked-execute ()
-  "execute marked actions on messages in the current buffer"
+(defun mu-headers-mark (action)
+  "mark the current msg for something: move, delete, trash, unmark"
+  (let ((target) (src (mu-headers-get-path)))
+    (when (and src
+	    (case action
+	      (move
+		(when (mu-headers-add-marked src (mu-ask-folder "Target maildir: "))
+		  (mu-headers-set-marker ?m)))
+	      (trash
+		(when (mu-headers-add-marked src mu-trash-folder)
+		  (mu-headers-set-marker ?d)))
+	      (delete
+		(when (mu-headers-add-marked src "/dev/null")
+		  (mu-headers-set-marker ?D)))
+	      (unmark
+		(when (mu-headers-remove-marked src "dummy")
+		  (mu-headers-set-marker nil)))
+	      (unmark-all
+		(when (y-or-n-p (format "Sure you want to remove all (%d) marks? "
+				  (hash-table-count mu-headers-marks-hash)))
+		  (save-excursion
+		    (maphash (lambda (k v) (goto-char k) (mu-headers-mark 'unmark))
+		      mu-headers-marks-hash)))
+		(t (message "Unsupported mark type"))))))))
+
+(defun mu-headers-marks-execute ()
+  "execute the actions for all marked messages"
   (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)))
-	(let ((failed (mu-headers-executed-marked 'delete)))
-	  (if (/= 0 failed)
-	    (message "Failed to delete %d of %d message(s)" failed deletenum)
-	    (message "%d message(s) deleted" deletenum)
-	    (mu-headers-refresh)))))))
-	  
+  (let ((n-marked (hash-table-count mu-headers-marks-hash)))
+    (if (= 0 n-marked)
+      (message "No marked messages")
+      (when (y-or-n-p
+	      (format "Execute actions for %d marked message(s)? " n-marked))
+	(save-excursion
+	  (maphash
+	    (lambda(bol v)
+	      (let ((src (car v)) (target (cdr v)) (inhibit-read-only t))
+		(when (mu-message-move src target)  
+		  (goto-char bol)
+		  (mu-headers-remove-marked)
+		  (put-text-property bol (line-beginning-position 2)
+		    'face 'invisible)))) ;; when it succeedes, hide msg..)
+	    mu-headers-marks-hash))))))
+  
+(defun mu-headers-mark-for-move () (interactive) (mu-headers-mark 'move))
+(defun mu-headers-mark-for-trash () (interactive) (mu-headers-mark 'trash))
+(defun mu-headers-mark-for-delete () (interactive) (mu-headers-mark 'delete))
+(defun mu-headers-unmark () (interactive) (mu-headers-mark 'unmark))
+(defun mu-headers-unmark-all () (interactive) (mu-headers-mark 'unmark-all))
 
-(defun mu-headers-executed-marked (execute-action)
-  "handle marked headers for action; return the number of failed
-actions"
-  (let ((failed 0))
-    (mu-headers-foreach-marked
-      (lambda (cell)
-	(let ((action (nth 0 cell)) (src (nth 1 cell)) (target (nth 2 cell)))
-	  (when (eq action execute-action)
-	    (unless
-	      (case action
-		('delete (mu-message-delete src))
-		(t (message "Unsupported action")))
-	      (setq failed (+ 1 failed)))))))
-    failed)) 
- 
-
-(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-headers-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-headers-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-headers-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")
-    (forward-line)))
-
-(defun mu-headers-mark-for-deletion ()
-  (interactive)
-  (when (mu-headers-mark 'delete)
-    (message "Message marked for deletion")
-    (forward-line)))
-
-(defun mu-headers-mark-for-move ()
-  (interactive)
-  (when (mu-headers-mark 'move)
-    (message "Message marked for moving")
-    (forward-line)))
-
-(defun mu-headers-unmark ()
-  (interactive)
-  (when (mu-headers-mark 'none)
-    (message "Message unmarked")
-    (forward-line)))
-   
 
 (provide 'mu-headers)
   
diff --git a/emacs/mu-message.el b/emacs/mu-message.el
index 6fe35ed2..e82e586c 100644
--- a/emacs/mu-message.el
+++ b/emacs/mu-message.el
@@ -129,14 +129,33 @@ to the message editor"
 creation, switch to the message editor"
   (mu-message-reply-or-forward path t))
 
-(defun mu-message-delete (path)
-  "delete message at PATH using 'mu mv'; return t if succeeded, nil otherwise"
-  (let
-    ((rv (call-process mu-binary nil nil nil "mv" path "/dev/null")))
-    (setq okay (and (numberp rv) (= rv 0)))
-    (message (if okay "Message has been deleted" "Message deletion failed"))
+(defun mu-message-move (src targetdir)
+  "move message at PATH using 'mu mv'; if targetdir is
+'/dev/null', move immediately. Return t if succeeded, nil
+otherwise"
+  (let* ((cmd (concat
+		mu-binary " mv --printtarget "
+		(shell-quote-argument src) " "
+		(shell-quote-argument targetdir)))
+	  (fulltarget (shell-command-to-string cmd)))
+    (mu-log cmd)
+    
+    (mu-log
+      (if fulltarget (concat "Message has been moved to " fulltarget)
+	"Message moving failed"))
     ;; now, if saving worked, anynchronously try to update the database
-    (start-process " *mu-remove*" nil mu-binary "remove" path)
-    okay)) ;; note, we don't check the result of the db output
+    (when fulltarget
+      (start-process " *mu-remove*" nil mu-binary "remove" src)
+      (unless (string= targetdir "/dev/null")
+	(start-process " *mu-add*" nil mu-binary "add" fulltarget)))))
+
+;; note, we don't check the result of the db output
+
+
+
+
+
+
+
 
 (provide 'mu-message)
diff --git a/emacs/mu-view.el b/emacs/mu-view.el
index 2b5eeb42..3a7d7ac5 100644
--- a/emacs/mu-view.el
+++ b/emacs/mu-view.el
@@ -110,20 +110,16 @@ buffer."
   (let ((str (mu-view-message path))
 	 (buf (mu-get-new-buffer mu-view-buffer-name)))
     (when str
-      (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 buf)
-      (mu-view-mode)
-
-      ;; these are buffer-local
-      (setq mu-parent-buffer parentbuf)
-      (setq mu-view-headers-buffer parentbuf)
-
-      (goto-char (point-min)))))
+      (insert str))
+    (mu-view-mode)
+     
+    (setq ;; these are buffer-local
+	mu-parent-buffer parentbuf
+	mu-view-headers-buffer parentbuf
+	mu-path path)
+      
+      (goto-char (point-min))))
 
 (defvar mu-view-mode-map
   (let ((map (make-sparse-keymap)))
@@ -152,8 +148,11 @@ buffer."
   (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)
+
+  (make-local-variable 'mu-parent-buffer)
+  (make-local-variable 'mu-headers-buffer)
+  (make-local-variable 'mu-path)
+    
   (setq major-mode 'mu-view-mode mode-name "*mu-view*")
   (setq truncate-lines t buffer-read-only t))
 
@@ -174,14 +173,14 @@ also `with-temp-buffer'."
   (interactive)
   (with-current-headers-buffer
     (when (mu-headers-next)
-      (mu-view (mu-get-path) (current-buffer)))))
+      (mu-view (mu-headers-get-path) (current-buffer)))))
 
 (defun mu-view-prev ()
   "move to the previous message"
   (interactive)
   (with-current-headers-buffer
     (when (mu-headers-prev)
-      (mu-view (mu-get-path) (current-buffer)))))
+      (mu-view (mu-headers-get-path) (current-buffer)))))
 
 (defun mu-view-mark-for-trash ()
   "mark for thrashing"
diff --git a/emacs/mu.el b/emacs/mu.el
index e5934f2c..b220ebd7 100644
--- a/emacs/mu.el
+++ b/emacs/mu.el
@@ -44,7 +44,7 @@
 (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-marked-execute)
+(define-key mu-headers-mode-map "x" 'mu-headers-marks-execute)
 
 
 (define-key mu-view-mode-map "q" 'mu-quit-buffer)