commit: Automatic merge.
13 years, 8 months
Stephen J. Turnbull
Stephen J. Turnbull
changeset: 5404:82e220b08ace
tag: tip
parent: 5403:413bf5efaedb
parent: 5402:97968d099404
user: Stephen J. Turnbull <stephen(a)xemacs.org>
date: Sun Apr 24 01:01:34 2011 +0900
description:
Automatic merge.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Remove leftover conflict markers.
13 years, 8 months
Stephen J. Turnbull
Stephen J. Turnbull
changeset: 5403:413bf5efaedb
parent: 5401:4486ba63476b
user: Stephen J. Turnbull <stephen(a)xemacs.org>
date: Sun Apr 24 00:15:47 2011 +0900
files: src/ChangeLog
description:
Remove leftover conflict markers.
diff -r 4486ba63476b -r 413bf5efaedb src/ChangeLog
--- a/src/ChangeLog Sun Apr 17 16:27:02 2011 -0400
+++ b/src/ChangeLog Sun Apr 24 00:15:47 2011 +0900
＠＠ -94,8 +94,6 ＠＠
* unicode.c (Funicode_precedence_list): "occurrance" -> "occurrence".
* window.c (struct window_mirror_stats): "Ancilliary" -> "Ancillary".
-=======
->>>>>>> other
2011-03-20 Mats Lidell <matsl(a)xemacs.org>
* alloca.c (find_stack_direction):
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Replace #'font-hex-string-to-number, #'font-warn with builtins, font.el
13 years, 8 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1303572264 -3600
# Node ID 97968d09940453d434aa438a8e0fc143ffe645f1
# Parent 4486ba63476b3cb139e197da3a5ecedf2cc08100
Replace #'font-hex-string-to-number, #'font-warn with builtins, font.el
2011-04-23 Aidan Kehoe <kehoea(a)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.
Lines beginning with 'HG:' are removed.
diff -r 4486ba63476b -r 97968d099404 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Apr 17 16:27:02 2011 -0400
+++ b/lisp/ChangeLog Sat Apr 23 16:24:24 2011 +0100
＠＠ -1,3 +1,18 ＠＠
+2011-04-23 Aidan Kehoe <kehoea(a)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(a)parhasard.net>
* cl-extra.el:
diff -r 4486ba63476b -r 97968d099404 lisp/font.el
--- a/lisp/font.el Sun Apr 17 16:27:02 2011 -0400
+++ b/lisp/font.el Sat Apr 23 16:24:24 2011 +0100
＠＠ -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)))
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Replace #'font-hex-string-to-number, #'font-warn with builtins, font.el
13 years, 8 months
Aidan Kehoe
Aidan Kehoe
changeset: 5402:97968d099404
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Apr 23 16:24:24 2011 +0100
files: lisp/ChangeLog lisp/font.el
description:
Replace #'font-hex-string-to-number, #'font-warn with builtins, font.el
2011-04-23 Aidan Kehoe <kehoea(a)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.
Lines beginning with 'HG:' are removed.
diff -r 4486ba63476b -r 97968d099404 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Apr 17 16:27:02 2011 -0400
+++ b/lisp/ChangeLog Sat Apr 23 16:24:24 2011 +0100
＠＠ -1,3 +1,18 ＠＠
+2011-04-23 Aidan Kehoe <kehoea(a)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(a)parhasard.net>
* cl-extra.el:
diff -r 4486ba63476b -r 97968d099404 lisp/font.el
--- a/lisp/font.el Sun Apr 17 16:27:02 2011 -0400
+++ b/lisp/font.el Sat Apr 23 16:24:24 2011 +0100
＠＠ -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,31 +1123,11 ＠＠
(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).
＠＠ -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)))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Fix compile issues for C89 compilers. Use log() instead of log2().
13 years, 8 months
Jeff Sparkes
Jeff Sparkes
changeset: 5401:4486ba63476b
tag: tip
user: Jeff Sparkes <jsparkes(a)gmail.com>
date: Sun Apr 17 16:27:02 2011 -0400
files: src/ChangeLog src/device-tty.c
description:
Fix compile issues for C89 compilers. Use log() instead of log2().
diff -r aa78b0b0b289 -r 4486ba63476b src/ChangeLog
--- a/src/ChangeLog Sun Apr 17 11:14:38 2011 +0100
+++ b/src/ChangeLog Sun Apr 17 16:27:02 2011 -0400
＠＠ -1,3 +1,8 ＠＠
+2011-04-17 Jeff Sparkes <jsparkes(a)gmail.com>
+
+ * device-tty.c (tty_device_system_metrics): Fix compile issues for
+ C89 compilers. Use log() instead of log2().
+
2011-04-04 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (count_with_tail):
diff -r aa78b0b0b289 -r 4486ba63476b src/device-tty.c
--- a/src/device-tty.c Sun Apr 17 11:14:38 2011 +0100
+++ b/src/device-tty.c Sun Apr 17 16:27:02 2011 -0400
＠＠ -197,7 +197,11 ＠＠
return Fcons (make_int (CONSOLE_TTY_DATA (con)->width),
make_int (CONSOLE_TTY_DATA (con)->height));
case DM_num_bit_planes:
- return make_int (log2 (CONSOLE_TTY_DATA (con)->colors));
+ {
+ EMACS_INT l2 = (EMACS_INT) (log (CONSOLE_TTY_DATA (con)->colors)
+ / log (2));
+ return make_int (l2);
+ }
case DM_num_color_cells:
return make_int (CONSOLE_TTY_DATA (con)->colors);
default: /* No such device metric property for TTY devices */
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: issue 757 - tty device metric for num-color-cells
13 years, 8 months
Jeff Sparkes
Jeff Sparkes
changeset: 5398:5256fedd50e6
parent: 5382:d363790fd936
user: Jeff Sparkes <jsparkes(a)gmail.com>
date: Mon Mar 28 09:25:15 2011 -0400
files: src/ChangeLog src/console-tty-impl.h src/device-tty.c src/device.c src/redisplay-tty.c
description:
issue 757 - tty device metric for num-color-cells
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2011-03-28 Jeff Sparkes <jsparkes(a)gmail.com>
* console-tty-impl.h (struct tty_console): Add field for number of
displayable colors.
* device-tty.c (tty_device_system_metrics): Return metrics for
num-color-cells and num-bit-planes. Tracker issue 757.
* device.c: There are two required args for device-system-metric.
* redisplay-tty.c (init_tty_for_redisplay): Retrieve number of
colors from terminal description. Default to 2 if none found.
diff -r d363790fd936 -r 5256fedd50e6 src/ChangeLog
--- a/src/ChangeLog Wed Mar 23 00:08:35 2011 +0100
+++ b/src/ChangeLog Mon Mar 28 09:25:15 2011 -0400
＠＠ -1,3 +1,13 ＠＠
+2011-03-28 Jeff Sparkes <jsparkes(a)gmail.com>
+
+ * console-tty-impl.h (struct tty_console): Add field for number of
+ displayable colors.
+ * device-tty.c (tty_device_system_metrics): Return metrics for
+ num-color-cells and num-bit-planes. Tracker issue 757.
+ * device.c: There are two required args for device-system-metric.
+ * redisplay-tty.c (init_tty_for_redisplay): Retrieve number of
+ colors from terminal description. Default to 2 if none found.
+
2011-03-20 Mats Lidell <matsl(a)xemacs.org>
* alloca.c (find_stack_direction):
diff -r d363790fd936 -r 5256fedd50e6 src/console-tty-impl.h
--- a/src/console-tty-impl.h Wed Mar 23 00:08:35 2011 +0100
+++ b/src/console-tty-impl.h Mon Mar 28 09:25:15 2011 -0400
＠＠ -62,6 +62,8 ＠＠
int height;
int width;
+
+ int colors;
/* The count of frame number. */
int frame_count;
diff -r d363790fd936 -r 5256fedd50e6 src/device-tty.c
--- a/src/device-tty.c Wed Mar 23 00:08:35 2011 +0100
+++ b/src/device-tty.c Mon Mar 28 09:25:15 2011 -0400
＠＠ -196,6 +196,10 ＠＠
case DM_size_device:
return Fcons (make_int (CONSOLE_TTY_DATA (con)->width),
make_int (CONSOLE_TTY_DATA (con)->height));
+ case DM_num_bit_planes:
+ return make_int (log2 (CONSOLE_TTY_DATA (con)->colors));
+ case DM_num_color_cells:
+ return make_int (CONSOLE_TTY_DATA (con)->colors);
default: /* No such device metric property for TTY devices */
return Qunbound;
}
diff -r d363790fd936 -r 5256fedd50e6 src/device.c
--- a/src/device.c Wed Mar 23 00:08:35 2011 +0100
+++ b/src/device.c Mon Mar 28 09:25:15 2011 -0400
＠＠ -1057,8 +1057,8 ＠＠
return DEVICE_PRINTER_P (decode_device (device)) ? Qt : Qnil;
}
-DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /*
-Get a metric for DEVICE as provided by the system.
+DEFUN ("device-system-metric", Fdevice_system_metric, 2, 3, 0, /*
+Get DEVICE METRIC as provided by the system.
METRIC must be a symbol specifying requested metric. Note that the metrics
returned are these provided by the system internally, not read from resources,
diff -r d363790fd936 -r 5256fedd50e6 src/redisplay-tty.c
--- a/src/redisplay-tty.c Wed Mar 23 00:08:35 2011 +0100
+++ b/src/redisplay-tty.c Mon Mar 28 09:25:15 2011 -0400
＠＠ -1116,6 +1116,13 ＠＠
if (CONSOLE_TTY_DATA (c)->width <= 0 || CONSOLE_TTY_DATA (c)->height <= 0)
return TTY_SIZE_UNSPECIFIED;
+ CONSOLE_TTY_DATA (c)->colors = tgetnum("Co");
+ if (CONSOLE_TTY_DATA (c)->colors == 0)
+ CONSOLE_TTY_DATA (c)->colors = tgetnum("colors");
+ if (CONSOLE_TTY_DATA (c)->colors == 0)
+ /* There is always foreground and background. */
+ CONSOLE_TTY_DATA (c)->colors = 2;
+
/*
* Initialize cursor motion information.
*/
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 4 participants
- 6 comments
[COMMIT] Add various Common Lisp character functions, making porting CL code easier.
13 years, 8 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1303035278 -3600
# Node ID aa78b0b0b289dbe8abf452285b31b3de3bb645e2
# Parent 5ec4534daf1664edc0120d99486e71cb82827c7a
Add various Common Lisp character functions, making porting CL code easier.
2011-04-17 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el:
* cl-extra.el ('char<): New.
* cl-extra.el ('char>=): New.
* cl-extra.el ('char>): New.
* cl-extra.el ('char<=): New.
* cl-extra.el (alpha-char-p): New.
* cl-extra.el (graphic-char-p): New.
* cl-extra.el (standard-char-p): New.
* cl-extra.el (char-name): New.
* cl-extra.el (name-char): New.
* cl-extra.el (upper-case-p): New.
* cl-extra.el (lower-case-p): New.
* cl-extra.el (both-case-p): New.
* cl-extra.el (char-upcase): New.
* cl-extra.el (char-downcase): New.
* cl-extra.el (integer-length): New.
Add various functions dealing (mainly) with characters, making
some Common Lisp code easier to port.
* descr-text.el (describe-char-unicode-data):
Add an autoload for this function, used by #'char-name.
diff -r 5ec4534daf16 -r aa78b0b0b289 lisp/ChangeLog
--- a/lisp/ChangeLog Thu Apr 14 08:40:18 2011 -0400
+++ b/lisp/ChangeLog Sun Apr 17 11:14:38 2011 +0100
＠＠ -1,3 +1,26 ＠＠
+2011-04-17 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-extra.el:
+ * cl-extra.el ('char<): New.
+ * cl-extra.el ('char>=): New.
+ * cl-extra.el ('char>): New.
+ * cl-extra.el ('char<=): New.
+ * cl-extra.el (alpha-char-p): New.
+ * cl-extra.el (graphic-char-p): New.
+ * cl-extra.el (standard-char-p): New.
+ * cl-extra.el (char-name): New.
+ * cl-extra.el (name-char): New.
+ * cl-extra.el (upper-case-p): New.
+ * cl-extra.el (lower-case-p): New.
+ * cl-extra.el (both-case-p): New.
+ * cl-extra.el (char-upcase): New.
+ * cl-extra.el (char-downcase): New.
+ * cl-extra.el (integer-length): New.
+ Add various functions dealing (mainly) with characters, making
+ some Common Lisp code easier to port.
+ * descr-text.el (describe-char-unicode-data):
+ Add an autoload for this function, used by #'char-name.
+
2011-04-12 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/mule-win32-init.el (windows-874):
diff -r 5ec4534daf16 -r aa78b0b0b289 lisp/cl-extra.el
--- a/lisp/cl-extra.el Thu Apr 14 08:40:18 2011 -0400
+++ b/lisp/cl-extra.el Sun Apr 17 11:14:38 2011 +0100
＠＠ -690,6 +690,138 ＠＠
(setq float-negative-epsilon (* x 2))))))
(cl-float-limits))
+;; No type-checking here, we should add it.
+(defalias 'char< '<)
+(defalias 'char>= '>=)
+(defalias 'char> '>)
+(defalias 'char<= '<=)
+
+;;; Character functions.
+(defun* digit-char-p (character &optional (radix 10))
+ "Return non-nil if CHARACTER represents a digit in base RADIX.
+
+RADIX defaults to ten. The actual non-nil value returned is the integer
+value of the character in base RADIX."
+ (check-type character character)
+ (check-type radix integer)
+ (if (<= radix 10)
+ (and (<= ?0 character (+ ?0 radix -1)) (- character ?0))
+ (or (and (<= ?0 character ?9) (- character ?0))
+ (and (<= ?a character (+ ?a (setq radix (- radix 11))))
+ (+ character (- 10 ?a)))
+ (and (<= ?A character (+ ?A radix))
+ (+ character (- 10 ?A))))))
+
+(defun* digit-char (weight &optional (radix 10))
+ "Return a character representing the integer WEIGHT in base RADIX.
+
+RADIX defaults to ten. If no such character exists, return nil."
+ (check-type weight integer)
+ (check-type radix integer)
+ (and (natnump weight) (< weight radix)
+ (if (< weight 10)
+ (int-char (+ ?0 weight))
+ (int-char (+ ?A (- weight 10))))))
+
+(defun alpha-char-p (character)
+ "Return t if CHARACTER is alphabetic, in some alphabet.
+
+Han characters are regarded as alphabetic."
+ (check-type character character)
+ (and (eql ?w (char-syntax character (standard-syntax-table)))
+ (not (<= ?0 character ?9))))
+
+(defun graphic-char-p (character)
+ "Return t if CHARACTER is not a control character.
+
+Control characters are those in the range ?\\x00 to ?\\x15 and ?\\x7f to
+?\\x9f, inclusive."
+ (check-type character character)
+ (not (or (<= ?\x00 character ?\x1f) (<= ?\x7f character ?\x9f))))
+
+(defun standard-char-p (character)
+ "Return t if CHARACTER is one of Common Lisp's standard characters.
+
+These are the non-control ASCII characters, plus the newline character."
+ (check-type character character)
+ (or (<= ?\x20 character ?\x7e) (eql character ?\n)))
+
+(symbol-macrolet
+ ((names '((?\x08 . "Backspace") (?\x09 . "Tab") (?\x0a . "Newline")
+ (?\x0C . "Page") (?\x0d . "Return") (?\x20 . "Space")
+ (?\x7f . "Rubout"))))
+
+ (defun char-name (character)
+ "Return a string naming CHARACTER.
+
+For the limited number of characters where the character name has been
+specified by Common Lisp, this always returns the appropriate string
+name. Otherwise, `char-name' requires that the Unicode database be
+available; see `describe-char-unicode-data'."
+ (check-type character character)
+ (or (cdr (assq character names))
+ (let ((unicode-data
+ (assoc "Name" (describe-char-unicode-data character))))
+ (and unicode-data
+ (if (string-match "^<[^>]+>$" (cadr unicode-data))
+ (format "U%04X" (char-to-unicode character))
+ (replace-in-string (cadr unicode-data) " " "_" t))))))
+
+ (defun name-char (name)
+ "Return a character with name NAME, a string."
+ (or (car (rassoc* name names :test #'equalp))
+ (if (string-match "^[uU][0-9A-Fa-f]+$" name)
+ (unicode-to-char (string-to-number (subseq name 1) 16))
+ (with-current-buffer (get-buffer-create " *Unicode Data*")
+ (require 'descr-text)
+ (when (zerop (buffer-size))
+ ;; Don't use -literally in case of DOS line endings.
+ (insert-file-contents describe-char-unicodedata-file))
+ (goto-char (point-min))
+ (setq case-fold-search nil)
+ (and (re-search-forward (format #r"^\([0-9A-F]\{4,6\}\);%s;"
+ (upcase (replace-in-string
+ name "_" " " t))) nil t)
+ (unicode-to-char (string-to-number (match-string 1) 16))))))))
+
+(defun upper-case-p (character)
+ "Return t if CHARACTER is majuscule in the standard case table."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table)
+ (not (eq character (downcase character)))))
+
+(defun lower-case-p (character)
+ "Return t if CHARACTER is minuscule in the standard case table."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table)
+ (not (eq character (upcase character)))))
+
+(defun both-case-p (character)
+ "Return t if CHARACTER has case information in the standard case table."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table)
+ (or (not (eq character (upcase character)))
+ (not (eq character (downcase character))))))
+
+(defun char-upcase (character)
+ "If CHARACTER is lowercase, return its corresponding uppercase character.
+Otherwise, return CHARACTER."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table) (upcase character)))
+
+(defun char-downcase (character)
+ "If CHARACTER is uppercase, return its corresponding lowercase character.
+Otherwise, return CHARACTER."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table) (downcase character)))
+
+(defun integer-length (integer)
+ "Return the number of bits need to represent INTEGER in two's complement."
+ (ecase (signum integer)
+ (0 0)
+ (-1 (1- (length (format "%b" (- integer)))))
+ (1 (length (format "%b" integer)))))
+
(run-hooks 'cl-extra-load-hook)
;; XEmacs addition
diff -r 5ec4534daf16 -r aa78b0b0b289 lisp/descr-text.el
--- a/lisp/descr-text.el Thu Apr 14 08:40:18 2011 -0400
+++ b/lisp/descr-text.el Sun Apr 17 11:14:38 2011 +0100
＠＠ -675,6 +675,7 ＠＠
database-file-name)))
;; End XEmacs additions.
+;;;###autoload
(defun describe-char-unicode-data (char)
"Return a list of Unicode data for unicode CHAR.
Each element is a list of a property description and the property value.
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Add various Common Lisp character functions, making porting CL code easier.
13 years, 8 months
Aidan Kehoe
Aidan Kehoe
changeset: 5400:aa78b0b0b289
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Apr 17 11:14:38 2011 +0100
files: lisp/ChangeLog lisp/cl-extra.el lisp/descr-text.el
description:
Add various Common Lisp character functions, making porting CL code easier.
2011-04-17 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el:
* cl-extra.el ('char<): New.
* cl-extra.el ('char>=): New.
* cl-extra.el ('char>): New.
* cl-extra.el ('char<=): New.
* cl-extra.el (alpha-char-p): New.
* cl-extra.el (graphic-char-p): New.
* cl-extra.el (standard-char-p): New.
* cl-extra.el (char-name): New.
* cl-extra.el (name-char): New.
* cl-extra.el (upper-case-p): New.
* cl-extra.el (lower-case-p): New.
* cl-extra.el (both-case-p): New.
* cl-extra.el (char-upcase): New.
* cl-extra.el (char-downcase): New.
* cl-extra.el (integer-length): New.
Add various functions dealing (mainly) with characters, making
some Common Lisp code easier to port.
* descr-text.el (describe-char-unicode-data):
Add an autoload for this function, used by #'char-name.
diff -r 5ec4534daf16 -r aa78b0b0b289 lisp/ChangeLog
--- a/lisp/ChangeLog Thu Apr 14 08:40:18 2011 -0400
+++ b/lisp/ChangeLog Sun Apr 17 11:14:38 2011 +0100
＠＠ -1,3 +1,26 ＠＠
+2011-04-17 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-extra.el:
+ * cl-extra.el ('char<): New.
+ * cl-extra.el ('char>=): New.
+ * cl-extra.el ('char>): New.
+ * cl-extra.el ('char<=): New.
+ * cl-extra.el (alpha-char-p): New.
+ * cl-extra.el (graphic-char-p): New.
+ * cl-extra.el (standard-char-p): New.
+ * cl-extra.el (char-name): New.
+ * cl-extra.el (name-char): New.
+ * cl-extra.el (upper-case-p): New.
+ * cl-extra.el (lower-case-p): New.
+ * cl-extra.el (both-case-p): New.
+ * cl-extra.el (char-upcase): New.
+ * cl-extra.el (char-downcase): New.
+ * cl-extra.el (integer-length): New.
+ Add various functions dealing (mainly) with characters, making
+ some Common Lisp code easier to port.
+ * descr-text.el (describe-char-unicode-data):
+ Add an autoload for this function, used by #'char-name.
+
2011-04-12 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/mule-win32-init.el (windows-874):
diff -r 5ec4534daf16 -r aa78b0b0b289 lisp/cl-extra.el
--- a/lisp/cl-extra.el Thu Apr 14 08:40:18 2011 -0400
+++ b/lisp/cl-extra.el Sun Apr 17 11:14:38 2011 +0100
＠＠ -690,6 +690,138 ＠＠
(setq float-negative-epsilon (* x 2))))))
(cl-float-limits))
+;; No type-checking here, we should add it.
+(defalias 'char< '<)
+(defalias 'char>= '>=)
+(defalias 'char> '>)
+(defalias 'char<= '<=)
+
+;;; Character functions.
+(defun* digit-char-p (character &optional (radix 10))
+ "Return non-nil if CHARACTER represents a digit in base RADIX.
+
+RADIX defaults to ten. The actual non-nil value returned is the integer
+value of the character in base RADIX."
+ (check-type character character)
+ (check-type radix integer)
+ (if (<= radix 10)
+ (and (<= ?0 character (+ ?0 radix -1)) (- character ?0))
+ (or (and (<= ?0 character ?9) (- character ?0))
+ (and (<= ?a character (+ ?a (setq radix (- radix 11))))
+ (+ character (- 10 ?a)))
+ (and (<= ?A character (+ ?A radix))
+ (+ character (- 10 ?A))))))
+
+(defun* digit-char (weight &optional (radix 10))
+ "Return a character representing the integer WEIGHT in base RADIX.
+
+RADIX defaults to ten. If no such character exists, return nil."
+ (check-type weight integer)
+ (check-type radix integer)
+ (and (natnump weight) (< weight radix)
+ (if (< weight 10)
+ (int-char (+ ?0 weight))
+ (int-char (+ ?A (- weight 10))))))
+
+(defun alpha-char-p (character)
+ "Return t if CHARACTER is alphabetic, in some alphabet.
+
+Han characters are regarded as alphabetic."
+ (check-type character character)
+ (and (eql ?w (char-syntax character (standard-syntax-table)))
+ (not (<= ?0 character ?9))))
+
+(defun graphic-char-p (character)
+ "Return t if CHARACTER is not a control character.
+
+Control characters are those in the range ?\\x00 to ?\\x15 and ?\\x7f to
+?\\x9f, inclusive."
+ (check-type character character)
+ (not (or (<= ?\x00 character ?\x1f) (<= ?\x7f character ?\x9f))))
+
+(defun standard-char-p (character)
+ "Return t if CHARACTER is one of Common Lisp's standard characters.
+
+These are the non-control ASCII characters, plus the newline character."
+ (check-type character character)
+ (or (<= ?\x20 character ?\x7e) (eql character ?\n)))
+
+(symbol-macrolet
+ ((names '((?\x08 . "Backspace") (?\x09 . "Tab") (?\x0a . "Newline")
+ (?\x0C . "Page") (?\x0d . "Return") (?\x20 . "Space")
+ (?\x7f . "Rubout"))))
+
+ (defun char-name (character)
+ "Return a string naming CHARACTER.
+
+For the limited number of characters where the character name has been
+specified by Common Lisp, this always returns the appropriate string
+name. Otherwise, `char-name' requires that the Unicode database be
+available; see `describe-char-unicode-data'."
+ (check-type character character)
+ (or (cdr (assq character names))
+ (let ((unicode-data
+ (assoc "Name" (describe-char-unicode-data character))))
+ (and unicode-data
+ (if (string-match "^<[^>]+>$" (cadr unicode-data))
+ (format "U%04X" (char-to-unicode character))
+ (replace-in-string (cadr unicode-data) " " "_" t))))))
+
+ (defun name-char (name)
+ "Return a character with name NAME, a string."
+ (or (car (rassoc* name names :test #'equalp))
+ (if (string-match "^[uU][0-9A-Fa-f]+$" name)
+ (unicode-to-char (string-to-number (subseq name 1) 16))
+ (with-current-buffer (get-buffer-create " *Unicode Data*")
+ (require 'descr-text)
+ (when (zerop (buffer-size))
+ ;; Don't use -literally in case of DOS line endings.
+ (insert-file-contents describe-char-unicodedata-file))
+ (goto-char (point-min))
+ (setq case-fold-search nil)
+ (and (re-search-forward (format #r"^\([0-9A-F]\{4,6\}\);%s;"
+ (upcase (replace-in-string
+ name "_" " " t))) nil t)
+ (unicode-to-char (string-to-number (match-string 1) 16))))))))
+
+(defun upper-case-p (character)
+ "Return t if CHARACTER is majuscule in the standard case table."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table)
+ (not (eq character (downcase character)))))
+
+(defun lower-case-p (character)
+ "Return t if CHARACTER is minuscule in the standard case table."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table)
+ (not (eq character (upcase character)))))
+
+(defun both-case-p (character)
+ "Return t if CHARACTER has case information in the standard case table."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table)
+ (or (not (eq character (upcase character)))
+ (not (eq character (downcase character))))))
+
+(defun char-upcase (character)
+ "If CHARACTER is lowercase, return its corresponding uppercase character.
+Otherwise, return CHARACTER."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table) (upcase character)))
+
+(defun char-downcase (character)
+ "If CHARACTER is uppercase, return its corresponding lowercase character.
+Otherwise, return CHARACTER."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table) (downcase character)))
+
+(defun integer-length (integer)
+ "Return the number of bits need to represent INTEGER in two's complement."
+ (ecase (signum integer)
+ (0 0)
+ (-1 (1- (length (format "%b" (- integer)))))
+ (1 (length (format "%b" integer)))))
+
(run-hooks 'cl-extra-load-hook)
;; XEmacs addition
diff -r 5ec4534daf16 -r aa78b0b0b289 lisp/descr-text.el
--- a/lisp/descr-text.el Thu Apr 14 08:40:18 2011 -0400
+++ b/lisp/descr-text.el Sun Apr 17 11:14:38 2011 +0100
＠＠ -675,6 +675,7 ＠＠
database-file-name)))
;; End XEmacs additions.
+;;;###autoload
(defun describe-char-unicode-data (char)
"Return a list of Unicode data for unicode CHAR.
Each element is a list of a property description and the property value.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Merge tty display color cells change that I couldn't push.
13 years, 8 months
Jeff Sparkes
Jeff Sparkes
changeset: 5399:5ec4534daf16
tag: tip
parent: 5397:a63e666bb68a
parent: 5398:5256fedd50e6
user: Jeff Sparkes <jsparkes(a)gmail.com>
date: Thu Apr 14 08:40:18 2011 -0400
files: src/ChangeLog
description:
Merge tty display color cells change that I couldn't push.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] No longer create windows-874 as a Win32-specific coding system; thanks Mats!
13 years, 9 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1302609667 -3600
# Node ID a63e666bb68adcbfb8fbc0cf11320dc6fa2ac08c
# Parent 75469840109bcd2bc7f84f30e9e9e9f26f9b1c36
No longer create windows-874 as a Win32-specific coding system; thanks Mats!
2011-04-12 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/mule-win32-init.el (windows-874):
No longer create this coding system, now it's provided by thai.el;
thanks for the report of the associated Win32 build problem, Mats!
diff -r 75469840109b -r a63e666bb68a lisp/ChangeLog
--- a/lisp/ChangeLog Fri Apr 08 14:44:20 2011 +0100
+++ b/lisp/ChangeLog Tue Apr 12 13:01:07 2011 +0100
＠＠ -1,3 +1,9 ＠＠
+2011-04-12 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * mule/mule-win32-init.el (windows-874):
+ No longer create this coding system, now it's provided by thai.el;
+ thanks for the report of the associated Win32 build problem, Mats!
+
2011-04-08 Aidan Kehoe <kehoea(a)parhasard.net>
* unicode.el (load-unicode-tables):
diff -r 75469840109b -r a63e666bb68a lisp/mule/mule-win32-init.el
--- a/lisp/mule/mule-win32-init.el Fri Apr 08 14:44:20 2011 +0100
+++ b/lisp/mule/mule-win32-init.el Tue Apr 12 13:01:07 2011 +0100
＠＠ -141,7 +141,7 ＠＠
("OEM" 865 no-conversion "MS-DOS Nordic")
; ("OEM" 866 no-conversion "MS-DOS Russian")
("OEM" 869 no-conversion "IBM Modern Greek")
- ("Ansi/OEM" 874 no-conversion "Thai")
+ ; ("Ansi/OEM" 874 no-conversion "Thai")
("EBCDIC" 875 no-conversion "EBCDIC")
("Ansi/OEM" 932 shift_jis "Japanese")
("Ansi/OEM" 936 iso_8_2 "Chinese (PRC, Singapore)")
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments