From: Jesse Rosenthal <jrosenthal@jhu.edu>
To: Notmuch developer list <notmuch@notmuchmail.org>
Subject: [PATCH 1/3] emacs: add tach.el,
	a minor mode for attaching files in message-mode.
Date: Tue, 27 Apr 2010 13:18:07 -0400
Message-ID: <878w88ke5s.fsf@jhu.edu>
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Precedence: list


Add tach.el, a general-purpose interface for attaching files in
message-mode. It opens up a bottom buffer, and allows the user to add or
remove files with "+" or "-". It is modeled roughly after mutt's
attachment interface.

More information can be found in this original announcement:
id:87sk8vz3hm.fsf@jhu.edu

This is not notmuch-specific, so it doesn't use a
notmuch-preface. It will only be required if called from a
notmuch function, to be added in a later patch in this series.
---
 emacs/tach.el |  335 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 335 insertions(+), 0 deletions(-)
 create mode 100644 emacs/tach.el

diff --git a/emacs/tach.el b/emacs/tach.el
new file mode 100644
index 0000000..440e71d
--- /dev/null
+++ b/emacs/tach.el
@@ -0,0 +1,335 @@
+;; tach.el -- Interface for handling attachments in message-mode
+
+;; Filename: tach.el
+;; Copyright (C) 2010 Jesse Rosenthal
+;; Author: Jesse Rosenthal <jrosenthal@jhu.edu>
+;; Maintainer: Jesse Rosenthal <jrosenthal@jhu.edu>
+;; Created: 18 Feb 2010
+;; Description: Handles attachments for message mode
+;; Version 0.01alpha
+
+;; This file is not part of GNU Emacs.
+
+;; This file 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 2, or (at your
+;; option) any later version.
+
+;; This program 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; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; To use: add the following to your .emacs:
+;;   (require 'tach)
+;;   (add-hook 'message-mode-hook 'tach-minor-mode)
+;;
+;; Pressing `C-cC-a' in message mode will open up an attachment
+;; window. The first time you open it, it will prompt for a file name.
+;;
+;; In the attachment window, you can press `+' to add a file, or `-'
+;; to remove one.
+;;
+;; Note that the attachment window is actually a different view of the
+;; message buffer, so that if there is some failure, the attachment
+;; list will be saved at the bottom of the message, as a numerical
+;; list under a customizable separator.
+;;
+;; The files will be added to the outgoing message by mml before it is
+;; sent.
+
+
+(require 'message)
+(require 'mml)
+
+(defconst tach-sep  "--attachments follow this line--")
+
+(defconst tach-line-regexp "^\\([0-9]+.\\) +\\(.+?\\) +\\(\\[.+, [0-9\.]+[KM]\\]\\)$")
+
+(defvar tach-send-confirmation nil)
+
+(defvar tach-buffer-name)
+(make-variable-buffer-local 'tach-buffer-name)
+
+(defvar tach-mode-hooks 'nil)
+(make-variable-buffer-local 'tach-mode-hooks)
+
+(defvar tach-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "+" 'tach-add-file)
+    (define-key map "-" 'tach-delete-file)
+    (define-key map "\C-c\C-c" 'tach-send-from-attach-buffer)
+    (define-key map [up] 'tach-prev-entry)
+    (define-key map [down] 'tach-next-entry)
+    (define-key map "n" 'tach-next-entry)
+    (define-key map "p" 'tach-prev-entry)
+    (define-key map "\C-n" 'tach-next-entry)
+    (define-key map "\C-p" 'tach-prev-entry)
+    map)
+  "Keymap for attachment mode")
+(fset 'tach-mode-map tach-mode-map)
+
+(defvar tach-minor-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-c\C-a"  'tach-goto)
+    map)
+  "Keymap for attachment minor mode")
+(fset 'tach-minor-mode-map tach-minor-mode-map)
+
+(defun tach-mode ()
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map 'tach-mode-map)
+  (hl-line-mode 1)
+  (setq major-mode 'tach-mode
+	mode-name "attachment")
+  (run-hooks 'tach-mode-hooks)
+  (widen)
+  (narrow-to-region (tach-buffer-point-min) (point-max))
+  (setq buffer-read-only t))
+
+(defun tach-buffer-point-min ()
+  (save-excursion
+    (goto-char (point-max))
+    (search-backward-regexp tach-sep)
+    (search-forward-regexp (concat tach-sep "\n"))
+    (point)))
+
+
+(defun tach-message-point-max ()
+  (save-excursion
+    (goto-char (point-max))
+    (search-backward-regexp tach-sep)
+    (point)))
+
+
+(defun tach-first-entry-p ()
+  (save-restriction
+    (widen)
+    (save-excursion
+      (forward-line -1)
+      (looking-at (concat "^" tach-sep "%")))))
+
+(defun tach-last-entry-p ()
+  (save-excursion
+    (forward-line)
+    (looking-at "^\s*$")))
+
+(defun tach-next-entry ()
+  (interactive)
+  (unless (tach-last-entry-p)
+    (forward-line 1)))
+
+(defun tach-prev-entry ()
+  (interactive)
+  (unless (tach-first-entry-p)
+    (forward-line -1)))
+
+
+(defun tach-has-attachments-p ()
+  (interactive)
+  (save-excursion
+  (goto-char (point-max))
+  (cond ((re-search-backward (concat "^" tach-sep "$")  nil t)
+	 (forward-line)
+	 (while (looking-at tach-line-regexp)
+	   (forward-line))
+	 (let ((remaining
+		(buffer-substring-no-properties (point) (point-max))))
+	   (if (string-match "[^\s\n]" remaining)
+	       nil
+	     t)))
+	(t
+	 nil))))
+
+(defun tach-message-initialize ()
+  (save-excursion
+   (unless (tach-has-attachments-p)
+     (goto-char (point-max))
+     (insert (concat "\n" tach-sep "\n")))
+    (narrow-to-region (point-min) (tach-message-point-max))))
+
+(defun tach-goto ()
+  (interactive)
+  (if (get-buffer tach-buffer-name)
+      (pop-to-buffer tach-buffer-name)
+    ;else
+    (tach-message-initialize)
+    (pop-to-buffer (make-indirect-buffer
+		    (current-buffer)
+		    tach-buffer-name)))
+  (tach-mode))
+
+(defun tach-read-list ()
+  (save-excursion
+    (let ((output nil))
+      (goto-char (point-max))
+      (re-search-backward (concat "^" tach-sep "$"))
+      (forward-line)
+      (while (and (looking-at tach-line-regexp)
+		  (not (= (line-end-position) (point-max))))
+	(setq output (cons (replace-regexp-in-string
+			    tach-line-regexp "\\2"
+			    (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
+			   output))
+	(forward-line))
+      (reverse output))))
+
+(defun tach-delete-list ()
+  (save-excursion
+    (goto-char (point-max))
+    (re-search-backward (concat "^" tach-sep "$"))
+    (end-of-line)
+    (delete-region (point) (point-max))))
+
+(defun tach-write-list (lst)
+  (save-excursion
+    (goto-char (point-max))
+    (re-search-backward (concat "^" tach-sep "$"))
+    (end-of-line)
+    (newline)
+    (let ((counter 1))
+      (dolist (elt lst)
+	(insert (concat (int-to-string counter) ". " elt
+			"  ["
+			(if (mm-default-file-encoding elt)
+			    (mm-default-file-encoding elt)
+			  "(type unknown)")
+			", "
+			(tach-format-file-size (nth 7 (file-attributes elt)))
+			"]"))
+	(newline)
+	(setq counter (+ counter 1))))))
+
+(defun tach-format-file-size (bytes)
+  (let ((kbytes (fceiling (/ bytes 1024.0))))
+    (cond ((< kbytes 1)p
+	   (format "%.1fK" kbytes))
+	  ((< kbytes 1000)
+	   (format "%.0fK" kbytes))
+	  (t
+	   (format "%.1fM" (/ kbytes 1000.0))))))
+
+(defun tach-first-n-items (lst n)
+  (let ((x 0)
+	y)
+    (if (> n (length lst))
+	(setq y lst)
+      (while (< x n)
+	(setq y (nconc y (list (nth x lst)))
+	      x (1+ x))))
+    y))
+
+(defun tach-insert-item-at-idx (item idx lst)
+  (append (tach-first-n-items lst idx) (cons item (nthcdr idx lst))))
+
+(defun tach-remove-item-at-idx (idx lst)
+  (append (tach-first-n-items lst idx) (nthcdr (+ 1 idx) lst)))
+
+(defun tach-add-file (f &optional idx)
+  (interactive "fFile to attach: ")
+  (if (file-directory-p f)
+      (error "Cannot attach a directory")
+    ;;else
+    (when buffer-read-only
+      (setq buffer-read-only nil))
+    (widen)
+    (let ((file-lst (tach-read-list))
+	  (orig-line (line-number-at-pos))
+	  (orig-point (point)))
+      (tach-delete-list)
+      (when (null idx)
+	(cond ((= (length file-lst) 0)
+	       (setq idx 0))
+	      (t
+	       (setq idx (- orig-line (line-number-at-pos))))))
+      (tach-write-list
+       (tach-insert-item-at-idx f idx file-lst)))
+      (narrow-to-region (tach-buffer-point-min) (point-max))
+      (forward-line idx)
+      (when (null buffer-read-only)
+	(setq buffer-read-only t))))
+
+(defun tach-delete-file (&optional idx)
+  (interactive)
+    (when buffer-read-only
+      (setq buffer-read-only nil))
+    (widen)
+    (let ((file-lst (tach-read-list))
+	  (orig-line (line-number-at-pos))
+	  (orig-point (point)))
+      (tach-delete-list)
+      (when (null idx)
+	(setq idx (- (- orig-line (line-number-at-pos)) 1)))
+      (tach-write-list (tach-remove-item-at-idx idx file-lst)))
+    (narrow-to-region (tach-buffer-point-min) (point-max))
+    (unless (= idx 0)
+      (forward-line (- idx 1)))
+    (when (null buffer-read-only)
+      (setq buffer-read-only t)))
+
+(defun tach-mml-files ()
+  (interactive)
+  (when (tach-has-attachments-p)
+  (widen)
+  (let ((file-lst (tach-read-list)))
+    (tach-delete-list)
+    (goto-char (point-max))
+    (re-search-backward (concat "^" tach-sep "$"))
+    (delete-region (point) (point-max))
+    (newline)
+    (dolist (f file-lst)
+      (mml-attach-file f)
+      (goto-char (point-max))))))
+
+
+(defun tach-kill-buffer ()
+  (when (get-buffer tach-buffer-name)
+    (delete-windows-on tach-buffer-name)
+    (kill-buffer tach-buffer-name)))
+
+(defun tach-send-from-attach-buffer ()
+  (interactive)
+  (when (buffer-base-buffer tach-buffer-name)
+    (with-current-buffer (buffer-base-buffer tach-buffer-name)
+      (message-send-and-exit))))
+
+
+
+(define-minor-mode tach-minor-mode ()
+  nil
+  " Tach"
+  'tach-minor-mode-map
+  (if tach-minor-mode
+      (progn
+  	;; set the attachment buffer local variable
+  	(setq tach-buffer-name
+  	      (generate-new-buffer-name
+  	       (concat
+  		"*"
+  		(replace-regexp-in-string
+  		 "^\\(\**\\)\\(.*?\\)\\(\**\\)$" "\\2" (buffer-name))
+  		"-attachments*")))
+  	;; add the send hook
+  	(add-hook 'message-send-hook '(lambda ()
+  					     (tach-mml-files)
+  					     (tach-kill-buffer))))
+    ;; remove the send hook
+    (remove-hook 'message-send-hook '(lambda ()
+  					    (tach-mml-files)
+  					    (tach-kill-buffer)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(provide 'tach)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-- 
1.6.3.3