[PATCH] emacs: Improved printing support.

[Aaron Ecay]

I don’t have (easy access to) a printer, so I haven’t actually exercised
the printing functionality of this patch.

In general, the patch LGTM.  Specific comments below.

On Tue,  3 Jan 2012 14:12:26 +0000, David Edmondson <dme at dme.org> wrote:
> Add various functions to print notmuch messages and tie them together
> with a simple frontend. No keybinding is currently made to encourage
> paper saving.
> ---
> 
> Fix the lack of shell quoting for muttprint. Rename the ps-print
> buffers to have a relevant name.
> 
>  emacs/Makefile.local   |    3 +-
>  emacs/notmuch-print.el |   79 ++++++++++++++++++++++++++++++++++++++++++++++++
>  emacs/notmuch-show.el  |   51 +++++++++++++++++++++++++++++++
>  3 files changed, 132 insertions(+), 1 deletions(-)
>  create mode 100644 emacs/notmuch-print.el
> 
> diff --git a/emacs/Makefile.local b/emacs/Makefile.local

[...]

> --- /dev/null
> +++ b/emacs/notmuch-print.el
> @@ -0,0 +1,79 @@
> +;; notmuch-print.el --- printing messages from notmuch.
> +;;
> +;; Copyright © David Edmondson
> +;;
> +;; This file is part of Notmuch.
> +;;
> +;; Notmuch 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.
> +;;
> +;; Notmuch 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 Notmuch.  If not, see <http://www.gnu.org/licenses/>.
> +;;
> +;; Authors: David Edmondson <dme at dme.org>
> +
> +(defcustom notmuch-print-mechanism 'notmuch-print-lpr
> +  "How should printing be done?"
> +  :group 'notmuch
> +  :type '(choice
> +	  (function :tag "Use lpr" notmuch-print-lpr)
> +	  (function :tag "Use ps-print" notmuch-print-ps-print)
> +	  (function :tag "Use ps-print then evince" notmuch-print-ps-print/evince)
> +	  (function :tag "Use muttprint" notmuch-print-muttprint)
> +	  (function :tag "Use muttprint then evince" notmuch-print-muttprint/evince)
> +	  (function :tag "Using a custom function")))
> +
> +(defmacro notmuch-print-with-file (filename &rest body)
> +  `(with-temp-buffer
> +     (insert-file-contents ,filename)
> +     (set-buffer-modified-p nil)
> +     , at body))
> +
> +(defun notmuch-print-lpr (filename msg)
> +  (notmuch-print-with-file filename
> +			   (lpr-buffer)))
> +
> +(defun notmuch-print-ps-print (filename msg)
> +  (let ((subject (plist-get (notmuch-show-get-prop :headers msg) :Subject)))
> +    (notmuch-print-with-file filename
> +			     (rename-buffer subject t)
> +			     (ps-print-buffer))))
> +
> +(defun notmuch-print-ps-print/evince (filename msg)
> +  (let ((ps-file (make-temp-file "notmuch"))
> +	(subject (plist-get (notmuch-show-get-prop :headers msg) :Subject)))
> +    (notmuch-print-with-file filename
> +			     (rename-buffer subject t)
> +			     (ps-print-buffer ps-file)
> +			     (async-shell-command (concat "evince " ps-file)))))
> +
> +(defun notmuch-print-muttprint (filename msg)
> +  (shell-command
> +   (concat "muttprint "
> +	   "--file " (shell-quote-argument filename) " "
> +	   ;; Show the tags.
> +	   "--printed-headers 'Date_To_From_CC_Newsgroups_*Subject*_/Tags/'")))
> +
> +(defun notmuch-print-muttprint/evince (filename msg)
> +  (let ((ps-file (make-temp-file "notmuch")))
> +    (call-process-shell-command
> +     (concat "muttprint "
> +	     "--file " (shell-quote-argument filename) " "
> +	     ;; Show the tags.
> +	     "--printed-headers 'Date_To_From_CC_Newsgroups_*Subject*_/Tags/' "
> +	     "--printer 'TO_FILE:" (shell-quote-argument ps-file) "'"))
> +    (async-shell-command (concat "evince " ps-file))))
> +
> +(defun notmuch-print-message (filename msg)
> +  (funcall notmuch-print-mechanism filename msg))
> +
> +;;

The above is just a stray comment line, right?

> +
> +(provide 'notmuch-print)
> diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
> index 5502efd..55ccfc5 100644
> --- a/emacs/notmuch-show.el
> +++ b/emacs/notmuch-show.el
> @@ -34,6 +34,7 @@
>  (require 'notmuch-wash)
>  (require 'notmuch-mua)
>  (require 'notmuch-crypto)
> +(require 'notmuch-print)
>  
>  (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
>  (declare-function notmuch-fontify-headers "notmuch" nil)
> @@ -186,6 +187,51 @@ indentation."
>        mm-handle (> (notmuch-count-attachments mm-handle) 1))))
>    (message "Done"))
>  
> +(defun notmuch-show-with-message-as-text (fn)
> +  "Apply function `fn' to a text representation of the current
> +message."

I think the docstring should say what agrs get passed to ‘fn’.  Also,
function arguments should be referred to with capital letters, and the
first line should be a complete sentence.  I’d recommend “Apply FN to
(...the rest unchanged)” for brevity in the first line.

(For anyone who is curious, these and other conventions are documented
in section D.6 of the Elisp manual.)

> +
> +  ;; Remake the header to ensure that all information is available.
> +  (let* ((to (notmuch-show-get-to))
> +	 (cc (notmuch-show-get-cc))
> +	 (from (notmuch-show-get-from))
> +	 (subject (notmuch-show-get-subject))
> +	 (date (notmuch-show-get-date))
> +	 (tags (notmuch-show-get-tags))
> +	 (depth (notmuch-show-get-depth))
> +
> +	 (header (concat
> +		  "Subject: " subject "\n"
> +		  "To: " to "\n"
> +		  (if (not (string= cc ""))
> +		      (concat "Cc: " cc "\n")
> +		    "")
> +		  "From: " from "\n"
> +		  "Date: " date "\n"
> +		  (if tags
> +		      (concat "Tags: "
> +			      (mapconcat '(lambda (tag) tag) tags ", ") "\n")

#'identity instead of the lambda

> +		    "")))
> +	 (all (buffer-substring (notmuch-show-message-top)
> +				(notmuch-show-message-bottom)))
> +
> +	 (file (make-temp-file "notmuch")))
> +    (with-temp-file file
> +      (insert all)
> +      (indent-rigidly (point-min) (point-max) (- depth))
> +      ;; Remove the original header.
> +      (goto-char (point-min))
> +      (re-search-forward "^$" (point-max) nil)
> +      (delete-region (point-min) (point))
> +      (insert header))
> +    (funcall fn file (notmuch-show-get-message-properties))
> +    (delete-file file)))

Why does this function write to a file?  It seems that, of the print
methods, two (ps-print and lpr) don’t use the file at all.  One
(ps-print/evince) creates yet another file, without depending on the
first.  The other muttprint functions do use the file.  So:
- This function would be more general if it didn’t handle file-writing
  itself, but rather let each consumer of text-ified messages handle
  that if needed.
- It would be cleaner if print backends that don’t crucially depend on
  the existence of a file didn’t create one at all.  If muttprint can
  accept a message on stdin (it looks from the source like it can; it
  gives me some error message about Iconv Perl modules when I try to run
  it, so I can’t be sure), maybe writing to a file isn’t necessary at
  all.

> +
> +(defun notmuch-show-print-message ()
> +  "Print the current message."
> +  (interactive)
> +  (notmuch-show-with-message-as-text 'notmuch-print-message))
> +
>  (defun notmuch-show-fontify-header ()
>    (let ((face (cond
>  	       ((looking-at "[Tt]o:")
> @@ -760,6 +806,8 @@ current buffer, if possible."
>        (overlay-put headers-overlay 'priority 10))
>      (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)
>  
> +    (plist-put msg :depth depth)
> +
>      ;; Save the properties for this message. Currently this saves the
>      ;; entire message (augmented it with other stuff), which seems
>      ;; like overkill. We might save a reduced subset (for example, not
> @@ -1111,6 +1159,9 @@ Some useful entries are:
>  (defun notmuch-show-get-to ()
>    (notmuch-show-get-header :To))
>  
> +(defun notmuch-show-get-depth ()
> +  (notmuch-show-get-prop :depth))
> +
>  (defun notmuch-show-set-tags (tags)
>    "Set the tags of the current message."
>    (notmuch-show-set-prop :tags tags)
> -- 
> 1.7.7.3
> 
> _______________________________________________
> notmuch mailing list
> notmuch at notmuchmail.org
> http://notmuchmail.org/mailman/listinfo/notmuch

-- 
Aaron Ecay