cgit.sxemacs.org Git - packages/blob - xemacs-packages/vm/lisp/vm-ps-print.el

   1 ;;; vm-ps-print.el --- PS-printing functions for VM
   2 ;;
   3 ;; Copyright (C) 1999 Robert Fenk
   4 ;;
   5 ;; Author:      Robert Fenk
   6 ;; Status:      Tested with XEmacs 21.4.15 & VM 7.18
   7 ;; Keywords:    extensions, vm, ps-print
   8 ;; X-URL:       http://www.robf.de/Hacking/elisp
   9 ;;
  10 ;; This code is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 1, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program; if not, write to the Free Software
  22 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25 ;;
  26 ;; There are three new user functions for generating postscript output:
  27 ;;   vm-ps-print-message
  28 ;;   vm-ps-print-each-message
  29 ;;   vm-ps-print-message-preview
  30 ;; The first one prints like vm-ps-print, but multiple messages are
  31 ;; concatenated to one printout.  In contrast to this the second
  32 ;; function creates one print job for each message.  Finally the the
  33 ;; third one prints the current message as displayed in the
  34 ;; presentation buffer -- the other two functions do their own MIME
  35 ;; decoding therefore messages are always display in their default
  36 ;; appearance.
  37 ;;
  38 ;; To use these functions you should put this file into your load-path
  39 ;; and add the following lines to your .vm file:
  40 ;;
  41 ;; (require 'vm-ps-print)
  42 ;;
  43 ;; To redefine the default VM settings for the tool bar and menu add
  44 ;; the following line.  The default is to use  `vm-ps-print-message',
  45 ;; but if you use an optional non nil argument you will get
  46 ;; `vm-ps-print-each-message' as print function.
  47 ;;
  48 ;; (vm-ps-print-message-infect-vm)
  49 ;;
  50 ;; This will refine the default VM settings and from now on you should
  51 ;; be able to print to your postscript printer by using the usual VM
  52 ;; commands.
  53 ;; Of course you still have to set `lpr-command' and `lpr-switches' or
  54 ;; `ps-lpr-command' and `ps-lpr-switches' to reasonable values!
  55 ;;
  56 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  57 ;;; Code:
  58
  59 (eval-when-compile
  60   (require 'vm-version)
  61   (require 'vm-message)
  62   (require 'vm-macro)
  63   (require 'vm-vars))
  64
  65 (require 'vm-save)
  66 (require 'ps-print)
  67
  68 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  69 (defgroup vm nil
  70   "VM"
  71   :group 'mail)
  72
  73 (defgroup vm-psprint nil
  74   "The VM ps-print lib"
  75   :group 'vm)
  76 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  77
  78 ;;;###autoload
  79 (defcustom vm-ps-print-message-function  'ps-print-buffer-with-faces
  80   "*This should point to the function which is used for ps-printing.
  81 The function should accept one optional argument which is a filename."
  82   :group 'vm-psprint
  83   :type 'function)
  84
  85 ;;;###autoload
  86 (defcustom vm-ps-print-message-separater  "\n"
  87   "*The separator between messages when printing multiple messages."
  88   :group 'vm-psprint
  89   :type 'string)
  90
  91 ;;;###autoload
  92 (defcustom vm-ps-print-message-font-size  10
  93   "*The font size for the PS-output of the message text."
  94   :group 'vm-psprint
  95   :type 'integer)
  96
  97 ;;----------------------------------------------------------------------------
  98
  99 ;;;###autoload
 100 (defcustom vm-ps-print-message-header-lines  2
 101   "*See `ps-header-lines'."
 102   :group 'vm-psprint
 103   :type 'integer)
 104
 105 ;;;###autoload
 106 (defcustom vm-ps-print-message-left-header
 107   '(list (format "(Folder `%s')" folder-name)
 108          (format "(%d message%s printed)" mcount (if (= mcount 1) "" "s")))
 109   "*This variable should contain a command returning a valid `ps-left-header'."
 110   :group 'vm-psprint
 111   :type 'sexp)
 112
 113 ;;;###autoload
 114 (defcustom vm-ps-print-message-right-header
 115   '(list"/pagenumberstring load" 'dd-mon-yyyy)
 116   "*This variable should contain a command returning a valid `ps-right-header'.
 117 The defaults to the number of pages and the date of the printout."
 118   :group 'vm-psprint
 119   :type 'sexp)
 120
 121 ;;;###autoload
 122 (defcustom vm-ps-print-message-summary-format
 123   (concat "******************************************************************************\n"
 124           (if (boundp 'vm-summary-format)
 125               vm-summary-format
 126             "%n %*%a %-17.17F %-3.3m %2d %4l/%-5c %I\"%s\"\n")
 127           "******************************************************************************\n")
 128   "*The summary line before a message.
 129 See `vm-summary-format' for a description of the conversion specifiers."
 130   :group 'vm-psprint
 131   :type 'string)
 132
 133 ;;----------------------------------------------------------------------------
 134 ;;;###autoload
 135 (defcustom vm-ps-print-each-message-header-lines 2
 136   "*See `ps-header-lines'."
 137   :group 'vm-psprint
 138   :type 'integer)
 139
 140 ;;;###autoload
 141 (defcustom vm-ps-print-each-message-left-header
 142   '(list (format "(Folder `%s')" folder-name)
 143          (format "(%s)" (vm-ps-print-tokenized-summary msg (vm-summary-sprintf vm-ps-print-each-message-summary-format msg t))))
 144   "*This command should return a valid `ps-left-header'.
 145 The default is to have the folder name and a summary according to the
 146 variable `vm-ps-print-each-message-summary-format' in the left header."
 147   :group 'vm-psprint
 148   :type 'sexp)
 149
 150 ;;;###autoload
 151 (defcustom vm-ps-print-each-message-right-header
 152   '(list  "/pagenumberstring load" 'dd-mon-yyyy)
 153   "*This variable should contain a command returning a valid `ps-right-header'.
 154 The defaults to the number of pages and the date of the printout."
 155   :group 'vm-psprint
 156   :type 'sexp)
 157
 158 ;;;###autoload
 159 (defcustom vm-ps-print-each-message-summary-format
 160   "Message# %n, Lines %l, Characters %c"
 161   "*The summary line for the postscript header.
 162 See `vm-summary-format' for a description of the conversion specifiers."
 163   :group 'vm-psprint
 164   :type 'string)
 165
 166 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 167 (defun vm-ps-print-message-internal (filename each folder-name mcount msg)
 168   "This function does the actual call to the ps-printing function.
 169 This is not a function to call interactively!
 170
 171 If the customization of headers is insufficient, then you may want
 172 to modify this function.  If FILENAME is a string, then the output is
 173 written to that file.  If EACH is t then create a new johb for each
 174 message.  FOLDER-NAME specifies the folder name which is displayed in
 175 the header line and MCOUNT is the number of messages to print, while
 176 MSG is a VM message pointer.
 177
 178 See:    `vm-ps-print-message-function'"
 179   (let* ((dd-mon-yyyy (format-time-string "%d %b %Y   %T" (current-time)))
 180          (ps-left-header (if each (eval vm-ps-print-each-message-left-header)
 181                            (eval vm-ps-print-message-left-header)))
 182          (ps-right-header (if each (eval vm-ps-print-each-message-right-header)
 183                             (eval vm-ps-print-message-right-header)))
 184          (ps-header-lines  (if each vm-ps-print-each-message-header-lines
 185                              vm-ps-print-each-message-header-lines))
 186          (ps-print-header-frame t)
 187          (ps-font-size vm-ps-print-message-font-size))
 188 ;    (setq filename (expand-file-name "~/mail.ps"))
 189     (funcall vm-ps-print-message-function filename)
 190     ))
 191
 192 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 193 (defun vm-ps-print-tokenized-summary (message tokens)
 194   "Return the summary string for MESSAGE according to the format in TOKENS.
 195 Like `vm-tokenized-summary-insert'."
 196   (if (stringp tokens)
 197       tokens
 198     (let (token summary)
 199       (while tokens
 200         (setq token (car tokens))
 201         (cond ((stringp token)
 202                (if vm-display-using-mime
 203                    (setq summary (concat summary
 204                                          (vm-decode-mime-encoded-words-in-string token)))
 205                  (setq summary (concat summary token))))
 206               ((eq token 'number)
 207                (setq summary (concat summary (vm-padded-number-of message))))
 208               ((eq token 'mark)
 209                (setq summary (concat summary (vm-su-mark message))))
 210               ((eq token 'thread-indent)
 211                (if (and vm-summary-show-threads
 212                         (natnump vm-summary-thread-indent-level))
 213                    (setq summary (concat summary
 214                                          ?\ (* vm-summary-thread-indent-level
 215                                                (vm-th-thread-indentation message)))))))
 216         (setq tokens (cdr tokens)))
 217       summary)))
 218
 219 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 220 (defun vm-ps-print-message-folder-name ()
 221   "Return a nice folder name, without complete path."
 222   (let* ((folder-name (or (buffer-file-name) (buffer-name)))
 223          (folder-name
 224           (if (and vm-folder-directory
 225                    (string-match (concat (regexp-quote (expand-file-name
 226                                                         vm-folder-directory))
 227                                          "/?\\(.+\\)")
 228                                  folder-name))
 229               (substring folder-name (match-beginning 1) (match-end 2))
 230             folder-name)))
 231     folder-name))
 232
 233 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 234 ;;;###autoload
 235 (defun vm-ps-print-message (&optional count filename each)
 236   "PS-Print the current message.
 237
 238 A positive COUNT arg N means print the current message and the next
 239 N-1 messages and a negative one print the current message and the
 240 previous N-1 messages.
 241
 242 If FILENAME is specified then write PS into that file.
 243
 244 When printing a single message it acts like `vm-ps-print-each-message'.
 245 When printing multiple messages it will insert a summary line according
 246 to the variable `vm-ps-print-message-summary-format' and a separator
 247 according to the variable `vm-ps-print-message-separater' between
 248 messages.  You might force the printing of one job per message, by
 249 giving a t EACH argument.
 250
 251 See: `vm-ps-print-message-function'
 252      `vm-ps-print-message-font-size'
 253      `vm-ps-print-message-summary-format'
 254      `vm-ps-print-message-separater'
 255      `vm-ps-print-message-left-header'
 256      `vm-ps-print-message-right-header'
 257 for customization of the output."
 258   (interactive "p")
 259   (vm-follow-summary-cursor)
 260   (vm-select-folder-buffer)
 261   (vm-check-for-killed-summary)
 262   (vm-error-if-folder-empty)
 263   (or count (setq count 1))
 264
 265   (let* ((vm-summary-faces-mode nil)
 266          (folder-name (vm-ps-print-message-folder-name))
 267          (mstart nil)
 268          (m nil)
 269          (mlist (vm-select-marked-or-prefixed-messages count))
 270          (mcount (length mlist))
 271          (tmpbuf (get-buffer-create "*vm-ps-print*")))
 272
 273     (set-buffer tmpbuf)
 274     (setq major-mode 'vm-mode)
 275     (erase-buffer)
 276     (if (= mcount 1) (setq each 1))
 277
 278     (while mlist
 279       (setq m (vm-real-message-of (car mlist)))
 280       (if (not each)
 281           (vm-tokenized-summary-insert
 282            m (vm-summary-sprintf vm-ps-print-message-summary-format m t)))
 283       (setq mstart (point-max))
 284       (vm-insert-region-from-buffer
 285        (vm-buffer-of m) (vm-vheaders-of m) (vm-end-of m))
 286       (vm-reorder-message-headers nil
 287                                   vm-visible-headers
 288                                   vm-invisible-header-regexp)
 289       (vm-decode-mime-encoded-words)
 290       (goto-char mstart)
 291       (re-search-forward "\n\n") ;; skip headers
 292       (if (not (vm-mime-plain-message-p m))
 293           (progn (vm-decode-mime-layout (vm-mm-layout m))
 294                  (delete-region (point) (point-max))))
 295       (narrow-to-region mstart (point-max))
 296       (vm-energize-urls)
 297       (vm-highlight-headers)
 298       (widen)
 299       (end-of-buffer)
 300       (if each
 301           (progn (save-excursion
 302                    (vm-ps-print-message-internal filename t folder-name
 303                                                  mcount m))
 304                  (set-buffer tmpbuf)
 305                  (erase-buffer))
 306         (if (> (length mlist) 1) (insert vm-ps-print-message-separater)))
 307       (setq mlist (cdr mlist)))
 308
 309     (if (not each)
 310         (vm-ps-print-message-internal filename nil folder-name mcount nil))
 311     (kill-buffer tmpbuf)
 312     ))
 313
 314 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 315 ;;;###autoload
 316 (defun vm-ps-print-each-message (&optional count filename)
 317   "PS-Print the current message.
 318 A positive COUNT arg N means print the current message and the next
 319 N-1 messages and a negative one print the current message and the
 320 previous N-1 messages.
 321
 322 If FILENAME is specified then write PS into that file.
 323
 324 This function acts like `vm-ps-print-message', but it will generate a
 325 separate print job for each message and it does not generate the
 326 summary lines between messages.
 327
 328 See: `vm-ps-print-message-function'
 329      `vm-ps-print-message-font-size'
 330      `vm-ps-print-each-message-separater'
 331      `vm-ps-print-each-message-left-header'
 332      `vm-ps-print-each-message-right-header'
 333      `vm-ps-print-each-message-summary-format'
 334 for customization of the output."
 335   (interactive "p")
 336   (vm-ps-print-message count filename t))
 337
 338 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 339 ;;;###autoload
 340 (defun vm-ps-print-message-presentation (&optional filename)
 341   "PS-Print the currently presented message.
 342 When called with a numeric prefix argument, prompts the user for the
 343 name of a file to save the PostScript image in, instead of sending it
 344 to the printer.
 345
 346 More specifically, the FILENAME argument is treated as follows: if it
 347 is nil, send the image to the printer.  If FILENAME is a string, save
 348 the PostScript image in a file with that name.  If FILENAME is a
 349 number, prompt the user for the name of the file to save in.
 350
 351 See: `vm-ps-print-message-function'
 352      `vm-ps-print-message-font-size'
 353      `vm-ps-print-each-message-separater'
 354      `vm-ps-print-each-message-left-header'
 355      `vm-ps-print-each-message-right-header'
 356      `vm-ps-print-each-message-summary-format'
 357 for customization of the output."
 358     (interactive (list (ps-print-preprint current-prefix-arg)))
 359     (save-excursion
 360       (vm-follow-summary-cursor)
 361       (vm-select-folder-buffer)
 362       (vm-check-for-killed-summary)
 363       (vm-error-if-folder-empty)
 364
 365       (let ((folder-name (vm-ps-print-message-folder-name))
 366             (mcount 1)
 367             (msg (car vm-message-pointer)))
 368
 369         (if (and (boundp 'vm-mail-buffer) (symbol-value 'vm-mail-buffer))
 370             (set-buffer (symbol-value 'vm-mail-buffer)))
 371         (if vm-presentation-buffer
 372             (set-buffer vm-presentation-buffer))
 373         (vm-ps-print-message-internal filename t folder-name mcount msg)
 374         )))
 375
 376 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 377 ;;;###autoload
 378 (defun vm-ps-print-message-fix-menu (menu each)
 379   "Fix VM-menu MENU.
 380 If EACH it t, then replace `vm-print-message' by
 381 'vm-ps-print-each-message', otherwise by `vm-ps-print-message'."
 382   (let ((tmpbuf (get-buffer-create "*vm-ps-print*")))
 383     (save-excursion
 384       (set-buffer tmpbuf)
 385       (erase-buffer)
 386       (insert (format "(setq %s '%S)" (symbol-name menu) (symbol-value menu)))
 387       (if (re-search-backward "vm-\\(ps-\\)?print-\\(each-\\)?message"
 388                               (point-min) t)
 389           (if each (replace-match "vm-print-each-message")
 390             (replace-match "vm-ps-print-message")))
 391       (eval-buffer)
 392       (kill-buffer tmpbuf)
 393       )))
 394
 395 ;;;###autoload
 396 (defun vm-ps-print-message-infect-vm (&optional each)
 397   "Call this function to hook the ps-printing functions into VM.
 398 Arranges that the usual VM printing commands in menus and the
 399 toolbar use `vm-ps-print-message' or `vm-ps-print-each-message'
 400 (when EACH is t) instead of `vm-print-message'."
 401   (interactive)
 402   (if each (fset 'vm-toolbar-print-command 'vm-ps-print-each-message)
 403     (fset 'vm-toolbar-print-command 'vm-ps-print-message))
 404   (require 'vm-version)
 405   (require 'vm-menu)
 406   (vm-ps-print-message-fix-menu 'vm-menu-dispose-menu each)
 407   (vm-ps-print-message-fix-menu 'vm-menu-vm-menu each)
 408   )
 409
 410 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 411 ;;; From: "Jeffrey J. Kosowsky" <jeff.kosowsky_ATsign_verizon_DOTsymbol_net>
 412 ;;;###autoload
 413 (defun vm-ps-print-marked (&optional filename seperate nup color)
 414   "Postscript print all marked emails in mail Summary. If no messages marked,
 415 print just the current message.
 416 Optionally write postscript output to FILENAME (default is to spool
 417 to printer).
 418 Optionally force SEPERATE printing of each message by setting to 't'.
 419 Optionally also print NUP pages per sheet.
 420 Optionally also print in COLOR by setting to non-nil.
 421
 422 Note when run interactively setting a positive prefix number prints
 423 NUP pages per sheet to  the printer, while negative number prints NUP
 424 pages per sheet to queried FILENAME. No prefix prints 1 page per sheet
 425 to printer while prefix without numerical argument simply queries for
 426 filename and formats 1 page per sheet. (JJK)"
 427   (interactive
 428    (if (and (integerp current-prefix-arg) (plusp current-prefix-arg))
 429        nil
 430      (list (ps-print-preprint current-prefix-arg))))
 431   (let ((last-command)
 432         (ps-print-color-p color)
 433         (ps-n-up-printing
 434          (cond
 435           (nup nup)
 436           ((integerp current-prefix-arg) (abs current-prefix-arg))
 437           (t 1)))                       ; default 1 page per sheet
 438         )
 439     (and (vm-marked-messages)
 440          (setq last-command 'vm-next-command-uses-marks))
 441     (vm-ps-print-message nil filename seperate)))
 442
 443 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 444
 445 (provide 'vm-ps-print)
 446
 447 ;;; vm-ps-print.el ends here