Mercurial > emacs

comparison lisp/faces.el @ 9569:943acba6d366

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(set-face-stipple): New function. (set-face-background-pixmap): An alias for that. (face-stipple): New function. (face-background-pixmap): An alias for that. (copy-face, face-equal, face-differs-from-default-p) (make-face-x-resource-internal): Handle stipple bitmaps.
author Richard M. Stallman <rms@gnu.org>
date Mon, 17 Oct 1994 07:31:52 +0000
parents 3fe469325a8b
children b36d5e88cccc
comparison
equal deleted inserted replaced
9568:0ea557ca2caa 9569:943acba6d366
26 26
27 27
28 ;;;; Functions for manipulating face vectors. 28 ;;;; Functions for manipulating face vectors.
29 29
30 ;;; A face vector is a vector of the form: 30 ;;; A face vector is a vector of the form:
31 ;;; [face NAME ID FONT FOREGROUND BACKGROUND BACKGROUND-PIXMAP UNDERLINE] 31 ;;; [face NAME ID FONT FOREGROUND BACKGROUND STIPPLE UNDERLINE]
32 32
33 ;;; Type checkers. 33 ;;; Type checkers.
34 (defsubst internal-facep (x) 34 (defsubst internal-facep (x)
35 (and (vectorp x) (= (length x) 8) (eq (aref x 0) 'face))) 35 (and (vectorp x) (= (length x) 8) (eq (aref x 0) 'face)))
36 36
68 If the optional argument FRAME is given, report on face FACE in that frame. 68 If the optional argument FRAME is given, report on face FACE in that frame.
69 If FRAME is t, report on the defaults for face FACE (for new frames). 69 If FRAME is t, report on the defaults for face FACE (for new frames).
70 If FRAME is omitted or nil, use the selected frame." 70 If FRAME is omitted or nil, use the selected frame."
71 (aref (internal-get-face face frame) 5)) 71 (aref (internal-get-face face frame) 5))
72 72
73 ;;(defsubst face-background-pixmap (face &optional frame) 73 (defsubst face-stipple (face &optional frame)
74 ;; "Return the background pixmap name of face FACE, or nil if unspecified. 74 "Return the stipple pixmap name of face FACE, or nil if unspecified.
75 ;;If the optional argument FRAME is given, report on face FACE in that frame. 75 If the optional argument FRAME is given, report on face FACE in that frame.
76 ;;Otherwise report on the defaults for face FACE (for new frames)." 76 If FRAME is t, report on the defaults for face FACE (for new frames).
77 ;; (aref (internal-get-face face frame) 6)) 77 If FRAME is omitted or nil, use the selected frame."
78 (aref (internal-get-face face frame) 6))
79
80 (defalias 'face-background-pixmap 'face-stipple)
78 81
79 (defsubst face-underline-p (face &optional frame) 82 (defsubst face-underline-p (face &optional frame)
80 "Return t if face FACE is underlined. 83 "Return t if face FACE is underlined.
81 If the optional argument FRAME is given, report on face FACE in that frame. 84 If the optional argument FRAME is given, report on face FACE in that frame.
82 If FRAME is t, report on the defaults for face FACE (for new frames). 85 If FRAME is t, report on the defaults for face FACE (for new frames).
106 If the optional FRAME argument is provided, change only 109 If the optional FRAME argument is provided, change only
107 in that frame; otherwise change each frame." 110 in that frame; otherwise change each frame."
108 (interactive (internal-face-interactive "background")) 111 (interactive (internal-face-interactive "background"))
109 (internal-set-face-1 face 'background color 5 frame)) 112 (internal-set-face-1 face 'background color 5 frame))
110 113
111 ;;(defsubst set-face-background-pixmap (face name &optional frame) 114 (defsubst set-face-stipple (face name &optional frame)
112 ;; "Change the background pixmap of face FACE to PIXMAP. 115 "Change the stipple pixmap of face FACE to PIXMAP.
113 ;;PIXMAP should be a string, the name of a file of pixmap data. 116 PIXMAP should be a string, the name of a file of pixmap data.
114 ;;The directories listed in the `x-bitmap-file-path' variable are searched. 117 The directories listed in the `x-bitmap-file-path' variable are searched.
115 118
116 ;;Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA) 119 Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA)
117 ;;where WIDTH and HEIGHT are the size in pixels, 120 where WIDTH and HEIGHT are the size in pixels,
118 ;;and DATA is a string, containing the raw bits of the bitmap. 121 and DATA is a string, containing the raw bits of the bitmap.
119 122
120 ;;If the optional FRAME argument is provided, change only 123 If the optional FRAME argument is provided, change only
121 ;;in that frame; otherwise change each frame." 124 in that frame; otherwise change each frame."
122 ;; (interactive (internal-face-interactive "background-pixmap")) 125 (interactive (internal-face-interactive "stipple"))
123 ;; (internal-set-face-1 face 'background-pixmap name 6 frame)) 126 (internal-set-face-1 face 'background-pixmap name 6 frame))
127
128 (defalias 'set-face-background-pixmap 'set-face-stipple)
124 129
125 (defsubst set-face-underline-p (face underline-p &optional frame) 130 (defsubst set-face-underline-p (face underline-p &optional frame)
126 "Specify whether face FACE is underlined. (Yes if UNDERLINE-P is non-nil.) 131 "Specify whether face FACE is underlined. (Yes if UNDERLINE-P is non-nil.)
127 If the optional FRAME argument is provided, change only 132 If the optional FRAME argument is provided, change only
128 in that frame; otherwise change each frame." 133 in that frame; otherwise change each frame."
303 "Face.AttributeForeground") 308 "Face.AttributeForeground")
304 (and set-anyway (face-foreground face)))) 309 (and set-anyway (face-foreground face))))
305 (bg (or (x-get-resource (concat name ".attributeBackground") 310 (bg (or (x-get-resource (concat name ".attributeBackground")
306 "Face.AttributeBackground") 311 "Face.AttributeBackground")
307 (and set-anyway (face-background face)))) 312 (and set-anyway (face-background face))))
308 ;; (bgp (or (x-get-resource (concat name ".attributeBackgroundPixmap") 313 (bgp (or (x-get-resource (concat name ".attributeStipple")
309 ;; "Face.AttributeBackgroundPixmap") 314 "Face.AttributeStipple")
310 ;; (and set-anyway (face-background-pixmap face)))) 315 (x-get-resource (concat name ".attributeBackgroundPixmap")
316 "Face.AttributeBackgroundPixmap")
317 (and set-anyway (face-stipple face))))
311 (ulp (let ((resource (x-get-resource 318 (ulp (let ((resource (x-get-resource
312 (concat name ".attributeUnderline") 319 (concat name ".attributeUnderline")
313 "Face.AttributeUnderline"))) 320 "Face.AttributeUnderline")))
314 (if resource 321 (if resource
315 (member (downcase resource) '("on" "true")) 322 (member (downcase resource) '("on" "true"))
325 (error (message "color `%s' not allocated for face `%s'" fg name)))) 332 (error (message "color `%s' not allocated for face `%s'" fg name))))
326 (if bg 333 (if bg
327 (condition-case () 334 (condition-case ()
328 (set-face-background face bg frame) 335 (set-face-background face bg frame)
329 (error (message "color `%s' not allocated for face `%s'" bg name)))) 336 (error (message "color `%s' not allocated for face `%s'" bg name))))
330 ;; (if bgp 337 (if bgp
331 ;; (condition-case () 338 (condition-case ()
332 ;; (set-face-background-pixmap face bgp frame) 339 (set-face-stipple face bgp frame)
333 ;; (error (message "pixmap `%s' not found for face `%s'" bgp name)))) 340 (error (message "pixmap `%s' not found for face `%s'" bgp name))))
334 (if (or ulp set-anyway) 341 (if (or ulp set-anyway)
335 (set-face-underline-p face ulp frame)) 342 (set-face-underline-p face ulp frame))
336 ))) 343 )))
337 face) 344 face)
338 345
368 (set-face-font new-face (face-font old-face frame) new-frame) 375 (set-face-font new-face (face-font old-face frame) new-frame)
369 (error 376 (error
370 (set-face-font new-face nil new-frame))) 377 (set-face-font new-face nil new-frame)))
371 (set-face-foreground new-face (face-foreground old-face frame) new-frame) 378 (set-face-foreground new-face (face-foreground old-face frame) new-frame)
372 (set-face-background new-face (face-background old-face frame) new-frame) 379 (set-face-background new-face (face-background old-face frame) new-frame)
373 ;;; (set-face-background-pixmap 380 (set-face-stipple new-face
374 ;;; new-face (face-background-pixmap old-face frame) new-frame) 381 (face-stipple old-face frame)
382 new-frame)
375 (set-face-underline-p new-face (face-underline-p old-face frame) 383 (set-face-underline-p new-face (face-underline-p old-face frame)
376 new-frame)) 384 new-frame))
377 new-face)) 385 new-face))
378 386
379 (defun face-equal (face1 face2 &optional frame) 387 (defun face-equal (face1 face2 &optional frame)
382 face2 (internal-get-face face2 frame)) 390 face2 (internal-get-face face2 frame))
383 (and (equal (face-foreground face1 frame) (face-foreground face2 frame)) 391 (and (equal (face-foreground face1 frame) (face-foreground face2 frame))
384 (equal (face-background face1 frame) (face-background face2 frame)) 392 (equal (face-background face1 frame) (face-background face2 frame))
385 (equal (face-font face1 frame) (face-font face2 frame)) 393 (equal (face-font face1 frame) (face-font face2 frame))
386 (eq (face-underline-p face1 frame) (face-underline-p face2 frame)) 394 (eq (face-underline-p face1 frame) (face-underline-p face2 frame))
387 ;; (equal (face-background-pixmap face1 frame) 395 (equal (face-stipple face1 frame)
388 ;; (face-background-pixmap face2 frame)) 396 (face-stipple face2 frame))))
389 ))
390 397
391 (defun face-differs-from-default-p (face &optional frame) 398 (defun face-differs-from-default-p (face &optional frame)
392 "True if face FACE displays differently from the default face, on FRAME. 399 "True if face FACE displays differently from the default face, on FRAME.
393 A face is considered to be ``the same'' as the default face if it is 400 A face is considered to be ``the same'' as the default face if it is
394 actually specified in the same way (equivalent fonts, etc) or if it is 401 actually specified in the same way (equivalent fonts, etc) or if it is
402 (or (equal (face-background default frame) 409 (or (equal (face-background default frame)
403 (face-background face frame)) 410 (face-background face frame))
404 (null (face-background face frame))) 411 (null (face-background face frame)))
405 (or (equal (face-font default frame) (face-font face frame)) 412 (or (equal (face-font default frame) (face-font face frame))
406 (null (face-font face frame))) 413 (null (face-font face frame)))
407 ;;; (or (equal (face-background-pixmap default frame) 414 (or (equal (face-stipple default frame)
408 ;;; (face-background-pixmap face frame)) 415 (face-stipple face frame))
409 ;;; (null (face-background-pixmap face frame))) 416 (null (face-stipple face frame)))
410 (equal (face-underline-p default frame) 417 (equal (face-underline-p default frame)
411 (face-underline-p face frame)) 418 (face-underline-p face frame))
412 )))) 419 ))))
413 420
414 421