From ce686d76d2cff20d5abc2bd3ee30bd79dd9a0aa8 Mon Sep 17 00:00:00 2001 From: djcb Date: Sun, 27 Nov 2011 16:23:14 +0200 Subject: [PATCH] * mm: add pipe-message support, inspect-with-guile support (WIP) --- toys/mm/mm-view.el | 90 ++++++++++++++++++++++++++++++++++++++++------ toys/mm/mm.el | 9 ++++- 2 files changed, 87 insertions(+), 12 deletions(-) diff --git a/toys/mm/mm-view.el b/toys/mm/mm-view.el index 172b0b13..7e74d37a 100644 --- a/toys/mm/mm-view.el +++ b/toys/mm/mm-view.el @@ -34,6 +34,7 @@ (eval-when-compile (require 'cl)) (require 'html2text) (require 'filladapt) +(require 'comint) (defconst mm/view-buffer-name "*mm-view*" "*internal* Name for the message view buffer") @@ -212,6 +213,8 @@ or if not available, :body-html converted to text)." (define-key map "e" 'mm/edit-draft) (define-key map "." 'mm/view-raw) + (define-key map "|" 'mm/view-pipe) + (define-key map "I" 'mm/inspect-message) ;; intra-message navigation (define-key map (kbd "SPC") 'scroll-up) @@ -266,6 +269,12 @@ or if not available, :body-html converted to text)." '("Toggle wrap lines" . mm/view-toggle-wrap-lines)) (define-key menumap [hide-cited] '("Toggle hide cited" . mm/view-toggle-hide-cited)) + (define-key menumap [view-raw] + '("View raw message" . mm/view-raw)) + (define-key menumap [pipe] + '("Pipe through shell" . mm/view-pipe)) + (define-key menumap [inspect] + '("Inspect with guile" . mm/inspect-message)) (define-key menumap [sepa8] '("--")) (define-key menumap [open-att] @@ -370,23 +379,25 @@ removing '^M' etc." (propertize (format "[%d]" num) 'face 'mm/view-url-number-face)))))))) - - - ;; raw mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; some buffer-local variables +(defvar mm/view-buffer nil + "*internal* View buffer connected to this raw view.") + (defun mm/view-raw-mode () "Major mode for viewing of raw e-mail message." (interactive) (kill-all-local-variables) (use-local-map mm/view-raw-mode-map) + (make-local-variable 'mm/view-buffer) + (setq major-mode 'mm/view-raw-mode mode-name mm/view-raw-buffer-name) (setq truncate-lines t buffer-read-only t)) - (defvar mm/view-raw-mode-map nil "Keymap for \"*mm-view-raw*\" buffers.") @@ -394,9 +405,9 @@ removing '^M' etc." (setq mm/view-raw-mode-map (let ((map (make-sparse-keymap))) - (define-key map "q" 'kill-buffer) - (define-key map "." 'kill-buffer) - + (define-key map "q" 'mm/view-raw-quit-buffer) + (define-key map "." 'mm/view-raw-quit-buffer) + ;; intra-message navigation (define-key map (kbd "SPC") 'scroll-up) (define-key map (kbd "") @@ -412,14 +423,14 @@ removing '^M' etc." (define-key map [menu-bar] (make-sparse-keymap)) (let ((menumap (make-sparse-keymap "Raw view"))) (define-key map [menu-bar headers] (cons "Raw view" menumap)) - - (define-key menumap [quit-buffer] '("Quit" . kill-buffer)) + (define-key menumap [quit-buffer] '("Quit" . + mm/view-raw-quit-buffer)) map)))) (fset 'mm/view-raw-mode-map mm/view-raw-mode-map) -(defun mm/view-raw-message (msg) +(defun mm/view-raw-message (msg view-buffer) "Display the raw contents of message MSG in a new buffer." (let ((buf (get-buffer-create mm/view-raw-buffer-name)) (inhibit-read-only t) @@ -431,8 +442,33 @@ removing '^M' etc." (insert-file file) ;; initialize view-mode (mm/view-raw-mode) + (setq mm/view-buffer view-buffer) (switch-to-buffer buf) (goto-char (point-min))))) + + +(defun mm/view-shell-command-on-raw-message (msg view-buffer cmd) + "Process the raw message with shell command CMD." + (let ((buf (get-buffer-create mm/view-raw-buffer-name)) + (inhibit-read-only t) + (file (plist-get msg :path))) + (unless (and file (file-readable-p file)) + (error "Not a readable file: %S" file)) + (with-current-buffer buf + (erase-buffer) + (process-file-shell-command cmd file buf) + (mm/view-raw-mode) + (setq mm/view-buffer view-buffer) + (switch-to-buffer buf) + (goto-char (point-min))))) + + +(defun mm/view-raw-quit-buffer () + "Quit the raw view and return to the message." + (interactive) + (if (buffer-live-p mm/view-buffer) + (switch-to-buffer mm/view-buffer) + (kill-buffer))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -563,7 +599,39 @@ list." (interactive) (unless mm/current-msg (error "No current message")) - (mm/view-raw-message mm/current-msg)) + (mm/view-raw-message mm/current-msg (current-buffer))) +(defun mm/view-pipe (cmd) + "Pipe the message through shell command CMD, and display the +results." + (interactive "sShell command: ") + (unless mm/current-msg + (error "No current message")) + (mm/view-shell-command-on-raw-message mm/current-msg (current-buffer) cmd)) + +(defconst mm/muile-buffer-name "*muile*" + "Name of the buffer to execute muile.") + +(defconst mm/muile-process-name "*muile*" + "Name of the muile process.") + + +;; note, implementation is very basic/primitive; we probably need comint to do +;; something like geiser does (http://www.nongnu.org/geiser/). Desirable +;; features: a) the output is not editable b) tab-completions work +(defun mm/inspect-message () + "Inspect the current message in the Guile/Muile shell." + (interactive) + (unless mm/muile-binary (error "`mm/muile-binary' is not defined")) + (unless (or (file-executable-p mm/muile-binary) + (executable-find mm/muile-binary)) + (error "%S not found" mm/muile-binary)) + (unless mm/current-msg + (error "No current message")) + (get-buffer-create mm/muile-buffer-name) + (start-process mm/muile-buffer-name mm/muile-process-name + mm/muile-binary "--msg" (plist-get mm/current-msg :path)) + (switch-to-buffer mm/muile-buffer-name) + (shell-mode)) (provide 'mm-view) diff --git a/toys/mm/mm.el b/toys/mm/mm.el index 52e42cf3..e6642b4b 100644 --- a/toys/mm/mm.el +++ b/toys/mm/mm.el @@ -50,7 +50,14 @@ (defcustom mm/mu-binary "mu" "Name of the mu-binary to use; if it cannot be found in your -PATH, you can specifiy the full path." +PATH, you can specify the full path." + :type 'file + :group 'mm + :safe 'stringp) + +(defcustom mm/muile-binary "muile" + "Name of the muile-binary to use; if it cannot be found in your +PATH, you can specify the full path." :type 'file :group 'mm :safe 'stringp)