emacs_el/tiny-tools/tiny/tinylpr.el

   1 ;;; tinylpr.el --- Easy Emacs lpr command handling, pop-up, completions
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   6
   7 ;; Copyright (C) 1996-2007 Jari Aalto
   8 ;; Keywords:     extensions
   9 ;; Author:       Jari Aalto
  10 ;; Maintainer:   Jari Aalto
  11 ;;
  12 ;; To get information on this program, call M-x tinylpr-version.
  13 ;; Look at the code with folding.el
  14
  15 ;; COPYRIGHT NOTICE
  16 ;;
  17 ;; This program is free software; you can redistribute it and/or modify it
  18 ;; under the terms of the GNU General Public License as published by the Free
  19 ;; Software Foundation; either version 2 of the License, or (at your option)
  20 ;; any later version.
  21 ;;
  22 ;; This program is distributed in the hope that it will be useful, but
  23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  24 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  25 ;; for more details.
  26 ;;
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with program; see the file COPYING. If not, write to the
  29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  30 ;; Boston, MA 02110-1301, USA.
  31 ;;
  32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  33
  34 ;;}}}
  35 ;;{{{ Install
  36
  37 ;;; Install:
  38
  39 ;; ....................................................... &t-install ...
  40 ;;   Put this file on your Emacs-Lisp load path, add following into your
  41 ;;   ~/.emacs startup file
  42 ;;
  43 ;;      (require 'tinylpr)
  44 ;;
  45 ;;  Suggested key binding. The commands are available via echo-menu, but
  46 ;;  you can bind each command individually too. The echo menu:
  47 ;;
  48 ;;      (ti::use-prefix-key "\C-z")          ;; Free C-z for us.
  49 ;;      (global-set-key "\C-zp" (ti::definteractive (ti::menu-menu 'tinylpr-:menu)))
  50 ;;
  51 ;;   Notice, that loading this file changes your `lpr-command' immediately
  52 ;;   to "sh". This is essential and if you want to use this package,
  53 ;;   leave it there or choose some compatible shell that accepts "-c"
  54 ;;   switch.
  55 ;;
  56 ;;   CHANGE THE VARIABLES !
  57 ;;
  58 ;;   You must copy the user variables and put your own definitions
  59 ;;   there. The ones that ship with this module are only examples
  60 ;;
  61 ;;   If you have any questions, use this function
  62 ;;
  63 ;;      M-x tinylpr-submit-feedback
  64
  65 ;;}}}
  66 ;;{{{ Documentation
  67
  68 ;; ..................................................... &t-commentary ...
  69
  70 ;;; Commentary:
  71
  72 ;;  Overview of features
  73 ;;
  74 ;;      o   Managing printers or print styles easily
  75 ;;      o   Queue information
  76 ;;      o   Has ready X-popup example to select print styles etc.
  77 ;;      o   Echo menu provided to select printing advice:
  78 ;;
  79 ;;          TinyLpr: 01c2 r)egion b)uffer l)ine numbers d)printer
  80 ;;                   Q)ueue s)tyle >P
  81 ;;
  82 ;;      o   Ps print support in another `P' echo-menu:
  83 ;;
  84 ;;          TinyLpr: 01c2(ps) rR)egion bB)uffer sS)Spool d)espool
  85 ;;
  86 ;;  Introduction
  87 ;;
  88 ;;      Unix environment offers numerous utilizes to format printing
  89 ;;      the user wants, not to mention the numerous printers that can be set.
  90 ;;      you may find these command in your system:
  91 ;;
  92 ;;          mmpage       multi-page 1-8, like sunOS enscript
  93 ;;          lp
  94 ;;          lpr
  95 ;;          a2ps
  96 ;;          squeeze.awk  my own empty line squeezer. Ever run CPP on C/C++ ?
  97 ;;          groff        I make some nroff files...
  98 ;;          banner       big letters
  99 ;;          lpstat
 100 ;;          col -bx      remove ctrl codes from man pages
 101 ;;          pps          pretty printer for PostScript -- jau@tut.fi
 102 ;;          pr           format files
 103 ;;          fold         fold long lines for finite width output device
 104 ;;          adjust       for filling, centering, ..justifying
 105 ;;
 106 ;;      If you want to print the file in some other format, i.e. combining
 107 ;;      some of the commands above, you have change `lpr-switches'
 108 ;;      every time. This is tedious. Instead this package offers a pop up menu
 109 ;;      where you can select lpstatus, select print command, cancel print
 110 ;;      job etc...
 111 ;;
 112 ;;  Example
 113 ;;
 114 ;;          (defun my-x-menu (event)
 115 ;;            "Pop up an X window of user defined commands. "
 116 ;;            (interactive "e")
 117 ;;            (let* ((pstat
 118 ;;                 (replace-regexp-in-string           ;remove directory name
 119 ;;                  ".*/"
 120 ;;                  ""
 121 ;;                  (or (my-print-status) "")))
 122 ;;                item)
 123 ;;              (setq
 124 ;;               item
 125 ;;               (x-popup-menu
 126 ;;                event
 127 ;;                (list
 128 ;;                 "Command Menu"
 129 ;;                 (list
 130 ;;               "Printer: "
 131 ;;               ;;   This first one is header, not selection
 132 ;;               (cons (concat ":: " pstat) 'ignore)
 133 ;;               ;; these are selections
 134 ;;               '("* Print region"     . print-region)
 135 ;;               '("* Print buffer"     . print-buffer)
 136 ;;               '("Destination"        . tinylpr-select-printer)
 137 ;;               '("Print style"        . tinylpr-print-style-select)
 138 ;;               '("Queue status"       . tinylpr-queue)))))
 139 ;;              (cond
 140 ;;               (item                                  ;direct command
 141 ;;                (call-interactively item)))))
 142
 143 ;;}}}
 144
 145 ;;; Change Log:
 146
 147 ;;; Code:
 148
 149 ;;{{{ setup: require
 150
 151 (require 'tinylibm)
 152 (require 'lpr)
 153
 154 (eval-and-compile
 155
 156   (autoload 'ps-print-buffer            "ps-print" nil t)
 157   (autoload 'ps-print-buffer-with-faces "ps-print" nil t)
 158   (autoload 'ps-print-region            "ps-print" nil t)
 159   (autoload 'ps-print-region-with-faces "ps-print" nil t)
 160   (autoload 'ps-spool-buffer            "ps-print" nil t)
 161   (autoload 'ps-spool-buffer-with-faces "ps-print" nil t)
 162   (autoload 'ps-spool-region            "ps-print" nil t)
 163   (autoload 'ps-spool-region-with-faces "ps-print" nil t)
 164
 165   (defvar ps-lpr-switches)              ;to quiet ByteCompiler
 166   (defvar lpr-switches)
 167   (defvar lpr-command))
 168
 169 (eval-when-compile (ti::package-use-dynamic-compilation))
 170
 171 (ti::package-defgroup-tiny TinyLpr tinylpr-: extensions
 172   "Easy Emacs lpr command handling, popup, completions
 173         o   Managing printers or print styles easily
 174         o   Queue information
 175         o   Has ready X-popup example to select print styles etc.")
 176
 177 ;;}}}
 178 ;;{{{ setup: variables
 179
 180 ;;; ......................................................... &v-hooks ...
 181
 182 (defcustom tinylpr-:load-hook nil
 183   "Hook run when file is loaded."
 184   :type  'hook
 185   :group 'TinyLpr)
 186
 187 ;;; .......................................................... &v-vars ...
 188 ;;; *** important ***
 189 ;;;
 190 ;;;     These are just examples. Copy the variables into your ~/.emacs
 191 ;;;     and make changes to reflect your system.
 192 ;;;
 193 ;;;
 194
 195 (defcustom tinylpr-:set-ps-lpr-switches  t
 196   "If non-nil, set also ps-lpr-switches from ps-print.el when
 197 changing printer."
 198   :type  'boolean
 199   :group 'TinyLpr)
 200
 201 (defcustom tinylpr-:queue-cmd
 202   (or (executable-find "lpstat")
 203       (let ((function (if (ti::win32-p)
 204                           'message
 205                         'error)))
 206         (funcall function
 207                  "TinyLpr: can't use default [lpstat] for tinylpr-:queue-cmd")))
 208   "*Shell Command to return queue status"
 209   :type  '(string :tag "Shell Command")
 210   :group 'TinyLpr)
 211
 212 (eval-and-compile
 213   (defcustom tinylpr-:printer-list
 214     (delq nil
 215           (list
 216            (getenv "PRINTER")
 217            (if (ti::win32-p) "lpt1:")
 218            (if (ti::win32-p) "prn:")))
 219     "*List of available printers, like  '(\"PRINTER1\" \"PRINTER2\")."
 220     :type  '(repeat (string :tag "printer"))
 221     :group 'TinyLpr)
 222
 223   (defcustom tinylpr-:print-style-list
 224     (let* ((mp   (executable-find "mpage")) ;HP-UX multipage
 225            (lp   (executable-find "lp"))
 226            (lpr  (executable-find "lpr"))
 227            (nl   (executable-find "nl"))
 228            (ens  (executable-find "enscript"))
 229            (gs   (executable-find "gs"))
 230            (gs32 (executable-find "gs386"))) ;; Ghostscript in Win32
 231       (delq
 232        nil                              ;Remove empty entries
 233        (list
 234         (if lp
 235             (list
 236              ;;  Select the first string so, that it's easy to complete.
 237              "lp, straight lp"    (concat lp " -d#")))
 238         (if lpr
 239             (list
 240              "lpr straight"    (concat lpr " -d#")))
 241         (if (and nl lp)
 242             (list
 243              "nl, numbered lp"    "nl | lp -d#"))
 244         (if mp
 245             (list
 246              "2 mpage"            (concat  mp " -A -2 -P#")))
 247         (if mp
 248             (list
 249              "4 mpage"            (concat  mp " -A -4 -P#")))
 250         (if mp
 251             (list
 252              "8 mpage"            (concat  mp " -A -8 -P#")))
 253         (if mp
 254             (list
 255              "2l mpage landscape" (concat  mp " -A -l -2 -P#")))
 256         (if ens
 257             (list
 258              "enscript"           (concat  ens " -d#")))
 259         (if ens
 260             (list
 261              "et enscript TOC"    (concat  ens " --toc -d#")))
 262         (if ens
 263             (list
 264              "2l enscript landscape" (concat  ens " -r -2 -d#")))
 265         (if gs
 266             (list
 267              "ghostscript a4"
 268              (concat gs "-q -dNOPAUSE -sDEVICE=SomeDevice"
 269                      "-r600 -sPAPERSIZE=a4 "
 270                      "-sOutputFile=#"
 271                      "-Ic:/gs -"))))))
 272     "*Available print styles.
 273 The # char tells where to install printer in command.
 274
 275 Format:
 276
 277   '((COMPLETION-STRING PRINTER-COMMAND-STRING) ..)
 278
 279 Example
 280
 281   '((\"2 pages\"  \"mpage -A -2 -P#\"))"
 282     :type '(repeat
 283             (list (string :tag "Completion name")
 284                   (string :tag "Shell Command.")))
 285
 286     :group 'TinyLpr)
 287
 288   ) ;; eval-and-compile
 289
 290 ;;; ....................................................... &v-private ...
 291
 292 (defvar tinylpr-:current-printer (car-safe tinylpr-:printer-list)
 293   "Private. Current printer.")
 294
 295 (defvar tinylpr-:current-print-style (car-safe (car-safe tinylpr-:print-style-list))
 296   "Private. Current print style.")
 297
 298 (defvar tinylpr-:printer-list-history nil
 299   "Private. History list for `tinylpr-:printer-list'.")
 300
 301 (defvar tinylpr-:print-style-history nil
 302   "Private. History list for tinylpr-print-style-completions.")
 303
 304 ;;; ....................................................... &v-version ...
 305
 306 (eval-and-compile
 307   (ti::macrof-version-bug-report
 308    "tinylpr.el"
 309    "tinylpr"
 310    tinylpr-:version-id
 311    "$Id: tinylpr.el,v 2.42 2007/05/01 17:20:49 jaalto Exp $"
 312    '(tinylpr-:version-id
 313      tinylpr-:load-hook
 314      tinylpr-:set-ps-lpr-switches
 315      tinylpr-:queue-cmd
 316      tinylpr-:printer-list
 317      tinylpr-:print-style-list
 318      tinylpr-:current-printer
 319      tinylpr-:current-print-style
 320      tinylpr-:printer-list-history
 321      tinylpr-:print-style-history)))
 322
 323 (defvar tinylpr-:menu
 324   '((format
 325      "TinyLpr: %s r)egion b)uffer l)ine numbers d)printer Q)ueue s)tyle >P"
 326      tinylpr-:current-printer)
 327     ((?d  . (t (call-interactively 'tinylpr-select-printer)))
 328      (?Q  . (  (call-interactively 'tinylpr-queue)))
 329      (?s  . (t (call-interactively 'tinylpr-print-style-select)))
 330      (?r  . (  (call-interactively 'print-region)))
 331      (?b  . (  (call-interactively 'print-buffer)))
 332      (?l  . (  (call-interactively 'tinylpr-print-with-line-numbers)))
 333      (?P  . tinylpr-:ps-print-menu)))
 334   "*Echo menu to access printer commands. Select `P' for ps-print.el commands.")
 335
 336 (defvar tinylpr-:ps-print-menu
 337   '((format "\
 338 TinyLpr: %s(ps) rR)egion bB)uffer sS)Spool d)espool "
 339             tinylpr-:current-printer)
 340     ((?r  . (  (call-interactively 'ps-print-region)))
 341      (?R  . (  (call-interactively 'ps-print-region-with-faces)))
 342      (?b  . (  (call-interactively 'ps-print-buffer)))
 343      (?B  . (  (call-interactively 'ps-print-buffer-with-faces)))
 344      (?s  . (  (call-interactively 'ps-spool-buffer)))
 345      (?S  . (  (call-interactively 'ps-spool-buffer-with-faces)))
 346      (?w  . (  (call-interactively 'ps-spool-region)))
 347      (?W  . (  (call-interactively 'ps-spool-region-with-faces)))
 348      (?d  . (  (call-interactively 'ps-despool)))))
 349   "*Echo menu to access ps-print commands.
 350
 351   r     Print region.
 352   R     Print region with faces.
 353   b     Print buffer.
 354   B     rint buffer with faces.
 355
 356   s     Spool buffer.
 357   S     Spool buffer with faces.
 358   w     Spool region.
 359   W     Spool region with faces.
 360
 361   d     Despool (send spooled items)")
 362
 363 ;;}}}
 364
 365 ;;; ########################################################### &Funcs ###
 366
 367 ;;{{{ code: funcs
 368
 369 ;;; ----------------------------------------------------------------------
 370 ;;;
 371 (defun tinylpr-install-lpr-command ()
 372   "Set correct shell for `lpr-command'."
 373   (interactive)
 374   (let* (sh)
 375     (unless (string-match "sh\\|bash\\|cmd.exe\\|command.exe"
 376                           (or lpr-command ""))
 377       ;; NT Cygnus users get served too by putting sh,bash test first.
 378       (cond
 379        ((setq sh (or (executable-find "sh")
 380                      (executable-find "bash")))
 381         (setq lpr-command sh))
 382        ((and (ti::win32-p)
 383              (setq sh (or (executable-find "cmd")
 384                           (executable-find "command"))))
 385         (setq lpr-command sh))
 386        (t
 387         (error "\
 388 TinyLpr: sh, bash or cmd.exe not available. Can't set lpr-command." ))))))
 389
 390 ;;; ----------------------------------------------------------------------
 391 ;;;
 392 (defun tinylpr-set-command (template printer)
 393   "Substitutes possible # n TEMPLATE with PRINTER name in."
 394   (if (string-match "\\(#\\)" template)
 395       (setq template (ti::replace-match 1 printer template)))
 396
 397   ;;  We know the lpr-command is "sh", so just put the "-c" as
 398   ;;  first option.
 399
 400   (cond
 401    ((string-match "\\(sh\\|bash\\)$" lpr-command)
 402     (setq lpr-switches (list "-c" template)))
 403    ((string-match "\\(command\\|cmd\\)\\.exe$" lpr-command) ;Win32
 404     (setq lpr-switches (list "/c" template)))))
 405
 406 ;;; ----------------------------------------------------------------------
 407 ;;;
 408 (defun tinylpr-print-with-line-numbers  ()
 409   "Adds line numbers to buffer and prints it. After printing,
 410 removes line numbers."
 411   (interactive)
 412   (let* (buffer-read-only
 413          fmt
 414          len)
 415     (with-buffer-modified
 416       (save-excursion
 417         (ti::pmax)
 418         ;;  Set dynamic format according to biggest line number
 419         (setq len  (ti::digit-length (ti::current-line-number))
 420               fmt  (concat "%0" len "d: %s"))
 421         (unwind-protect
 422             (progn
 423               (ti::buffer-insert-line-numbers (point-min) (point-max) 1 1 fmt)
 424               (print-buffer))
 425           (ti::buffer-remove-line-numbers
 426            (point-min)
 427            (point-max)
 428            "^[0-9]+: " 0))))))
 429
 430 ;;; ----------------------------------------------------------------------
 431 ;;;
 432 (defun tinylpr-print-style-completions ()
 433   "Build up the completion array."
 434   (let* ((list  tinylpr-:print-style-list)
 435          (i 0)
 436          completions)
 437     (mapcar
 438      (function
 439       (lambda (x)
 440         (setq i (1+ i))
 441         (setq completions (cons  (cons (car x) i) completions))))
 442      list)
 443     completions))
 444
 445 ;;; ----------------------------------------------------------------------
 446 ;;;
 447 (defun tinylpr-setting-status ()
 448   "Return current settings."
 449   (interactive)
 450   (let* ((stat  (nth 1 lpr-switches)))
 451     (if (interactive-p)
 452         (message stat))
 453     stat))
 454
 455 ;;; ----------------------------------------------------------------------
 456 ;;;
 457 (defun tinylpr-queue ()
 458   "Return queue status."
 459   (interactive)
 460   (let* ((cmd       tinylpr-:queue-cmd)
 461          (buffer    (ti::temp-buffer "*tmp*" 'clear)))
 462     (display-buffer buffer)
 463     (shell-command cmd buffer)))
 464
 465 ;;; ----------------------------------------------------------------------
 466 ;;;
 467 (defun tinylpr-select-printer (printer)
 468   "Select PRINTER printer."
 469   (interactive
 470    (list
 471     (completing-read
 472      (concat "Printer [" tinylpr-:current-printer "]: ")
 473      (ti::list-to-assoc-menu tinylpr-:printer-list)
 474      nil t
 475      nil
 476      'tinylpr-:printer-list-history)))
 477   (when (not (ti::nil-p printer))
 478     (setq tinylpr-:current-printer printer)
 479     (if tinylpr-:set-ps-lpr-switches
 480         (setq ps-lpr-switches (list (concat "-P" printer))))
 481     (tinylpr-print-style-select tinylpr-:current-print-style)))
 482
 483 ;;; ----------------------------------------------------------------------
 484 ;;;
 485 (defun tinylpr-print-style-select (arg)
 486   "Select print output style with ARG."
 487   (interactive
 488    (list
 489     (completing-read
 490      (format "Print style [%s: %s ]: "
 491              (or tinylpr-:current-print-style "<style unknown>")
 492              (tinylpr-setting-status))
 493      (tinylpr-print-style-completions)
 494      nil
 495      t)))
 496
 497   (let* ((printer (or tinylpr-:current-printer ""))
 498          elt
 499          args)
 500     ;;  Try to find the style in assoc array
 501     (if (not (and arg (setq elt (assoc arg tinylpr-:print-style-list))))
 502         (message "No such style")
 503       ;;  replace # with printer name
 504       (setq tinylpr-:current-print-style arg)
 505       (setq args (nth 1 elt))
 506       (tinylpr-set-command args printer)
 507       (message "Print <%s> on %s" arg (tinylpr-setting-status)))))
 508
 509 ;;}}}
 510 ;;{{{ code: install
 511
 512 ;;; .................................................... &auto-install ...
 513
 514 ;; Install package, reset lpr variables
 515
 516 (tinylpr-install-lpr-command)
 517
 518 (let* ((template (nth 1 (car  tinylpr-:print-style-list))))
 519   (if (and template tinylpr-:current-printer)
 520       (tinylpr-set-command template tinylpr-:current-printer)
 521     (message "\
 522 TinyLpr: ** Auto setup failure, please define tinylpr-:print-style-list and
 523 TinyLpr: ** tinylpr-:current-printer")))
 524
 525 ;;}}}
 526
 527 (provide 'tinylpr)
 528 (run-hooks 'tinylpr-:load-hook)
 529
 530 ;;; tinylpr.el ends here