aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaroly Lorentey2004-06-05 17:21:43 +0000
committerKaroly Lorentey2004-06-05 17:21:43 +0000
commit3d63dd9d07a4ce2fbff5c4dd674f2593c1e3a278 (patch)
tree148939ccc16f4f81c8231987a0556ec21d529e7b
parentbf2d7b586bf6add7527739fcbdc007e921259397 (diff)
parent8e330b2257db682ec067cdd72d8e7a4580f97505 (diff)
downloademacs-3d63dd9d07a4ce2fbff5c4dd674f2593c1e3a278.tar.gz
emacs-3d63dd9d07a4ce2fbff5c4dd674f2593c1e3a278.zip
Merged in changes from CVS trunk.
Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-366 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-367 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-368 Improve display-supports-face-attributes-p on non-ttys * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-369 Rewrite face-differs-from-default-p * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-370 Move `display-supports-face-attributes-p' entirely into C code * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-371 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372 Simplify face-differs-from-default-p; don't consider :stipple. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-373 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-374 (tty_supports_face_attributes_p): Ensure attributes differ from default * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-375 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-185
-rw-r--r--etc/NEWS7
-rw-r--r--lisp/ChangeLog62
-rw-r--r--lisp/battery.el45
-rw-r--r--lisp/faces.el62
-rw-r--r--lisp/help-fns.el17
-rw-r--r--lisp/textmodes/table.el17
-rw-r--r--lisp/vc-svn.el5
-rw-r--r--lisp/woman.el104
-rw-r--r--lispref/display.texi6
-rw-r--r--nt/ChangeLog6
-rw-r--r--nt/INSTALL47
-rw-r--r--src/ChangeLog23
-rw-r--r--src/xfaces.c599
13 files changed, 635 insertions, 365 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 07f0f09739a..d1fc40d036d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -107,7 +107,8 @@ C-c <left> and C-c <right>, respectively. This is an incompatible change.
107 107
108** Help commands `describe-funcion' and `describe-key' now show function 108** Help commands `describe-funcion' and `describe-key' now show function
109arguments in lowercase italics on displays that support it. To change the 109arguments in lowercase italics on displays that support it. To change the
110default, redefine the function `help-default-arg-highlight'. 110default, customize face `help-argument-name' or redefine the function
111`help-default-arg-highlight'.
111 112
112--- 113---
113** The comint prompt can now be made read-only, using the new user 114** The comint prompt can now be made read-only, using the new user
@@ -3032,6 +3033,10 @@ A new predicate `supports' has also been added to the `defface' face
3032specification language, which can be used to do this test for faces 3033specification language, which can be used to do this test for faces
3033defined with defface. 3034defined with defface.
3034 3035
3036** The function face-differs-from-default-p now truly checks whether the
3037given face displays differently from the default face or not (previously
3038it did only a very cursory check).
3039
3035+++ 3040+++
3036** face-attribute, face-foreground, face-background, and face-stipple now 3041** face-attribute, face-foreground, face-background, and face-stipple now
3037accept a new optional argument, INHERIT, which controls how face 3042accept a new optional argument, INHERIT, which controls how face
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 83f8a0e1cf0..3922ef9bf41 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,59 @@
12004-06-05 Juanma Barranquero <lektu@terra.es>
2
3 * help-fns.el (help-argument-name): Reintroduce face.
4 (help-default-arg-highlight): Use it, now that
5 `face-differs-from-default-p' can be trusted.
6
72004-06-05 Matt Hodges <matt@stchem.bham.ac.uk> (tiny change)
8
9 * textmodes/table.el: Sentence commands added to Point Motion
10 group; kill and backward-kill commands added to Extraction group.
11
122004-06-04 Mario Lang <mlang@delysid.org>
13
14 * battery.el (battery-linux-proc-acpi): mA was hardcored, but some
15 systems appear to use mW, make the code handle this. Fix a
16 division-by-zero bug while at it, and handle kernels with
17 a slightly different layout in /proc/acpi.
18
192004-06-04 Karl Fogel <kfogel@red-bean.com>
20
21 * vc-svn.el (vc-svn-checkin): Use 'nconc' instead of 'list*',
22 because the latter is a CL-ism. This fixes the bug reported by
23 Shawn Boyette <mdxi@collapsar.net> in
24 http://lists.gnu.org/archive/html/emacs-devel/2004-05/msg00442.html.
25
262004-06-04 Miles Bader <miles@gnu.org>
27
28 * faces.el (display-supports-face-attributes-p): Function moved to
29 C code. Previously only the tty-related portion of this function
30 was done in C; however the previous attempt to do a halfway-proper
31 job for non-tty displays in lisp didn't work properly because of
32 funny conditions during Emacs startup.
33 (face-differs-from-default-p): Simplify, now that
34 display-supports-face-attributes-p works properly on all display
35 types. Remove :stipple from comparison; it doesn't really work
36 in emacs anyway.
37
382004-06-04 Miles Bader <miles@gnu.org>
39
40 * faces.el (face-differs-from-default-p): Use a different
41 implementation, so we can really check whether FACE displays
42 differently or not.
43
442004-06-04 Miles Bader <miles@gnu.org>
45
46 * faces.el (display-supports-face-attributes-p): Implement a
47 `different from default' check for non-tty displays.
48
492004-06-03 David Kastrup <dak@gnu.org>
50
51 * woman.el (woman-mapcan): More concise code.
52 (woman-topic-all-completions, woman-topic-all-completions-1)
53 (woman-topic-all-completions-merge): Replace by a simpler and
54 much faster implementation based on O(n log n) sort/merge instead
55 of the old O(n^2) behavior.
56
12004-06-03 Miles Bader <miles@gnu.org> 572004-06-03 Miles Bader <miles@gnu.org>
2 58
3 * subr.el (read-number): Use canonical format for default in prompt. 59 * subr.el (read-number): Use canonical format for default in prompt.
@@ -193,7 +249,7 @@
193 * thumbs.el (thumbs-show-name): Do nothing if no image at point. 249 * thumbs.el (thumbs-show-name): Do nothing if no image at point.
194 (thumbs-mouse-find-image): New command. 250 (thumbs-mouse-find-image): New command.
195 (thumbs-mode-map): Bind it to mouse-2. 251 (thumbs-mode-map): Bind it to mouse-2.
196 (thumbs-mode): Make mode-class special. 252 (thumbs-mode): Make mode-class special.
197 (thumbs-view-image-mode): Likewise. 253 (thumbs-view-image-mode): Likewise.
198 254
1992004-05-29 Pavel Kobiakov <pk_at_work@yahoo.com> 2552004-05-29 Pavel Kobiakov <pk_at_work@yahoo.com>
@@ -1382,7 +1438,7 @@
1382 (sql-connect-postgres): Add username prompt. 1438 (sql-connect-postgres): Add username prompt.
1383 (sql-imenu-generic-expression, sql-mode-font-lock-object-name): 1439 (sql-imenu-generic-expression, sql-mode-font-lock-object-name):
1384 Make patterns less product specific. 1440 Make patterns less product specific.
1385 (sql-xemacs-p, sql-emacs19-p): Add flags for emacs variants. 1441 (sql-xemacs-p, sql-emacs19-p): Add flags for Emacs variants.
1386 (sql-mode-abbrev-table): Modify initialization. 1442 (sql-mode-abbrev-table): Modify initialization.
1387 (sql-builtin-face): Add variable. 1443 (sql-builtin-face): Add variable.
1388 (sql-keywords-re): Add macro. 1444 (sql-keywords-re): Add macro.
@@ -6381,7 +6437,7 @@
6381 (ffap-file-at-point): Use the new regexp to strip the prompts from 6437 (ffap-file-at-point): Use the new regexp to strip the prompts from
6382 the file names. This is an issue mostly for user prompts that 6438 the file names. This is an issue mostly for user prompts that
6383 don't have a trailing space and find-file-at-point is invoked from 6439 don't have a trailing space and find-file-at-point is invoked from
6384 within a shell inside emacs. 6440 within a shell inside Emacs.
6385 6441
63862003-09-24 Andre Spiegel <spiegel@gnu.org> 64422003-09-24 Andre Spiegel <spiegel@gnu.org>
6387 6443
diff --git a/lisp/battery.el b/lisp/battery.el
index c82d3ac02b3..73d78067571 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -61,7 +61,7 @@ introduced by a `%' character in a control string."
61 (cond ((eq battery-status-function 'battery-linux-proc-apm) 61 (cond ((eq battery-status-function 'battery-linux-proc-apm)
62 "Power %L, battery %B (%p%% load, remaining time %t)") 62 "Power %L, battery %B (%p%% load, remaining time %t)")
63 ((eq battery-status-function 'battery-linux-proc-acpi) 63 ((eq battery-status-function 'battery-linux-proc-acpi)
64 "Power %L, battery %B at %r mA (%p%% load, remaining time %t)")) 64 "Power %L, battery %B at %r (%p%% load, remaining time %t)"))
65 "*Control string formatting the string to display in the echo area. 65 "*Control string formatting the string to display in the echo area.
66Ordinary characters in the control string are printed as-is, while 66Ordinary characters in the control string are printed as-is, while
67conversion specifications introduced by a `%' character in the control 67conversion specifications introduced by a `%' character in the control
@@ -243,7 +243,8 @@ The following %-sequences are provided:
243%m Remaining time in minutes 243%m Remaining time in minutes
244%h Remaining time in hours 244%h Remaining time in hours
245%t Remaining time in the form `h:min'" 245%t Remaining time in the form `h:min'"
246 (let (capacity design-capacity rate charging-state warn low minutes hours) 246 (let (capacity design-capacity rate rate-type charging-state warn low
247 minutes hours)
247 (when (file-directory-p "/proc/acpi/battery/") 248 (when (file-directory-p "/proc/acpi/battery/")
248 ;; ACPI provides information about each battery present in the system in 249 ;; ACPI provides information about each battery present in the system in
249 ;; a separate subdirectory. We are going to merge the available 250 ;; a separate subdirectory. We are going to merge the available
@@ -261,32 +262,41 @@ The following %-sequences are provided:
261 ;; battery is "charging"/"discharging", the others are 262 ;; battery is "charging"/"discharging", the others are
262 ;; "unknown". 263 ;; "unknown".
263 (setq charging-state (match-string 1))) 264 (setq charging-state (match-string 1)))
264 (when (re-search-forward "present rate: +\\([0-9]+\\) mA$" nil t) 265 (when (re-search-forward "present rate: +\\([0-9]+\\) \\(m[AW]\\)$"
265 (setq rate (+ (or rate 0) (string-to-int (match-string 1))))) 266 nil t)
266 (when (re-search-forward "remaining capacity: +\\([0-9]+\\) mAh$" 267 (setq rate (+ (or rate 0) (string-to-int (match-string 1)))
268 rate-type (or (and rate-type
269 (if (string= rate-type (match-string 2))
270 rate-type
271 (error
272 "Inconsistent rate types (%s vs. %s)"
273 rate-type (match-string 2))))
274 (match-string 2))))
275 (when (re-search-forward "remaining capacity: +\\([0-9]+\\) m[AW]h$"
267 nil t) 276 nil t)
268 (setq capacity 277 (setq capacity
269 (+ (or capacity 0) (string-to-int (match-string 1)))))) 278 (+ (or capacity 0) (string-to-int (match-string 1))))))
270 (goto-char (point-max)) 279 (goto-char (point-max))
271 (insert-file-contents (expand-file-name "info" dir)) 280 (insert-file-contents (expand-file-name "info" dir))
272 (when (re-search-forward "present: +yes$" nil t) 281 (when (re-search-forward "present: +yes$" nil t)
273 (when (re-search-forward "design capacity: +\\([0-9]+\\) mAh$" 282 (when (re-search-forward "design capacity: +\\([0-9]+\\) m[AW]h$"
274 nil t) 283 nil t)
275 (setq design-capacity (+ (or design-capacity 0) 284 (setq design-capacity (+ (or design-capacity 0)
276 (string-to-int (match-string 1))))) 285 (string-to-int (match-string 1)))))
277 (when (re-search-forward "design capacity warning: +\\([0-9]+\\) mAh$" 286 (when (re-search-forward "design capacity warning: +\\([0-9]+\\) m[AW]h$"
278 nil t) 287 nil t)
279 (setq warn (+ (or warn 0) (string-to-int (match-string 1))))) 288 (setq warn (+ (or warn 0) (string-to-int (match-string 1)))))
280 (when (re-search-forward "design capacity low: +\\([0-9]+\\) mAh$" 289 (when (re-search-forward "design capacity low: +\\([0-9]+\\) m[AW]h$"
281 nil t) 290 nil t)
282 (setq low (+ (or low 0) 291 (setq low (+ (or low 0)
283 (string-to-int (match-string 1)))))))) 292 (string-to-int (match-string 1))))))))
284 (directory-files "/proc/acpi/battery/" t "BAT"))) 293 (directory-files "/proc/acpi/battery/" t "BAT")))
285 (and capacity rate 294 (and capacity rate
286 (setq minutes (floor (* (/ (float (if (string= charging-state 295 (setq minutes (if (zerop rate) 0
287 "charging") 296 (floor (* (/ (float (if (string= charging-state
288 (- design-capacity capacity) 297 "charging")
289 capacity)) rate) 60)) 298 (- design-capacity capacity)
299 capacity)) rate) 60)))
290 hours (/ minutes 60))) 300 hours (/ minutes 60)))
291 (list (cons ?c (or (and capacity (number-to-string capacity)) "N/A")) 301 (list (cons ?c (or (and capacity (number-to-string capacity)) "N/A"))
292 (cons ?L (or (when (file-exists-p "/proc/acpi/ac_adapter/AC/state") 302 (cons ?L (or (when (file-exists-p "/proc/acpi/ac_adapter/AC/state")
@@ -304,8 +314,17 @@ The following %-sequences are provided:
304 (when (re-search-forward 314 (when (re-search-forward
305 "temperature: +\\([0-9]+\\) C$" nil t) 315 "temperature: +\\([0-9]+\\) C$" nil t)
306 (match-string 1)))) 316 (match-string 1))))
317 (when (file-exists-p
318 "/proc/acpi/thermal_zone/THM/temperature")
319 (with-temp-buffer
320 (insert-file-contents
321 "/proc/acpi/thermal_zone/THM/temperature")
322 (when (re-search-forward
323 "temperature: +\\([0-9]+\\) C$" nil t)
324 (match-string 1))))
307 "N/A")) 325 "N/A"))
308 (cons ?r (or (and rate (number-to-string rate)) "N/A")) 326 (cons ?r (or (and rate (concat (number-to-string rate) " "
327 rate-type)) "N/A"))
309 (cons ?B (or charging-state "N/A")) 328 (cons ?B (or charging-state "N/A"))
310 (cons ?b (or (and (string= charging-state "charging") "+") 329 (cons ?b (or (and (string= charging-state "charging") "+")
311 (and low (< capacity low) "!") 330 (and low (< capacity low) "!")
diff --git a/lisp/faces.el b/lisp/faces.el
index 721c2fa3631..15e0f2549a8 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -240,27 +240,24 @@ If FRAME is omitted or nil, use the selected frame."
240 240
241 241
242(defun face-differs-from-default-p (face &optional frame) 242(defun face-differs-from-default-p (face &optional frame)
243 "Non-nil if FACE displays differently from the default face. 243 "Return non-nil if FACE displays differently from the default face.
244If the optional argument FRAME is given, report on face FACE in that frame. 244If the optional argument FRAME is given, report on face FACE in that frame.
245If FRAME is t, report on the defaults for face FACE (for new frames). 245If FRAME is t, report on the defaults for face FACE (for new frames).
246If FRAME is omitted or nil, use the selected frame. 246If FRAME is omitted or nil, use the selected frame."
247A face is considered to be ``the same'' as the default face if it is 247 (let ((attrs
248actually specified in the same way (equal attributes) or if it is 248 '(:family :width :height :weight :slant :foreground
249fully-unspecified, and thus inherits the attributes of any face it 249 :foreground :background :underline :overline
250is displayed on top of." 250 :strike-through :box :inverse-video))
251 (cond ((eq frame t) (setq frame nil)) 251 (differs nil))
252 ((null frame) (setq frame (selected-frame)))) 252 (while (and attrs (not differs))
253 (let* ((v1 (internal-lisp-face-p face frame)) 253 (let* ((attr (pop attrs))
254 (n (if v1 (length v1) 0)) 254 (attr-val (face-attribute face attr frame t)))
255 (v2 (internal-lisp-face-p 'default frame)) 255 (when (and
256 (i 1)) 256 (not (eq attr-val 'unspecified))
257 (unless v1 257 (display-supports-face-attributes-p (list attr attr-val)
258 (error "Not a face: %S" face)) 258 frame))
259 (while (and (< i n) 259 (setq differs attr))))
260 (or (eq 'unspecified (aref v1 i)) 260 differs))
261 (equal (aref v1 i) (aref v2 i))))
262 (setq i (1+ i)))
263 (< i n)))
264 261
265 262
266(defun face-nontrivial-p (face &optional frame) 263(defun face-nontrivial-p (face &optional frame)
@@ -1489,33 +1486,6 @@ If omitted or nil, that stands for the selected frame's display."
1489 (t 1486 (t
1490 (> (tty-color-gray-shades display) 2))))) 1487 (> (tty-color-gray-shades display) 2)))))
1491 1488
1492(defun display-supports-face-attributes-p (attributes &optional display)
1493 "Return non-nil if all the face attributes in ATTRIBUTES are supported.
1494The optional argument DISPLAY can be a display name, a frame, or
1495nil (meaning the selected frame's display)
1496
1497The definition of `supported' is somewhat heuristic, but basically means
1498that a face containing all the attributes in ATTRIBUTES, when merged
1499with the default face for display, can be represented in a way that's
1500
1501 (1) different in appearance than the default face, and
1502 (2) `close in spirit' to what the attributes specify, if not exact.
1503
1504Point (2) implies that a `:weight black' attribute will be satisfied by
1505any display that can display bold, and a `:foreground \"yellow\"' as long
1506as it can display a yellowish color, but `:slant italic' will _not_ be
1507satisfied by the tty display code's automatic substitution of a `dim'
1508face for italic."
1509 (let ((frame
1510 (if (framep display)
1511 display
1512 (car (frames-on-display-list display)))))
1513 ;; For now, we assume that non-tty displays can support everything.
1514 ;; Later, we should add the ability to query about specific fonts,
1515 ;; colors, etc.
1516 (or (memq (framep frame) '(x w32 mac))
1517 (tty-supports-face-attributes-p attributes frame))))
1518
1519 1489
1520;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1490;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1521;;; Background mode. 1491;;; Background mode.
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index e7e09a431bd..03ea5bef653 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -237,14 +237,19 @@ KIND should be `var' for a variable or `subr' for a subroutine."
237 (concat "src/" file) 237 (concat "src/" file)
238 file))))) 238 file)))))
239 239
240;;;###autoload
241(defface help-argument-name '((((supports :slant italic)) :inherit italic))
242 "Face to highlight argument names in *Help* buffers.")
243
240(defun help-default-arg-highlight (arg) 244(defun help-default-arg-highlight (arg)
241 "Default function to highlight arguments in *Help* buffers. 245 "Default function to highlight arguments in *Help* buffers.
242It returns ARG in lowercase italics, if the display supports it; 246It returns ARG in face `help-argument-name'; ARG is also
243else ARG is returned in uppercase normal." 247downcased if it displays differently than the default
244 (let ((attrs '(:slant italic))) 248face (according to `face-differs-from-default-p')."
245 (if (display-supports-face-attributes-p attrs) 249 (propertize (if (face-differs-from-default-p 'help-argument-name)
246 (propertize (downcase arg) 'face attrs) 250 (downcase arg)
247 arg))) 251 arg)
252 'face 'help-argument-name))
248 253
249(defun help-do-arg-highlight (doc args) 254(defun help-do-arg-highlight (doc args)
250 (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table) 255 (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 93ea3cc0c14..7b13d498b2e 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -1,11 +1,11 @@
1;;; table.el --- create and edit WYSIWYG text based embedded tables 1;;; table.el --- create and edit WYSIWYG text based embedded tables
2 2
3;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. 3;; Copyright (C) 2000, 01, 02, 03, 04 Free Software Foundation, Inc.
4 4
5;; Keywords: wp, convenience 5;; Keywords: wp, convenience
6;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com> 6;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com>
7;; Created: Sat Jul 08 2000 13:28:45 (PST) 7;; Created: Sat Jul 08 2000 13:28:45 (PST)
8;; Revised: Tue Dec 09 2003 14:36:50 (PST) 8;; Revised: Tue Jun 01 2004 11:36:39 (PDT)
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11 11
@@ -1410,6 +1410,8 @@ the last cache point coordinate."
1410 end-of-buffer 1410 end-of-buffer
1411 forward-word 1411 forward-word
1412 backward-word 1412 backward-word
1413 forward-sentence
1414 backward-sentence
1413 forward-paragraph 1415 forward-paragraph
1414 backward-paragraph)) 1416 backward-paragraph))
1415 1417
@@ -1434,9 +1436,18 @@ the last cache point coordinate."
1434 (cons (cons command func-symbol) 1436 (cons (cons command func-symbol)
1435 table-command-remap-alist)))) 1437 table-command-remap-alist))))
1436 '(kill-region 1438 '(kill-region
1439 kill-ring-save
1437 delete-region 1440 delete-region
1438 copy-region-as-kill 1441 copy-region-as-kill
1439 kill-line)) 1442 kill-line
1443 kill-word
1444 backward-kill-word
1445 kill-sentence
1446 backward-kill-sentence
1447 kill-paragraph
1448 backward-kill-paragraph
1449 kill-sexp
1450 backward-kill-sexp))
1440 1451
1441;; Pasting Group 1452;; Pasting Group
1442(mapcar 1453(mapcar
diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el
index 4db9788cc3b..82c09cbd435 100644
--- a/lisp/vc-svn.el
+++ b/lisp/vc-svn.el
@@ -195,8 +195,9 @@ This is only possible if SVN is responsible for FILE's directory.")
195 195
196(defun vc-svn-checkin (file rev comment) 196(defun vc-svn-checkin (file rev comment)
197 "SVN-specific version of `vc-backend-checkin'." 197 "SVN-specific version of `vc-backend-checkin'."
198 (let ((status (apply 'vc-svn-command nil 1 file 198 (let ((status (apply
199 "ci" (list* "-m" comment (vc-switches 'SVN 'checkin))))) 199 'vc-svn-command nil 1 file "ci"
200 (nconc (list "-m" comment) (vc-switches 'SVN 'checkin)))))
200 (set-buffer "*vc*") 201 (set-buffer "*vc*")
201 (goto-char (point-min)) 202 (goto-char (point-min))
202 (unless (equal status 0) 203 (unless (equal status 0)
diff --git a/lisp/woman.el b/lisp/woman.el
index d69c631f27b..ba511bca1ae 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1,6 +1,6 @@
1;;; woman.el --- browse UN*X manual pages `wo (without) man' 1;;; woman.el --- browse UN*X manual pages `wo (without) man'
2 2
3;; Copyright (C) 2000, 2002 Free Software Foundation, Inc. 3;; Copyright (C) 2000, 2002, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk> 5;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
6;; Maintainer: Francis J. Wright <F.J.Wright@qmul.ac.uk> 6;; Maintainer: Francis J. Wright <F.J.Wright@qmul.ac.uk>
@@ -402,6 +402,7 @@
402;; Alexander Hinds <ahinds@thegrid.net> 402;; Alexander Hinds <ahinds@thegrid.net>
403;; Stefan Hornburg <sth@hacon.de> 403;; Stefan Hornburg <sth@hacon.de>
404;; Theodore Jump <tjump@cais.com> 404;; Theodore Jump <tjump@cais.com>
405;; David Kastrup <dak@gnu.org>
405;; Paul Kinnucan <paulk@mathworks.com> 406;; Paul Kinnucan <paulk@mathworks.com>
406;; Jonas Linde <jonas@init.se> 407;; Jonas Linde <jonas@init.se>
407;; Andrew McRae <andrewm@optimation.co.nz> 408;; Andrew McRae <andrewm@optimation.co.nz>
@@ -438,7 +439,8 @@
438 "Return concatenated list of FN applied to successive `car' elements of X. 439 "Return concatenated list of FN applied to successive `car' elements of X.
439FN must return a list, cons or nil. Useful for splicing into a list." 440FN must return a list, cons or nil. Useful for splicing into a list."
440 ;; Based on the Standard Lisp function MAPCAN but with args swapped! 441 ;; Based on the Standard Lisp function MAPCAN but with args swapped!
441 (and x (nconc (funcall fn (car x)) (woman-mapcan fn (cdr x))))) 442 ;; More concise implementation than the recursive one. -- dak
443 (apply #'nconc (mapcar fn x)))
442 444
443(defun woman-parse-colon-path (paths) 445(defun woman-parse-colon-path (paths)
444 "Explode search path string PATHS into a list of directory names. 446 "Explode search path string PATHS into a list of directory names.
@@ -1367,15 +1369,16 @@ The cdr of each alist element is the path-index / filename."
1367 ;; is re-processed by `woman-topic-all-completions-merge'. 1369 ;; is re-processed by `woman-topic-all-completions-merge'.
1368 (let (dir files (path-index 0)) ; indexing starts at zero 1370 (let (dir files (path-index 0)) ; indexing starts at zero
1369 (while path 1371 (while path
1370 (setq dir (car path) 1372 (setq dir (pop path))
1371 path (cdr path))
1372 (if (woman-not-member dir path) ; use each directory only once! 1373 (if (woman-not-member dir path) ; use each directory only once!
1373 (setq files 1374 (push (woman-topic-all-completions-1 dir path-index)
1374 (nconc files 1375 files))
1375 (woman-topic-all-completions-1 dir path-index))))
1376 (setq path-index (1+ path-index))) 1376 (setq path-index (1+ path-index)))
1377 ;; Uniquefy topics: 1377 ;; Uniquefy topics:
1378 (woman-topic-all-completions-merge files))) 1378 ;; Concate all lists with a single nconc call to
1379 ;; avoid retraversing the first lists repeatedly -- dak
1380 (woman-topic-all-completions-merge
1381 (apply #'nconc files))))
1379 1382
1380(defun woman-topic-all-completions-1 (dir path-index) 1383(defun woman-topic-all-completions-1 (dir path-index)
1381 "Return an alist of the man topics in directory DIR with index PATH-INDEX. 1384 "Return an alist of the man topics in directory DIR with index PATH-INDEX.
@@ -1388,55 +1391,54 @@ of the first `woman-cache-level' elements from the following list:
1388 ;; unnecessary. So let us assume that `woman-file-regexp' will 1391 ;; unnecessary. So let us assume that `woman-file-regexp' will
1389 ;; filter out any directories, which probably should not be there 1392 ;; filter out any directories, which probably should not be there
1390 ;; anyway, i.e. it is a user error! 1393 ;; anyway, i.e. it is a user error!
1391 (mapcar 1394 ;;
1392 (lambda (file) 1395 ;; Don't sort files: we do that when merging, anyway. -- dak
1393 (cons 1396 (let (newlst (lst (directory-files dir nil woman-file-regexp t))
1394 (file-name-sans-extension 1397 ;; Make an explicit regexp for stripping extension and
1395 (if (string-match woman-file-compression-regexp file) 1398 ;; compression extension: file-name-sans-extension is a
1396 (file-name-sans-extension file) 1399 ;; far too costly function. -- dak
1397 file)) 1400 (ext (format "\\(\\.[^.\\/]*\\)?\\(%s\\)?\\'"
1398 (if (> woman-cache-level 1) 1401 woman-file-compression-regexp)))
1399 (cons 1402 ;; Use a loop instead of mapcar in order to avoid the speed
1400 path-index 1403 ;; penalty of binding function arguments. -- dak
1401 (if (> woman-cache-level 2) 1404 (dolist (file lst newlst)
1402 (cons file nil)))))) 1405 (push
1403 (directory-files dir nil woman-file-regexp))) 1406 (cons
1407 (if (string-match ext file)
1408 (substring file 0 (match-beginning 0))
1409 file)
1410 (and (> woman-cache-level 1)
1411 (cons
1412 path-index
1413 (and (> woman-cache-level 2)
1414 (list file)))))
1415 newlst))))
1404 1416
1405(defun woman-topic-all-completions-merge (alist) 1417(defun woman-topic-all-completions-merge (alist)
1406 "Merge the alist ALIST so that the keys are unique. 1418 "Merge the alist ALIST so that the keys are unique.
1407Also make each path-info component into a list. 1419Also make each path-info component into a list.
1408\(Note that this function changes the value of ALIST.)" 1420\(Note that this function changes the value of ALIST.)"
1409 ;; Intended to be fast by avoiding recursion and list copying. 1421 ;; Replaces unreadably "optimized" O(n^2) implementation.
1410 (if (> woman-cache-level 1) 1422 ;; Instead we use sorting to merge stuff efficiently. -- dak
1411 (let ((newalist alist)) 1423 (let (elt newalist)
1412 (while newalist 1424 ;; Sort list into reverse order
1413 (let ((tail newalist) (topic (car (car newalist)))) 1425 (setq alist (sort alist (lambda(x y) (string< (car y) (car x)))))
1414 ;; Make the path-info into a list: 1426 ;; merge duplicate keys.
1415 (setcdr (car newalist) (list (cdr (car newalist)))) 1427 (if (> woman-cache-level 1)
1416 (while tail 1428 (while alist
1417 (while (and tail (not (string= topic (car (car (cdr tail)))))) 1429 (setq elt (pop alist))
1418 (setq tail (cdr tail))) 1430 (if (equal (car elt) (caar newalist))
1419 (if tail ; merge path-info into (car newalist) 1431 (unless (member (cdr elt) (cdar newalist))
1420 (let ((path-info (cdr (car (cdr tail))))) 1432 (setcdr (car newalist) (cons (cdr elt)
1421 (if (member path-info (cdr (car newalist))) 1433 (cdar newalist))))
1422 () 1434 (setcdr elt (list (cdr elt)))
1423 ;; Make the path-info into a list: 1435 (push elt newalist)))
1424 (nconc (car newalist) (list path-info)))
1425 (setcdr tail (cdr (cdr tail))))
1426 ))
1427 (setq newalist (cdr newalist))))
1428 alist)
1429 ;; woman-cache-level = 1 => elements are single-element lists ... 1436 ;; woman-cache-level = 1 => elements are single-element lists ...
1430 (while (and alist (member (car alist) (cdr alist))) 1437 (while alist
1431 (setq alist (cdr alist))) 1438 (setq elt (pop alist))
1432 (if alist 1439 (unless (equal (car elt) (caar newalist))
1433 (let ((newalist alist) cdr_alist) 1440 (push elt newalist))))
1434 (while (setq cdr_alist (cdr alist)) 1441 newalist))
1435 (if (not (member (car cdr_alist) (cdr cdr_alist)))
1436 (setq alist cdr_alist)
1437 (setcdr alist (cdr cdr_alist)))
1438 )
1439 newalist))))
1440 1442
1441(defun woman-file-name-all-completions (topic) 1443(defun woman-file-name-all-completions (topic)
1442 "Return an alist of the files in all man directories that match TOPIC." 1444 "Return an alist of the files in all man directories that match TOPIC."
diff --git a/lispref/display.texi b/lispref/display.texi
index ddf8cdb4723..addf66dd7a6 100644
--- a/lispref/display.texi
+++ b/lispref/display.texi
@@ -2288,10 +2288,8 @@ same attributes for display.
2288@end defun 2288@end defun
2289 2289
2290@defun face-differs-from-default-p face &optional frame 2290@defun face-differs-from-default-p face &optional frame
2291This returns @code{t} if the face @var{face} displays differently from 2291This returns non-@code{nil} if the face @var{face} displays
2292the default face. A face is considered to be ``the same'' as the 2292differently from the default face.
2293default face if each attribute is either the same as that of the default
2294face, or unspecified (meaning to inherit from the default).
2295@end defun 2293@end defun
2296 2294
2297@node Auto Faces 2295@node Auto Faces
diff --git a/nt/ChangeLog b/nt/ChangeLog
index fa411283e76..7faf16a0836 100644
--- a/nt/ChangeLog
+++ b/nt/ChangeLog
@@ -1,3 +1,9 @@
12004-06-04 Juanma Barranquero <lektu@terra.es>
2
3 * INSTALL: Reword the section on image support. Add reference to
4 GnuWin32. Mention problems when mixing binaries from different
5 compilers.
6
12004-05-06 Jason Rumney <jasonr@gnu.org> 72004-05-06 Jason Rumney <jasonr@gnu.org>
2 8
3 * configure.bat: Use -mno-cygwin to check for image libraries 9 * configure.bat: Use -mno-cygwin to check for image libraries
diff --git a/nt/INSTALL b/nt/INSTALL
index 273c6b1e16b..420dced5505 100644
--- a/nt/INSTALL
+++ b/nt/INSTALL
@@ -1,7 +1,7 @@
1 Building and Installing Emacs 1 Building and Installing Emacs
2 on Windows NT/2000 and Windows 95/98/ME 2 on Windows NT/2K/XP and Windows 95/98/ME
3 3
4 Copyright (c) 2001 Free Software Foundation, Inc. 4 Copyright (c) 2001,2004 Free Software Foundation, Inc.
5 See the end of the file for copying permissions. 5 See the end of the file for copying permissions.
6 6
7 If you used WinZip to unpack the distribution, we suggest to 7 If you used WinZip to unpack the distribution, we suggest to
@@ -31,7 +31,7 @@
31 like this, we recommend the use of the supported compilers mentioned 31 like this, we recommend the use of the supported compilers mentioned
32 in the previous paragraph. 32 in the previous paragraph.
33 33
34 If you build Emacs on Windows 9X or ME, not on Windows 2000 or 34 If you build Emacs on Windows 9X or ME, not on Windows 2K/XP or
35 Windows NT, we suggest to install the Cygwin port of Bash. 35 Windows NT, we suggest to install the Cygwin port of Bash.
36 36
37 Please see http://www.mingw.org for pointers to GCC/Mingw binaries. 37 Please see http://www.mingw.org for pointers to GCC/Mingw binaries.
@@ -90,22 +90,35 @@
90 90
91* Optional image library support 91* Optional image library support
92 92
93 To build Emacs with support for PNG images, the libpng and zlib 93 In addition to its "native" image formats (pbm and xbm), Emacs can
94 headers must be in the include path when the configure script is 94 handle other image types: xpm, tiff, gif, png and jpeg (postscript is
95 run. This can be setup using environment variables, or by 95 currently unsupported on Windows). To build Emacs with support for
96 specifying --cflags -I... options on the command-line to 96 them, the corresponding headers must be in the include path when the
97 configure.bat. Similarly, the jpeg-6b, libXpm, tiff and libungif 97 configure script is run. This can be setup using environment
98 headers need to be in the include path for support for those image 98 variables, or by specifying --cflags -I... options on the command-line
99 formats to work. The configure script will report whether it was 99 to configure.bat. The configure script will report whether it was
100 able to detect the headers. 100 able to detect the headers.
101 101
102 To use the PNG support, zlib.dll (or zlibd.dll) and libpng.dll (or 102 To use the external image support, the DLLs implementing the
103 libpng13.dll, or libpng13d.dll) must be on the PATH or in the same 103 functionality must be found when Emacs is started, either on the PATH,
104 directory as emacs.exe when Emacs is started. Similar instructions 104 or in the same directory as emacs.exe. Failure to find a library is
105 apply for other image libraries. Note that tiff support depends on 105 not an error; the associated image format will simply be unavailable.
106 the jpeg library. If you did not compile the libraries yourself, you 106
107 must make sure that the jpeg library you install is the same one 107 Some image libraries have dependencies on one another, or on zlib.
108 that the tiff library was compiled against. 108 For example, tiff support depends on the jpeg library. If you did not
109 compile the libraries yourself, you must make sure that any dependency
110 is in the PATH or otherwise accesible and that the binaries are
111 compatible (for example, that they were built with the same compiler).
112
113 Binaries for the image libraries (among many others) can be found at
114 GnuWin32 (http://gnuwin32.sourceforge.net). These are built with
115 MinGW and work better with GCC/MinGW builds of Emacs, like the
116 official binary tarballs for Windows. Compatibility with MSVC is
117 still weak and should not be trusted in production environments; if
118 you really need an MSVC-compiled Emacs with image support, you should
119 try to build the required libraries with the same compiler (though it
120 can be extremely non-trivial, and we'll be interested on hearing of
121 any such effort).
109 122
110* Building 123* Building
111 124
diff --git a/src/ChangeLog b/src/ChangeLog
index fd108641f22..d9000d6dd05 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,26 @@
12004-06-05 Miles Bader <miles@gnu.org>
2
3 * xfaces.c (tty_supports_face_attributes_p): Make sure the specified
4 attributes have different values than the default face.
5
62004-06-04 Eli Zaretskii <eliz@gnu.org>
7
8 * xfaces.c (x_supports_face_attributes_p): Make this function
9 conditional on HAVE_WINDOW_SYSTEM.
10 (Fdisplay_supports_face_attributes_p) [HAVE_WINDOW_SYSTEM]: Don't
11 call x_supports_face_attributes_p if it was not compiled in.
12
132004-06-04 Miles Bader <miles@gnu.org>
14
15 * xfaces.c (tty_supports_face_attributes_p): New function, mostly
16 from Ftty_supports_face_attributes_p.
17 (x_supports_face_attributes_p): New function.
18 (Ftty_supports_face_attributes_p): Function deleted.
19 (Fdisplay_supports_face_attributes_p): New function.
20 (syms_of_xfaces): Initialize Sdisplay_supports_face_attributes_p.
21 (face_attr_equal_p): New function
22 (lface_equal_p): Use it.
23
12004-06-03 Juanma Barranquero <lektu@terra.es> 242004-06-03 Juanma Barranquero <lektu@terra.es>
2 25
3 * w32fns.c (Fx_display_grayscale_p, Fw32_send_sys_command) 26 * w32fns.c (Fx_display_grayscale_p, Fw32_send_sys_command)
diff --git a/src/xfaces.c b/src/xfaces.c
index bae9b569f1a..6e447e0cb0e 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -4870,49 +4870,51 @@ If FRAME is omitted or nil, use the selected frame. */)
4870} 4870}
4871 4871
4872 4872
4873/* Compare face vectors V1 and V2 for equality. Value is non-zero if 4873/* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
4874 all attributes are `equal'. Tries to be fast because this function 4874 all attributes are `equal'. Tries to be fast because this function
4875 is called quite often. */ 4875 is called quite often. */
4876 4876
4877static INLINE int 4877static INLINE int
4878lface_equal_p (v1, v2) 4878face_attr_equal_p (v1, v2)
4879 Lisp_Object *v1, *v2;
4880{ 4879{
4881 int i, equal_p = 1; 4880 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4881 and the other is specified. */
4882 if (XTYPE (v1) != XTYPE (v2))
4883 return 0;
4882 4884
4883 for (i = 1; i < LFACE_VECTOR_SIZE && equal_p; ++i) 4885 if (EQ (v1, v2))
4884 { 4886 return 1;
4885 Lisp_Object a = v1[i];
4886 Lisp_Object b = v2[i];
4887 4887
4888 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil, 4888 switch (XTYPE (v1))
4889 and the other is specified. */ 4889 {
4890 equal_p = XTYPE (a) == XTYPE (b); 4890 case Lisp_String:
4891 if (!equal_p) 4891 if (SBYTES (v1) != SBYTES (v2))
4892 break; 4892 return 0;
4893 4893
4894 if (!EQ (a, b)) 4894 return bcmp (SDATA (v1), SDATA (v2), SBYTES (v1)) == 0;
4895 {
4896 switch (XTYPE (a))
4897 {
4898 case Lisp_String:
4899 equal_p = ((SBYTES (a)
4900 == SBYTES (b))
4901 && bcmp (SDATA (a), SDATA (b),
4902 SBYTES (a)) == 0);
4903 break;
4904 4895
4905 case Lisp_Int: 4896 case Lisp_Int:
4906 case Lisp_Symbol: 4897 case Lisp_Symbol:
4907 equal_p = 0; 4898 return 0;
4908 break;
4909 4899
4910 default: 4900 default:
4911 equal_p = !NILP (Fequal (a, b)); 4901 return !NILP (Fequal (v1, v2));
4912 break;
4913 }
4914 }
4915 } 4902 }
4903}
4904
4905
4906/* Compare face vectors V1 and V2 for equality. Value is non-zero if
4907 all attributes are `equal'. Tries to be fast because this function
4908 is called quite often. */
4909
4910static INLINE int
4911lface_equal_p (v1, v2)
4912 Lisp_Object *v1, *v2;
4913{
4914 int i, equal_p = 1;
4915
4916 for (i = 1; i < LFACE_VECTOR_SIZE && equal_p; ++i)
4917 equal_p = face_attr_equal_p (v1[i], v2[i]);
4916 4918
4917 return equal_p; 4919 return equal_p;
4918} 4920}
@@ -5212,192 +5214,6 @@ If FRAME is unspecified or nil, the current frame is used. */)
5212 5214
5213 5215
5214/*********************************************************************** 5216/***********************************************************************
5215 Face capability testing for ttys
5216 ***********************************************************************/
5217
5218
5219/* If the distance (as returned by color_distance) between two colors is
5220 less than this, then they are considered the same, for determining
5221 whether a color is supported or not. The range of values is 0-65535. */
5222
5223#define TTY_SAME_COLOR_THRESHOLD 10000
5224
5225
5226DEFUN ("tty-supports-face-attributes-p",
5227 Ftty_supports_face_attributes_p, Stty_supports_face_attributes_p,
5228 1, 2, 0,
5229 doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5230The optional argument FRAME is the frame on which to test; if it is nil
5231or unspecified, then the current frame is used. If FRAME is not a tty
5232frame, then nil is returned.
5233
5234The definition of `supported' is somewhat heuristic, but basically means
5235that a face containing all the attributes in ATTRIBUTES, when merged
5236with the default face for display, can be represented in a way that's
5237
5238 \(1) different in appearance than the default face, and
5239 \(2) `close in spirit' to what the attributes specify, if not exact.
5240
5241Point (2) implies that a `:weight black' attribute will be satisfied
5242by any terminal that can display bold, and a `:foreground "yellow"' as
5243long as the terminal can display a yellowish color, but `:slant italic'
5244will _not_ be satisfied by the tty display code's automatic
5245substitution of a `dim' face for italic. */)
5246 (attributes, frame)
5247 Lisp_Object attributes, frame;
5248{
5249 int weight, i;
5250 struct frame *f;
5251 Lisp_Object val, fg, bg;
5252 XColor fg_tty_color, fg_std_color;
5253 XColor bg_tty_color, bg_std_color;
5254 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5255 unsigned test_caps = 0;
5256
5257 if (NILP (frame))
5258 frame = selected_frame;
5259 CHECK_LIVE_FRAME (frame);
5260 f = XFRAME (frame);
5261
5262 for (i = 0; i < LFACE_VECTOR_SIZE; i++)
5263 attrs[i] = Qunspecified;
5264 merge_face_vector_with_property (f, attrs, attributes);
5265
5266 /* This function only works on ttys. */
5267 if (!FRAME_TERMCAP_P (f) && !FRAME_MSDOS_P (f))
5268 return Qnil;
5269
5270 /* First check some easy-to-check stuff; ttys support none of the
5271 following attributes, so we can just return nil if any are requested. */
5272
5273 /* stipple */
5274 val = attrs[LFACE_STIPPLE_INDEX];
5275 if (!UNSPECIFIEDP (val) && !NILP (val))
5276 return Qnil;
5277
5278 /* font height */
5279 val = attrs[LFACE_HEIGHT_INDEX];
5280 if (!UNSPECIFIEDP (val) && !NILP (val))
5281 return Qnil;
5282
5283 /* font width */
5284 val = attrs[LFACE_SWIDTH_INDEX];
5285 if (!UNSPECIFIEDP (val) && !NILP (val)
5286 && face_numeric_swidth (val) != XLFD_SWIDTH_MEDIUM)
5287 return Qnil;
5288
5289 /* overline */
5290 val = attrs[LFACE_OVERLINE_INDEX];
5291 if (!UNSPECIFIEDP (val) && !NILP (val))
5292 return Qnil;
5293
5294 /* strike-through */
5295 val = attrs[LFACE_STRIKE_THROUGH_INDEX];
5296 if (!UNSPECIFIEDP (val) && !NILP (val))
5297 return Qnil;
5298
5299 /* boxes */
5300 val = attrs[LFACE_BOX_INDEX];
5301 if (!UNSPECIFIEDP (val) && !NILP (val))
5302 return Qnil;
5303
5304 /* slant (italics/oblique); We consider any non-default value
5305 unsupportable on ttys, even though the face code actually `fakes'
5306 them using a dim attribute if possible. This is because the faked
5307 result is too different from what the face specifies. */
5308 val = attrs[LFACE_SLANT_INDEX];
5309 if (!UNSPECIFIEDP (val) && !NILP (val)
5310 && face_numeric_slant (val) != XLFD_SLANT_ROMAN)
5311 return Qnil;
5312
5313
5314 /* Test for terminal `capabilities' (non-color character attributes). */
5315
5316 /* font weight (bold/dim) */
5317 weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
5318 if (weight >= 0)
5319 {
5320 if (weight > XLFD_WEIGHT_MEDIUM)
5321 test_caps = TTY_CAP_BOLD;
5322 else if (weight < XLFD_WEIGHT_MEDIUM)
5323 test_caps = TTY_CAP_DIM;
5324 }
5325
5326 /* underlining */
5327 val = attrs[LFACE_UNDERLINE_INDEX];
5328 if (!UNSPECIFIEDP (val) && !NILP (val))
5329 {
5330 if (STRINGP (val))
5331 return Qnil; /* ttys don't support colored underlines */
5332 else
5333 test_caps |= TTY_CAP_UNDERLINE;
5334 }
5335
5336 /* inverse video */
5337 val = attrs[LFACE_INVERSE_INDEX];
5338 if (!UNSPECIFIEDP (val) && !NILP (val))
5339 test_caps |= TTY_CAP_INVERSE;
5340
5341
5342 /* Color testing. */
5343
5344 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
5345 we use them when calling `tty_capable_p' below, even if the face
5346 specifies no colors. */
5347 fg_tty_color.pixel = FACE_TTY_DEFAULT_FG_COLOR;
5348 bg_tty_color.pixel = FACE_TTY_DEFAULT_BG_COLOR;
5349
5350 /* Check if foreground color is close enough. */
5351 fg = attrs[LFACE_FOREGROUND_INDEX];
5352 if (STRINGP (fg))
5353 {
5354 if (! tty_lookup_color (f, fg, &fg_tty_color, &fg_std_color))
5355 return Qnil;
5356 else if (color_distance (&fg_tty_color, &fg_std_color)
5357 > TTY_SAME_COLOR_THRESHOLD)
5358 return Qnil;
5359 }
5360
5361 /* Check if background color is close enough. */
5362 bg = attrs[LFACE_BACKGROUND_INDEX];
5363 if (STRINGP (bg))
5364 {
5365 if (! tty_lookup_color (f, bg, &bg_tty_color, &bg_std_color))
5366 return Qnil;
5367 else if (color_distance (&bg_tty_color, &bg_std_color)
5368 > TTY_SAME_COLOR_THRESHOLD)
5369 return Qnil;
5370 }
5371
5372 /* If both foreground and background are requested, see if the
5373 distance between them is OK. We just check to see if the distance
5374 between the tty's foreground and background is close enough to the
5375 distance between the standard foreground and background. */
5376 if (STRINGP (fg) && STRINGP (bg))
5377 {
5378 int delta_delta
5379 = (color_distance (&fg_std_color, &bg_std_color)
5380 - color_distance (&fg_tty_color, &bg_tty_color));
5381 if (delta_delta > TTY_SAME_COLOR_THRESHOLD
5382 || delta_delta < -TTY_SAME_COLOR_THRESHOLD)
5383 return Qnil;
5384 }
5385
5386
5387 /* See if the capabilities we selected above are supported, with the
5388 given colors. */
5389 if (test_caps != 0 &&
5390 ! tty_capable_p (FRAME_TTY (f), test_caps, fg_tty_color.pixel, bg_tty_color.pixel))
5391 return Qnil;
5392
5393
5394 /* Hmmm, everything checks out, this terminal must support this face. */
5395 return Qt;
5396}
5397
5398
5399
5400/***********************************************************************
5401 Face Cache 5217 Face Cache
5402 ***********************************************************************/ 5218 ***********************************************************************/
5403 5219
@@ -5917,6 +5733,351 @@ DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector,
5917 5733
5918 5734
5919/*********************************************************************** 5735/***********************************************************************
5736 Face capability testing
5737 ***********************************************************************/
5738
5739
5740/* If the distance (as returned by color_distance) between two colors is
5741 less than this, then they are considered the same, for determining
5742 whether a color is supported or not. The range of values is 0-65535. */
5743
5744#define TTY_SAME_COLOR_THRESHOLD 10000
5745
5746#ifdef HAVE_WINDOW_SYSTEM
5747
5748/* Return non-zero if all the face attributes in ATTRS are supported
5749 on the window-system frame F.
5750
5751 The definition of `supported' is somewhat heuristic, but basically means
5752 that a face containing all the attributes in ATTRS, when merged with the
5753 default face for display, can be represented in a way that's
5754
5755 \(1) different in appearance than the default face, and
5756 \(2) `close in spirit' to what the attributes specify, if not exact. */
5757
5758static int
5759x_supports_face_attributes_p (f, attrs, def_face)
5760 struct frame *f;
5761 Lisp_Object *attrs;
5762 struct face *def_face;
5763{
5764 Lisp_Object *def_attrs = def_face->lface;
5765
5766 /* Check that other specified attributes are different that the default
5767 face. */
5768 if ((!UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX])
5769 && face_attr_equal_p (attrs[LFACE_UNDERLINE_INDEX],
5770 def_attrs[LFACE_UNDERLINE_INDEX]))
5771 || (!UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX])
5772 && face_attr_equal_p (attrs[LFACE_INVERSE_INDEX],
5773 def_attrs[LFACE_INVERSE_INDEX]))
5774 || (!UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX])
5775 && face_attr_equal_p (attrs[LFACE_FOREGROUND_INDEX],
5776 def_attrs[LFACE_FOREGROUND_INDEX]))
5777 || (!UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX])
5778 && face_attr_equal_p (attrs[LFACE_BACKGROUND_INDEX],
5779 def_attrs[LFACE_BACKGROUND_INDEX]))
5780 || (!UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
5781 && face_attr_equal_p (attrs[LFACE_STIPPLE_INDEX],
5782 def_attrs[LFACE_STIPPLE_INDEX]))
5783 || (!UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
5784 && face_attr_equal_p (attrs[LFACE_OVERLINE_INDEX],
5785 def_attrs[LFACE_OVERLINE_INDEX]))
5786 || (!UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
5787 && face_attr_equal_p (attrs[LFACE_STRIKE_THROUGH_INDEX],
5788 def_attrs[LFACE_STRIKE_THROUGH_INDEX]))
5789 || (!UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
5790 && face_attr_equal_p (attrs[LFACE_BOX_INDEX],
5791 def_attrs[LFACE_BOX_INDEX])))
5792 return 0;
5793
5794 /* Check font-related attributes, as those are the most commonly
5795 "unsupported" on a window-system (because of missing fonts). */
5796 if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
5797 || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
5798 || !UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
5799 || !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
5800 || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
5801 || !UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX]))
5802 {
5803 struct face *face;
5804 Lisp_Object merged_attrs[LFACE_VECTOR_SIZE];
5805
5806 bcopy (def_attrs, merged_attrs, sizeof merged_attrs);
5807
5808 merge_face_vectors (f, attrs, merged_attrs, Qnil);
5809
5810 face = FACE_FROM_ID (f, lookup_face (f, merged_attrs, 0, 0));
5811
5812 if (! face)
5813 signal_error ("cannot make face", 0);
5814
5815 /* If the font is the same, then not supported. */
5816 if (face->font == def_face->font)
5817 return 0;
5818 }
5819
5820 /* Everything checks out, this face is supported. */
5821 return 1;
5822}
5823
5824#endif /* HAVE_WINDOW_SYSTEM */
5825
5826/* Return non-zero if all the face attributes in ATTRS are supported
5827 on the tty frame F.
5828
5829 The definition of `supported' is somewhat heuristic, but basically means
5830 that a face containing all the attributes in ATTRS, when merged
5831 with the default face for display, can be represented in a way that's
5832
5833 \(1) different in appearance than the default face, and
5834 \(2) `close in spirit' to what the attributes specify, if not exact.
5835
5836 Point (2) implies that a `:weight black' attribute will be satisfied
5837 by any terminal that can display bold, and a `:foreground "yellow"' as
5838 long as the terminal can display a yellowish color, but `:slant italic'
5839 will _not_ be satisfied by the tty display code's automatic
5840 substitution of a `dim' face for italic. */
5841
5842static int
5843tty_supports_face_attributes_p (f, attrs, def_face)
5844 struct frame *f;
5845 Lisp_Object *attrs;
5846 struct face *def_face;
5847{
5848 int weight, i;
5849 Lisp_Object val, fg, bg;
5850 XColor fg_tty_color, fg_std_color;
5851 XColor bg_tty_color, bg_std_color;
5852 unsigned test_caps = 0;
5853 Lisp_Object *def_attrs = def_face->lface;
5854
5855
5856 /* First check some easy-to-check stuff; ttys support none of the
5857 following attributes, so we can just return false if any are requested
5858 (even if `nominal' values are specified, we should still return false,
5859 as that will be the same value that the default face uses). We
5860 consider :slant unsupportable on ttys, even though the face code
5861 actually `fakes' them using a dim attribute if possible. This is
5862 because the faked result is too different from what the face
5863 specifies. */
5864 if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
5865 || !UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
5866 || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
5867 || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
5868 || !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
5869 || !UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
5870 || !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
5871 || !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX]))
5872 return 0;
5873
5874
5875 /* Test for terminal `capabilities' (non-color character attributes). */
5876
5877 /* font weight (bold/dim) */
5878 weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
5879 if (weight >= 0)
5880 {
5881 int def_weight = face_numeric_weight (def_attrs[LFACE_WEIGHT_INDEX]);
5882
5883 if (weight > XLFD_WEIGHT_MEDIUM)
5884 {
5885 if (def_weight > XLFD_WEIGHT_MEDIUM)
5886 return 0; /* same as default */
5887 test_caps = TTY_CAP_BOLD;
5888 }
5889 else if (weight < XLFD_WEIGHT_MEDIUM)
5890 {
5891 if (def_weight < XLFD_WEIGHT_MEDIUM)
5892 return 0; /* same as default */
5893 test_caps = TTY_CAP_DIM;
5894 }
5895 else if (def_weight == XLFD_WEIGHT_MEDIUM)
5896 return 0; /* same as default */
5897 }
5898
5899 /* underlining */
5900 val = attrs[LFACE_UNDERLINE_INDEX];
5901 if (!UNSPECIFIEDP (val))
5902 {
5903 if (STRINGP (val))
5904 return 0; /* ttys can't use colored underlines */
5905 else if (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX]))
5906 return 0; /* same as default */
5907 else
5908 test_caps |= TTY_CAP_UNDERLINE;
5909 }
5910
5911 /* inverse video */
5912 val = attrs[LFACE_INVERSE_INDEX];
5913 if (!UNSPECIFIEDP (val))
5914 {
5915 if (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX]))
5916 return 0; /* same as default */
5917 else
5918 test_caps |= TTY_CAP_INVERSE;
5919 }
5920
5921
5922 /* Color testing. */
5923
5924 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
5925 we use them when calling `tty_capable_p' below, even if the face
5926 specifies no colors. */
5927 fg_tty_color.pixel = FACE_TTY_DEFAULT_FG_COLOR;
5928 bg_tty_color.pixel = FACE_TTY_DEFAULT_BG_COLOR;
5929
5930 /* Check if foreground color is close enough. */
5931 fg = attrs[LFACE_FOREGROUND_INDEX];
5932 if (STRINGP (fg))
5933 {
5934 Lisp_Object def_fg = def_attrs[LFACE_FOREGROUND_INDEX];
5935
5936 if (face_attr_equal_p (fg, def_fg))
5937 return 0; /* same as default */
5938 else if (! tty_lookup_color (f, fg, &fg_tty_color, &fg_std_color))
5939 return 0; /* not a valid color */
5940 else if (color_distance (&fg_tty_color, &fg_std_color)
5941 > TTY_SAME_COLOR_THRESHOLD)
5942 return 0; /* displayed color is too different */
5943 else
5944 /* Make sure the color is really different than the default. */
5945 {
5946 XColor def_fg_color;
5947 if (tty_lookup_color (f, def_fg, &def_fg_color, 0)
5948 && (color_distance (&fg_tty_color, &def_fg_color)
5949 <= TTY_SAME_COLOR_THRESHOLD))
5950 return 0;
5951 }
5952 }
5953
5954 /* Check if background color is close enough. */
5955 bg = attrs[LFACE_BACKGROUND_INDEX];
5956 if (STRINGP (bg))
5957 {
5958 Lisp_Object def_bg = def_attrs[LFACE_FOREGROUND_INDEX];
5959
5960 if (face_attr_equal_p (bg, def_bg))
5961 return 0; /* same as default */
5962 else if (! tty_lookup_color (f, bg, &bg_tty_color, &bg_std_color))
5963 return 0; /* not a valid color */
5964 else if (color_distance (&bg_tty_color, &bg_std_color)
5965 > TTY_SAME_COLOR_THRESHOLD)
5966 return 0; /* displayed color is too different */
5967 else
5968 /* Make sure the color is really different than the default. */
5969 {
5970 XColor def_bg_color;
5971 if (tty_lookup_color (f, def_bg, &def_bg_color, 0)
5972 && (color_distance (&bg_tty_color, &def_bg_color)
5973 <= TTY_SAME_COLOR_THRESHOLD))
5974 return 0;
5975 }
5976 }
5977
5978 /* If both foreground and background are requested, see if the
5979 distance between them is OK. We just check to see if the distance
5980 between the tty's foreground and background is close enough to the
5981 distance between the standard foreground and background. */
5982 if (STRINGP (fg) && STRINGP (bg))
5983 {
5984 int delta_delta
5985 = (color_distance (&fg_std_color, &bg_std_color)
5986 - color_distance (&fg_tty_color, &bg_tty_color));
5987 if (delta_delta > TTY_SAME_COLOR_THRESHOLD
5988 || delta_delta < -TTY_SAME_COLOR_THRESHOLD)
5989 return 0;
5990 }
5991
5992
5993 /* See if the capabilities we selected above are supported, with the
5994 given colors. */
5995 if (test_caps != 0 &&
5996 ! tty_capable_p (FRAME_TTY (f), test_caps, fg_tty_color.pixel, bg_tty_color.pixel))
5997 return 0;
5998
5999
6000 /* Hmmm, everything checks out, this terminal must support this face. */
6001 return 1;
6002}
6003
6004
6005DEFUN ("display-supports-face-attributes-p",
6006 Fdisplay_supports_face_attributes_p, Sdisplay_supports_face_attributes_p,
6007 1, 2, 0,
6008 doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
6009The optional argument DISPLAY can be a display name, a frame, or
6010nil (meaning the selected frame's display)
6011
6012The definition of `supported' is somewhat heuristic, but basically means
6013that a face containing all the attributes in ATTRIBUTES, when merged
6014with the default face for display, can be represented in a way that's
6015
6016 \(1) different in appearance than the default face, and
6017 \(2) `close in spirit' to what the attributes specify, if not exact.
6018
6019Point (2) implies that a `:weight black' attribute will be satisfied by
6020any display that can display bold, and a `:foreground \"yellow\"' as long
6021as it can display a yellowish color, but `:slant italic' will _not_ be
6022satisfied by the tty display code's automatic substitution of a `dim'
6023face for italic. */)
6024 (attributes, display)
6025 Lisp_Object attributes, display;
6026{
6027 int supports, i;
6028 Lisp_Object frame;
6029 struct frame *f;
6030 struct face *def_face;
6031 Lisp_Object attrs[LFACE_VECTOR_SIZE];
6032
6033 if (NILP (display))
6034 frame = selected_frame;
6035 else if (FRAMEP (display))
6036 frame = display;
6037 else
6038 {
6039 /* Find any frame on DISPLAY. */
6040 Lisp_Object fl_tail;
6041
6042 frame = Qnil;
6043 for (fl_tail = Vframe_list; CONSP (fl_tail); fl_tail = XCDR (fl_tail))
6044 {
6045 frame = XCAR (fl_tail);
6046 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay,
6047 XFRAME (frame)->param_alist)),
6048 display)))
6049 break;
6050 }
6051 }
6052
6053 CHECK_LIVE_FRAME (frame);
6054 f = XFRAME (frame);
6055
6056 for (i = 0; i < LFACE_VECTOR_SIZE; i++)
6057 attrs[i] = Qunspecified;
6058 merge_face_vector_with_property (f, attrs, attributes);
6059
6060 def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
6061 if (def_face == NULL)
6062 {
6063 if (! realize_basic_faces (f))
6064 signal_error ("Cannot realize default face", 0);
6065 def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
6066 }
6067
6068 /* Dispatch to the appropriate handler. */
6069 if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
6070 supports = tty_supports_face_attributes_p (f, attrs, def_face);
6071#ifdef HAVE_WINDOW_SYSTEM
6072 else
6073 supports = x_supports_face_attributes_p (f, attrs, def_face);
6074#endif
6075
6076 return supports ? Qt : Qnil;
6077}
6078
6079
6080/***********************************************************************
5920 Font selection 6081 Font selection
5921 ***********************************************************************/ 6082 ***********************************************************************/
5922 6083
@@ -7722,7 +7883,7 @@ syms_of_xfaces ()
7722 defsubr (&Sinternal_merge_in_global_face); 7883 defsubr (&Sinternal_merge_in_global_face);
7723 defsubr (&Sface_font); 7884 defsubr (&Sface_font);
7724 defsubr (&Sframe_face_alist); 7885 defsubr (&Sframe_face_alist);
7725 defsubr (&Stty_supports_face_attributes_p); 7886 defsubr (&Sdisplay_supports_face_attributes_p);
7726 defsubr (&Scolor_distance); 7887 defsubr (&Scolor_distance);
7727 defsubr (&Sinternal_set_font_selection_order); 7888 defsubr (&Sinternal_set_font_selection_order);
7728 defsubr (&Sinternal_set_alternative_font_family_alist); 7889 defsubr (&Sinternal_set_alternative_font_family_alist);