(ps-xemacs-color-name, ps-xemacs-face-kind-p): Only

do work for XEmacs.
(ps-xemacs-mapper): Rename from ps-mapper, only work on XEmacs.
(ps-xemacs-extent-sorter): Rename from ps-extent-sorter, only work
on XEmacs.
(ps-x-color-instance-p, ps-x-color-instance-rgb-components)
(ps-x-color-name, ps-x-color-specifier-p)
(ps-x-copy-coding-system, ps-x-device-class)
(ps-x-extent-end-position, ps-x-extent-face)
(ps-x-extent-priority, ps-x-extent-start-position)
(ps-x-face-font-instance, ps-x-find-coding-system)
(ps-x-font-instance-properties, ps-x-make-color-instance)
(ps-x-map-extents, ps-e-face-bold-p, ps-e-face-italic-p)
(ps-e-next-overlay-change, ps-e-overlays-at, ps-e-overlay-get)
(ps-e-overlay-end, ps-e-x-color-values, ps-e-color-values):
(ps-generate-postscript-with-faces): Delete defaliases.
(ps-face-foreground-name, ps-face-background-name)
(ps-color-values, ps-face-bold-p, ps-face-italic-p): Move
definitions to top level, make the body conditional on the emacs
flavor. Replace uses of deleted aliases and renamed functions.
(ps-generate-postscript-with-faces, ps-color-device): Replace uses
of deleted aliases and renamed functions.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ea7356efedde164181153b47799d8d07561cfa17..0a46ee2d2d4a6b46ceea7ed314cdb08aaca88d7a 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,28 @@
 2007-10-29  Dan Nicolaescu  <dann@ics.uci.edu>
 
+       * ps-print.el (ps-xemacs-color-name, ps-xemacs-face-kind-p): Only
+       do work for XEmacs.
+       (ps-xemacs-mapper): Rename from ps-mapper, only work on XEmacs.
+       (ps-xemacs-extent-sorter): Rename from ps-extent-sorter, only work
+       on XEmacs.
+       (ps-x-color-instance-p, ps-x-color-instance-rgb-components)
+       (ps-x-color-name, ps-x-color-specifier-p)
+       (ps-x-copy-coding-system, ps-x-device-class)
+       (ps-x-extent-end-position, ps-x-extent-face)
+       (ps-x-extent-priority, ps-x-extent-start-position)
+       (ps-x-face-font-instance, ps-x-find-coding-system)
+       (ps-x-font-instance-properties, ps-x-make-color-instance)
+       (ps-x-map-extents, ps-e-face-bold-p, ps-e-face-italic-p)
+       (ps-e-next-overlay-change, ps-e-overlays-at, ps-e-overlay-get)
+       (ps-e-overlay-end, ps-e-x-color-values, ps-e-color-values):
+       (ps-generate-postscript-with-faces): Delete defaliases.
+       (ps-face-foreground-name, ps-face-background-name)
+       (ps-color-values, ps-face-bold-p, ps-face-italic-p): Move
+       definitions to top level, make the body conditional on the emacs
+       flavor. Replace uses of deleted aliases and renamed functions.
+       (ps-generate-postscript-with-faces, ps-color-device): Replace uses
+       of deleted aliases and renamed functions.
+
        * calc/calc.el (calc-emacs-type-lucid): Remove.
        (calc-digit-map, calcDigit-start, calc-read-key)
        (calc-clear-unread-commands):

diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 43df4eddad69b2b4a4262fba5b17302881ff1ca1..d15d5879d69c4a10ca170b6399c7baa79bd19929 100644 (file)
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -1481,32 +1481,7 @@ Please send all bug fixes and enhancements to
 
 ;; 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)
-
 ;; 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-find-composition (if (fboundp 'find-composition)
                                     'find-composition
                                   'ignore))
@@ -1519,9 +1494,10 @@ Please send all bug fixes and enhancements to
 
 
 (defun ps-xemacs-color-name (color)
-  (if (ps-x-color-specifier-p color)
-      (ps-x-color-name color)
-    color))
+  (when (featurep 'xemacs)
+    (if (color-specifier-p color)
+       (color-name color)
+      color)))
 
 (defalias 'ps-frame-parameter
   (if (fboundp 'frame-parameter) 'frame-parameter 'frame-property))
@@ -1532,19 +1508,15 @@ Please send all bug fixes and enhancements to
     (defvar mark-active)               ; To shup up XEmacs's byte compiler.
     (lambda () mark-active)))          ; Emacs
 
-(cond ((featurep 'xemacs)              ; XEmacs
-       (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)))
-       )
-      (t                               ; Emacs 22 or higher
-       (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-foreground-name (face)
+  (if (featurep 'xemacs)
+      (ps-xemacs-color-name (face-foreground face))
+    (face-foreground face nil t)))
 
+(defun ps-face-background-name (face)
+  (if (featurep 'xemacs)
+      (ps-xemacs-color-name (face-background face))
+    (face-background face nil t)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; User Variables:
@@ -3925,90 +3897,84 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'."
                  (and (= emacs-major-version 19)
                       (>= emacs-minor-version 12)))) ; XEmacs >= 19.12
         (lambda ()
-          (eq (ps-x-device-class) 'color)))
+          (eq (device-class) 'color)))
 
        (t                              ; Emacs
         (lambda ()
           (if (fboundp 'color-values)
-              (ps-e-color-values "Green")
+              (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)))
+(defun ps-xemacs-mapper (extent list)
+  (when (featurep 'xemacs)
+    (nconc list
+          (list (list (extent-start-position extent) 'push extent)
+                (list (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-extent-sorter (a b)
+  (when (featurep 'xemacs)
+    (< (extent-priority a) (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)
-       (defvar coding-system-for-read)
-       (defvar buffer-file-coding-system)
-
-       (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)))
-       ))
+  (when (featurep 'xemacs)
+    (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)))))
+
+(when (featurep 'xemacs)
+  ;; to avoid XEmacs compilation gripes
+  (defvar coding-system-for-write)
+  (defvar coding-system-for-read)
+  (defvar buffer-file-coding-system)
+  
+  (and (fboundp 'find-coding-system)
+       (or (find-coding-system 'raw-text-unix)
+          (copy-coding-system 'no-conversion-unix 'raw-text-unix))))
+
+(defun ps-color-values (x-color)
+  (if (featurep 'xemacs)
+      (let ((color (ps-xemacs-color-name x-color)))
+       (cond
+        ((fboundp 'x-color-values)
+         (x-color-values color))
+        ((and (fboundp 'color-instance-rgb-components)
+              (ps-color-device))
+         (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"))))
+    (cond
+     ((fboundp 'color-values)
+      (color-values x-color))
+     ((fboundp 'x-color-values)
+      (x-color-values x-color))
+     (t
+      (error "No available function to determine X color values")))))
+
+(defun ps-face-bold-p (face)
+  (if (featurep 'xemacs)
+      (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
+         (memq face ps-bold-faces))    ; Kludge-compatible
+    (or (face-bold-p face)
+       (memq face ps-bold-faces))))
 
+(defun ps-face-italic-p (face)
+  (if (featurep 'xemacs)
+      (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
+    (or (face-italic-p face)
+       (memq face ps-italic-faces))))
 
 (defvar ps-print-color-scale 1.0)
 
@@ -6636,7 +6602,7 @@ If FACE is not a valid face name, use default face."
        ;; 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)
+         (map-extents 'ps-xemacs-mapper nil from to a)
          (setq a (sort (cdr a) 'car-less-than-car)
                extent-list nil)
 
@@ -6662,16 +6628,16 @@ If FACE is not a valid face name, use default face."
 
            (cond
             ((eq type 'push)
-             (and (ps-x-extent-face extent)
+             (and (extent-face extent)
                   (setq extent-list (sort (cons extent extent-list)
-                                          'ps-extent-sorter))))
+                                          'ps-xemacs-extent-sorter))))
 
             ((eq type 'pull)
              (setq extent-list (sort (delq extent extent-list)
-                                     'ps-extent-sorter))))
+                                     'ps-xemacs-extent-sorter))))
 
            (setq face (if extent-list
-                          (ps-x-extent-face (car extent-list))
+                          (extent-face (car extent-list))
                         'default)
                  from position
                  a (cdr a)))))
@@ -6688,7 +6654,7 @@ If FACE is not a valid face name, use default face."
                 (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)
+                (setq overlay-change (min (next-overlay-change from)
                                           to)))
            (setq position (min property-change overlay-change)
                  before-string nil
@@ -6709,22 +6675,22 @@ If FACE is not a valid face name, use default face."
                         'emacs--invisible--face)
                        ((get-text-property from 'face))
                        (t 'default)))
-           (let ((overlays (ps-e-overlays-at from))
+           (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
-                       (ps-e-overlay-get overlay 'invisible))
+                       (overlay-get overlay 'invisible))
                       (overlay-priority
-                       (or (ps-e-overlay-get overlay 'priority) 0)))
+                       (or (overlay-get overlay 'priority) 0)))
                  (and (> overlay-priority face-priority)
                       (setq before-string
-                            (or (ps-e-overlay-get overlay 'before-string)
+                            (or (overlay-get overlay 'before-string)
                                 before-string)
                             after-string
-                            (or (and (<= (ps-e-overlay-end overlay) position)
-                                     (ps-e-overlay-get overlay 'after-string))
+                            (or (and (<= (overlay-end overlay) position)
+                                     (overlay-get overlay 'after-string))
                                 after-string)
                             face-priority overlay-priority
                             face
@@ -6736,7 +6702,7 @@ If FACE is not a valid face name, use default face."
                                     (assq overlay-invisible
                                           save-buffer-invisibility-spec)))
                               'emacs--invisible--face)
-                             ((ps-e-overlay-get overlay 'face))
+                             ((overlay-get overlay 'face))
                              (t face)
                              ))))
                (setq overlays (cdr overlays))))