diff options
Diffstat (limited to 'lisp/ps-print.el')
| -rw-r--r-- | lisp/ps-print.el | 109 |
1 files changed, 23 insertions, 86 deletions
diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 000aa850834..8dd1d1e2bf2 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -4,14 +4,15 @@ ;; Author: Jim Thompson (was <thompson@wg2.waii.com>) ;; Jacques Duthen (was <duthen@cegelec-red.fr>) -;; Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Kenichi Handa <handa@m17n.org> (multi-byte characters) -;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters) -;; Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Kenichi Handa <handa@gnu.org> (multi-byte characters) +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, print, PostScript ;; Version: 7.3.5 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre +(eval-when-compile (require 'cl-lib)) + (defconst ps-print-version "7.3.5" "ps-print.el, v 7.3.5 <2009/12/23 vinicius> @@ -20,7 +21,7 @@ Emacs without changes to the version number. When reporting bugs, please also report the version of Emacs, if any, that ps-print was distributed with. Please send all bug fixes and enhancements to - bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl@ig.com.br>.") + bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>.") ;; This file is part of GNU Emacs. @@ -46,7 +47,7 @@ Please send all bug fixes and enhancements to ;; ;; This package provides printing of Emacs buffers on PostScript printers; the ;; buffer's bold and italic text attributes are preserved in the printer -;; output. ps-print is intended for use with Emacs or XEmacs, together with a +;; output. ps-print is intended for use with Emacs, together with a ;; fontifying package such as font-lock or hilit. ;; ;; ps-print uses the same face attributes defined through font-lock or hilit to @@ -1216,7 +1217,7 @@ Please send all bug fixes and enhancements to ;; New since version 2.8 ;; --------------------- ;; -;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; [vinicius] Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; ;; 2007-10-27 ;; `ps-fg-validate-p', `ps-fg-list' @@ -1274,7 +1275,7 @@ Please send all bug fixes and enhancements to ;; ;; `ps-print-region-function' ;; -;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; [vinicius] Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; ;; 1999-03-01 ;; PostScript tumble and setpagedevice. @@ -1287,7 +1288,7 @@ Please send all bug fixes and enhancements to ;; ;; Multi-byte buffer handling. ;; -;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; [vinicius] Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; ;; 1998-03-06 ;; Skip invisible text. @@ -1403,7 +1404,7 @@ Please send all bug fixes and enhancements to ;; prologue code suggestion, for odd/even printing suggestion and for ;; `ps-prologue-file' enhancement. ;; -;; Thanks to Ken'ichi Handa <handa@m17n.org> for multi-byte buffer handling. +;; Thanks to Ken'ichi Handa <handa@gnu.org> for multi-byte buffer handling. ;; ;; Thanks to Matthew O Persico <Matthew.Persico@lazard.com> for line number on ;; empty columns. @@ -1463,16 +1464,7 @@ Please send all bug fixes and enhancements to (require 'lpr) - -(if (featurep 'xemacs) - (or (featurep 'lisp-float-type) - (error "`ps-print' requires floating point support")) - (unless (and (boundp 'emacs-major-version) - (>= emacs-major-version 23)) - (error "`ps-print' only supports Emacs 23 and higher"))) - - -;; Load XEmacs/Emacs definitions +;; Load Emacs definitions (require 'ps-def) ;; autoloads for secondary file @@ -1773,7 +1765,7 @@ See `ps-lpr-command'." (defcustom ps-print-region-function (if (memq system-type '(ms-dos windows-nt)) - #'w32-direct-ps-print-region-function + 'w32-direct-ps-print-region-function #'call-process-region) "Specify a function to print the region on a PostScript printer. See definition of `call-process-region' for calling conventions. The fourth @@ -2950,13 +2942,8 @@ Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)." ;;; Colors ;; Printing color requires x-color-values. -;; XEmacs change: Need autoload for the "Options->Printing->Color Printing" -;; widget to work. ;;;###autoload -(defcustom ps-print-color-p - (or (fboundp 'x-color-values) ; Emacs - (fboundp 'color-instance-rgb-components)) - ; XEmacs +(defcustom ps-print-color-p (fboundp 'x-color-values) "Specify how buffer's text color is printed. Valid values are: @@ -3380,13 +3367,7 @@ It's like the very first character of buffer (or region) is ^L (\\014)." :version "20" :group 'ps-print-headers) -(defcustom ps-postscript-code-directory - (cond ((fboundp 'locate-data-directory) ; XEmacs - (locate-data-directory "ps-print")) - ((boundp 'data-directory) ; XEmacs and Emacs. - data-directory) - (t ; don't know what to do - (error "`ps-postscript-code-directory' isn't set properly"))) +(defcustom ps-postscript-code-directory data-directory "Directory where it's located the PostScript prologue file used by ps-print. By default, this directory is the same as in the variable `data-directory'." :type 'directory @@ -3631,8 +3612,7 @@ The table depends on the current ps-print setup." (mapconcat #'ps-print-quote (list - (concat "\n;;; (" (if (featurep 'xemacs) "XEmacs" "Emacs") - ") ps-print version " ps-print-version "\n") + (concat "\n;;; (Emacs) ps-print version " ps-print-version "\n") ";; internal vars" (ps-comment-string "emacs-version " emacs-version) (ps-comment-string "lpr-windows-system" lpr-windows-system) @@ -4140,48 +4120,6 @@ If EXTENSION is any other symbol, it is ignored." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Adapted from font-lock: (obsolete stuff) -;; 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 (symbol-value 'font-lock-face-attributes))) - (while face-attributes - (let* ((face-attribute - (car (prog1 face-attributes - (setq face-attributes (cdr 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 '(:weight bold) face-spec))) - (when italic-p - (setq face-spec (append '(:slant italic) 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 @@ -4654,7 +4592,9 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th (defsubst ps-output-string-prim (string) (insert "(") ;insert start-string delimiter (save-excursion ;insert string - (insert (string-as-unibyte string))) + (insert (if (multibyte-string-p string) + (encode-coding-string string 'utf-8) + string))) ;; Find and quote special characters as necessary for PS ;; This skips everything except control chars, non-ASCII chars, (, ) and \. (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp))) @@ -5812,9 +5752,9 @@ XSTART YSTART are the relative position for the first page in a sheet.") ps-footer-font-size-internal (ps-get-font-size 'ps-footer-font-size) ps-control-or-escape-regexp (cond ((eq ps-print-control-characters '8-bit) - (string-as-unibyte "[\000-\037\177-\377]")) + "[\000-\037\177-\377]") ((eq ps-print-control-characters 'control-8-bit) - (string-as-unibyte "[\000-\037\177-\237]")) + "[\000-\037\177-\237]") ((eq ps-print-control-characters 'control) "[\000-\037\177]") (t "[\t\n\f]")) @@ -5869,6 +5809,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") ;; They may be overridden by ps-mule-begin-job. ps-basic-plot-string-function 'ps-basic-plot-string ps-encode-header-string-function nil) + (cl-assert (not (multibyte-string-p ps-control-or-escape-regexp))) ;; initialize page dimensions (ps-get-page-dimensions) ;; final check @@ -6341,7 +6282,7 @@ If FACE is not a valid face name, use default face." (ps-font-number 'ps-font-for-text (or (aref ps-font-type (logand effect 3)) face)) - fg-color bg-color (lsh effect -2))))) + fg-color bg-color (ash effect -2))))) (goto-char to)) @@ -6350,10 +6291,6 @@ If FACE is not a valid face name, use default face." (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 (mapc 'ps-map-face (face-list)) |