X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6fb87e513c66805b11cf0ba895acb4bd4d3ace32..7d5cb920d08d07a3e44c6893f1524352bc207ce3:/lisp/ps-print.el diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 52d74af9f2..6be1f12d43 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -10,11 +10,11 @@ ;; Maintainer: Kenichi Handa (multi-byte characters) ;; Vinicius Jose Latorre ;; Keywords: wp, print, PostScript -;; Version: 6.7.5 +;; Version: 7.3.1 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre -(defconst ps-print-version "6.7.5" - "ps-print.el, v 6.7.5 <2007/07/20 vinicius> +(defconst ps-print-version "7.3.1" + "ps-print.el, v 7.3.1 <2007/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, please also @@ -27,7 +27,7 @@ Please send all bug fixes and enhancements to ;; GNU Emacs 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 2, or (at your option) any later +;; Software Foundation; either version 3, or (at your option) any later ;; version. ;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY @@ -1089,6 +1089,14 @@ Please send all bug fixes and enhancements to ;; You can also set `ps-print-color-p' to 'black-white to have a better looking ;; on black/white printers. See also `ps-black-white-faces' for documentation. ;; +;; ps-print also detects if the text foreground and background colors are +;; equals when `ps-fg-validate-p' is non-nil. In this case, if these colors +;; are used, no text will appear. You can use `ps-fg-list' to give a list of +;; foreground colors to be used when text foreground and background colors are +;; equals. It'll be used the first foreground color in `ps-fg-list' which is +;; different from the background color. If `ps-fg-list' is nil, the default +;; foreground color is used. +;; ;; ;; How Ps-Print Maps Faces ;; ----------------------- @@ -1212,85 +1220,88 @@ Please send all bug fixes and enhancements to ;; ;; [vinicius] Vinicius Jose Latorre ;; -;; 20040229 +;; 2007-10-27 +;; `ps-fg-validate-p', `ps-fg-list' +;; +;; 2004-02-29 ;; `ps-time-stamp-yyyy-mm-dd', `ps-time-stamp-iso8601' ;; -;; 20010619 +;; 2001-06-19 ;; `ps-time-stamp-locale-default' ;; -;; 20010530 +;; 2001-05-30 ;; Handle before-string and after-string overlay properties. ;; -;; 20010407 +;; 2001-04-07 ;; `ps-line-number-color', `ps-print-footer', `ps-footer-offset', ;; `ps-print-footer-frame', `ps-footer-font-family', ;; `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines', ;; `ps-left-footer', `ps-right-footer', `ps-footer-frame-alist' and ;; `ps-header-frame-alist'. ;; -;; 20010328 +;; 2001-03-28 ;; `ps-line-spacing', `ps-paragraph-spacing', `ps-paragraph-regexp', ;; `ps-begin-cut-regexp' and `ps-end-cut-regexp'. ;; -;; 20001122 +;; 2000-11-22 ;; `ps-line-number-font', `ps-line-number-font-size' and ;; `ps-end-with-control-d'. ;; -;; 20000821 +;; 2000-08-21 ;; `ps-even-or-odd-pages' ;; -;; 20000617 +;; 2000-06-17 ;; `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down', ;; `ps-selected-pages', `ps-last-selected-pages', ;; `ps-restore-selected-pages', `ps-switch-header', ;; `ps-line-number-step', `ps-line-number-start', ;; `ps-zebra-stripe-follow' and `ps-use-face-background'. ;; -;; 20000310 +;; 2000-03-10 ;; PostScript error handler. ;; `ps-user-defined-prologue' and `ps-error-handler-message'. ;; -;; 19991211 +;; 1999-12-11 ;; `ps-print-customize'. ;; -;; 19990703 +;; 1999-07-03 ;; Better customization. ;; `ps-banner-page-when-duplexing' and `ps-zebra-color'. ;; -;; 19990513 +;; 1999-05-13 ;; N-up printing. ;; Hook: `ps-print-begin-sheet-hook'. ;; -;; [kenichi] 19990509 Ken'ichi Handa +;; [kenichi] 1999-05-09 Ken'ichi Handa ;; ;; `ps-print-region-function' ;; ;; [vinicius] Vinicius Jose Latorre ;; -;; 19990301 +;; 1999-03-01 ;; PostScript tumble and setpagedevice. ;; -;; 19980922 +;; 1998-09-22 ;; PostScript prologue header comment insertion. ;; Skip invisible text better. ;; -;; [kenichi] 19980819 Ken'ichi Handa +;; [kenichi] 1998-08-19 Ken'ichi Handa ;; ;; Multi-byte buffer handling. ;; ;; [vinicius] Vinicius Jose Latorre ;; -;; 19980306 +;; 1998-03-06 ;; Skip invisible text. ;; -;; 19971130 +;; 1997-11-30 ;; Hooks: `ps-print-hook', `ps-print-begin-page-hook' and ;; `ps-print-begin-column-hook'. ;; Put one header per page over the columns. ;; Better database font management. ;; Better control characters handling. ;; -;; 19971121 +;; 1997-11-21 ;; Dynamic evaluation at print time of `ps-lpr-switches'. ;; Handle control characters. ;; Face remapping. @@ -1299,12 +1310,12 @@ Please send all bug fixes and enhancements to ;; Zebra stripes. ;; Text and/or image on background. ;; -;; [jack] 19960517 Jacques Duthen +;; [jack] 1996-05-17 Jacques Duthen ;; -;; Font family and float size for text and header. -;; Landscape mode. -;; Multiple columns. -;; Tools for page setup. +;; Font family and float size for text and header. +;; Landscape mode. +;; Multiple columns. +;; Tools for page setup. ;; ;; ;; Known bugs and limitations of ps-print @@ -1331,7 +1342,7 @@ Please send all bug fixes and enhancements to ;; ;; Faces are always treated as opaque. ;; -;; Epoch, Lucid and Emacs 21 not supported. At all. +;; Epoch, Lucid and Emacs 22 not supported. At all. ;; ;; Fixed-pitch fonts work better for line folding, but are not required. ;; @@ -1343,8 +1354,11 @@ Please send all bug fixes and enhancements to ;; ---------------- ;; ;; Avoid page break inside a paragraph. +;; ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy). +;; ;; Improve the memory management for big files (hard?). +;; ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care of folding ;; lines. ;; @@ -1445,61 +1459,16 @@ Please send all bug fixes and enhancements to (require 'lpr) + (or (featurep 'lisp-float-type) (error "`ps-print' requires floating point support")) -(let ((case-fold-search t)) - (cond ((string-match "XEmacs" emacs-version)) - ((string-match "Lucid" emacs-version) - (error "`ps-print' doesn't support Lucid")) - ((string-match "Epoch" emacs-version) - (error "`ps-print' doesn't support Epoch")) - (t - (unless (and (boundp 'emacs-major-version) - (>= emacs-major-version 22)) - (error "`ps-print' only supports Emacs 22 and higher"))))) - -;; GNU Emacs -(or (fboundp 'line-beginning-position) - (defun line-beginning-position (&optional n) - (save-excursion - (and n (/= n 1) (forward-line (1- n))) - (beginning-of-line) - (point)))) - - -;; to avoid compilation gripes - -;; XEmacs -(defalias 'ps-x-color-instance-p 'color-instance-p) -(defalias 'ps-x-color-instance-rgb-components 'color-instance-rgb-components) -(defalias 'ps-x-color-name 'color-name) -(defalias 'ps-x-color-specifier-p 'color-specifier-p) -(defalias 'ps-x-copy-coding-system 'copy-coding-system) -(defalias 'ps-x-device-class 'device-class) -(defalias 'ps-x-extent-end-position 'extent-end-position) -(defalias 'ps-x-extent-face 'extent-face) -(defalias 'ps-x-extent-priority 'extent-priority) -(defalias 'ps-x-extent-start-position 'extent-start-position) -(defalias 'ps-x-face-font-instance 'face-font-instance) -(defalias 'ps-x-find-coding-system 'find-coding-system) -(defalias 'ps-x-font-instance-properties 'font-instance-properties) -(defalias 'ps-x-make-color-instance 'make-color-instance) -(defalias 'ps-x-map-extents 'map-extents) - -;; GNU Emacs -(defalias 'ps-e-face-bold-p 'face-bold-p) -(defalias 'ps-e-face-italic-p 'face-italic-p) -(defalias 'ps-e-next-overlay-change 'next-overlay-change) -(defalias 'ps-e-overlays-at 'overlays-at) -(defalias 'ps-e-overlay-get 'overlay-get) -(defalias 'ps-e-overlay-end 'overlay-end) -(defalias 'ps-e-x-color-values 'x-color-values) -(defalias 'ps-e-color-values 'color-values) -(defalias 'ps-e-find-composition (if (fboundp 'find-composition) - 'find-composition - 'ignore)) +(if (featurep 'xemacs) + () + (unless (and (boundp 'emacs-major-version) + (>= emacs-major-version 23)) + (error "`ps-print' only supports Emacs 23 and higher"))) (defconst ps-windows-system @@ -1508,32 +1477,8 @@ Please send all bug fixes and enhancements to (memq system-type '(usg-unix-v dgux hpux irix))) -(defun ps-xemacs-color-name (color) - (if (ps-x-color-specifier-p color) - (ps-x-color-name color) - color)) - -(defalias 'ps-frame-parameter - (if (fboundp 'frame-parameter) 'frame-parameter 'frame-property)) - -(defalias 'ps-mark-active-p - (if (fboundp 'region-active-p) - 'region-active-p ; XEmacs - (defvar mark-active) ; To shup up XEmacs's byte compiler. - (lambda () mark-active))) ; Emacs - -(cond ((featurep 'xemacs) ; XEmacs - (defun ps-face-foreground-name (face) - (ps-xemacs-color-name (face-foreground face))) - (defun ps-face-background-name (face) - (ps-xemacs-color-name (face-background face))) - ) - (t ; Emacs 22 or higher - (defun ps-face-foreground-name (face) - (face-foreground face nil t)) - (defun ps-face-background-name (face) - (face-background face nil t)) - )) +;; Load XEmacs/Emacs definitions +(eval-and-compile (require 'ps-def)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1807,7 +1752,28 @@ an explicit filename is given as the last argument." :group 'ps-print-printer) (defcustom ps-lpr-switches lpr-switches - "*A list of extra switches to pass to `ps-lpr-command'." + "*List of extra switches to pass to `ps-lpr-command'. + +The list element can be: + + string it should be an option for `ps-lpr-command' (which see). + For example: \"-o Duplex=DuplexNoTumble\" + + symbol it can be a function or variable symbol. If it's a function + symbol, it should be a function with no argument. The result + of the function or the variable value should be a string or a + list of strings. + + list the header should be a symbol function and the tail is the + arguments for this function. This function should return a + string or a list of strings. + +Any other value is silently ignored. + +It is recommended to set `ps-printer-name' (which see) instead of including an +explicit switch on this list. + +See `ps-lpr-command'." :type '(repeat :tag "PostScript lpr Switches" (choice :menu-tag "PostScript lpr Switch" :tag "PostScript lpr Switch" @@ -2869,7 +2835,8 @@ uses the fonts resident in your printer." :group 'ps-print-font) (defcustom ps-font-size '(7 . 8.5) - "*Font size, in points, for ordinary text, when generating PostScript." + "*Font size, in points, for ordinary text, when generating PostScript. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)." :type '(choice :menu-tag "Ordinary Text Font Size" :tag "Ordinary Text Font Size" (number :tag "Text Size") @@ -2886,7 +2853,8 @@ uses the fonts resident in your printer." :group 'ps-print-font) (defcustom ps-header-font-size '(10 . 12) - "*Font size, in points, for text in the header, when generating PostScript." + "*Font size, in points, for text in the header, when generating PostScript. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)." :type '(choice :menu-tag "Header Font Size" :tag "Header Font Size" (number :tag "Header Size") @@ -2897,7 +2865,8 @@ uses the fonts resident in your printer." :group 'ps-print-font) (defcustom ps-header-title-font-size '(12 . 14) - "*Font size, in points, for the top line of text in header, in PostScript." + "*Font size, in points, for the top line of text in header, in PostScript. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)." :type '(choice :menu-tag "Header Title Font Size" :tag "Header Title Font Size" (number :tag "Header Title Size") @@ -2914,7 +2883,8 @@ uses the fonts resident in your printer." :group 'ps-print-font) (defcustom ps-footer-font-size '(10 . 12) - "*Font size, in points, for text in the footer, when generating PostScript." + "*Font size, in points, for text in the footer, when generating PostScript. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)." :type '(choice :menu-tag "Footer Font Size" :tag "Footer Font Size" (number :tag "Footer Size") @@ -2946,7 +2916,8 @@ uses the fonts resident in your printer." :group 'ps-print-miscellany) (defcustom ps-line-number-font-size 6 - "*Font size, in points, for line number, when generating PostScript." + "*Font size, in points, for line number, when generating PostScript. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)." :type '(choice :menu-tag "Line Number Font Size" :tag "Line Number Font Size" (number :tag "Font Size") @@ -3009,14 +2980,15 @@ Valid values are: LIST It's a list of RGB values, that is a list of three real values of the form: - (RED, GREEN, BLUE) + (RED GREEN BLUE) Where RED, GREEN and BLUE are reals between 0.0 (no color) and 1.0 (full color). Any other value is ignored and black color will be used. -It's used only when `ps-print-color-p' is non-nil." +This variable is used only when `ps-print-color-p' (which see) is neither nil +nor black-white." :type '(choice :menu-tag "Default Foreground Gray/Color" :tag "Default Foreground Gray/Color" (const :tag "Session Foreground" t) @@ -3052,14 +3024,15 @@ Valid values are: LIST It's a list of RGB values, that is a list of three real values of the form: - (RED, GREEN, BLUE) + (RED GREEN BLUE) Where RED, GREEN and BLUE are reals between 0.0 (no color) and 1.0 (full color). Any other value is ignored and white color will be used. -It's used only when `ps-print-color-p' is non-nil. +This variable is used only when `ps-print-color-p' (which see) is neither nil +nor black-white. See also `ps-use-face-background'." :type '(choice :menu-tag "Default Background Gray/Color" @@ -3075,6 +3048,58 @@ See also `ps-use-face-background'." :version "20" :group 'ps-print-color) +(defcustom ps-fg-list nil + "*Specify foreground color list. + +This list is used to chose a text foreground color which is different than the +background color. It'll be used the first foreground color in `ps-fg-list' +which is different from the background color. + +If this list is nil, the default foreground color is used. See +`ps-default-fg'. + +The list element valid values are: + + NUMBER It's a real value between 0.0 (black) and 1.0 (white) that + indicate the gray color. + + COLOR-NAME It's a string which contains the color name. For example: + \"yellow\". + + LIST It's a list of RGB values, that is a list of three real values + of the form: + + (RED GREEN BLUE) + + Where RED, GREEN and BLUE are reals between 0.0 (no color) and + 1.0 (full color). + +Any other value is ignored and black color will be used. + +This variable is used only when `ps-fg-validate-p' (which see) is non-nil and +when `ps-print-color-p' (which see) is neither nil nor black-white." + :type '(repeat + (choice :menu-tag "Foreground Gray/Color" + :tag "Foreground Gray/Color" + (number :tag "Gray Scale" :value 0.0) + (string :tag "Color Name" :value "black") + (list :tag "RGB Color" :value (0.0 0.0 0.0) + (number :tag "Red") + (number :tag "Green") + (number :tag "Blue")))) + :version "22" + :group 'ps-print-color) + +(defcustom ps-fg-validate-p t + "*Non-nil means validate if foreground color is different than background. + +If text foreground and background colors are equals, no text will appear. + +See also `ps-fg-list'." + :type 'boolean + :version "22" + :group 'ps-print-color) + (defcustom ps-auto-font-detect t "*Non-nil means automatically detect bold/italic/underline face attributes. If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', and @@ -3339,9 +3364,9 @@ It's like the very first character of buffer (or region) is ^L (\\014)." (defcustom ps-postscript-code-directory (or (if (featurep 'xemacs) (cond ((fboundp 'locate-data-directory) ; XEmacs - (locate-data-directory "ps-print")) + (funcall 'locate-data-directory "ps-print")) ((boundp 'data-directory) ; XEmacs - data-directory) + (symbol-value 'data-directory)) (t ; don't know what to do nil)) data-directory) ; Emacs @@ -3355,6 +3380,8 @@ By default, this directory is the same as in the variable `data-directory'." (defcustom ps-line-spacing 0 "*Specify line spacing, in points, for ordinary text. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE). + See also `ps-paragraph-spacing' and `ps-paragraph-regexp'. To get all lines with some spacing set both `ps-line-spacing' and @@ -3371,6 +3398,8 @@ To get all lines with some spacing set both `ps-line-spacing' and (defcustom ps-paragraph-spacing 0 "*Specify paragraph spacing, in points, for ordinary text. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE). + See also `ps-line-spacing' and `ps-paragraph-regexp'. To get all lines with some spacing set both `ps-line-spacing' and @@ -3616,9 +3645,11 @@ The table depends on the current ps-print setup." '(23 . ps-line-number-step) '(23 . ps-line-number-start) nil - '(17 . ps-default-fg) - '(17 . ps-default-bg) '(17 . ps-razzle-dazzle) + '(17 . ps-default-bg) + '(17 . ps-default-fg) + '(17 . ps-fg-validate-p) + '(17 . ps-fg-list) nil '(23 . ps-use-face-background) nil @@ -3698,9 +3729,9 @@ The table depends on the current ps-print setup." '(20 . ps-underlined-faces) '(20 . ps-black-white-faces) " )\n -;; The following customized variables have long lists and are seldom modified: -;; ps-page-dimensions-database -;; ps-font-info-database +\;; The following customized variables have long lists and are seldom modified: +\;; ps-page-dimensions-database +\;; ps-font-info-database \;;; ps-print - end of settings\n") "\n"))) @@ -3833,108 +3864,6 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'." (format-time-string "%T")) -(and (featurep 'xemacs) - ;; XEmacs change: Need to check for emacs-major-version too. - (or (< emacs-major-version 19) - (and (= emacs-major-version 19) (< emacs-minor-version 12))) - (setq ps-print-color-p nil)) - - -;; Return t if the device (which can be changed during an emacs session) -;; can handle colors. -;; This function is not yet implemented for GNU emacs. -(defalias 'ps-color-device - (cond ((and (featurep 'xemacs) - ;; XEmacs change: Need to check for emacs-major-version too. - (or (> emacs-major-version 19) - (and (= emacs-major-version 19) - (>= emacs-minor-version 12)))) ; XEmacs >= 19.12 - (lambda () - (eq (ps-x-device-class) 'color))) - - (t ; Emacs - (lambda () - (if (fboundp 'color-values) - (ps-e-color-values "Green") - t))))) - - -(defun ps-mapper (extent list) - (nconc list - (list (list (ps-x-extent-start-position extent) 'push extent) - (list (ps-x-extent-end-position extent) 'pull extent))) - nil) - -(defun ps-extent-sorter (a b) - (< (ps-x-extent-priority a) (ps-x-extent-priority b))) - -(defun ps-xemacs-face-kind-p (face kind kind-regex) - (let* ((frame-font (or (ps-x-face-font-instance face) - (ps-x-face-font-instance 'default))) - (kind-cons - (and frame-font - (assq kind - (ps-x-font-instance-properties frame-font)))) - (kind-spec (cdr-safe kind-cons)) - (case-fold-search t)) - (and kind-spec (string-match kind-regex kind-spec)))) - -(cond ((featurep 'xemacs) ; XEmacs - - ;; to avoid XEmacs compilation gripes - (defvar coding-system-for-write) - (defvar coding-system-for-read) - (defvar buffer-file-coding-system) - - (and (fboundp 'find-coding-system) - (or (ps-x-find-coding-system 'raw-text-unix) - (ps-x-copy-coding-system 'no-conversion-unix 'raw-text-unix))) - - (defun ps-color-values (x-color) - (let ((color (ps-xemacs-color-name x-color))) - (cond - ((fboundp 'x-color-values) - (ps-e-x-color-values color)) - ((and (fboundp 'color-instance-rgb-components) - (ps-color-device)) - (ps-x-color-instance-rgb-components - (if (ps-x-color-instance-p x-color) - x-color - (ps-x-make-color-instance color)))) - (t - (error "No available function to determine X color values"))))) - - (defun ps-face-bold-p (face) - (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold") - (memq face ps-bold-faces))) ; Kludge-compatible - - (defun ps-face-italic-p (face) - (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o") - (ps-xemacs-face-kind-p face 'SLANT "i\\|o") - (memq face ps-italic-faces))) ; Kludge-compatible - ) - - (t ; Emacs - - (defun ps-color-values (x-color) - (cond - ((fboundp 'color-values) - (ps-e-color-values x-color)) - ((fboundp 'x-color-values) - (ps-e-x-color-values x-color)) - (t - (error "No available function to determine X color values")))) - - (defun ps-face-bold-p (face) - (or (ps-e-face-bold-p face) - (memq face ps-bold-faces))) - - (defun ps-face-italic-p (face) - (or (ps-e-face-italic-p face) - (memq face ps-italic-faces))) - )) - - (defvar ps-print-color-scale 1.0) (defun ps-color-scale (color) @@ -4009,20 +3938,12 @@ Note: No major/minor-mode is activated and no local variables are evaluated for (defvar ps-default-color nil) (defvar ps-current-color nil) (defvar ps-current-bg nil) +(defvar ps-foreground-list nil) (defvar ps-zebra-stripe-full-p nil) (defvar ps-razchunk 0) (defvar ps-color-p nil) -(defvar ps-color-format - (if (featurep 'xemacs) - ;; XEmacs will have to make do with %s (princ) for floats. - "%s %s %s" - - ;; Emacs understands the %f format; we'll use it to limit color RGB - ;; values to three decimals to cut down some on the size of the - ;; PostScript output. - "%0.3f %0.3f %0.3f")) ;; These values determine how much print-height to deduct when headers/footers ;; are turned on. This is a pretty clumsy way of handling it, but it'll do for @@ -4808,65 +4729,35 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th (goto-char (point-max)) (insert-file-contents fname))) -;; These functions are used in `ps-mule' to get charset of header and footer. -;; To avoid unnecessary calls to functions in `ps-left-header', -;; `ps-right-header', `ps-left-footer' and `ps-right-footer'. - -(defun ps-generate-string-list (content) - (let (str) - (while content - (setq str (cons (cond - ;; string - ((stringp (car content)) - (car content)) - ;; function symbol - ((functionp (car content)) - (concat "(" (funcall (car content)) ")")) - ;; variable symbol - ((and (symbolp (car content)) (boundp (car content))) - (concat "(" (symbol-value (car content)) ")")) - ;; otherwise, empty string - (t - "")) - str) - content (cdr content))) - (nreverse str))) - -(defvar ps-lh-cache nil) -(defvar ps-rh-cache nil) -(defvar ps-lf-cache nil) -(defvar ps-rf-cache nil) - -(defun ps-header-footer-string () - (and ps-print-header - (setq ps-lh-cache (ps-generate-string-list ps-left-header) - ps-rh-cache (ps-generate-string-list ps-right-header))) - (and ps-print-footer - (setq ps-lf-cache (ps-generate-string-list ps-left-footer) - ps-rf-cache (ps-generate-string-list ps-right-footer))) - (append ps-lh-cache ps-rh-cache ps-lf-cache ps-rf-cache)) - ;; These functions insert the arrays that define the contents of the headers. +(defvar ps-encode-header-string-function nil) + (defun ps-generate-header-line (fonttag &optional content) (ps-output " [" fonttag " ") (cond ;; Literal strings should be output as is -- the string must contain its own ;; PS string delimiters, '(' and ')', if necessary. ((stringp content) - (ps-output (ps-mule-encode-header-string content fonttag))) + (ps-output content)) ;; Functions are called -- they should return strings; they will be inserted ;; as strings and the PS string delimiters added. ((functionp content) - (ps-output-string (ps-mule-encode-header-string (funcall content) - fonttag))) + (if (functionp ps-encode-header-string-function) + (dolist (l (funcall ps-encode-header-string-function + (funcall content) fonttag)) + (ps-output-string l)) + (ps-output-string (funcall content)))) ;; Variables will have their contents inserted. They should contain ;; strings, and will be inserted as strings. ((and (symbolp content) (boundp content)) - (ps-output-string (ps-mule-encode-header-string (symbol-value content) - fonttag))) + (if (fboundp ps-encode-header-string-function) + (dolist (l (funcall ps-encode-header-string-function + (symbol-value content) fonttag)) + (ps-output-string l)) + (ps-output-string (symbol-value content)))) ;; Anything else will get turned into an empty string. (t @@ -4932,15 +4823,6 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th (vector 0 0 0 0))))) -;; Emacs understands the %f format; we'll use it to limit color RGB values -;; to three decimals to cut down some on the size of the PostScript output. -;; XEmacs will have to make do with %s (princ) for floats. - -(defvar ps-float-format (if (featurep 'xemacs) - "%s " ; XEmacs - "%0.3f ")) ; Emacs - - (defun ps-float-format (value &optional default) (let ((literal (or value default))) (cond ((null literal) @@ -5017,15 +4899,15 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th (defun ps-background (page-number) (let (has-local-background) - (mapcar #'(lambda (range) - (and (<= (aref range 0) page-number) - (<= page-number (aref range 1)) - (if has-local-background - (ps-output (aref range 2)) - (setq has-local-background t) - (ps-output "/printLocalBackground{\n" - (aref range 2))))) - ps-background-pages) + (mapc #'(lambda (range) + (and (<= (aref range 0) page-number) + (<= page-number (aref range 1)) + (if has-local-background + (ps-output (aref range 2)) + (setq has-local-background t) + (ps-output "/printLocalBackground{\n" + (aref range 2))))) + ps-background-pages) (and has-local-background (ps-output "}def\n")))) @@ -5661,7 +5543,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") (ps-output "\n" ps-print-prologue-1 "\n/printGlobalBackground{\n") - (mapcar 'ps-output ps-background-all-pages) + (mapc 'ps-output ps-background-all-pages) (ps-output "}def\n/printLocalBackground{\n}def\n" "\n%%EndProlog\n\n%%BeginSetup\n" @@ -5841,6 +5723,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") (t (list default default default)))) +(defvar ps-basic-plot-string-function 'ps-basic-plot-string) (defun ps-begin-job (genfunc) ;; prologue files @@ -5920,7 +5803,8 @@ XSTART YSTART are the relative position for the first page in a sheet.") 1.0) ps-default-background (ps-rgb-color (cond - ((or (not (eq ps-print-color-p t)) + ((or (member ps-print-color-p + '(nil back-white)) (eq genfunc 'ps-generate-postscript)) nil) ((eq ps-default-bg 'frame-parameter) @@ -5933,7 +5817,8 @@ XSTART YSTART are the relative position for the first page in a sheet.") 1.0) ps-default-foreground (ps-rgb-color (cond - ((or (not (eq ps-print-color-p t)) + ((or (member ps-print-color-p + '(nil back-white)) (eq genfunc 'ps-generate-postscript)) nil) ((eq ps-default-fg 'frame-parameter) @@ -5944,12 +5829,27 @@ XSTART YSTART are the relative position for the first page in a sheet.") ps-default-fg)) "unspecified-fg" 0.0) - ps-default-color (and (eq ps-print-color-p t) + ps-foreground-list (mapcar + #'(lambda (arg) + (ps-rgb-color arg "unspecified-fg" 0.0)) + (append (and (not (member ps-print-color-p + '(nil back-white))) + ps-fg-list) + (list ps-default-foreground + "black"))) + ps-default-color (and (not (member ps-print-color-p + '(nil back-white))) ps-default-foreground) - ps-current-color ps-default-color) + ps-current-color ps-default-color + ;; Set up default functions. + ;; They may be overridden by ps-mule-begin-job. + ps-basic-plot-string-function 'ps-basic-plot-string + ps-encode-header-string-function nil) ;; initialize page dimensions (ps-get-page-dimensions) ;; final check + (unless (listp ps-lpr-switches) + (error "`ps-lpr-switches' value should be a list.")) (and ps-color-p (equal ps-default-background ps-default-foreground) (error @@ -6031,28 +5931,19 @@ XSTART YSTART are the relative position for the first page in a sheet.") (format "/PageNumber %d def\n" (ps-page-number))) (when ps-print-header - (ps-generate-header "HeaderLinesLeft" "/h0" "/h1" - (or ps-lh-cache ps-left-header)) - (ps-generate-header "HeaderLinesRight" "/h0" "/h1" - (or ps-rh-cache ps-right-header)) - (ps-output (format "%d SetHeaderLines\n" ps-header-lines)) - (setq ps-lh-cache nil - ps-rh-cache nil)) + (ps-generate-header "HeaderLinesLeft" "/h0" "/h1" ps-left-header) + (ps-generate-header "HeaderLinesRight" "/h0" "/h1" ps-right-header) + (ps-output (format "%d SetHeaderLines\n" ps-header-lines))) (when ps-print-footer - (ps-generate-header "FooterLinesLeft" "/H0" "/H0" - (or ps-lf-cache ps-left-footer)) - (ps-generate-header "FooterLinesRight" "/H0" "/H0" - (or ps-rf-cache ps-right-footer)) - (ps-output (format "%d SetFooterLines\n" ps-footer-lines)) - (setq ps-lf-cache nil - ps-rf-cache nil)) + (ps-generate-header "FooterLinesLeft" "/H0" "/H0" ps-left-footer) + (ps-generate-header "FooterLinesRight" "/H0" "/H0" ps-right-footer) + (ps-output (format "%d SetFooterLines\n" ps-footer-lines))) (ps-output (number-to-string ps-lines-printed) " BeginPage\n") (ps-set-font ps-current-font) (ps-set-bg ps-current-bg) - (ps-set-color ps-current-color) - (ps-mule-begin-page)) + (ps-set-color ps-current-color)) (defsubst ps-skip-newline (limit) (setq ps-showline-count (1+ ps-showline-count) @@ -6096,7 +5987,6 @@ XSTART YSTART are the relative position for the first page in a sheet.") (ps-avg-char-width 'ps-font-for-text))) (to (car wrappoint)) (str (substring string from to))) - (ps-mule-prepare-ascii-font str) (ps-output-string str) (ps-output " S\n") wrappoint)) @@ -6106,7 +5996,6 @@ XSTART YSTART are the relative position for the first page in a sheet.") (ps-avg-char-width 'ps-font-for-text))) (to (car wrappoint)) (string (buffer-substring-no-properties from to))) - (ps-mule-prepare-ascii-font string) (ps-output-string string) (ps-output " S\n") wrappoint)) @@ -6186,16 +6075,24 @@ to the equivalent Latin-1 characters.") (or (equal font ps-current-font) (ps-set-font font)) - ;; Specify a foreground color only if one's specified and it's - ;; different than the current. + ;; Specify a foreground color only if: + ;; one's specified, + ;; it's different than the background (if `ps-fg-validate-p' is non-nil) + ;; and it's different than the current. (let ((fg (or fg-color ps-default-foreground))) + (if ps-fg-validate-p + (let ((bg (or bg-color ps-default-background)) + (el ps-foreground-list)) + (while (and el (equal fg bg)) + (setq fg (car el) + el (cdr el))))) (or (equal fg ps-current-color) (ps-set-color fg))) (or (equal bg-color ps-current-bg) (ps-set-bg bg-color)) - ;; Specify effects (underline, overline, box, etc) + ;; Specify effects (underline, overline, box, etc.) (cond ((not (integerp effects)) (ps-output "0 EF\n") @@ -6223,26 +6120,16 @@ to the equivalent Latin-1 characters.") (if (re-search-forward ps-control-or-escape-regexp to t) ;; region with some control characters or some multi-byte characters (let* ((match-point (match-beginning 0)) - (match (char-after match-point)) - (composition (ps-e-find-composition from (1+ match-point)))) - (if composition - (if (and (nth 2 composition) - (<= (car composition) match-point)) - (progn - (setq match-point (car composition) - match 0) - (goto-char (nth 1 composition))) - (setq composition nil))) + (match (char-after match-point))) (when (< from match-point) - (ps-mule-set-ascii-font) - (ps-plot 'ps-basic-plot-string from match-point bg-color)) + (ps-plot ps-basic-plot-string-function + from match-point bg-color)) (cond ((= match ?\t) ; tab (let ((linestart (line-beginning-position))) (forward-char -1) (setq from (+ linestart (current-column))) (when (re-search-forward "[ \t]+" to t) - (ps-mule-set-ascii-font) (ps-plot 'ps-basic-plot-whitespace from (+ linestart (current-column)) bg-color)))) @@ -6267,30 +6154,11 @@ to the equivalent Latin-1 characters.") (ps-skip-newline to)) (ps-next-page))) - (composition ; a composite sequence - (ps-plot 'ps-mule-plot-composition match-point (point) bg-color)) - - ((> match 255) ; a multi-byte character - (setq match (or (aref ps-print-translation-table match) match)) - (let* ((charset (char-charset match)) - (composition (ps-e-find-composition match-point to)) - (stop (if (nth 2 composition) (car composition) to))) - (or (eq charset 'composition) - (while (and (< (point) stop) - (let ((ch (following-char))) - (setq ch - (or (aref ps-print-translation-table ch) - ch)) - (eq (char-charset ch) charset))) - (forward-char 1))) - (ps-plot 'ps-mule-plot-string match-point (point) bg-color))) - ; characters from ^@ to ^_ and (t ; characters from 127 to 255 (ps-control-character match))) (setq from (point))) - ;; region without control characters nor multi-byte characters - (ps-mule-set-ascii-font) - (ps-plot 'ps-basic-plot-string from to bg-color) + ;; region without control characters + (ps-plot ps-basic-plot-string-function from to bg-color) (setq from to))))) (defvar ps-string-control-codes @@ -6322,11 +6190,22 @@ to the equivalent Latin-1 characters.") (if (< (car wrappoint) to) (ps-continue-line)) (setq ps-width-remaining (- ps-width-remaining (* len char-width))) - (ps-mule-prepare-ascii-font str) (ps-output-string str) (ps-output " S\n"))) +(defsubst ps-face-foreground-color-p (attr) + (memq attr '(foreground-color :foreground))) + + +(defsubst ps-face-background-color-p (attr) + (memq attr '(background-color :background))) + + +(defsubst ps-face-color-p (attr) + (memq attr '(foreground-color :foreground background-color :background))) + + (defun ps-face-attributes (face) "Return face attribute vector. @@ -6350,27 +6229,26 @@ If FACE is not a valid face name, use default face." (setq ps-print-face-alist (cons new-face ps-print-face-alist))) new-face)))) - ((eq (car face) 'foreground-color) + ((ps-face-foreground-color-p (car face)) (vector 0 (cdr face) nil)) - ((eq (car face) 'background-color) + ((ps-face-background-color-p (car face)) (vector 0 nil (cdr face))) (t (vector 0 nil nil)))) (defun ps-face-background (face background) - (and (cond ((eq ps-use-face-background t)) ; always + (and (cond ((eq ps-use-face-background t)) ; always ((null ps-use-face-background) nil) ; never ;; ps-user-face-background is a symbol face list ((symbolp face) (memq face ps-use-face-background)) ((listp face) - (or (memq (car face) '(foreground-color background-color)) + (or (ps-face-color-p (car face)) (let (ok) (while face (if (or (memq (car face) ps-use-face-background) - (memq (car face) - '(foreground-color background-color))) + (ps-face-color-p (car face))) (setq face nil ok t) (setq face (cdr face)))) @@ -6387,10 +6265,10 @@ If FACE is not a valid face name, use default face." ((not (listp face-or-list)) (ps-face-attributes face-or-list)) ;; only foreground color, not a `real' face - ((eq (car face-or-list) 'foreground-color) + ((ps-face-foreground-color-p (car face-or-list)) (vector 0 (cdr face-or-list) nil)) ;; only background color, not a `real' face - ((eq (car face-or-list) 'background-color) + ((ps-face-background-color-p (car face-or-list)) (vector 0 nil (cdr face-or-list))) ;; list of faces (t @@ -6445,10 +6323,10 @@ If FACE is not a valid face name, use default face." ;; Now, rebuild reference face lists (setq ps-print-face-alist nil) (if ps-auto-font-detect - (mapcar 'ps-map-face (face-list)) - (mapcar 'ps-set-face-bold ps-bold-faces) - (mapcar 'ps-set-face-italic ps-italic-faces) - (mapcar 'ps-set-face-underline ps-underlined-faces)) + (mapc 'ps-map-face (face-list)) + (mapc 'ps-set-face-bold ps-bold-faces) + (mapc 'ps-set-face-italic ps-italic-faces) + (mapc 'ps-set-face-underline ps-underlined-faces)) (setq ps-build-face-reference nil)) @@ -6523,125 +6401,7 @@ If FACE is not a valid face name, use default face." (save-restriction (narrow-to-region from to) (ps-print-ensure-fontified from to) - (let ((face 'default) - (position to)) - (cond - ((featurep 'xemacs) ; XEmacs - ;; Build the list of extents... - (let ((a (cons 'dummy nil)) - record type extent extent-list) - (ps-x-map-extents 'ps-mapper nil from to a) - (setq a (sort (cdr a) 'car-less-than-car) - extent-list nil) - - ;; Loop through the extents... - (while a - (setq record (car a) - position (car record) - - record (cdr record) - type (car record) - - record (cdr record) - extent (car record)) - - ;; Plot up to this record. - ;; XEmacs 19.12: for some reason, we're getting into a - ;; situation in which some of the records have - ;; positions less than 'from'. Since we've narrowed - ;; the buffer, this'll generate errors. This is a hack, - ;; but don't call ps-plot-with-face unless from > point-min. - (and (>= from (point-min)) - (ps-plot-with-face from (min position (point-max)) face)) - - (cond - ((eq type 'push) - (and (ps-x-extent-face extent) - (setq extent-list (sort (cons extent extent-list) - 'ps-extent-sorter)))) - - ((eq type 'pull) - (setq extent-list (sort (delq extent extent-list) - 'ps-extent-sorter)))) - - (setq face (if extent-list - (ps-x-extent-face (car extent-list)) - 'default) - from position - a (cdr a))))) - - (t ; Emacs - (let ((property-change from) - (overlay-change from) - (save-buffer-invisibility-spec buffer-invisibility-spec) - (buffer-invisibility-spec nil) - before-string after-string) - (while (< from to) - (and (< property-change to) ; Don't search for property change - ; unless previous search succeeded. - (setq property-change (next-property-change from nil to))) - (and (< overlay-change to) ; Don't search for overlay change - ; unless previous search succeeded. - (setq overlay-change (min (ps-e-next-overlay-change from) - to))) - (setq position (min property-change overlay-change) - before-string nil - after-string nil) - ;; The code below is not quite correct, - ;; because a non-nil overlay invisible property - ;; which is inactive according to the current value - ;; of buffer-invisibility-spec nonetheless overrides - ;; a face text property. - (setq face - (cond ((let ((prop (get-text-property from 'invisible))) - ;; Decide whether this invisible property - ;; really makes the text invisible. - (if (eq save-buffer-invisibility-spec t) - (not (null prop)) - (or (memq prop save-buffer-invisibility-spec) - (assq prop save-buffer-invisibility-spec)))) - 'emacs--invisible--face) - ((get-text-property from 'face)) - (t 'default))) - (let ((overlays (ps-e-overlays-at from)) - (face-priority -1)) ; text-property - (while (and overlays - (not (eq face 'emacs--invisible--face))) - (let* ((overlay (car overlays)) - (overlay-invisible - (ps-e-overlay-get overlay 'invisible)) - (overlay-priority - (or (ps-e-overlay-get overlay 'priority) 0))) - (and (> overlay-priority face-priority) - (setq before-string - (or (ps-e-overlay-get overlay 'before-string) - before-string) - after-string - (or (and (<= (ps-e-overlay-end overlay) position) - (ps-e-overlay-get overlay 'after-string)) - after-string) - face-priority overlay-priority - face - (cond - ((if (eq save-buffer-invisibility-spec t) - (not (null overlay-invisible)) - (or (memq overlay-invisible - save-buffer-invisibility-spec) - (assq overlay-invisible - save-buffer-invisibility-spec))) - 'emacs--invisible--face) - ((ps-e-overlay-get overlay 'face)) - (t face) - )))) - (setq overlays (cdr overlays)))) - ;; Plot up to this record. - (and before-string - (ps-plot-string before-string)) - (ps-plot-with-face from position face) - (and after-string - (ps-plot-string after-string)) - (setq from position))))) - (ps-plot-with-face from to face)))) + (ps-generate-postscript-with-faces1 from to))) (defun ps-generate-postscript (from to) (ps-plot-region from to 0)) @@ -6689,6 +6449,7 @@ If FACE is not a valid face name, use default face." (ps-begin-page) (funcall genfunc from to) (ps-end-page) + (ps-mule-end-job) (ps-end-job needs-begin-file) ;; Setting this variable tells the unwind form that the @@ -6786,10 +6547,23 @@ If FACE is not a valid face name, use default face." (and (fboundp 'start-process) 0) nil (ps-flatten-list ; dynamic evaluation - (mapcar 'ps-eval-switch ps-lpr-switches))))) + (ps-string-list + (mapcar 'ps-eval-switch ps-lpr-switches)))))) (and ps-razzle-dazzle (message "Printing...done"))) (kill-buffer ps-spool-buffer))) +(defun ps-string-list (arg) + (let (lstr) + (dolist (elm arg) + (cond ((stringp elm) + (setq lstr (cons elm lstr))) + ((listp elm) + (let ((s (ps-string-list elm))) + (when s + (setq lstr (cons s lstr))))) + (t ))) ; ignore any other value + (nreverse lstr))) + ;; Dynamic evaluation (defun ps-eval-switch (arg) (cond ((stringp arg) arg) @@ -6834,213 +6608,13 @@ If FACE is not a valid face name, use default face." (t (setq kill-emacs-hook 'ps-kill-emacs-check))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Sample Setup Code: - - -;; This stuff is for anybody that's brave enough to look this far, -;; and able to figure out how to use it. It isn't really part of -;; ps-print, but I'll leave it here in hopes it might be useful: - -;; WARNING!!! The following code is *sample* code only. -;; Don't use it unless you understand what it does! - -;; The key `f22' should probably be replaced by `print'. --Stef - -;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the -;; `ps-left-headers' specially for mail messages. -(defun ps-rmail-mode-hook () - (local-set-key [(f22)] 'ps-rmail-print-message-from-summary) - (setq ps-header-lines 3 - ps-left-header - ;; The left headers will display the message's subject, its - ;; author, and the name of the folder it was in. - '(ps-article-subject ps-article-author buffer-name))) - -;; See `ps-gnus-print-article-from-summary'. This function does the -;; same thing for rmail. -(defun ps-rmail-print-message-from-summary () - (interactive) - (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL")) - -;; Used in `ps-rmail-print-article-from-summary', -;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'. -(defun ps-print-message-from-summary (summary-buffer summary-default) - (let ((ps-buf (or (and (boundp summary-buffer) - (symbol-value summary-buffer)) - summary-default))) - (and (get-buffer ps-buf) - (save-excursion - (set-buffer ps-buf) - (ps-spool-buffer-with-faces))))) - -;; Look in an article or mail message for the Subject: line. To be -;; placed in `ps-left-headers'. -(defun ps-article-subject () - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) - "Subject ???"))) - -;; Look in an article or mail message for the From: line. Sorta-kinda -;; understands RFC-822 addresses and can pull the real name out where -;; it's provided. To be placed in `ps-left-headers'. -(defun ps-article-author () - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t) - (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1)))) - (cond - - ;; Try first to match addresses that look like - ;; thompson@wg2.waii.com (Jim Thompson) - ((string-match ".*[ \t]+(\\(.*\\))" fromstring) - (substring fromstring (match-beginning 1) (match-end 1))) - - ;; Next try to match addresses that look like - ;; Jim Thompson or - ;; "Jim Thompson" - ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring) - (substring fromstring (match-beginning 2) (match-end 2))) - - ;; Couldn't find a real name -- show the address instead. - (t fromstring))) - "From ???"))) - -;; A hook to bind to `gnus-article-prepare-hook'. This will set the -;; `ps-left-headers' specially for gnus articles. Unfortunately, -;; `gnus-article-mode-hook' is called only once, the first time the *Article* -;; buffer enters that mode, so it would only work for the first time -;; we ran gnus. The second time, this hook wouldn't get set up. The -;; only alternative is `gnus-article-prepare-hook'. -(defun ps-gnus-article-prepare-hook () - (setq ps-header-lines 3 - ps-left-header - ;; The left headers will display the article's subject, its - ;; author, and the newsgroup it was in. - '(ps-article-subject ps-article-author gnus-newsgroup-name))) - -;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the -;; `ps-left-headers' specially for mail messages. -(defun ps-vm-mode-hook () - (local-set-key [(f22)] 'ps-vm-print-message-from-summary) - (setq ps-header-lines 3 - ps-left-header - ;; The left headers will display the message's subject, its - ;; author, and the name of the folder it was in. - '(ps-article-subject ps-article-author buffer-name))) - -;; Every now and then I forget to switch from the *Summary* buffer to -;; the *Article* before hitting prsc, and a nicely formatted list of -;; article subjects shows up at the printer. This function, bound to -;; prsc for the gnus *Summary* buffer means I don't have to switch -;; buffers first. -;; sb: Updated for Gnus 5. -(defun ps-gnus-print-article-from-summary () - (interactive) - (ps-print-message-from-summary 'gnus-article-buffer "*Article*")) - -;; See `ps-gnus-print-article-from-summary'. This function does the -;; same thing for vm. -(defun ps-vm-print-message-from-summary () - (interactive) - (ps-print-message-from-summary 'vm-mail-buffer "")) - -;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind -;; prsc. -(defun ps-gnus-summary-setup () - (local-set-key [(f22)] 'ps-gnus-print-article-from-summary)) - -;; Look in an article or mail message for the Subject: line. To be -;; placed in `ps-left-headers'. -(defun ps-info-file () - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) - "File ???"))) - -;; Look in an article or mail message for the Subject: line. To be -;; placed in `ps-left-headers'. -(defun ps-info-node () - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) - "Node ???"))) - -(defun ps-info-mode-hook () - (setq ps-left-header - ;; The left headers will display the node name and file name. - '(ps-info-node ps-info-file))) - -;; WARNING! The following function is a *sample* only, and is *not* -;; meant to be used as a whole unless you understand what the effects -;; will be! (In fact, this is a copy of Jim's setup for ps-print -- -;; I'd be very surprised if it was useful to *anybody*, without -;; modification.) - -(defun ps-jts-ps-setup () - (global-set-key [(f22)] 'ps-spool-buffer-with-faces) ;f22 is prsc - (global-set-key [(shift f22)] 'ps-spool-region-with-faces) - (global-set-key [(control f22)] 'ps-despool) - (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook) - (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup) - (add-hook 'vm-mode-hook 'ps-vm-mode-hook) - (add-hook 'vm-mode-hooks 'ps-vm-mode-hook) - (add-hook 'Info-mode-hook 'ps-info-mode-hook) - (setq ps-spool-duplex t - ps-print-color-p nil - ps-lpr-command "lpr" - ps-lpr-switches '("-Jjct,duplex_long")) - 'ps-jts-ps-setup) - -;; WARNING! The following function is a *sample* only, and is *not* -;; meant to be used as a whole unless it corresponds to your needs. -;; (In fact, this is a copy of Jack's setup for ps-print -- -;; I would not be that surprised if it was useful to *anybody*, -;; without modification.) - -(defun ps-jack-setup () - (setq ps-print-color-p nil - ps-lpr-command "lpr" - ps-lpr-switches nil - - ps-paper-type 'a4 - ps-landscape-mode t - ps-number-of-columns 2 - - ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm - ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm - ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm - ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm - ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm - ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm - ps-header-line-pad .15 - ps-print-header t - ps-print-header-frame t - ps-header-lines 2 - ps-show-n-of-n t - ps-spool-duplex nil - - ps-font-family 'Courier - ps-font-size 5.5 - ps-header-font-family 'Helvetica - ps-header-font-size 6 - ps-header-title-font-size 8) - 'ps-jack-setup) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; To make this file smaller, some commands go in a separate file. ;; But autoload them here to make the separation invisible. -;;;### (autoloads (ps-mule-begin-page ps-mule-begin-job ps-mule-encode-header-string -;;;;;; ps-mule-initialize ps-mule-plot-composition ps-mule-plot-string -;;;;;; ps-mule-set-ascii-font ps-mule-prepare-ascii-font ps-multibyte-buffer) -;;;;;; "ps-mule" "ps-mule.el" "cbb193f9b6bebd27378819035d3788f7") +;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize +;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "ba0ba38bf1f9831ca12701290fd4b211") ;;; Generated autoloads from ps-mule.el (defvar ps-multibyte-buffer nil "\ @@ -7086,71 +6660,21 @@ Valid values are: Any other value is treated as nil.") -(custom-autoload (quote ps-multibyte-buffer) "ps-mule" t) - -(autoload (quote ps-mule-prepare-ascii-font) "ps-mule" "\ -Setup special ASCII font for STRING. -STRING should contain only ASCII characters. - -\(fn STRING)" nil nil) - -(autoload (quote ps-mule-set-ascii-font) "ps-mule" "\ -Not documented - -\(fn)" nil nil) - -(autoload (quote ps-mule-plot-string) "ps-mule" "\ -Generate PostScript code for plotting characters in the region FROM and TO. - -It is assumed that all characters in this region belong to the same charset. +(custom-autoload 'ps-multibyte-buffer "ps-mule" t) -Optional argument BG-COLOR specifies background color. - -Returns the value: - - (ENDPOS . RUN-WIDTH) - -Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of -the sequence. - -\(fn FROM TO &optional BG-COLOR)" nil nil) - -(autoload (quote ps-mule-plot-composition) "ps-mule" "\ -Generate PostScript code for plotting composition in the region FROM and TO. - -It is assumed that all characters in this region belong to the same -composition. - -Optional argument BG-COLOR specifies background color. - -Returns the value: - - (ENDPOS . RUN-WIDTH) - -Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of -the sequence. - -\(fn FROM TO &optional BG-COLOR)" nil nil) - -(autoload (quote ps-mule-initialize) "ps-mule" "\ +(autoload 'ps-mule-initialize "ps-mule" "\ Initialize global data for printing multi-byte characters. \(fn)" nil nil) -(autoload (quote ps-mule-encode-header-string) "ps-mule" "\ -Generate PostScript code for ploting STRING by font FONTTAG. -FONTTAG should be a string \"/h0\" or \"/h1\". - -\(fn STRING FONTTAG)" nil nil) - -(autoload (quote ps-mule-begin-job) "ps-mule" "\ +(autoload 'ps-mule-begin-job "ps-mule" "\ Start printing job for multi-byte chars between FROM and TO. -This checks if all multi-byte characters in the region are printable or not. +It checks if all multi-byte characters in the region are printable or not. \(fn FROM TO)" nil nil) -(autoload (quote ps-mule-begin-page) "ps-mule" "\ -Not documented +(autoload 'ps-mule-end-job "ps-mule" "\ +Finish printing job for multi-byte chars. \(fn)" nil nil)