[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 8064f64 2/2: Remove XEmacs compat code from ps-prin
|
From: |
Lars Ingebrigtsen |
|
Subject: |
[Emacs-diffs] master 8064f64 2/2: Remove XEmacs compat code from ps-print |
|
Date: |
Wed, 19 Jun 2019 16:30:26 -0400 (EDT) |
branch: master
commit 8064f64eb14882f68851cc8f91b86fb287589499
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>
Remove XEmacs compat code from ps-print
* lisp/ps-print.el:
(ps-print-color-p, ps-postscript-code-directory, ps-setup):
* lisp/ps-def.el:
(ps-mark-active-p, ps-face-foreground-name)
(ps-face-background-name, ps-color-device, ps-color-values)
(ps-face-bold-p, ps-face-italic-p, ps-face-strikeout-p)
(ps-face-overline-p, ps-face-box-p)
(ps-generate-postscript-with-faces1): Remove XEmacs compat code
and some outdated Emacs compat code.
---
lisp/ps-def.el | 348 +++++++++++--------------------------------------------
lisp/ps-print.el | 31 +----
2 files changed, 73 insertions(+), 306 deletions(-)
diff --git a/lisp/ps-def.el b/lisp/ps-def.el
index 0f3b2f7..f33f817 100644
--- a/lisp/ps-def.el
+++ b/lisp/ps-def.el
@@ -1,4 +1,4 @@
-;;; ps-def.el --- XEmacs and Emacs definitions for ps-print -*-
lexical-binding: t -*-
+;;; ps-def.el --- Emacs definitions for ps-print -*- lexical-binding: t -*-
;; Copyright (C) 2007-2019 Free Software Foundation, Inc.
@@ -37,316 +37,104 @@
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; XEmacs Definitions
-
-
-(cond
- ((featurep 'xemacs) ; XEmacs
-
- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; ps-bdf
-
- (defvar installation-directory nil)
- (defvar coding-system-for-read)
-
- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; ps-mule
-
- (or (fboundp 'charset-dimension)
- (defun charset-dimension (_charset) 1)) ; ascii
-
- (or (fboundp 'char-width)
- (defun char-width (_char) 1)) ; ascii
-
- (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)))
-
-
- (defalias 'ps-frame-parameter 'frame-property)
-
-
- ;; Return t if the device (which can be changed during an emacs session)
- ;; can handle colors.
- (defun ps-color-device ()
- (eq (device-class) 'color))
-
- (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)
- (defvar buffer-file-coding-system)
-
- (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
-
-
- (defalias 'ps-face-strikeout-p 'ignore)
-
-
- (defalias 'ps-face-overline-p 'ignore)
-
-
- (defalias 'ps-face-box-p 'ignore)
-
-
- ;; 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
-
-
- (defun ps-mark-active-p ()
- mark-active)
-
+(defun ps-mark-active-p ()
+ mark-active)
- (defun ps-face-foreground-name (face)
- (face-foreground face nil t))
+(defun ps-face-foreground-name (face)
+ (face-foreground face nil t))
- (defun ps-face-background-name (face)
- (face-background face nil t))
+(defun ps-face-background-name (face)
+ (face-background face nil t))
- (defalias 'ps-frame-parameter 'frame-parameter)
+(defalias 'ps-frame-parameter 'frame-parameter)
- ;; 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))
+;; 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-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-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)))
+(defun ps-face-italic-p (face)
+ (or (face-italic-p face)
+ (memq face ps-italic-faces)))
- (defun ps-face-strikeout-p (face)
- (eq (face-attribute face :strike-through) t))
+(defun ps-face-strikeout-p (face)
+ (eq (face-attribute face :strike-through) t))
- (defun ps-face-overline-p (face)
- (eq (face-attribute face :overline) t))
+(defun ps-face-overline-p (face)
+ (eq (face-attribute face :overline) t))
- (defun ps-face-box-p (face)
- (not (memq (face-attribute face :box) '(nil unspecified))))
+(defun ps-face-box-p (face)
+ (not (memq (face-attribute face :box) '(nil unspecified))))
- ;; 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 ")
+;; 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)
- before-string after-string)
- (while (< from to)
- (and (< property-change to) ; Don't search for property change
+(defun ps-generate-postscript-with-faces1 (from to)
+ ;; Generate some PostScript.
+ (let ((face 'default)
+ (position to)
+ ;; Emacs
+ (property-change from)
+ (overlay-change from)
+ 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
+ (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)
- (setq face
- (cond ((invisible-p from)
- 'emacs--invisible--face)
- ((get-char-property from 'face))
- (t 'default)))
- ;; 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
+ (setq overlay-change (min (next-overlay-change from)
+ to)))
+ (setq position (min property-change overlay-change)
+ before-string nil
+ after-string nil)
+ (setq face
+ (cond ((invisible-p from)
+ 'emacs--invisible--face)
+ ((get-char-property from 'face))
+ (t 'default)))
+ ;; 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)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 994048d..8dd1d1e 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -47,7 +47,7 @@ Please send all bug fixes and enhancements to
;;
;; This package provides printing of Emacs buffers on PostScript printers; the
;; buffer's bold and italic text attributes are preserved in the printer
-;; output. ps-print is intended for use with Emacs or XEmacs, together with a
+;; output. ps-print is intended for use with Emacs, together with a
;; fontifying package such as font-lock or hilit.
;;
;; ps-print uses the same face attributes defined through font-lock or hilit to
@@ -1464,16 +1464,7 @@ Please send all bug fixes and enhancements to
(require 'lpr)
-
-(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")))
-
-
-;; Load XEmacs/Emacs definitions
+;; Load Emacs definitions
(require 'ps-def)
;; autoloads for secondary file
@@ -2951,13 +2942,8 @@ Either a float or a cons of floats (LANDSCAPE-SIZE .
PORTRAIT-SIZE)."
;;; Colors
;; Printing color requires x-color-values.
-;; XEmacs change: Need autoload for the "Options->Printing->Color Printing"
-;; widget to work.
;;;###autoload
-(defcustom ps-print-color-p
- (or (fboundp 'x-color-values) ; Emacs
- (fboundp 'color-instance-rgb-components))
- ; XEmacs
+(defcustom ps-print-color-p (fboundp 'x-color-values)
"Specify how buffer's text color is printed.
Valid values are:
@@ -3381,13 +3367,7 @@ It's like the very first character of buffer (or region)
is ^L (\\014)."
:version "20"
:group 'ps-print-headers)
-(defcustom ps-postscript-code-directory
- (cond ((fboundp 'locate-data-directory) ; XEmacs
- (locate-data-directory "ps-print"))
- ((boundp 'data-directory) ; XEmacs and Emacs.
- data-directory)
- (t ; don't know what to do
- (error "`ps-postscript-code-directory' isn't set properly")))
+(defcustom ps-postscript-code-directory data-directory
"Directory where it's located the PostScript prologue file used by ps-print.
By default, this directory is the same as in the variable `data-directory'."
:type 'directory
@@ -3632,8 +3612,7 @@ The table depends on the current ps-print setup."
(mapconcat
#'ps-print-quote
(list
- (concat "\n;;; (" (if (featurep 'xemacs) "XEmacs" "Emacs")
- ") ps-print version " ps-print-version "\n")
+ (concat "\n;;; (Emacs) ps-print version " ps-print-version "\n")
";; internal vars"
(ps-comment-string "emacs-version " emacs-version)
(ps-comment-string "lpr-windows-system" lpr-windows-system)