Mercurial > emacs

changeset 85763:3b291390be13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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.
author Dan Nicolaescu <dann@ics.uci.edu>
date Mon, 29 Oct 2007 16:45:23 +0000
parents 29e75576e47f
children e12efff1fa77
files lisp/ChangeLog lisp/ps-print.el
diffstat 2 files changed, 116 insertions(+), 127 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Mon Oct 29 15:33:04 2007 +0000
+++ b/lisp/ChangeLog	Mon Oct 29 16:45:23 2007 +0000
@@ -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):
--- a/lisp/ps-print.el	Mon Oct 29 15:33:04 2007 +0000
+++ b/lisp/ps-print.el	Mon Oct 29 16:45:23 2007 +0000
@@ -1481,32 +1481,7 @@
 
 ;; 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 @@
 
 
 (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 @@
     (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 @@
 		  (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 @@
 	;; 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 @@
 
 	    (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 @@
 		 (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 @@
 			 '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 @@
 				     (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))))