;;; ps-print.el --- print text from the buffer as PostScript
;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
-;; 2003, 2004 Free Software Foundation, Inc.
+;; 2003, 2004, 2005 Free Software Foundation, Inc.
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Jacques Duthen (was <duthen@cegelec-red.fr>)
;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Keywords: wp, print, PostScript
-;; Time-stamp: <2004/07/21 23:12:05 vinicius>
-;; Version: 6.6.5
+;; Time-stamp: <2005/06/27 00:57:22 vinicius>
+;; Version: 6.6.7
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
-(defconst ps-print-version "6.6.5"
- "ps-print.el, v 6.6.5 <2004/07/21 vinicius>
+(defconst ps-print-version "6.6.7"
+ "ps-print.el, v 6.6.7 <2005/06/27 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
;; You should have received a copy of the GNU General Public License along with
;; GNU Emacs; see the file COPYING. If not, write to the Free Software
-;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
;;; Commentary:
;; (my-mixed-family
;; (fonts (normal . "Courier-Bold")
;; (bold . "Helvetica")
-;; (italic . "Zapf-Chancery-MediumItalic")
+;; (italic . "ZapfChancery-MediumItalic")
;; (bold-italic . "NewCenturySchlbk-BoldItalic")
;; (w3-table-hack-x-face . "LineDrawNormal"))
;; (size . 10.0)
;; (fonts (w3-table-hack-x-face . "LineDrawNormal")
;; (bold . "Helvetica")
;; (bold-italic . "NewCenturySchlbk-BoldItalic")
-;; (italic . "Zapf-Chancery-MediumItalic")
+;; (italic . "ZapfChancery-MediumItalic")
;; (normal . "Courier-Bold"))
;; (avg-char-width . 6.0)
;; (space-width . 6.0)
(defvar mark-active nil)
(defun ps-mark-active-p ()
mark-active)
- (defalias 'ps-face-foreground-name 'face-foreground)
- (defalias 'ps-face-background-name 'face-background)
- ))
+ (defun ps-face-foreground-name (face)
+ (face-foreground face nil t))
+ (defun ps-face-background-name (face)
+ (face-background face nil t))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Interface to the command system
(defgroup postscript nil
- "PostScript Group"
+ "PostScript Group."
:tag "PostScript"
:version "20"
:group 'emacs)
(defgroup ps-print nil
- "PostScript generator for Emacs"
+ "PostScript generator for Emacs."
:link '(emacs-library-link :tag "Source Lisp File" "ps-print.el")
:prefix "ps-"
:version "20"
:group 'postscript)
(defgroup ps-print-horizontal nil
- "Horizontal page layout"
+ "Horizontal page layout."
:prefix "ps-"
:tag "Horizontal"
:version "20"
:group 'ps-print)
(defgroup ps-print-vertical nil
- "Vertical page layout"
+ "Vertical page layout."
:prefix "ps-"
:tag "Vertical"
:version "20"
:group 'ps-print)
(defgroup ps-print-headers nil
- "Headers & footers layout"
+ "Headers & footers layout."
:prefix "ps-"
:tag "Header & Footer"
:version "20"
:group 'ps-print)
(defgroup ps-print-font nil
- "Fonts customization"
+ "Fonts customization."
:prefix "ps-"
:tag "Font"
:version "20"
:group 'ps-print)
(defgroup ps-print-color nil
- "Color customization"
+ "Color customization."
:prefix "ps-"
:tag "Color"
:version "20"
:group 'ps-print)
(defgroup ps-print-face nil
- "Faces customization"
+ "Faces customization."
:prefix "ps-"
:tag "PS Faces"
:version "20"
:group 'faces)
(defgroup ps-print-n-up nil
- "N-up customization"
+ "N-up customization."
:prefix "ps-"
:tag "N-Up"
:version "20"
:group 'ps-print)
(defgroup ps-print-zebra nil
- "Zebra customization"
+ "Zebra customization."
:prefix "ps-"
:tag "Zebra"
:version "20"
:group 'ps-print)
(defgroup ps-print-background nil
- "Background customization"
+ "Background customization."
:prefix "ps-"
:tag "Background"
:version "20"
:group 'ps-print)
(defgroup ps-print-printer '((lpr custom-group))
- "Printer customization"
+ "Printer customization."
:prefix "ps-"
:tag "Printer"
:version "20"
:group 'ps-print)
(defgroup ps-print-page nil
- "Page customization"
+ "Page customization."
:prefix "ps-"
:tag "Page"
:version "20"
:group 'ps-print)
(defgroup ps-print-miscellany nil
- "Miscellany customization"
+ "Miscellany customization."
:prefix "ps-"
:tag "Miscellany"
:version "20"
(line-height . 9.63)
(space-width . 2.78)
(avg-char-width . 2.78))
+ (ZapfChancery-MediumItalic
+ (fonts (normal . "ZapfChancery-MediumItalic"))
+ (size . 10.0)
+ (line-height . 11.45)
+ (space-width . 2.2)
+ (avg-char-width . 4.10811))
+ ;; We keep this wrong entry name (but with correct font name) for
+ ;; backward compatibility.
(Zapf-Chancery-MediumItalic
- (fonts (normal . "Zapf-Chancery-MediumItalic"))
+ (fonts (normal . "ZapfChancery-MediumItalic"))
(size . 10.0)
(line-height . 11.45)
(space-width . 2.2)
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 wich contains the color name. For example:
+ 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
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 wich contains the color name. For example:
+ 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
"(setq ")
key
(if (> col len)
- (make-string (- col len) ?\ )
+ (make-string (- col len) ?\s)
" ")
(ps-value-string val))))
(t "")
((stringp (car content))
(car content))
;; function symbol
- ((and (symbolp (car content)) (fboundp (car content)))
+ ((functionp (car content))
(concat "(" (funcall (car content)) ")"))
;; variable symbol
((and (symbolp (car content)) (boundp (car content)))
(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)))
- (mapconcat 'identity
- (append ps-lh-cache ps-rh-cache ps-lf-cache ps-rf-cache)
- ""))
+ (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.
;; Functions are called -- they should return strings; they will be inserted
;; as strings and the PS string delimiters added.
- ((and (symbolp content) (fboundp content))
+ ((functionp content)
(ps-output-string (ps-mule-encode-header-string (funcall content)
fonttag)))
(ps-begin-page))
+(defun ps-end-sheet ()
+ (and ps-print-page-p (> ps-page-sheet 0)
+ (ps-output "EndSheet\n")))
+
+
(defun ps-header-sheet ()
;; Print only when a new sheet begins.
- (and ps-print-page-p (> ps-page-sheet 0)
- (ps-output "EndSheet\n"))
+ (ps-end-sheet)
(setq ps-page-sheet (1+ ps-page-sheet))
(when (ps-print-sheet-p)
(setq ps-page-order (1+ ps-page-order))
(defvar ps-current-effect 0)
+(defvar ps-print-translation-table
+ (let ((tbl (make-char-table 'translation-table nil)))
+ (if (and (boundp 'ucs-mule-8859-to-mule-unicode)
+ (char-table-p ucs-mule-8859-to-mule-unicode))
+ (map-char-table
+ #'(lambda (k v)
+ (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v))
+ (aset tbl k v)))
+ ucs-mule-8859-to-mule-unicode))
+ tbl)
+ "Translation table for PostScript printing.
+The default value is a table that translates non-Latin-1 Latin characters
+to the equivalent Latin-1 characters.")
(defun ps-plot-region (from to font &optional fg-color bg-color effects)
(or (equal font ps-current-font)
(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) (eq (charset-after) charset))
+ (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
(defun ps-end-job (needs-begin-file)
- (let ((previous-print ps-print-page-p)
- (ps-print-page-p t))
+ (let ((ps-print-page-p t))
(ps-flush-output)
(save-excursion
(let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing))
(number-to-string ps-lines-printed) " BeginPage\n")
(ps-end-page)))
;; Set end of PostScript file
- (and previous-print
- (ps-output "EndSheet\n"))
+ (ps-end-sheet)
(ps-output "\n%%Trailer\n%%Pages: "
(number-to-string
(if (and needs-begin-file