Mercurial > emacs

changeset 21954:73f9f4219198

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Some doc fixes, eliminate (require cl). (ps-print-version): New version number (3.06.1) and doc fix. (ps-print-control-characters, ps-extend-face): Doc fix. (ps-font-lock-face-attributes): Eliminate `pop'. (ps-font): Eliminate `loop' and `return'. (ps-fonts): Eliminate `loop'. (ps-font-number): Replace `position' by `ps-position'. (ps-select-font): Eliminate `flet'. (ps-lookup, ps-size-scale): New macros. (ps-output-string-prim): Handle multibyte characters. (ps-position): New function. (ps-begin-file): Eliminate `loop'. (ps-header-page): Eliminate `incf'.
author Richard M. Stallman <rms@gnu.org>
date Wed, 06 May 1998 04:06:30 +0000
parents 6655c426d447
children c4de7c7bc14a
files lisp/ps-print.el
diffstat 1 files changed, 94 insertions(+), 48 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ps-print.el	Tue May 05 21:47:53 1998 +0000
+++ b/lisp/ps-print.el	Wed May 06 04:06:30 1998 +0000
@@ -7,11 +7,11 @@
 ;; Author:     Vinicius Jose Latorre <vinicius@cpqd.com.br>
 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
 ;; Keywords:   print, PostScript
-;; Time-stamp: <98/03/06 11:14:08 vinicius>
-;; Version:    3.06
-
-(defconst ps-print-version "3.06"
-  "ps-print.el, v 3.06 <98/03/06 vinicius>
+;; Time-stamp: <98/05/05  12:36:30 vinicius>
+;; Version:    3.06.1
+
+(defconst ps-print-version "3.06.1"
+  "ps-print.el, v 3.06.1 <98/05/05 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,
@@ -371,17 +371,26 @@
 ;;
 ;; 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".
+;; sending, for example, a ^D (\004) 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).
+;;  '8-bit          This is the value to use when you want an ascii encoding of
+;;                  any control or non-ascii character. Control characters are
+;;                  encoded as "^D", and non-ascii characters have an
+;;                  octal encoding.
+;;
+;;  'control-8-bit  This is the value to use when you want an ascii encoding of
+;;                  any control character, whether it is 7 or 8-bit.
+;;                  European 8-bits accented characters are printed according
+;;                  the current font.
+;;
+;;  'control        Only ascii control characters have an ascii encoding.
+;;                  European 8-bits accented characters are printed according
+;;                  the current font.
+;;
+;;  nil             No ascii encoding. Any character is printed according the
+;;                  current font.
 ;;
 ;; Any other value is treated as nil.
 ;;
@@ -811,15 +820,22 @@
 ;; Acknowledgements
 ;; ----------------
 ;;
+;; Thanks to Roland Ducournau <ducour@lirmm.fr> for
+;; `ps-print-control-characters' variable documentation.
+;;
 ;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
 ;; database font management.
 ;;
 ;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one
-;; header per page over the columns.
+;; header per page over the columns and correct line numbers when printing a
+;; region.
 ;;
 ;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
 ;; print time of `ps-lpr-switches'.
 ;;
+;; Thanks to Kevin Rodgers <kevinr@ihs.com> for handling control characters
+;; (his code was severely modified, but the main idea was kept).
+;;
 ;; Thanks to some suggestions on:
 ;;  * Face color map: Marco Melgazzi <marco@techie.com>
 ;;  * XEmacs compatibility: William J. Henney <will@astrosmo.unam.mx>
@@ -856,9 +872,6 @@
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl))
-
 (unless (featurep 'lisp-float-type)
   (error "`ps-print' requires floating point support"))
 
@@ -981,14 +994,28 @@
 
 (defcustom ps-print-control-characters 'control-8-bit
   "*Specifies the printable form for control and 8-bit characters.
+That is, instead of sending, for example, a ^D (\004) to printer,
+it is sent the string \"^D\".
+
 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).
+
+  '8-bit          This is the value to use when you want an ascii encoding of
+                  any control or non-ascii character. Control characters are
+                  encoded as \"^D\", and non-ascii characters have an
+                  octal encoding.
+
+  'control-8-bit  This is the value to use when you want an ascii encoding of
+                  any control character, whether it is 7 or 8-bit.
+                  European 8-bits accented characters are printed according
+                  the current font.
+
+  'control        Only ascii control characters have an ascii encoding.
+                  European 8-bits accented characters are printed according
+                  the current font.
+
+  nil             No ascii encoding. Any character is printed according the
+                  current font.
+
 Any other value is treated as nil."
   :type '(choice (const 8-bit) (const control-8-bit)
 		 (const control) (const nil))
@@ -2488,7 +2515,7 @@
 (defun ps-extend-face (face-extension &optional merge-p)
   "Extend face in `ps-print-face-extension-alist'.
 
-If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
+If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
 with face extensions in `ps-print-face-extension-alist'; otherwise, overrides.
 
 The elements of FACE-EXTENSION list have the form:
@@ -2554,7 +2581,9 @@
        (boundp 'font-lock-face-attributes)
        (let ((face-attributes font-lock-face-attributes))
 	 (while face-attributes
-	   (let* ((face-attribute (pop 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.
@@ -2645,15 +2674,15 @@
   "Font family name for text of `font-type', when generating PostScript."
   (let* ((font-list (ps-font-list font-sym))
 	 (normal-font (cdr (assq 'normal font-list))))
-    (loop for font in font-list do
-	  (when (eq font-type (car font))
-	    (return (or (cdr font) normal-font))))))
+    (while (and font-list (not (eq font-type (car (car font-list)))))
+      (setq font-list (cdr font-list)))
+    (or (cdr (car font-list)) normal-font)))
 
 (defun ps-fonts (font-sym)
-  (loop for font in (ps-font-list font-sym) collect (cdr font)))
+  (mapcar 'cdr (ps-font-list font-sym)))
 
 (defun ps-font-number (font-sym font-type)
-  (or (position font-type (ps-font-list font-sym) :key 'car)
+  (or (ps-position font-type (ps-font-list font-sym))
       0))
 
 (defsubst ps-line-height (font-sym)
@@ -2767,21 +2796,23 @@
     (insert "\n")
     (display-buffer buf 'not-this-window)))
 
+;; macros used in `ps-select-font'
+(defmacro ps-lookup (key) `(cdr (assq ,key font-entry)))
+(defmacro ps-size-scale (key) `(/ (* (ps-lookup ,key) font-size) size))
+
 (defun ps-select-font (font-family sym font-size title-font-size)
   (let ((font-entry (cdr (assq font-family ps-font-info-database))))
     (or font-entry
 	(error "Don't have data to scale font %s. Known fonts families are %s"
 	       font-family
 	       (mapcar 'car ps-font-info-database)))
-    (flet ((lookup (key) (cdr (assq key font-entry))))
-      (let ((size (lookup 'size)))
-	(put sym 'fonts (lookup 'fonts))
-	(flet ((size-scale (key) (/ (* (lookup key) font-size) size)))
-	  (put sym 'space-width (size-scale 'space-width))
-	  (put sym 'avg-char-width (size-scale 'avg-char-width))
-	  (put sym 'line-height (size-scale 'line-height))
-	  (put sym 'title-line-height
-	       (/ (* (lookup 'line-height) title-font-size) size)))))))
+    (let ((size (ps-lookup 'size)))
+      (put sym 'fonts (ps-lookup 'fonts))
+      (put sym 'space-width (ps-size-scale 'space-width))
+      (put sym 'avg-char-width (ps-size-scale 'avg-char-width))
+      (put sym 'line-height (ps-size-scale 'line-height))
+      (put sym 'title-line-height
+	   (/ (* (ps-lookup 'line-height) title-font-size) size)))))
 
 (defun ps-get-page-dimensions ()
   (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
@@ -3154,6 +3185,19 @@
       (setq tail (cdr tail)))
     (nreverse new)))
 
+;; Find the first occurrence of ITEM in LIST.
+;; Return the index of the matching item, or nil if not found.
+;; Elements are compared with `eq'.
+(defun ps-position (item list)
+  (let ((tail list) (index 0) found)
+    (while tail
+      (if (setq found (eq (car tail) item))
+	  (setq tail nil)
+	(setq index (1+ index)
+	      tail (cdr tail))))
+    (and found index)))
+
+
 (defun ps-begin-file ()
   (ps-get-page-dimensions)
   (setq ps-showline-count (if ps-printing-region (car ps-printing-region) 1)
@@ -3247,13 +3291,15 @@
   (ps-output ps-print-prologue-2)
 
   ;; Text fonts
-  (loop for font in (ps-font-list 'ps-font-for-text)
-	for i from 0
-	do
-	(ps-output (format "/f%d %s /%s DefFont\n"
-			   i
-			   ps-font-size
-			   (ps-font 'ps-font-for-text (car font)))))
+  (let ((font (ps-font-list 'ps-font-for-text))
+	(i 0))
+    (while font
+      (ps-output (format "/f%d %s /%s DefFont\n"
+			 i
+			 ps-font-size
+			 (ps-font 'ps-font-for-text (car (car font)))))
+      (setq font (cdr font)
+	    i (1+ i))))
 
   (ps-output "\nBeginDoc\n\n"
 	     "%%EndPrologue\n"))
@@ -3307,7 +3353,7 @@
 (defun ps-header-page ()
   (if (prog1
 	  (zerop (mod ps-page-count ps-number-of-columns))
-	(incf ps-page-count))
+	(setq ps-page-count (1+ ps-page-count)))
       ;; Print only when a new real page begins.
       (let ((page-number (ps-page-number)))
 	(ps-output (format "\n%%%%Page: %d %d\n" page-number page-number))