mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-22 10:26:20 +00:00
Code Issues Releases Activity

Split XEmacs/Emacs definitions and sample setup code into separate files

Browse Source
This commit is contained in:
Vinicius Jose Latorre 2007-01-26 02:30:28 +00:00
parent 830f437ef1
commit c97a3f22ed
6 changed files with 779 additions and 584 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
lisp/ChangeLog.unicode
View File

@ -1,3 +1,61 @@
2007-01-25 Vinicius Jose Latorre <viniciusjl@ig.com.br>
* ps-print.el: Split XEmacs/Emacs definitions and sample setup code
into separate files.
(ps-print-version): New Version 7.2.
(ps-postscript-code-directory): Fix XEmacs initialization.
(ps-generate-postscript-with-faces): Call
ps-generate-postscript-with-faces1 (new fun).
(ps-color-format, ps-float-format): Vars moved to ps-def.el.
(ps-xemacs-color-name, ps-mapper, ps-extent-sorter)
(ps-xemacs-face-kind-p, ps-mark-active-p, ps-face-foreground-name)
(ps-face-background-name, ps-frame-parameter, ps-color-device)
(ps-color-values, ps-face-bold-p, ps-face-italic-p): Funs moved to
ps-def.el.
(ps-prsc, ps-c-prsc, ps-s-prsc, ps-rmail-mode-hook)
(ps-rmail-print-message-from-summary, ps-print-message-from-summary)
(ps-article-subject, ps-article-author, ps-gnus-article-prepare-hook)
(ps-vm-mode-hook, ps-gnus-print-article-from-summary)
(ps-vm-print-message-from-summary, ps-gnus-summary-setup, ps-info-file)
(ps-info-node, ps-info-mode-hook, ps-jts-ps-setup, ps-jack-setup): Funs
moved to ps-samp.el.
* ps-bdf.el (installation-directory, coding-system-for-read): Vars
moved to ps-def.el.
* ps-mule.el (leading-code-private-22): Var moved to ps-def.el.
(charset-bytes, charset-dimension, charset-id, charset-width)
(find-charset-region, char-width, chars-in-region, forward-point)
(decompose-composite-char, encode-coding-string, coding-system-p)
(ccl-execute-on-string, define-ccl-program, multibyte-string-p)
(string-make-multibyte, encode-char): Funs moved to ps-def.el.
* ps-def.el: New file. XEmacs/Emacs definitions.
(ps-generate-postscript-with-faces1): New fun.
(ps-color-format, ps-float-format): Vars moved from ps-print.el.
(ps-xemacs-color-name, ps-mapper, ps-extent-sorter)
(ps-xemacs-face-kind-p, ps-mark-active-p, ps-face-foreground-name)
(ps-face-background-name, ps-frame-parameter, ps-color-device)
(ps-color-values, ps-face-bold-p, ps-face-italic-p): Funs moved from
ps-print.el.
(installation-directory, coding-system-for-read): Vars moved from
ps-bdf.el.
(leading-code-private-22): Var moved from ps-mule.el.
(charset-bytes, charset-dimension, charset-id, charset-width)
(find-charset-region, char-width, chars-in-region, forward-point)
(decompose-composite-char, encode-coding-string, coding-system-p)
(ccl-execute-on-string, define-ccl-program, multibyte-string-p)
(string-make-multibyte, encode-char): Funs moved from ps-mule.el.
* ps-samp.el: New file. Sample setup code.
(ps-prsc, ps-c-prsc, ps-s-prsc, ps-rmail-mode-hook)
(ps-rmail-print-message-from-summary, ps-print-message-from-summary)
(ps-article-subject, ps-article-author, ps-gnus-article-prepare-hook)
(ps-vm-mode-hook, ps-gnus-print-article-from-summary)
(ps-vm-print-message-from-summary, ps-gnus-summary-setup, ps-info-file)
(ps-info-node, ps-info-mode-hook, ps-jts-ps-setup, ps-jack-setup): Funs
moved from ps-print.el.
2007-01-21 Vinicius Jose Latorre <viniciusjl@ig.com.br>
* ps-print.el: Handle frame parameters (background and/or foreground

6
lisp/ps-bdf.el
View File

@ -38,11 +38,7 @@
;;; Code:
(eval-and-compile
(require 'ps-mule)
;; to avoid XEmacs compilation gripes
(defvar installation-directory nil)
(defvar coding-system-for-read nil))
(require 'ps-mule))
;;;###autoload
(defvar bdf-directory-list

461
lisp/ps-def.el Normal file
View File

@ -0,0 +1,461 @@
;;; ps-def.el --- XEmacs and Emacs definitions for ps-print
;; Copyright (C) 2007 Free Software Foundation, Inc.
;; Author: 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>
;; Keywords: wp, print, PostScript
;; Version: 7.2
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify it under
;; the terms of the GNU General Public License as published by the Free
;; Software Foundation; either version 2, or (at your option) any later
;; version.
;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY
;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
;; details.
;; 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
;;; Commentary:
;; See ps-print.el for documentation.
;;; Code:
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; XEmacs Definitions
(cond
((featurep 'xemacs) ; xemacs
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ps-bdf
(defvar installation-directory nil)
(defvar coding-system-for-read nil)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ps-mule
(defvar leading-code-private-22 157)
(or (fboundp 'charset-bytes)
(defun charset-bytes (charset) 1)) ; ascii
(or (fboundp 'charset-dimension)
(defun charset-dimension (charset) 1)) ; ascii
(or (fboundp 'charset-id)
(defun charset-id (charset) 0)) ; ascii
(or (fboundp 'charset-width)
(defun charset-width (charset) 1)) ; ascii
(or (fboundp 'find-charset-region)
(defun find-charset-region (beg end &optional table)
(list 'ascii)))
(or (fboundp 'char-width)
(defun char-width (char) 1)) ; ascii
(or (fboundp 'chars-in-region)
(defun chars-in-region (beg end)
(- (max beg end) (min beg end))))
(or (fboundp 'forward-point)
(defun forward-point (arg)
(save-excursion
(let ((count (abs arg))
(step (if (zerop arg)
0
(/ arg arg))))
(while (and (> count 0)
(< (point-min) (point)) (< (point) (point-max)))
(forward-char step)
(setq count (1- count)))
(+ (point) (* count step))))))
(or (fboundp 'decompose-composite-char)
(defun decompose-composite-char (char &optional type
with-composition-rule)
nil))
(or (fboundp 'encode-coding-string)
(defun encode-coding-string (string coding-system &optional nocopy)
(if nocopy
string
(copy-sequence string))))
(or (fboundp 'coding-system-p)
(defun coding-system-p (obj) nil))
(or (fboundp 'ccl-execute-on-string)
(defun ccl-execute-on-string (ccl-prog status str
&optional contin unibyte-p)
str))
(or (fboundp 'define-ccl-program)
(defmacro define-ccl-program (name ccl-program &optional doc)
`(defconst ,name nil ,doc)))
(or (fboundp 'multibyte-string-p)
(defun multibyte-string-p (str)
(let ((len (length str))
(i 0)
multibyte)
(while (and (< i len) (not (setq multibyte (> (aref str i) 255))))
(setq i (1+ i)))
multibyte)))
(or (fboundp 'string-make-multibyte)
(defalias 'string-make-multibyte 'copy-sequence))
(or (fboundp 'encode-char)
(defun encode-char (ch ccs)
ch))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ps-print
;; GNU Emacs
(or (fboundp 'line-beginning-position)
(defun line-beginning-position (&optional n)
(save-excursion
(and n (/= n 1) (forward-line (1- n)))
(beginning-of-line)
(point))))
;; GNU Emacs
(or (fboundp 'find-composition)
(defalias 'find-composition 'ignore))
(defun ps-xemacs-color-name (color)
(if (color-specifier-p color)
(color-name color)
color))
(defalias 'ps-mark-active-p 'region-active-p)
(defun ps-face-foreground-name (face)
(ps-xemacs-color-name (face-foreground face)))
(defun ps-face-background-name (face)
(ps-xemacs-color-name (face-background face)))
(defun ps-frame-parameter (param)
(frame-property nil param))
;; Return t if the device (which can be changed during an emacs session)
;; can handle colors.
;; XEmacs change: Need to check for emacs-major-version too.
(if (or (> emacs-major-version 19)
(and (= emacs-major-version 19)
(>= emacs-minor-version 12)))
;; xemacs >= 19.12
(defun ps-color-device ()
(eq (device-class) 'color))
;; xemacs < 19.12
(setq ps-print-color-p nil)
(defalias 'ps-color-device 'ignore))
(defun ps-mapper (extent list)
(nconc list
(list (list (extent-start-position extent) 'push extent)
(list (extent-end-position extent) 'pull extent)))
nil)
(defun ps-extent-sorter (a b)
(< (extent-priority a) (extent-priority b)))
(defun ps-xemacs-face-kind-p (face kind kind-regex)
(let* ((frame-font (or (face-font-instance face)
(face-font-instance 'default)))
(kind-cons
(and frame-font
(assq kind
(font-instance-properties frame-font))))
(kind-spec (cdr-safe kind-cons))
(case-fold-search t))
(and kind-spec (string-match kind-regex kind-spec))))
;; to avoid XEmacs compilation gripes
(defvar coding-system-for-write nil)
(defvar coding-system-for-read nil)
(defvar buffer-file-coding-system nil)
(and (fboundp 'find-coding-system)
(or (funcall 'find-coding-system 'raw-text-unix)
(funcall 'copy-coding-system 'no-conversion-unix 'raw-text-unix)))
(defun ps-color-values (x-color)
(let ((color (ps-xemacs-color-name x-color)))
(cond
((fboundp 'x-color-values)
(funcall 'x-color-values color))
((and (fboundp 'color-instance-rgb-components)
(ps-color-device))
(funcall 'color-instance-rgb-components
(if (color-instance-p x-color)
x-color
(make-color-instance color))))
(t
(error "No available function to determine X color values")))))
(defun ps-face-bold-p (face)
(or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
(memq face ps-bold-faces))) ; Kludge-compatible
(defun ps-face-italic-p (face)
(or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o")
(ps-xemacs-face-kind-p face 'SLANT "i\\|o")
(memq face ps-italic-faces))) ; Kludge-compatible
;; XEmacs will have to make do with %s (princ) for floats.
(defvar ps-color-format "%s %s %s")
(defvar ps-float-format "%s ")
(defun ps-generate-postscript-with-faces1 (from to)
;; Generate some PostScript.
(let ((face 'default)
(position to)
;; XEmacs
;; Build the list of extents...
(a (cons 'dummy nil))
record type extent extent-list)
(map-extents 'ps-mapper nil from to a)
(setq a (sort (cdr a) 'car-less-than-car)
extent-list nil)
;; Loop through the extents...
(while a
(setq record (car a)
position (car record)
record (cdr record)
type (car record)
record (cdr record)
extent (car record))
;; Plot up to this record.
;; XEmacs 19.12: for some reason, we're getting into a
;; situation in which some of the records have
;; positions less than 'from'. Since we've narrowed
;; the buffer, this'll generate errors. This is a hack,
;; but don't call ps-plot-with-face unless from > point-min.
(and (>= from (point-min))
(ps-plot-with-face from (min position (point-max)) face))
(cond
((eq type 'push)
(and (extent-face extent)
(setq extent-list (sort (cons extent extent-list)
'ps-extent-sorter))))
((eq type 'pull)
(setq extent-list (sort (delq extent extent-list)
'ps-extent-sorter))))
(setq face (if extent-list
(extent-face (car extent-list))
'default)
from position
a (cdr a)))
(ps-plot-with-face from to face)))
)
(t ; emacs
;; Do nothing
)) ; end cond featurep
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Emacs Definitions
(cond
((featurep 'xemacs) ; xemacs
;; Do nothing
)
(t ; emacs
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ps-print
(defvar mark-active nil)
(defun ps-mark-active-p ()
mark-active)
(defun ps-face-foreground-name (face)
(face-foreground face nil t))
(defun ps-face-background-name (face)
(face-background face nil t))
(defun ps-frame-parameter (param)
(frame-parameter nil param))
;; Return t if the device (which can be changed during an emacs session) can
;; handle colors. This function is not yet implemented for GNU emacs.
(defun ps-color-device ()
(if (fboundp 'color-values)
(funcall 'color-values "Green")
t))
(defun ps-color-values (x-color)
(cond
((fboundp 'color-values)
(funcall 'color-values x-color))
((fboundp 'x-color-values)
(funcall 'x-color-values x-color))
(t
(error "No available function to determine X color values"))))
(defun ps-face-bold-p (face)
(or (face-bold-p face)
(memq face ps-bold-faces)))
(defun ps-face-italic-p (face)
(or (face-italic-p face)
(memq face ps-italic-faces)))
;; Emacs understands the %f format; we'll use it to limit color RGB values
;; to three decimals to cut down some on the size of the PostScript output.
(defvar ps-color-format "%0.3f %0.3f %0.3f")
(defvar ps-float-format "%0.3f ")
(defun ps-generate-postscript-with-faces1 (from to)
;; Generate some PostScript.
(let ((face 'default)
(position to)
;; Emacs
(property-change from)
(overlay-change from)
(save-buffer-invisibility-spec buffer-invisibility-spec)
(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.
(setq property-change (next-property-change from nil to)))
(and (< overlay-change to) ; Don't search for overlay change
; unless previous search succeeded.
(setq overlay-change (min (next-overlay-change from)
to)))
(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
;; of buffer-invisibility-spec nonetheless overrides
;; a face text property.
(setq face
(cond ((let ((prop (get-text-property from 'invisible)))
;; Decide whether this invisible property
;; really makes the text invisible.
(if (eq save-buffer-invisibility-spec t)
(not (null prop))
(or (memq prop save-buffer-invisibility-spec)
(assq prop save-buffer-invisibility-spec))))
'emacs--invisible--face)
((get-text-property from 'face))
(t 'default)))
(let ((overlays (overlays-at from))
(face-priority -1)) ; text-property
(while (and overlays
(not (eq face 'emacs--invisible--face)))
(let* ((overlay (car overlays))
(overlay-invisible
(overlay-get overlay 'invisible))
(overlay-priority
(or (overlay-get overlay 'priority) 0)))
(and (> overlay-priority face-priority)
(setq before-string
(or (overlay-get overlay 'before-string)
before-string)
after-string
(or (and (<= (overlay-end overlay) position)
(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)
((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)))
)) ; end cond featurep
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide 'ps-def)
;;; arch-tag: fb06a585-1112-4206-885d-a57d95d50579
;;; ps-def.el ends here

64
lisp/ps-mule.el
View File

@ -91,69 +91,7 @@
;;; Code:
(eval-and-compile
(require 'ps-print)
;; to avoid XEmacs compilation gripes
(defvar leading-code-private-22 157)
(or (fboundp 'charset-bytes)
(defun charset-bytes (charset) 1)) ; ascii
(or (fboundp 'charset-dimension)
(defun charset-dimension (charset) 1)) ; ascii
(or (fboundp 'charset-id)
(defun charset-id (charset) 0)) ; ascii
(or (fboundp 'charset-width)
(defun charset-width (charset) 1)) ; ascii
(or (fboundp 'find-charset-region)
(defun find-charset-region (beg end &optional table)
(list 'ascii)))
(or (fboundp 'char-width)
(defun char-width (char) 1)) ; ascii
(or (fboundp 'chars-in-region)
(defun chars-in-region (beg end)
(- (max beg end) (min beg end))))
(or (fboundp 'forward-point)
(defun forward-point (arg)
(save-excursion
(let ((count (abs arg))
(step (if (zerop arg)
0
(/ arg arg))))
(while (and (> count 0)
(< (point-min) (point)) (< (point) (point-max)))
(forward-char step)
(setq count (1- count)))
(+ (point) (* count step))))))
(or (fboundp 'decompose-composite-char)
(defun decompose-composite-char (char &optional type
with-composition-rule)
nil))
(or (fboundp 'encode-coding-string)
(defun encode-coding-string (string coding-system &optional nocopy)
(if nocopy
string
(copy-sequence string))))
(or (fboundp 'coding-system-p)
(defun coding-system-p (obj) nil))
(or (fboundp 'ccl-execute-on-string)
(defun ccl-execute-on-string (ccl-prog status str
&optional contin unibyte-p)
str))
(or (fboundp 'define-ccl-program)
(defmacro define-ccl-program (name ccl-program &optional doc)
`(defconst ,name nil ,doc)))
(or (fboundp 'multibyte-string-p)
(defun multibyte-string-p (str)
(let ((len (length str))
(i 0)
multibyte)
(while (and (< i len) (not (setq multibyte (> (aref str i) 255))))
(setq i (1+ i)))
multibyte)))
(or (fboundp 'string-make-multibyte)
(defalias 'string-make-multibyte 'copy-sequence))
(or (fboundp 'encode-char)
(defun encode-char (ch ccs)
ch)))
(require 'ps-print))
;;;###autoload

525
lisp/ps-print.el
View File

@ -10,11 +10,11 @@
;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Keywords: wp, print, PostScript
;; Version: 7.1
;; Version: 7.2
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
(defconst ps-print-version "7.1"
"ps-print.el, v 7.1 <2007/01/21 vinicius>
(defconst ps-print-version "7.2"
"ps-print.el, v 7.2 <2007/01/19 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
@ -1445,6 +1445,7 @@ Please send all bug fixes and enhancements to
(require 'lpr)
(or (featurep 'lisp-float-type)
(error "`ps-print' requires floating point support"))
@ -1463,82 +1464,14 @@ Please send all bug fixes and enhancements to
'emacs))))
;; GNU Emacs
(or (fboundp 'line-beginning-position)
(defun line-beginning-position (&optional n)
(save-excursion
(and n (/= n 1) (forward-line (1- n)))
(beginning-of-line)
(point))))
;; to avoid compilation gripes
;; XEmacs
(defalias 'ps-x-color-instance-p 'color-instance-p)
(defalias 'ps-x-color-instance-rgb-components 'color-instance-rgb-components)
(defalias 'ps-x-color-name 'color-name)
(defalias 'ps-x-color-specifier-p 'color-specifier-p)
(defalias 'ps-x-copy-coding-system 'copy-coding-system)
(defalias 'ps-x-device-class 'device-class)
(defalias 'ps-x-extent-end-position 'extent-end-position)
(defalias 'ps-x-extent-face 'extent-face)
(defalias 'ps-x-extent-priority 'extent-priority)
(defalias 'ps-x-extent-start-position 'extent-start-position)
(defalias 'ps-x-face-font-instance 'face-font-instance)
(defalias 'ps-x-find-coding-system 'find-coding-system)
(defalias 'ps-x-font-instance-properties 'font-instance-properties)
(defalias 'ps-x-make-color-instance 'make-color-instance)
(defalias 'ps-x-map-extents 'map-extents)
(defalias 'ps-x-frame-property 'frame-property)
;; GNU Emacs
(defalias 'ps-e-face-bold-p 'face-bold-p)
(defalias 'ps-e-face-italic-p 'face-italic-p)
(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)
(defalias 'ps-e-frame-parameter 'frame-parameter)
(if (fboundp 'find-composition)
(defalias 'ps-e-find-composition 'find-composition)
(defalias 'ps-e-find-composition 'ignore))
(defconst ps-windows-system
(memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
(defconst ps-lp-system
(memq system-type '(usg-unix-v dgux hpux irix)))
(defun ps-xemacs-color-name (color)
(if (ps-x-color-specifier-p color)
(ps-x-color-name color)
color))
(cond ((featurep 'xemacs) ; xemacs
(defalias 'ps-mark-active-p 'region-active-p)
(defun ps-face-foreground-name (face)
(ps-xemacs-color-name (face-foreground face)))
(defun ps-face-background-name (face)
(ps-xemacs-color-name (face-background face)))
(defun ps-frame-parameter (param)
(ps-x-frame-property nil param))
)
(t ; emacs 23 or higher
(defvar mark-active nil)
(defun ps-mark-active-p ()
mark-active)
(defun ps-face-foreground-name (face)
(face-foreground face nil t))
(defun ps-face-background-name (face)
(face-background face nil t))
(defun ps-frame-parameter (param)
(ps-e-frame-parameter nil param))
))
;; Load XEmacs/Emacs definitions
(eval-and-compile (require 'ps-def))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -3344,9 +3277,9 @@ It's like the very first character of buffer (or region) is ^L (\\014)."
(defcustom ps-postscript-code-directory
(or (if (featurep 'xemacs)
(cond ((fboundp 'locate-data-directory) ; xemacs
(locate-data-directory "ps-print"))
(funcall 'locate-data-directory "ps-print"))
((boundp 'data-directory) ; xemacs
data-directory)
(symbol-value 'data-directory))
(t ; don't know what to do
nil))
data-directory) ; emacs
@ -3838,107 +3771,6 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'."
(format-time-string "%T"))
(and (featurep 'xemacs)
;; XEmacs change: Need to check for emacs-major-version too.
(or (< emacs-major-version 19)
(and (= emacs-major-version 19) (< emacs-minor-version 12)))
(setq ps-print-color-p nil))
;; Return t if the device (which can be changed during an emacs session)
;; can handle colors.
;; This function is not yet implemented for GNU emacs.
(cond ((and (featurep 'xemacs)
;; XEmacs change: Need to check for emacs-major-version too.
(or (> emacs-major-version 19)
(and (= emacs-major-version 19)
(>= emacs-minor-version 12)))) ; xemacs >= 19.12
(defun ps-color-device ()
(eq (ps-x-device-class) 'color)))
(t ; emacs
(defun ps-color-device ()
(if (fboundp 'color-values)
(ps-e-color-values "Green")
t))))
(defun ps-mapper (extent list)
(nconc list
(list (list (ps-x-extent-start-position extent) 'push extent)
(list (ps-x-extent-end-position extent) 'pull extent)))
nil)
(defun ps-extent-sorter (a b)
(< (ps-x-extent-priority a) (ps-x-extent-priority b)))
(defun ps-xemacs-face-kind-p (face kind kind-regex)
(let* ((frame-font (or (ps-x-face-font-instance face)
(ps-x-face-font-instance 'default)))
(kind-cons
(and frame-font
(assq kind
(ps-x-font-instance-properties frame-font))))
(kind-spec (cdr-safe kind-cons))
(case-fold-search t))
(and kind-spec (string-match kind-regex kind-spec))))
(cond ((featurep 'xemacs) ; xemacs
;; to avoid XEmacs compilation gripes
(defvar coding-system-for-write nil)
(defvar coding-system-for-read nil)
(defvar buffer-file-coding-system nil)
(and (fboundp 'find-coding-system)
(or (ps-x-find-coding-system 'raw-text-unix)
(ps-x-copy-coding-system 'no-conversion-unix 'raw-text-unix)))
(defun ps-color-values (x-color)
(let ((color (ps-xemacs-color-name x-color)))
(cond
((fboundp 'x-color-values)
(ps-e-x-color-values color))
((and (fboundp 'color-instance-rgb-components)
(ps-color-device))
(ps-x-color-instance-rgb-components
(if (ps-x-color-instance-p x-color)
x-color
(ps-x-make-color-instance color))))
(t
(error "No available function to determine X color values")))))
(defun ps-face-bold-p (face)
(or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
(memq face ps-bold-faces))) ; Kludge-compatible
(defun ps-face-italic-p (face)
(or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o")
(ps-xemacs-face-kind-p face 'SLANT "i\\|o")
(memq face ps-italic-faces))) ; Kludge-compatible
)
(t ; emacs
(defun ps-color-values (x-color)
(cond
((fboundp 'color-values)
(ps-e-color-values x-color))
((fboundp 'x-color-values)
(ps-e-x-color-values x-color))
(t
(error "No available function to determine X color values"))))
(defun ps-face-bold-p (face)
(or (ps-e-face-bold-p face)
(memq face ps-bold-faces)))
(defun ps-face-italic-p (face)
(or (ps-e-face-italic-p face)
(memq face ps-italic-faces)))
))
(defvar ps-print-color-scale 1.0)
(defun ps-color-scale (color)
@ -4018,15 +3850,6 @@ Note: No major/minor-mode is activated and no local variables are evaluated for
(defvar ps-razchunk 0)
(defvar ps-color-p nil)
(defvar ps-color-format
(if (featurep 'xemacs)
;; XEmacs will have to make do with %s (princ) for floats.
"%s %s %s"
;; Emacs understands the %f format; we'll use it to limit color RGB
;; values to three decimals to cut down some on the size of the
;; PostScript output.
"%0.3f %0.3f %0.3f"))
;; These values determine how much print-height to deduct when headers/footers
;; are turned on. This is a pretty clumsy way of handling it, but it'll do for
@ -4906,15 +4729,6 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
(vector 0 0 0 0)))))
;; Emacs understands the %f format; we'll use it to limit color RGB values
;; to three decimals to cut down some on the size of the PostScript output.
;; XEmacs will have to make do with %s (princ) for floats.
(defvar ps-float-format (if (featurep 'xemacs)
"%s " ; xemacs
"%0.3f ")) ; emacs
(defun ps-float-format (value &optional default)
(let ((literal (or value default)))
(cond ((null literal)
@ -6442,125 +6256,7 @@ If FACE is not a valid face name, it is used default face."
(save-restriction
(narrow-to-region from to)
(ps-print-ensure-fontified from to)
(let ((face 'default)
(position to))
(cond
((featurep 'xemacs) ; xemacs
;; Build the list of extents...
(let ((a (cons 'dummy nil))
record type extent extent-list)
(ps-x-map-extents 'ps-mapper nil from to a)
(setq a (sort (cdr a) 'car-less-than-car)
extent-list nil)
;; Loop through the extents...
(while a
(setq record (car a)
position (car record)
record (cdr record)
type (car record)
record (cdr record)
extent (car record))
;; Plot up to this record.
;; XEmacs 19.12: for some reason, we're getting into a
;; situation in which some of the records have
;; positions less than 'from'. Since we've narrowed
;; the buffer, this'll generate errors. This is a hack,
;; but don't call ps-plot-with-face unless from > point-min.
(and (>= from (point-min))
(ps-plot-with-face from (min position (point-max)) face))
(cond
((eq type 'push)
(and (ps-x-extent-face extent)
(setq extent-list (sort (cons extent extent-list)
'ps-extent-sorter))))
((eq type 'pull)
(setq extent-list (sort (delq extent extent-list)
'ps-extent-sorter))))
(setq face (if extent-list
(ps-x-extent-face (car extent-list))
'default)
from position
a (cdr a)))))
(t ; emacs
(let ((property-change from)
(overlay-change from)
(save-buffer-invisibility-spec buffer-invisibility-spec)
(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.
(setq property-change (next-property-change from nil to)))
(and (< overlay-change to) ; Don't search for overlay change
; unless previous search succeeded.
(setq overlay-change (min (ps-e-next-overlay-change from)
to)))
(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
;; of buffer-invisibility-spec nonetheless overrides
;; a face text property.
(setq face
(cond ((let ((prop (get-text-property from 'invisible)))
;; Decide whether this invisible property
;; really makes the text invisible.
(if (eq save-buffer-invisibility-spec t)
(not (null prop))
(or (memq prop save-buffer-invisibility-spec)
(assq prop save-buffer-invisibility-spec))))
'emacs--invisible--face)
((get-text-property from 'face))
(t 'default)))
(let ((overlays (ps-e-overlays-at from))
(face-priority -1)) ; text-property
(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)))
(and (> overlay-priority face-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))))
(ps-generate-postscript-with-faces1 from to)))
(defun ps-generate-postscript (from to)
(ps-plot-region from to 0 nil))
@ -6754,209 +6450,6 @@ If FACE is not a valid face name, it is used default face."
(t
(setq kill-emacs-hook 'ps-kill-emacs-check)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sample Setup Code:
;; This stuff is for anybody that's brave enough to look this far,
;; and able to figure out how to use it. It isn't really part of
;; ps-print, but I'll leave it here in hopes it might be useful:
;; WARNING!!! The following code is *sample* code only.
;; Don't use it unless you understand what it does!
(defmacro ps-prsc ()
`(if (featurep 'xemacs) 'f22 [f22]))
(defmacro ps-c-prsc ()
`(if (featurep 'xemacs) '(control f22) [C-f22]))
(defmacro ps-s-prsc ()
`(if (featurep 'xemacs) '(shift f22) [S-f22]))
;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
;; `ps-left-headers' specially for mail messages.
(defun ps-rmail-mode-hook ()
(local-set-key (ps-prsc) 'ps-rmail-print-message-from-summary)
(setq ps-header-lines 3
ps-left-header
;; The left headers will display the message's subject, its
;; author, and the name of the folder it was in.
'(ps-article-subject ps-article-author buffer-name)))
;; See `ps-gnus-print-article-from-summary'. This function does the
;; same thing for rmail.
(defun ps-rmail-print-message-from-summary ()
(interactive)
(ps-print-message-from-summary 'rmail-summary-buffer "RMAIL"))
;; Used in `ps-rmail-print-article-from-summary',
;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'.
(defun ps-print-message-from-summary (summary-buffer summary-default)
(let ((ps-buf (or (and (boundp summary-buffer)
(symbol-value summary-buffer))
summary-default)))
(and (get-buffer ps-buf)
(save-excursion
(set-buffer ps-buf)
(ps-spool-buffer-with-faces)))))
;; Look in an article or mail message for the Subject: line. To be
;; placed in `ps-left-headers'.
(defun ps-article-subject ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
(buffer-substring (match-beginning 1) (match-end 1))
"Subject ???")))
;; Look in an article or mail message for the From: line. Sorta-kinda
;; understands RFC-822 addresses and can pull the real name out where
;; it's provided. To be placed in `ps-left-headers'.
(defun ps-article-author ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
(let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
(cond
;; Try first to match addresses that look like
;; thompson@wg2.waii.com (Jim Thompson)
((string-match ".*[ \t]+(\\(.*\\))" fromstring)
(substring fromstring (match-beginning 1) (match-end 1)))
;; Next try to match addresses that look like
;; Jim Thompson <thompson@wg2.waii.com> or
;; "Jim Thompson" <thompson@wg2.waii.com>
((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)
(substring fromstring (match-beginning 2) (match-end 2)))
;; Couldn't find a real name -- show the address instead.
(t fromstring)))
"From ???")))
;; A hook to bind to `gnus-article-prepare-hook'. This will set the
;; `ps-left-headers' specially for gnus articles. Unfortunately,
;; `gnus-article-mode-hook' is called only once, the first time the *Article*
;; buffer enters that mode, so it would only work for the first time
;; we ran gnus. The second time, this hook wouldn't get set up. The
;; only alternative is `gnus-article-prepare-hook'.
(defun ps-gnus-article-prepare-hook ()
(setq ps-header-lines 3
ps-left-header
;; The left headers will display the article's subject, its
;; author, and the newsgroup it was in.
'(ps-article-subject ps-article-author gnus-newsgroup-name)))
;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
;; `ps-left-headers' specially for mail messages.
(defun ps-vm-mode-hook ()
(local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
(setq ps-header-lines 3
ps-left-header
;; The left headers will display the message's subject, its
;; author, and the name of the folder it was in.
'(ps-article-subject ps-article-author buffer-name)))
;; Every now and then I forget to switch from the *Summary* buffer to
;; the *Article* before hitting prsc, and a nicely formatted list of
;; article subjects shows up at the printer. This function, bound to
;; prsc for the gnus *Summary* buffer means I don't have to switch
;; buffers first.
;; sb: Updated for Gnus 5.
(defun ps-gnus-print-article-from-summary ()
(interactive)
(ps-print-message-from-summary 'gnus-article-buffer "*Article*"))
;; See `ps-gnus-print-article-from-summary'. This function does the
;; same thing for vm.
(defun ps-vm-print-message-from-summary ()
(interactive)
(ps-print-message-from-summary 'vm-mail-buffer ""))
;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
;; prsc.
(defun ps-gnus-summary-setup ()
(local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
;; Look in an article or mail message for the Subject: line. To be
;; placed in `ps-left-headers'.
(defun ps-info-file ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
(buffer-substring (match-beginning 1) (match-end 1))
"File ???")))
;; Look in an article or mail message for the Subject: line. To be
;; placed in `ps-left-headers'.
(defun ps-info-node ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
(buffer-substring (match-beginning 1) (match-end 1))
"Node ???")))
(defun ps-info-mode-hook ()
(setq ps-left-header
;; The left headers will display the node name and file name.
'(ps-info-node ps-info-file)))
;; WARNING! The following function is a *sample* only, and is *not*
;; meant to be used as a whole unless you understand what the effects
;; will be! (In fact, this is a copy of Jim's setup for ps-print --
;; I'd be very surprised if it was useful to *anybody*, without
;; modification.)
(defun ps-jts-ps-setup ()
(global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
(global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
(global-set-key (ps-c-prsc) 'ps-despool)
(add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
(add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
(add-hook 'vm-mode-hook 'ps-vm-mode-hook)
(add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
(add-hook 'Info-mode-hook 'ps-info-mode-hook)
(setq ps-spool-duplex t
ps-print-color-p nil
ps-lpr-command "lpr"
ps-lpr-switches '("-Jjct,duplex_long"))
'ps-jts-ps-setup)
;; WARNING! The following function is a *sample* only, and is *not*
;; meant to be used as a whole unless it corresponds to your needs.
;; (In fact, this is a copy of Jack's setup for ps-print --
;; I would not be that surprised if it was useful to *anybody*,
;; without modification.)
(defun ps-jack-setup ()
(setq ps-print-color-p nil
ps-lpr-command "lpr"
ps-lpr-switches nil
ps-paper-type 'a4
ps-landscape-mode t
ps-number-of-columns 2
ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
ps-header-line-pad .15
ps-print-header t
ps-print-header-frame t
ps-header-lines 2
ps-show-n-of-n t
ps-spool-duplex nil
ps-font-family 'Courier
ps-font-size 5.5
ps-header-font-family 'Helvetica
ps-header-font-size 6
ps-header-title-font-size 8)
'ps-jack-setup)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; To make this file smaller, some commands go in a separate file.

249
lisp/ps-samp.el Normal file
View File

@ -0,0 +1,249 @@
;;; ps-samp.el --- ps-print sample setup code
;; Copyright (C) 2007 Free Software Foundation, Inc.
;; 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>
;; Keywords: wp, print, PostScript
;; Version: 7.2
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify it under
;; the terms of the GNU General Public License as published by the Free
;; Software Foundation; either version 2, or (at your option) any later
;; version.
;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY
;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
;; details.
;; 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
;;; Commentary:
;; See ps-print.el for documentation.
;;; Code:
(eval-and-compile (require 'ps-print))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sample Setup Code:
;; This stuff is for anybody that's brave enough to look this far,
;; and able to figure out how to use it. It isn't really part of
;; ps-print, but I'll leave it here in hopes it might be useful:
;; WARNING!!! The following code is *sample* code only.
;; Don't use it unless you understand what it does!
(defmacro ps-prsc ()
`(if (featurep 'xemacs) 'f22 [f22]))
(defmacro ps-c-prsc ()
`(if (featurep 'xemacs) '(control f22) [C-f22]))
(defmacro ps-s-prsc ()
`(if (featurep 'xemacs) '(shift f22) [S-f22]))
;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
;; `ps-left-headers' specially for mail messages.
(defun ps-rmail-mode-hook ()
(local-set-key (ps-prsc) 'ps-rmail-print-message-from-summary)
(setq ps-header-lines 3
ps-left-header
;; The left headers will display the message's subject, its
;; author, and the name of the folder it was in.
'(ps-article-subject ps-article-author buffer-name)))
;; See `ps-gnus-print-article-from-summary'. This function does the
;; same thing for rmail.
(defun ps-rmail-print-message-from-summary ()
(interactive)
(ps-print-message-from-summary 'rmail-summary-buffer "RMAIL"))
;; Used in `ps-rmail-print-article-from-summary',
;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'.
(defun ps-print-message-from-summary (summary-buffer summary-default)
(let ((ps-buf (or (and (boundp summary-buffer)
(symbol-value summary-buffer))
summary-default)))
(and (get-buffer ps-buf)
(save-excursion
(set-buffer ps-buf)
(ps-spool-buffer-with-faces)))))
;; Look in an article or mail message for the Subject: line. To be
;; placed in `ps-left-headers'.
(defun ps-article-subject ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
(buffer-substring (match-beginning 1) (match-end 1))
"Subject ???")))
;; Look in an article or mail message for the From: line. Sorta-kinda
;; understands RFC-822 addresses and can pull the real name out where
;; it's provided. To be placed in `ps-left-headers'.
(defun ps-article-author ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
(let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
(cond
;; Try first to match addresses that look like
;; thompson@wg2.waii.com (Jim Thompson)
((string-match ".*[ \t]+(\\(.*\\))" fromstring)
(substring fromstring (match-beginning 1) (match-end 1)))
;; Next try to match addresses that look like
;; Jim Thompson <thompson@wg2.waii.com> or
;; "Jim Thompson" <thompson@wg2.waii.com>
((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)
(substring fromstring (match-beginning 2) (match-end 2)))
;; Couldn't find a real name -- show the address instead.
(t fromstring)))
"From ???")))
;; A hook to bind to `gnus-article-prepare-hook'. This will set the
;; `ps-left-headers' specially for gnus articles. Unfortunately,
;; `gnus-article-mode-hook' is called only once, the first time the *Article*
;; buffer enters that mode, so it would only work for the first time
;; we ran gnus. The second time, this hook wouldn't get set up. The
;; only alternative is `gnus-article-prepare-hook'.
(defun ps-gnus-article-prepare-hook ()
(setq ps-header-lines 3
ps-left-header
;; The left headers will display the article's subject, its
;; author, and the newsgroup it was in.
'(ps-article-subject ps-article-author gnus-newsgroup-name)))
;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
;; `ps-left-headers' specially for mail messages.
(defun ps-vm-mode-hook ()
(local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
(setq ps-header-lines 3
ps-left-header
;; The left headers will display the message's subject, its
;; author, and the name of the folder it was in.
'(ps-article-subject ps-article-author buffer-name)))
;; Every now and then I forget to switch from the *Summary* buffer to
;; the *Article* before hitting prsc, and a nicely formatted list of
;; article subjects shows up at the printer. This function, bound to
;; prsc for the gnus *Summary* buffer means I don't have to switch
;; buffers first.
;; sb: Updated for Gnus 5.
(defun ps-gnus-print-article-from-summary ()
(interactive)
(ps-print-message-from-summary 'gnus-article-buffer "*Article*"))
;; See `ps-gnus-print-article-from-summary'. This function does the
;; same thing for vm.
(defun ps-vm-print-message-from-summary ()
(interactive)
(ps-print-message-from-summary 'vm-mail-buffer ""))
;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
;; prsc.
(defun ps-gnus-summary-setup ()
(local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
;; Look in an article or mail message for the Subject: line. To be
;; placed in `ps-left-headers'.
(defun ps-info-file ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
(buffer-substring (match-beginning 1) (match-end 1))
"File ???")))
;; Look in an article or mail message for the Subject: line. To be
;; placed in `ps-left-headers'.
(defun ps-info-node ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
(buffer-substring (match-beginning 1) (match-end 1))
"Node ???")))
(defun ps-info-mode-hook ()
(setq ps-left-header
;; The left headers will display the node name and file name.
'(ps-info-node ps-info-file)))
;; WARNING! The following function is a *sample* only, and is *not*
;; meant to be used as a whole unless you understand what the effects
;; will be! (In fact, this is a copy of Jim's setup for ps-print --
;; I'd be very surprised if it was useful to *anybody*, without
;; modification.)
(defun ps-jts-ps-setup ()
(global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
(global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
(global-set-key (ps-c-prsc) 'ps-despool)
(add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
(add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
(add-hook 'vm-mode-hook 'ps-vm-mode-hook)
(add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
(add-hook 'Info-mode-hook 'ps-info-mode-hook)
(setq ps-spool-duplex t
ps-print-color-p nil
ps-lpr-command "lpr"
ps-lpr-switches '("-Jjct,duplex_long"))
'ps-jts-ps-setup)
;; WARNING! The following function is a *sample* only, and is *not*
;; meant to be used as a whole unless it corresponds to your needs.
;; (In fact, this is a copy of Jack's setup for ps-print --
;; I would not be that surprised if it was useful to *anybody*,
;; without modification.)
(defun ps-jack-setup ()
(setq ps-print-color-p nil
ps-lpr-command "lpr"
ps-lpr-switches nil
ps-paper-type 'a4
ps-landscape-mode t
ps-number-of-columns 2
ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
ps-header-line-pad .15
ps-print-header t
ps-print-header-frame t
ps-header-lines 2
ps-show-n-of-n t
ps-spool-duplex nil
ps-font-family 'Courier
ps-font-size 5.5
ps-header-font-family 'Helvetica
ps-header-font-size 6
ps-header-title-font-size 8)
'ps-jack-setup)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide 'ps-samp)
;;; arch-tag: fb06a585-1112-4206-885d-a57d95d50579
;;; ps-samp.el ends here