[PATCH 1/3] emacs: add tach.el, a minor mode for attaching files in message-mode.
Jesse Rosenthal
jrosenthal at jhu.edu
Tue Apr 27 10:18:07 PDT 2010
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 at 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 at jhu.edu>
+;; Maintainer: Jesse Rosenthal <jrosenthal at 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
More information about the notmuch
mailing list