Mercurial > hg > xemacs-beta

changeset 5460:82e220b08ace

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Automatic merge.
author Stephen J. Turnbull <stephen@xemacs.org>
date Sun, 24 Apr 2011 01:01:34 +0900
parents 413bf5efaedb (current diff) 97968d099404 (diff)
children 568ec109e73d 248176c74e6b
files
diffstat 2 files changed, 35 insertions(+), 61 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun Apr 24 00:15:47 2011 +0900
+++ b/lisp/ChangeLog	Sun Apr 24 01:01:34 2011 +0900
@@ -1,3 +1,18 @@
+2011-04-23  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* font.el:
+	* font.el (font-warn): Removed.
+	* font.el (font-hex-string-to-number): Removed.
+	* font.el (internal-facep):
+	* font.el (font-lookup-rgb-components):
+	* font.el (font-parse-rgb-components):
+	Use #'string-to-number with the BASE argument instead of
+	#'font-hex-string-to-number, #'display-warning instead of
+	#'font-warn.
+	This entire file smells bitrotted, with lots of functions of very
+	little relevance to XEmacs, but addressing that is more work than
+	I can do today.
+
 2011-04-17  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl-extra.el:
--- a/lisp/font.el	Sun Apr 24 00:15:47 2011 +0900
+++ b/lisp/font.el	Sun Apr 24 01:01:34 2011 +0900
@@ -50,9 +50,6 @@
    get-fontset-info mswindows-define-rgb-color cancel-function-timers
    mswindows-font-regexp mswindows-canonicalize-font-name
    mswindows-parse-font-style mswindows-construct-font-style
-   ;; #### perhaps we should rewrite font-warn to avoid the warning
-   ;;   Eh, now I look at the code, we definitely should. 
-   font-warn
    fc-pattern-get-family fc-pattern-get-size fc-pattern-get-weight
    fc-font-weight-translate-from-constant make-fc-pattern
    fc-pattern-add-family fc-pattern-add-size))
@@ -1072,24 +1069,6 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Various color related things
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(cond
- ((fboundp 'display-warning)
-  (fset 'font-warn 'display-warning))
- ((fboundp 'w3-warn)
-  (fset 'font-warn 'w3-warn))
- ((fboundp 'url-warn)
-  (fset 'font-warn 'url-warn))
- ((fboundp 'warn)
-  (defun font-warn (class message &optional level)
-    (warn "(%s/%s) %s" class (or level 'warning) message)))
- (t
-  (defun font-warn (class message &optional level)
-    (save-excursion
-      (set-buffer (get-buffer-create "*W3-WARNINGS*"))
-      (goto-char (point-max))
-      (save-excursion
-	(insert (format "(%s/%s) %s\n" class (or level 'warning) message)))
-      (display-buffer (current-buffer))))))
 
 (defun font-lookup-rgb-components (color)
   "Lookup COLOR (a color name) in rgb.txt and return a list of RGB values.
@@ -1144,32 +1123,12 @@
 		  (setq r (* (read (current-buffer)) 256)
 			g (* (read (current-buffer)) 256)
 			b (* (read (current-buffer)) 256)))
-	      (font-warn 'color (format "No such color: %s" color))
+	      (display-warning 'color (format "No such color: %s" color))
 	      (setq r 0
 		    g 0
 		    b 0))
 	    (list r g b) ))))))
 
-(defun font-hex-string-to-number (string)
-  "Convert STRING to an integer by parsing it as a hexadecimal number."
-  (let ((conv-list '((?0 . 0) (?a . 10) (?A . 10)
-		     (?1 . 1) (?b . 11) (?B . 11)
-		     (?2 . 2) (?c . 12) (?C . 12)
-		     (?3 . 3) (?d . 13) (?D . 13)
-		     (?4 . 4) (?e . 14) (?E . 14)
-		     (?5 . 5) (?f . 15) (?F . 15)
-		     (?6 . 6)
-		     (?7 . 7)
-		     (?8 . 8)
-		     (?9 . 9)))
-	(n 0)
-	(i 0)
-	(lim (length string)))
-    (while (< i lim)
-      (setq n (+ (* n 16) (or (cdr (assq (aref string i) conv-list)) 0))
-	    i (1+ i)))
-    n ))
-
 (defun font-parse-rgb-components (color)
   "Parse RGB color specification and return a list of integers (R G B).
 #FEFEFE and rgb:fe/fe/fe style specifications are parsed."
@@ -1178,33 +1137,33 @@
   (cond ((string-match "^#[0-9a-f]+$" color)
 	 (cond
 	  ((eql (length color) 4)
-	   (setq r (font-hex-string-to-number (substring color 1 2))
-		 g (font-hex-string-to-number (substring color 2 3))
-		 b (font-hex-string-to-number (substring color 3 4))
+	   (setq r (string-to-number (substring color 1 2) 16)
+		 g (string-to-number (substring color 2 3) 16)
+		 b (string-to-number (substring color 3 4) 16)
 		 r (* r 4096)
 		 g (* g 4096)
 		 b (* b 4096)))
 	  ((eql (length color) 7)
-	   (setq r (font-hex-string-to-number (substring color 1 3))
-		 g (font-hex-string-to-number (substring color 3 5))
-		 b (font-hex-string-to-number (substring color 5 7))
+	   (setq r (string-to-number (substring color 1 3) 16)
+		 g (string-to-number (substring color 3 5) 16)
+		 b (string-to-number (substring color 5 7) 16)
 		 r (* r 256)
 		 g (* g 256)
 		 b (* b 256)))
 	  ((eql (length color) 10)
-	   (setq r (font-hex-string-to-number (substring color 1 4))
-		 g (font-hex-string-to-number (substring color 4 7))
-		 b (font-hex-string-to-number (substring color 7 10))
+	   (setq r (string-to-number (substring color 1 4) 16)
+		 g (string-to-number (substring color 4 7) 16)
+		 b (string-to-number (substring color 7 10) 16)
 		 r (* r 16)
 		 g (* g 16)
 		 b (* b 16)))
 	  ((eql (length color) 13)
-	   (setq r (font-hex-string-to-number (substring color 1 5))
-		 g (font-hex-string-to-number (substring color 5 9))
-		 b (font-hex-string-to-number (substring color 9 13))))
+	   (setq r (string-to-number (substring color 1 5) 16)
+		 g (string-to-number (substring color 5 9) 16)
+		 b (string-to-number (substring color 9 13) 16)))
 	  (t
-	   (font-warn 'color (format "Invalid RGB color specification: %s"
-				     color))
+	   (display-warning 'color
+	     (format "Invalid RGB color specification: %s" color))
 	   (setq r 0
 		 g 0
 		 b 0))))
@@ -1215,17 +1174,17 @@
 		 (> (- (match-end 3) (match-beginning 3)) 4))
 	     (error "Invalid RGB color specification: %s" color)
 	   (setq str (match-string 1 color)
-		 r (* (font-hex-string-to-number str)
+		 r (* (string-to-number str 16)
 		      (expt 16 (- 4 (length str))))
 		 str (match-string 2 color)
-		 g (* (font-hex-string-to-number str)
+		 g (* (string-to-number str 16)
 		      (expt 16 (- 4 (length str))))
 		 str (match-string 3 color)
-		 b (* (font-hex-string-to-number str)
+		 b (* (string-to-number str 16)
 		      (expt 16 (- 4 (length str)))))))
 	(t
-	 (font-warn 'html (format "Invalid RGB color specification: %s"
-				color))
+	 (display-warning 'color (format "Invalid RGB color specification: %s"
+					color))
 	 (setq r 0
 	       g 0
 	       b 0)))