# HG changeset patch # User Richard M. Stallman # Date 883074832 0 # Node ID d33438261904a259eb522c20b12f298c94eb1cb8 # Parent 2edce6cd0ef033d5f53272e28cdc7fbecacbb3be Some comment, doc and bug fixes. (ps-print-version): New version number (3.05.3) and doc fix. (ps-output-string-prim, ps-begin-job, ps-control-character) (ps-plot-region): Bug fix. (ps-print-control-characters): New custom var. (ps-string-escape-codes, ps-string-control-codes): New var. (ps-color-device, ps-font-lock-face-attributes, ps-eval-switch) (ps-flatten-list, ps-flatten-list-1): New fn. (ps-setup): Update current setup. (ps-begin-file): Adjust PostScript header file. (ps-plot, ps-face-attribute-list): Little programming improvement. (ps-print-prologue-1): Replace NumberOfZebra by ZebraHeight. (ps-print-without-faces, ps-print-with-faces): Little reprogramming. (ps-plot-with-face): Get color only on color screen device. (ps-build-reference-face-lists): Handle obsolete font-lock-face-attributes. (ps-print-ensure-fontified): Little programming setting. (ps-generate-postscript-with-faces): Adjust initializations, get color only on color screen device. (ps-generate): Replace (if A B) by (and A B). (ps-do-despool): Dynamic evaluation for ps-lpr-switches, Replace (if A B) by (and A B). (color-instance-rgb-components, ps-color-values): Replace pixel-components by color-instance-rgb-components. (ps-xemacs-face-kind-p): Replace face-font by face-font-instance, replace x-font-properties by font-instance-properties. diff -r 2edce6cd0ef0 -r d33438261904 lisp/ps-print.el --- a/lisp/ps-print.el Thu Dec 25 01:11:47 1997 +0000 +++ b/lisp/ps-print.el Thu Dec 25 18:33:52 1997 +0000 @@ -4,13 +4,14 @@ ;; Author: Jim Thompson (was ) ;; Author: Jacques Duthen +;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre ;; Keywords: print, PostScript -;; Time-stamp: <97/08/28 22:35:25 vinicius> -;; Version: 3.05.2 - -(defconst ps-print-version "3.05.2" - "ps-print.el, v 3.05.2 <97/08/28 vinicius> +;; Time-stamp: <97/11/21 22:12:47 vinicius> +;; Version: 3.05.3 + +(defconst ps-print-version "3.05.3" + "ps-print.el, v 3.05.3 <97/11/21 vinicius> Vinicius's last change version -- this file may have been edited as part of Emacs without changes to the version number. When reporting bugs, @@ -362,6 +363,30 @@ ;; for your printer. ;; ;; +;; Control And 8-bit Characters +;; ---------------------------- +;; +;; The variable `ps-print-control-characters' specifies whether you want to see +;; a printable form for control and 8-bit characters, that is, instead of +;; sending, for example, a ^D (\005) to printer, it is sent the string "^D". +;; +;; Valid values for `ps-print-control-characters' are: +;; +;; '8-bit printable form for control and 8-bit characters +;; (characters from \000 to \037 and \177 to \377). +;; 'control-8-bit printable form for control and *control* 8-bit characters +;; (characters from \000 to \037 and \177 to \237). +;; 'control printable form for control character +;; (characters from \000 to \037 and \177). +;; nil raw character (no printable form). +;; +;; Any other value is treated as nil. +;; +;; The default is 'control-8-bit. +;; +;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine. +;; +;; ;; Line Number ;; ----------- ;; @@ -497,15 +522,16 @@ ;; always right. For example, you might want to map colors into faces ;; so that blue faces print in bold, and red faces in italic. ;; -;; It is possible to force ps-print to consider specific faces bold or -;; italic, no matter what font they are displayed in, by setting the -;; variables `ps-bold-faces' and `ps-italic-faces'. These variables -;; contain lists of faces that ps-print should consider bold or -;; italic; to set them, put code like the following into your .emacs -;; file: +;; It is possible to force ps-print to consider specific faces bold, +;; italic or underline, no matter what font they are displayed in, by setting +;; the variables `ps-bold-faces', `ps-italic-faces' and `ps-underlined-faces'. +;; These variables contain lists of faces that ps-print should consider bold, +;; italic or underline; to set them, put code like the following into your +;; .emacs file: ;; ;; (setq ps-bold-faces '(my-blue-face)) ;; (setq ps-italic-faces '(my-red-face)) +;; (setq ps-underlined-faces '(my-green-face)) ;; ;; Faces like bold-italic that are both bold and italic should go in ;; *both* lists. @@ -519,7 +545,9 @@ ;; get out of sync, if a face changes, or if new faces are added. To ;; get the lists back in sync, you can set the variable ;; `ps-build-face-reference' to t, and the lists will be rebuilt the -;; next time ps-print is invoked. +;; next time ps-print is invoked. If you need that the lists always be +;; rebuilt when ps-print is invoked, set the variable +;; `ps-always-build-face-reference' to t. ;; ;; ;; How Ps-Print Deals With Color @@ -649,7 +677,7 @@ ;; New since version 2.8 ;; --------------------- ;; -;; [vinicius] 970809 Vinicius Jose Latorre +;; [vinicius] 971121 Vinicius Jose Latorre ;; ;; Handle control characters. ;; Face remapping. @@ -678,12 +706,12 @@ ;; Automatic font-attribute detection doesn't work well, especially ;; with hilit19 and older versions of get-create-face. Users having ;; problems with auto-font detection should use the lists -;; `ps-italic-faces' and `ps-bold-faces' and/or turn off automatic -;; detection by setting `ps-auto-font-detect' to nil. +;; `ps-italic-faces', `ps-bold-faces' and `ps-underlined-faces' and/or +;; turn off automatic detection by setting `ps-auto-font-detect' to nil. ;; ;; Automatic font-attribute detection doesn't work with XEmacs 19.12 -;; in tty mode; use the lists `ps-italic-faces' and `ps-bold-faces' -;; instead. +;; in tty mode; use the lists `ps-italic-faces', `ps-bold-faces' and +;; `ps-underlined-faces' instead. ;; ;; Still too slow; could use some hand-optimization. ;; @@ -713,6 +741,9 @@ ;; ;; Acknowledgements ;; ---------------- +;; Thanks to Jacques Duthen (Jack) for the 3.4 version +;; I started from. [vinicius] +;; ;; Thanks to Jim Thompson for the 2.8 version I started from. ;; [jack] ;; @@ -846,6 +877,7 @@ (number :tag "Height"))) :group 'ps-print) +;;;###autoload (defcustom ps-paper-type 'letter "*Specifies the size of paper to format for. Should be one of the paper types defined in `ps-page-dimensions-database', for @@ -863,6 +895,20 @@ :type 'boolean :group 'ps-print) +(defcustom ps-print-control-characters 'control-8-bit + "*Specifies the printable form for control and 8-bit characters. +Valid values are: + '8-bit printable form for control and 8-bit characters + (characters from \000 to \037 and \177 to \377). + 'control-8-bit printable form for control and *control* 8-bit characters + (characters from \000 to \037 and \177 to \237). + 'control printable form for control character + (characters from \000 to \037 and \177). + nil raw character (no printable form). +Any other value is treated as nil." + :type '(choice (const 8-bit) (const control-8-bit) (const control) (const nil)) + :group 'ps-print) + (defcustom ps-number-of-columns (if ps-landscape-mode 2 1) "*Specifies the number of columns" :type 'number @@ -1182,7 +1228,8 @@ ;; Printing color requires x-color-values. (defcustom ps-print-color-p (or (fboundp 'x-color-values) ; Emacs - (fboundp 'pixel-components)) ; XEmacs + (fboundp 'color-instance-rgb-components)) + ; XEmacs "*If non-nil, print the buffer's text in color." :type 'boolean :group 'ps-print-color) @@ -1451,6 +1498,8 @@ ps-zebra-stripe-height %s ps-line-number %s + ps-print-control-characters %s + ps-print-background-image %s ps-print-background-text %s @@ -1483,6 +1532,7 @@ ps-zebra-stripes ps-zebra-stripe-height ps-line-number + ps-print-control-characters ps-print-background-image ps-print-background-text ps-left-margin @@ -1519,6 +1569,15 @@ (require 'faces)) ; face-font, face-underline-p, ; x-font-regexp +;; Return t if the device (which can be changed during an emacs session) +;; can handle colors. +;; This is function is not yet implemented for GNU emacs. +(defun ps-color-device () + (if (and (eq ps-print-emacs-type 'xemacs) + (>= emacs-minor-version 12)) + (eq (device-class) 'color) + t)) + (require 'time-stamp) (defvar ps-font nil @@ -1864,7 +1923,7 @@ /printZebra { gsave 0.985 setgray - /double-zebra NumberOfZebra NumberOfZebra add def + /double-zebra ZebraHeight ZebraHeight add def /yiter double-zebra LineHeight mul neg def /xiter PrintWidth InterColumn add def NumberOfColumns {LinesPerColumn doColumnZebra xiter 0 rmoveto}repeat @@ -1874,9 +1933,9 @@ % stack: lines-per-column |- -- /doColumnZebra { gsave - dup double-zebra idiv {NumberOfZebra doZebra 0 yiter rmoveto}repeat + dup double-zebra idiv {ZebraHeight doZebra 0 yiter rmoveto}repeat double-zebra mod - dup 0 le {pop}{dup NumberOfZebra gt {pop NumberOfZebra}if doZebra}ifelse + dup 0 le {pop}{dup ZebraHeight gt {pop ZebraHeight}if doZebra}ifelse grestore } def @@ -2173,6 +2232,8 @@ (defvar ps-page-count 0) (defvar ps-showline-count 1) +(defvar ps-control-or-escape-regexp nil) + (defvar ps-background-pages nil) (defvar ps-background-all-pages nil) (defvar ps-background-text-count 0) @@ -2350,12 +2411,50 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Adapted from font-lock: +;; Originally face attributes were specified via `font-lock-face-attributes'. +;; Users then changed the default face attributes by setting that variable. +;; However, we try and be back-compatible and respect its value if set except +;; for faces where M-x customize has been used to save changes for the face. + +(defun ps-font-lock-face-attributes () + (and (boundp 'font-lock-mode) (symbol-value 'font-lock-mode) + (boundp 'font-lock-face-attributes) + (let ((face-attributes font-lock-face-attributes)) + (while face-attributes + (let* ((face-attribute (pop face-attributes)) + (face (car face-attribute))) + ;; Rustle up a `defface' SPEC from a + ;; `font-lock-face-attributes' entry. + (unless (get face 'saved-face) + (let ((foreground (nth 1 face-attribute)) + (background (nth 2 face-attribute)) + (bold-p (nth 3 face-attribute)) + (italic-p (nth 4 face-attribute)) + (underline-p (nth 5 face-attribute)) + face-spec) + (when foreground + (setq face-spec (cons ':foreground + (cons foreground face-spec)))) + (when background + (setq face-spec (cons ':background + (cons background face-spec)))) + (when bold-p + (setq face-spec (append '(:bold t) face-spec))) + (when italic-p + (setq face-spec (append '(:italic t) face-spec))) + (when underline-p + (setq face-spec (append '(:underline t) face-spec))) + (custom-declare-face face (list (list t face-spec)) nil) + ))))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal functions and variables (defun ps-print-without-faces (from to &optional filename region-p) - (ps-printing-region region-p) - (ps-generate (current-buffer) from to 'ps-generate-postscript) + (ps-spool-without-faces from to region-p) (ps-do-despool filename)) @@ -2365,8 +2464,7 @@ (defun ps-print-with-faces (from to &optional filename region-p) - (ps-printing-region region-p) - (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces) + (ps-spool-with-faces from to region-p) (ps-do-despool filename)) @@ -2377,8 +2475,9 @@ (defsubst ps-count-lines (from to) (+ (count-lines from to) - (save-excursion (goto-char to) - (if (= (current-column) 0) 1 0)))) + (save-excursion + (goto-char to) + (if (= (current-column) 0) 1 0)))) (defvar ps-printing-region nil @@ -2636,19 +2735,47 @@ ;; The following functions implement a simple list-buffering scheme so ;; that ps-print doesn't have to repeatedly switch between buffers -;; while spooling. The functions ps-output and ps-output-string build -;; up the lists; the function ps-flush-output takes the lists and +;; while spooling. The functions `ps-output' and `ps-output-string' build +;; up the lists; the function `ps-flush-output' takes the lists and ;; insert its contents into the spool buffer (*PostScript*). +(defvar ps-string-escape-codes + (let ((table (make-vector 256 nil)) + (char ?\000)) + ;; control characters + (while (<= char ?\037) + (aset table char (format "\\%03o" char)) + (setq char (1+ char))) + ;; printable characters + (while (< char ?\177) + (aset table char (format "%c" char)) + (setq char (1+ char))) + ;; DEL and 8-bit characters + (while (<= char ?\377) + (aset table char (format "\\%o" char)) + (setq char (1+ char))) + ;; Override ASCII formatting characters with named escape code: + (aset table ?\n "\\n") ; [NL] linefeed + (aset table ?\r "\\r") ; [CR] carriage return + (aset table ?\t "\\t") ; [HT] horizontal tab + (aset table ?\b "\\b") ; [BS] backspace + (aset table ?\f "\\f") ; [NP] form feed + ;; Escape PostScript escape and string delimiter characters: + (aset table ?\\ "\\\\") + (aset table ?\( "\\(") + (aset table ?\) "\\)") + table) + "Vector used to map characters to PostScript string escape codes.") + (defun ps-output-string-prim (string) (insert "(") ;insert start-string delimiter (save-excursion ;insert string (insert string)) ;; Find and quote special characters as necessary for PS - (while (re-search-forward "[()\\]" nil t) - (save-excursion - (forward-char -1) - (insert "\\"))) + (while (re-search-forward "[\000-\037\177-\377()\\]" nil t) + (let ((special (preceding-char))) + (delete-char -1) + (insert (aref ps-string-escape-codes special)))) (goto-char (point-max)) (insert ")")) ;insert end-string delimiter @@ -2870,7 +2997,8 @@ "%%Title: " (buffer-name) ; Take job name from name of ; first buffer printed "\n%%Creator: " (user-full-name) - "\n%%CreationDate: " + " (using ps-print v" ps-print-version + ")\n%%CreationDate: " (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) "\n%%Orientation: " (if ps-landscape-mode "Landscape" "Portrait") @@ -2914,7 +3042,7 @@ (ps-output-boolean "Zebra" ps-zebra-stripes) (ps-output-boolean "PrintLineNumber" ps-line-number) - (ps-output (format "/NumberOfZebra %d def\n" ps-zebra-stripe-height) + (ps-output (format "/ZebraHeight %d def\n" ps-zebra-stripe-height) (format "/Lines %d def\n" (if ps-printing-region (cdr ps-printing-region) @@ -2973,7 +3101,12 @@ (and (buffer-modified-p) " (unsaved)"))))) (defun ps-begin-job () - (setq ps-page-count 0)) + (setq ps-page-count 0 + ps-control-or-escape-regexp + (cond ((eq ps-print-control-characters '8-bit) "[\000-\037\177-\377]") + ((eq ps-print-control-characters 'control-8-bit) "[\000-\037\177-\237]") + ((eq ps-print-control-characters 'control) "[\000-\037\177]") + (t "[\t\n\f]")))) (defun ps-end-file () (ps-output "\nEndDoc\n\n%%Trailer\n%%Pages: " @@ -3076,7 +3209,7 @@ (let* ((q-todo (- (point-max) (point-min))) (q-done (- (point) (point-min))) (chunkfrac (/ q-todo 8)) - (chunksize (if (> chunkfrac 1000) 1000 chunkfrac))) + (chunksize (min chunkfrac 1000))) (if (> (- q-done ps-razchunk) chunksize) (progn (setq ps-razchunk q-done) @@ -3135,44 +3268,55 @@ ;; ...break the region up into chunks separated by tabs, linefeeds, ;; pagefeeds, control characters, and plot each chunk. (while (< from to) - (if (re-search-forward "[\000-\037\177-\377]" to t) + (if (re-search-forward ps-control-or-escape-regexp to t) ;; region with some control characters (let ((match (char-after (match-beginning 0)))) - (if (= match ?\t) ; tab - (let ((linestart - (save-excursion (beginning-of-line) (point)))) - (ps-plot 'ps-basic-plot-string from (1- (point)) - bg-color) - (forward-char -1) - (setq from (+ linestart (current-column))) - (if (re-search-forward "[ \t]+" to t) - (ps-plot 'ps-basic-plot-whitespace - from (+ linestart (current-column)) - bg-color))) - ;; any other control character except tab - (ps-plot 'ps-basic-plot-string from (1- (point)) bg-color) - (cond - ((= match ?\n) ; newline - (ps-next-line)) - - ((= match ?\f) ; form feed - (ps-next-page)) - - ((<= match ?\037) ; characters from ^@ to ^_ - (ps-control-character (format "^%c" (+ match ?@)))) - - ((= match ?\177) ; del (127) is printed ^? - (ps-control-character "^?")) - - (t ; characters from 128 to 255 - (ps-control-character (format "\\%o" match))))) + (ps-plot 'ps-basic-plot-string from (1- (point)) bg-color) + (cond + ((= match ?\t) ; tab + (let ((linestart (save-excursion (beginning-of-line) (point)))) + (forward-char -1) + (setq from (+ linestart (current-column))) + (if (re-search-forward "[ \t]+" to t) + (ps-plot 'ps-basic-plot-whitespace + from (+ linestart (current-column)) + bg-color)))) + + ((= match ?\n) ; newline + (ps-next-line)) + + ((= match ?\f) ; form feed + (ps-next-page)) + ; characters from ^@ to ^_ and + (t ; characters from 127 to 255 + (ps-control-character match))) (setq from (point))) ;; region without control characters (ps-plot 'ps-basic-plot-string from to bg-color) (setq from to))))) -(defun ps-control-character (str) - (let* ((from (1- (point))) +(defvar ps-string-control-codes + (let ((table (make-vector 256 nil)) + (char ?\000)) + ;; control character + (while (<= char ?\037) + (aset table char (format "^%c" (+ char ?@))) + (setq char (1+ char))) + ;; printable character + (while (< char ?\177) + (aset table char (format "%c" char)) + (setq char (1+ char))) + ;; DEL + (aset table char "^?") + ;; 8-bit character + (while (<= (setq char (1+ char)) ?\377) + (aset table char (format "\\%o" char))) + table) + "Vector used to map characters to a printable string.") + +(defun ps-control-character (char) + (let* ((str (aref ps-string-control-codes char)) + (from (1- (point))) (len (length str)) (to (+ from len)) (wrappoint (ps-find-wrappoint from to ps-avg-char-width))) @@ -3189,8 +3333,16 @@ (defun ps-color-values (x-color) (cond ((fboundp 'x-color-values) (x-color-values x-color)) - ((fboundp 'pixel-components) - (pixel-components x-color)) + ((fboundp 'color-instance-rgb-components) + (if (ps-color-device) + (color-instance-rgb-components + (if (color-instance-p x-color) + x-color + (make-color-instance + (if (color-specifier-p x-color) + (color-name x-color) + x-color)))) + (error "No available function to determine X color values."))) (t (error "No available function to determine X color values.")))) @@ -3215,10 +3367,10 @@ (defun ps-face-attribute-list (face-or-list) (if (listp face-or-list) ;; list of faces - (let ((effects 0) foreground background face-attr face) + (let ((effects 0) + foreground background face-attr) (while face-or-list - (setq face (car face-or-list) - face-attr (ps-face-attributes face) + (setq face-attr (ps-face-attributes (car face-or-list)) effects (logior effects (aref face-attr 0))) (or foreground (setq foreground (aref face-attr 1))) (or background (setq background (aref face-attr 2))) @@ -3234,11 +3386,11 @@ (effect (aref face-bit 0)) (foreground (aref face-bit 1)) (background (aref face-bit 2)) - (fg-color (if (and ps-print-color-p foreground) + (fg-color (if (and ps-print-color-p foreground (ps-color-device)) (mapcar 'ps-color-value (ps-color-values foreground)) ps-default-color)) - (bg-color (and ps-print-color-p background + (bg-color (and ps-print-color-p background (ps-color-device) (mapcar 'ps-color-value (ps-color-values background))))) (ps-plot-region from to (logand effect 3) @@ -3248,8 +3400,10 @@ (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list) - (let* ((frame-font (or (face-font face) (face-font 'default))) - (kind-cons (assq kind (x-font-properties frame-font))) + (let* ((frame-font (or (face-font-instance face) + (face-font-instance 'default))) + (kind-cons (and frame-font + (assq kind (font-instance-properties frame-font)))) (kind-spec (cdr-safe kind-cons)) (case-fold-search t)) (or (and kind-spec (string-match kind-regex kind-spec)) @@ -3279,6 +3433,10 @@ (defun ps-build-reference-face-lists () + ;; Ensure that face database is updated with faces on + ;; `font-lock-face-attributes' (obsolete stuff) + (ps-font-lock-face-attributes) + ;; Now, rebuild reference face lists (setq ps-print-face-alist nil) (if ps-auto-font-detect (mapcar 'ps-map-face (face-list)) @@ -3335,15 +3493,14 @@ (< (extent-priority a) (extent-priority b))) (defun ps-print-ensure-fontified (start end) - (and (boundp 'lazy-lock-mode) lazy-lock-mode + (and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode) (if (fboundp 'lazy-lock-fontify-region) (lazy-lock-fontify-region start end) ; the new (lazy-lock-fontify-buffer)))) ; the old (defun ps-generate-postscript-with-faces (from to) ;; Some initialization... - (setq ps-current-effect 0 - ps-print-face-alist nil) + (setq ps-current-effect 0) ;; Build the reference lists of faces if necessary. (if (or ps-always-build-face-reference @@ -3355,7 +3512,7 @@ ;; that ps-print can be dumped into emacs. This expression can't be ;; evaluated at dump-time because X isn't initialized. (setq ps-print-color-scale - (if ps-print-color-p + (if (and ps-print-color-p (ps-color-device)) (float (car (ps-color-values "white"))) 1.0)) ;; Generate some PostScript. @@ -3482,8 +3639,8 @@ (inhibit-read-only t)) (save-restriction (narrow-to-region from to) - (if ps-razzle-dazzle - (message "Formatting...%3d%%" (setq ps-razchunk 0))) + (and ps-razzle-dazzle + (message "Formatting...%3d%%" (setq ps-razchunk 0))) (set-buffer buffer) (setq ps-source-buffer buffer ps-spool-buffer (get-buffer-create ps-spool-buffer-name)) @@ -3535,9 +3692,9 @@ (set-buffer ps-spool-buffer) (delete-region (marker-position safe-marker) (point-max)))))) - (if ps-razzle-dazzle - (message "Formatting...done")))))) - + (and ps-razzle-dazzle (message "Formatting...done")))))) + +;; Permit dynamic evaluation at print time of `ps-lpr-switches'. (defun ps-do-despool (filename) (if (or (not (boundp 'ps-spool-buffer)) (not (symbol-value 'ps-spool-buffer))) @@ -3546,16 +3703,13 @@ (ps-flush-output) (if filename (save-excursion - (if ps-razzle-dazzle - (message "Saving...")) + (and ps-razzle-dazzle (message "Saving...")) (set-buffer ps-spool-buffer) (setq filename (expand-file-name filename)) (write-region (point-min) (point-max) filename) - (if ps-razzle-dazzle - (message "Wrote %s" filename))) + (and ps-razzle-dazzle (message "Wrote %s" filename))) ;; Else, spool to the printer - (if ps-razzle-dazzle - (message "Printing...")) + (and ps-razzle-dazzle (message "Printing...")) (save-excursion (set-buffer ps-spool-buffer) (if (and (eq system-type 'ms-dos) @@ -3565,13 +3719,37 @@ (let ((binary-process-input t)) ; for MS-DOS (apply 'call-process-region (point-min) (point-max) ps-lpr-command nil - (if (fboundp 'start-process) 0 nil) + (and (fboundp 'start-process) 0) nil - ps-lpr-switches)))) - (if ps-razzle-dazzle - (message "Printing...done"))) + (ps-flatten-list ; dynamic evaluation + (mapcar 'ps-eval-switch ps-lpr-switches)))))) + (and ps-razzle-dazzle (message "Printing...done"))) (kill-buffer ps-spool-buffer))) +;; Dynamic evaluation +(defun ps-eval-switch (arg) + (cond ((stringp arg) arg) + ((functionp arg) (apply arg nil)) + ((symbolp arg) (symbol-value arg)) + ((consp arg) (apply (car arg) (cdr arg))) + (t nil))) + +;; `ps-flatten-list' is defined here (copied from "message.el" and +;; enhanced to handle dotted pairs as well) until we can get some +;; sensible autoloads, or `flatten-list' gets put somewhere decent. + +;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j)) +;; => (a b c d e f g h i j) + +(defun ps-flatten-list (&rest list) + (ps-flatten-list-1 list)) + +(defun ps-flatten-list-1 (list) + (cond ((null list) nil) + ((consp list) (append (ps-flatten-list-1 (car list)) + (ps-flatten-list-1 (cdr list)))) + (t (list list)))) + (defun ps-kill-emacs-check () (let (ps-buffer) (and (setq ps-buffer (get-buffer ps-spool-buffer-name))