X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/fd8091590517160c946c178aa15d493446781abe..cc39a9dba6e3633e67501eaf0361fb2f040cb064:/lisp/ps-print.el diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 89bcb6e0af..b51eb94469 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -1,8 +1,6 @@ ;;; ps-print.el --- print text from the buffer as PostScript -;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 -;; Free Software Foundation, Inc. +;; Copyright (C) 1993-2011 Free Software Foundation, Inc. ;; Author: Jim Thompson (was ) ;; Jacques Duthen (was ) @@ -11,11 +9,11 @@ ;; Maintainer: Kenichi Handa (multi-byte characters) ;; Vinicius Jose Latorre ;; Keywords: wp, print, PostScript -;; Version: 7.3.4 +;; Version: 7.3.5 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre -(defconst ps-print-version "7.3.4" - "ps-print.el, v 7.3.4 <2009/01/24 vinicius> +(defconst ps-print-version "7.3.5" + "ps-print.el, v 7.3.5 <2009/12/23 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 @@ -1366,6 +1364,9 @@ Please send all bug fixes and enhancements to ;; Acknowledgments ;; --------------- ;; +;; Thanks to Eduard Wiebe for fixing face +;; background/foreground extraction. +;; ;; Thanks to Friedrich Delgado Friedrichs for new label ;; printer page sizes. ;; @@ -1463,25 +1464,22 @@ Please send all bug fixes and enhancements to (require 'lpr) -(or (featurep 'lisp-float-type) - (error "`ps-print' requires floating point support")) - - (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"))) (defconst ps-windows-system - (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) + (memq system-type '(ms-dos windows-nt))) (defconst ps-lp-system (memq system-type '(usg-unix-v hpux irix))) ;; Load XEmacs/Emacs definitions -(eval-and-compile (require 'ps-def)) +(require 'ps-def) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1491,10 +1489,10 @@ Please send all bug fixes and enhancements to ;;; Interface to the command system (defgroup postscript nil - "PostScript Group." + "Support for printing and PostScript." :tag "PostScript" :version "20" - :group 'emacs) + :group 'external) (defgroup ps-print nil "PostScript generator for Emacs." @@ -1829,6 +1827,7 @@ If it's nil, automatic feeding takes place." ;;;###autoload (defcustom ps-page-dimensions-database + (purecopy (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") (list 'letter (* 72 8.5) (* 72 11.0) "Letter") @@ -1865,7 +1864,7 @@ If it's nil, automatic feeding takes place." '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150") '(vhsface 205.0 127.0 "VHSFace") '(vhsspine 400.0 50.0 "VHSSpine") - '(zipdisk 156.0 136.0 "ZipDisk")) + '(zipdisk 156.0 136.0 "ZipDisk"))) "List associating a symbolic paper type to its width, height and doc media. See `ps-paper-type'." :type '(repeat (list :tag "Paper Type" @@ -4327,14 +4326,17 @@ Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head" (ps-header-font-size-internal (or ps-header-font-size-internal (ps-get-font-size 'ps-header-font-size))) + (ps-footer-font-size-internal + (or ps-footer-font-size-internal + (ps-get-font-size 'ps-footer-font-size))) (ps-header-title-font-size-internal (or ps-header-title-font-size-internal (ps-get-font-size 'ps-header-title-font-size))) (buf (get-buffer-create "*Line-lengths*")) (ifs ps-font-size-internal) ; initial font size - (icw (ps-avg-char-width 'ps-font-for-text)) ; initial character width (print-width (progn (ps-get-page-dimensions) ps-print-width)) + (icw (ps-avg-char-width 'ps-font-for-text)) ; initial character width (ps-setup (ps-setup)) ; setup for the current buffer (fs-min 5) ; minimum font size cw-min ; minimum character width @@ -4374,6 +4376,9 @@ and on the current ps-print setup." (ps-header-font-size-internal (or ps-header-font-size-internal (ps-get-font-size 'ps-header-font-size))) + (ps-footer-font-size-internal + (or ps-footer-font-size-internal + (ps-get-font-size 'ps-footer-font-size))) (ps-header-title-font-size-internal (or ps-header-title-font-size-internal (ps-get-font-size 'ps-header-title-font-size))) @@ -4383,9 +4388,9 @@ and on the current ps-print setup." (buf (get-buffer-create "*Nb-Pages*")) (ils ps-line-spacing-internal) ; initial line spacing (ifs ps-font-size-internal) ; initial font size - (ilh (ps-line-height 'ps-font-for-text)) ; initial line height (page-height (progn (ps-get-page-dimensions) ps-print-height)) + (ilh (ps-line-height 'ps-font-for-text)) ; initial line height (ps-setup (ps-setup)) ; setup for the current buffer (fs-min 4) ; minimum font size lh-min ; minimum line height @@ -4730,8 +4735,7 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th (ps-output 'prologue (if (stringp args) (list args) args))) (defun ps-flush-output () - (save-excursion - (set-buffer ps-spool-buffer) + (with-current-buffer ps-spool-buffer (goto-char (point-max)) (while ps-output-head (let ((it (car ps-output-head))) @@ -4752,8 +4756,7 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th (defun ps-insert-file (fname) (ps-flush-output) - (save-excursion - (set-buffer ps-spool-buffer) + (with-current-buffer ps-spool-buffer (goto-char (point-max)) (insert-file-contents fname))) @@ -4836,8 +4839,7 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th (defun ps-get-boundingbox () - (save-excursion - (set-buffer ps-spool-buffer) + (with-current-buffer ps-spool-buffer (save-excursion (if (re-search-forward ps-boundingbox-re nil t) (vector (string-to-number ; lower x @@ -4905,8 +4907,7 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th ;; coordinate adjustment to center image ;; around x and y position (let ((box (ps-get-boundingbox))) - (save-excursion - (set-buffer ps-spool-buffer) + (with-current-buffer ps-spool-buffer (save-excursion (if (re-search-backward "^--back--" nil t) (replace-match @@ -5791,8 +5792,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") ps-line-number-step ps-zebra-stripe-height)))) ;; spooling buffer - (save-excursion - (set-buffer ps-spool-buffer) + (with-current-buffer ps-spool-buffer (goto-char (point-max)) (and (re-search-backward "^%%Trailer$" nil t) (delete-region (match-beginning 0) (point-max)))) @@ -5878,7 +5878,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") (ps-get-page-dimensions) ;; final check (unless (listp ps-lpr-switches) - (error "`ps-lpr-switches' value should be a list.")) + (error "`ps-lpr-switches' value should be a list")) (and ps-color-p (equal ps-default-background ps-default-foreground) (error @@ -6250,6 +6250,7 @@ If FACE is not in `ps-print-face-extension-alist' or in return the attribute vector. If FACE is not a valid face name, use default face." + (and (stringp face) (facep face) (setq face (intern face))) (cond (ps-black-white-faces-alist (or (and (symbolp face) @@ -6407,17 +6408,15 @@ If FACE is not a valid face name, use default face." (ps-face-background-name face)))) -;; to avoid compilation gripes -(defalias 'ps-jitify 'jit-lock-fontify-now) -(defalias 'ps-lazify 'lazy-lock-fontify-region) - +(declare-function jit-lock-fontify-now "jit-lock" (&optional start end)) +(declare-function lazy-lock-fontify-region "lazy-lock" (beg end)) ;; to avoid compilation gripes (defun ps-print-ensure-fontified (start end) (cond ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode)) - (ps-jitify start end)) + (jit-lock-fontify-now start end)) ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode)) - (ps-lazify start end)))) + (lazy-lock-fontify-region start end)))) (defun ps-generate-postscript-with-faces (from to) @@ -6571,8 +6570,7 @@ If FACE is not a valid face name, use default face." (and ps-razzle-dazzle (message "Wrote %s" filename))) ;; Else, spool to the printer (and ps-razzle-dazzle (message "Printing...")) - (save-excursion - (set-buffer ps-spool-buffer) + (with-current-buffer ps-spool-buffer (let* ((coding-system-for-write 'raw-text-unix) (ps-printer-name (or ps-printer-name (and (boundp 'printer-name) @@ -6647,7 +6645,8 @@ If FACE is not a valid face name, use default face." (error "Unprinted PostScript")))) (cond ((fboundp 'add-hook) - (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check)) + (unless noninteractive + (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check))) (kill-emacs-hook (message "Won't override existing `kill-emacs-hook'")) (t @@ -6659,7 +6658,7 @@ If FACE is not a valid face name, use default face." ;; But autoload them here to make the separation invisible. ;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize -;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "1d4fa71bb8102914d3c5f0bf853a08e3") +;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "14536f28e0dcaa956901bb59ad86a875") ;;; Generated autoloads from ps-mule.el (defvar ps-multibyte-buffer nil "\ @@ -6729,5 +6728,4 @@ Finish printing job for multi-byte chars. (provide 'ps-print) -;; arch-tag: fb06a585-1112-4206-885d-a57d95d50579 ;;; ps-print.el ends here