;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
;; Keywords: wp, print, PostScript
-;; Time-stamp: <2001/04/07 13:41:03 Vinicius>
-;; Version: 6.5.1
+;; Time-stamp: <2001/05/30 17:44:36 vinicius>
+;; Version: 6.5.2
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
-(defconst ps-print-version "6.5.1"
- "ps-print.el, v 6.5.1 <2001/04/07 vinicius>
+(defconst ps-print-version "6.5.2"
+ "ps-print.el, v 6.5.2 <2001/05/30 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
(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)
(if (fboundp 'find-composition)
:group 'ps-print-headers)
(defcustom ps-header-frame-alist
- '((fore-color . 0)
+ '((fore-color . 0.0)
(back-color . 0.9)
(border-width . 0.4)
- (border-color . 0)
- (shadow-color . 0))
+ (border-color . 0.0)
+ (shadow-color . 0.0))
"*Specify header frame properties alist.
Valid frame properties are:
(const :format "" fore-color)
(choice :menu-tag "Foreground Color"
:tag "Foreground Color"
- (number :tag "Gray Scale" :value 0)
+ (number :tag "Gray Scale" :value 0.0)
(string :tag "Color Name" :value "black")
- (list :tag "RGB Color" :value (0 0 0)
+ (list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))
(const :format "" border-color)
(choice :menu-tag "Border Color"
:tag "Border Color"
- (number :tag "Gray Scale" :value 0)
+ (number :tag "Gray Scale" :value 0.0)
(string :tag "Color Name" :value "black")
- (list :tag "RGB Color" :value (0 0 0)
+ (list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))
(const :format "" shadow-color)
(choice :menu-tag "Shadow Color"
:tag "Shadow Color"
- (number :tag "Gray Scale" :value 0)
+ (number :tag "Gray Scale" :value 0.0)
(string :tag "Color Name" :value "black")
- (list :tag "RGB Color" :value (0 0 0)
+ (list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))))
:group 'ps-print-headers)
(defcustom ps-footer-frame-alist
- '((fore-color . 0)
+ '((fore-color . 0.0)
(back-color . 0.9)
(border-width . 0.4)
- (border-color . 0)
- (shadow-color . 0))
+ (border-color . 0.0)
+ (shadow-color . 0.0))
"*Specify footer frame properties alist.
Don't change this alist directly, instead use customization, or `ps-value',
(const :format "" fore-color)
(choice :menu-tag "Foreground Color"
:tag "Foreground Color"
- (number :tag "Gray Scale" :value 0)
+ (number :tag "Gray Scale" :value 0.0)
(string :tag "Color Name" :value "black")
- (list :tag "RGB Color" :value (0 0 0)
+ (list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))
(const :format "" border-color)
(choice :menu-tag "Border Color"
:tag "Border Color"
- (number :tag "Gray Scale" :value 0)
+ (number :tag "Gray Scale" :value 0.0)
(string :tag "Color Name" :value "black")
- (list :tag "RGB Color" :value (0 0 0)
+ (list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))
(const :format "" shadow-color)
(choice :menu-tag "Shadow Color"
:tag "Shadow Color"
- (number :tag "Gray Scale" :value 0)
+ (number :tag "Gray Scale" :value 0.0)
(string :tag "Color Name" :value "black")
- (list :tag "RGB Color" :value (0 0 0)
+ (list :tag "RGB Color" :value (0.0 0.0 0.0)
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))))
(interactive (list (count-lines (mark) (point))))
(ps-nb-pages nb-lines))
+(defvar ps-prefix-quote nil
+ "Used for `ps-print-quote' (which see).")
+
;;;###autoload
(defun ps-setup ()
"Return the current PostScript-generation setup."
- (let (prefix)
+ (let (ps-prefix-quote)
(mapconcat
- #'(lambda (elt)
- (cond
- ((null elt) "")
- ((stringp elt) elt)
- (t
- (let* ((col (car elt))
- (sym (cdr elt))
- (key (symbol-name sym))
- (len (length key))
- (val (symbol-value sym)))
- (concat (if prefix
- prefix
- (setq prefix " ")
- "(setq ")
- key
- (if (> col len)
- (make-string (- col len) ?\ )
- " ")
- (cond ((null val) "nil")
- ((eq val t) "t")
- ((or (symbolp val) (listp val)) (format "'%S" val))
- (t (format "%S" val))))))
- ))
+ #'ps-print-quote
(list
(concat "\n;;; ps-print version " ps-print-version "\n")
'(25 . ps-print-color-p)
'(20 . ps-bold-faces)
'(20 . ps-italic-faces)
'(20 . ps-underlined-faces)
- ")\n
+ " )\n
;; The following customized variables have long lists and are seldom modified:
;; ps-page-dimensions-database
;; ps-font-info-database
;; Utility functions and variables:
+(defun ps-print-quote (elt)
+ "Quote ELT for printing (used for showing settings).
+
+If ELT is nil, return an empty string.
+If ELT is string, return it.
+Otherwise, ELT should be a cons (LEN . SYM) where SYM is a variable symbol and
+LEN is the field length where SYM name will be inserted. The variable
+`ps-prefix-quote' is used to form the string, if `ps-prefix-quote' is nil, it's
+used \"(setq \" as prefix; otherwise, it's used \" \". So, the string
+generated is:
+
+ * If `ps-prefix-quote' is nil:
+ \"(setq SYM-NAME SYM-VALUE\"
+ |<------->|
+ LEN
+
+ * If `ps-prefix-quote' is non-nil:
+ \" SYM-NAME SYM-VALUE\"
+ |<------->|
+ LEN
+
+If `ps-prefix-quote' is nil, it's set to t after generating string."
+ (cond
+ ((null elt) "")
+ ((stringp elt) elt)
+ (t
+ (let* ((col (car elt))
+ (sym (cdr elt))
+ (key (symbol-name sym))
+ (len (length key))
+ (val (symbol-value sym)))
+ (concat (if ps-prefix-quote
+ " "
+ (setq ps-prefix-quote t)
+ "(setq ")
+ key
+ (if (> col len)
+ (make-string (- col len) ?\ )
+ " ")
+ (cond ((null val) "nil")
+ ((eq val t) "t")
+ ((or (symbolp val) (listp val)) (format "'%S" val))
+ (t (format "%S" val))))))
+ ))
+
+
(defun ps-value (alist-sym key)
"Return value from association list ALIST-SYM which car is `eq' to KEY."
(cdr (assq key (symbol-value alist-sym))))
(defun ps-output-frame-properties (name alist)
(ps-output "/" name " ["
- (ps-format-color (cdr (assq 'fore-color alist)) 0)
+ (ps-format-color (cdr (assq 'fore-color alist)) 0.0)
(ps-format-color (cdr (assq 'back-color alist)) 0.9)
(ps-float-format (or (cdr (assq 'border-width alist)) 0.4))
- (ps-format-color (cdr (assq 'border-color alist)) 0)
- (ps-format-color (cdr (assq 'shadow-color alist)) 0)
+ (ps-format-color (cdr (assq 'border-color alist)) 0.0)
+ (ps-format-color (cdr (assq 'shadow-color alist)) 0.0)
"]def\n"))
(defun ps-float-format (value &optional default)
(let ((literal (or value default)))
- (if literal
- (format (if (numberp literal)
- ps-float-format
- "%s ")
- literal)
- " ")))
+ (cond ((null literal)
+ " ")
+ ((numberp literal)
+ (format ps-float-format (* literal 1.0))) ; force float number
+ (t
+ (format "%s " literal))
+ )))
(defun ps-background-text ()
(if (and the-color (listp the-color))
(concat "["
(format ps-color-format
- (nth 0 the-color)
- (nth 1 the-color)
- (nth 2 the-color))
+ (* (nth 0 the-color) 1.0) ; force float number
+ (* (nth 1 the-color) 1.0) ; force float number
+ (* (nth 2 the-color) 1.0)) ; force float number
"] ")
(ps-float-format (if (numberp the-color) the-color default)))))
(cons to (* todo char-width))
(cons (+ from avail) ps-width-remaining))))
+(defun ps-basic-plot-str (from to string)
+ (let* ((wrappoint (ps-find-wrappoint from to
+ (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))
+
(defun ps-basic-plot-string (from to &optional bg-color)
(let* ((wrappoint (ps-find-wrappoint from to
(ps-avg-char-width 'ps-font-for-text)))
" FG\n"))
+(defsubst ps-plot-string (string)
+ (ps-plot 'ps-basic-plot-str 0 (length string) string))
+
+
(defvar ps-current-effect 0)
(defun ps-plot-region (from to font &optional fg-color bg-color effects)
- (if (not (equal font ps-current-font))
+ (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.
- (if (not (equal fg-color ps-current-color))
- (ps-set-color fg-color))
+ (let ((fg (or fg-color ps-default-foreground)))
+ (or (equal fg ps-current-color)
+ (ps-set-color fg)))
- (if (not (equal bg-color ps-current-bg))
+ (or (equal bg-color ps-current-bg)
(ps-set-bg bg-color))
;; Specify effects (underline, overline, box, etc)
(let ((property-change from)
(overlay-change from)
(save-buffer-invisibility-spec buffer-invisibility-spec)
- (buffer-invisibility-spec nil))
+ (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.
; unless previous search succeeded.
(setq overlay-change (min (ps-e-next-overlay-change from)
to)))
- (setq position (min property-change overlay-change))
+ (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
(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)))
+ (overlay-invisible
+ (ps-e-overlay-get overlay 'invisible))
+ (overlay-priority
+ (or (ps-e-overlay-get overlay 'priority) 0)))
(and (> overlay-priority face-priority)
- (setq 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))
- face-priority overlay-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))))
HCoop / bpt / emacs.git / blobdiff