diff options
| author | Karoly Lorentey | 2004-06-05 17:21:43 +0000 |
|---|---|---|
| committer | Karoly Lorentey | 2004-06-05 17:21:43 +0000 |
| commit | 3d63dd9d07a4ce2fbff5c4dd674f2593c1e3a278 (patch) | |
| tree | 148939ccc16f4f81c8231987a0556ec21d529e7b | |
| parent | bf2d7b586bf6add7527739fcbdc007e921259397 (diff) | |
| parent | 8e330b2257db682ec067cdd72d8e7a4580f97505 (diff) | |
| download | emacs-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/NEWS | 7 | ||||
| -rw-r--r-- | lisp/ChangeLog | 62 | ||||
| -rw-r--r-- | lisp/battery.el | 45 | ||||
| -rw-r--r-- | lisp/faces.el | 62 | ||||
| -rw-r--r-- | lisp/help-fns.el | 17 | ||||
| -rw-r--r-- | lisp/textmodes/table.el | 17 | ||||
| -rw-r--r-- | lisp/vc-svn.el | 5 | ||||
| -rw-r--r-- | lisp/woman.el | 104 | ||||
| -rw-r--r-- | lispref/display.texi | 6 | ||||
| -rw-r--r-- | nt/ChangeLog | 6 | ||||
| -rw-r--r-- | nt/INSTALL | 47 | ||||
| -rw-r--r-- | src/ChangeLog | 23 | ||||
| -rw-r--r-- | src/xfaces.c | 599 |
13 files changed, 635 insertions, 365 deletions
| @@ -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 |
| 109 | arguments in lowercase italics on displays that support it. To change the | 109 | arguments in lowercase italics on displays that support it. To change the |
| 110 | default, redefine the function `help-default-arg-highlight'. | 110 | default, 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 | |||
| 3032 | specification language, which can be used to do this test for faces | 3033 | specification language, which can be used to do this test for faces |
| 3033 | defined with defface. | 3034 | defined with defface. |
| 3034 | 3035 | ||
| 3036 | ** The function face-differs-from-default-p now truly checks whether the | ||
| 3037 | given face displays differently from the default face or not (previously | ||
| 3038 | it 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 |
| 3037 | accept a new optional argument, INHERIT, which controls how face | 3042 | accept 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 @@ | |||
| 1 | 2004-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 | |||
| 7 | 2004-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 | |||
| 12 | 2004-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 | |||
| 19 | 2004-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 | |||
| 26 | 2004-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 | |||
| 38 | 2004-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 | |||
| 44 | 2004-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 | |||
| 49 | 2004-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 | |||
| 1 | 2004-06-03 Miles Bader <miles@gnu.org> | 57 | 2004-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 | ||
| 199 | 2004-05-29 Pavel Kobiakov <pk_at_work@yahoo.com> | 255 | 2004-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 | ||
| 6386 | 2003-09-24 Andre Spiegel <spiegel@gnu.org> | 6442 | 2003-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. |
| 66 | Ordinary characters in the control string are printed as-is, while | 66 | Ordinary characters in the control string are printed as-is, while |
| 67 | conversion specifications introduced by a `%' character in the control | 67 | conversion 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. |
| 244 | If the optional argument FRAME is given, report on face FACE in that frame. | 244 | If the optional argument FRAME is given, report on face FACE in that frame. |
| 245 | If FRAME is t, report on the defaults for face FACE (for new frames). | 245 | If FRAME is t, report on the defaults for face FACE (for new frames). |
| 246 | If FRAME is omitted or nil, use the selected frame. | 246 | If FRAME is omitted or nil, use the selected frame." |
| 247 | A face is considered to be ``the same'' as the default face if it is | 247 | (let ((attrs |
| 248 | actually specified in the same way (equal attributes) or if it is | 248 | '(:family :width :height :weight :slant :foreground |
| 249 | fully-unspecified, and thus inherits the attributes of any face it | 249 | :foreground :background :underline :overline |
| 250 | is 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. | ||
| 1494 | The optional argument DISPLAY can be a display name, a frame, or | ||
| 1495 | nil (meaning the selected frame's display) | ||
| 1496 | |||
| 1497 | The definition of `supported' is somewhat heuristic, but basically means | ||
| 1498 | that a face containing all the attributes in ATTRIBUTES, when merged | ||
| 1499 | with 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 | |||
| 1504 | Point (2) implies that a `:weight black' attribute will be satisfied by | ||
| 1505 | any display that can display bold, and a `:foreground \"yellow\"' as long | ||
| 1506 | as it can display a yellowish color, but `:slant italic' will _not_ be | ||
| 1507 | satisfied by the tty display code's automatic substitution of a `dim' | ||
| 1508 | face 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. |
| 242 | It returns ARG in lowercase italics, if the display supports it; | 246 | It returns ARG in face `help-argument-name'; ARG is also |
| 243 | else ARG is returned in uppercase normal." | 247 | downcased if it displays differently than the default |
| 244 | (let ((attrs '(:slant italic))) | 248 | face (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. |
| 439 | FN must return a list, cons or nil. Useful for splicing into a list." | 440 | FN 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. |
| 1407 | Also make each path-info component into a list. | 1419 | Also 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 |
| 2291 | This returns @code{t} if the face @var{face} displays differently from | 2291 | This returns non-@code{nil} if the face @var{face} displays |
| 2292 | the default face. A face is considered to be ``the same'' as the | 2292 | differently from the default face. |
| 2293 | default face if each attribute is either the same as that of the default | ||
| 2294 | face, 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 @@ | |||
| 1 | 2004-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 | |||
| 1 | 2004-05-06 Jason Rumney <jasonr@gnu.org> | 7 | 2004-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 @@ | |||
| 1 | 2004-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 | |||
| 6 | 2004-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 | |||
| 13 | 2004-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 | |||
| 1 | 2004-06-03 Juanma Barranquero <lektu@terra.es> | 24 | 2004-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 | ||
| 4877 | static INLINE int | 4877 | static INLINE int |
| 4878 | lface_equal_p (v1, v2) | 4878 | face_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 | |||
| 4910 | static INLINE int | ||
| 4911 | lface_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 | |||
| 5226 | DEFUN ("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. | ||
| 5230 | The optional argument FRAME is the frame on which to test; if it is nil | ||
| 5231 | or unspecified, then the current frame is used. If FRAME is not a tty | ||
| 5232 | frame, then nil is returned. | ||
| 5233 | |||
| 5234 | The definition of `supported' is somewhat heuristic, but basically means | ||
| 5235 | that a face containing all the attributes in ATTRIBUTES, when merged | ||
| 5236 | with 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 | |||
| 5241 | Point (2) implies that a `:weight black' attribute will be satisfied | ||
| 5242 | by any terminal that can display bold, and a `:foreground "yellow"' as | ||
| 5243 | long as the terminal can display a yellowish color, but `:slant italic' | ||
| 5244 | will _not_ be satisfied by the tty display code's automatic | ||
| 5245 | substitution 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 | |||
| 5758 | static int | ||
| 5759 | x_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 | |||
| 5842 | static int | ||
| 5843 | tty_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 | |||
| 6005 | DEFUN ("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. | ||
| 6009 | The optional argument DISPLAY can be a display name, a frame, or | ||
| 6010 | nil (meaning the selected frame's display) | ||
| 6011 | |||
| 6012 | The definition of `supported' is somewhat heuristic, but basically means | ||
| 6013 | that a face containing all the attributes in ATTRIBUTES, when merged | ||
| 6014 | with 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 | |||
| 6019 | Point (2) implies that a `:weight black' attribute will be satisfied by | ||
| 6020 | any display that can display bold, and a `:foreground \"yellow\"' as long | ||
| 6021 | as it can display a yellowish color, but `:slant italic' will _not_ be | ||
| 6022 | satisfied by the tty display code's automatic substitution of a `dim' | ||
| 6023 | face 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); |