Mercurial > hg > xemacs-beta

comparison lisp/faces.el @ 373:6240c7796c7a r21-2b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b2
author cvs
date Mon, 13 Aug 2007 11:04:06 +0200
parents cc15677e0335
children d883f39b8495
comparison
equal deleted inserted replaced
372:49e1ed2d7ed8 373:6240c7796c7a
316 highlight Highlight all text covered by this face. 316 highlight Highlight all text covered by this face.
317 Only used by faces on TTY devices. 317 Only used by faces on TTY devices.
318 For valid instantiators, see `face-boolean-specifier-p'. 318 For valid instantiators, see `face-boolean-specifier-p'.
319 319
320 dim Dim all text covered by this face. 320 dim Dim all text covered by this face.
321 Only used by faces on TTY devices.
322 For valid instantiators, see `face-boolean-specifier-p'. 321 For valid instantiators, see `face-boolean-specifier-p'.
323 322
324 blinking Blink all text covered by this face. 323 blinking Blink all text covered by this face.
325 Only used by faces on TTY devices. 324 Only used by faces on TTY devices.
326 For valid instantiators, see `face-boolean-specifier-p'. 325 For valid instantiators, see `face-boolean-specifier-p'.
688 HOW-TO-ADD arguments." 687 HOW-TO-ADD arguments."
689 (interactive (face-interactive "highlight-p" "highlighted")) 688 (interactive (face-interactive "highlight-p" "highlighted"))
690 (set-face-property face 'highlight highlight-p locale tag-set how-to-add)) 689 (set-face-property face 'highlight highlight-p locale tag-set how-to-add))
691 690
692 (defun face-dim-p (face &optional domain default no-fallback) 691 (defun face-dim-p (face &optional domain default no-fallback)
693 "Return t if FACE is dimmed in DOMAIN (TTY domains only). 692 "Return t if FACE is dimmed in DOMAIN.
694 See `face-property-instance' for the semantics of the DOMAIN argument." 693 See `face-property-instance' for the semantics of the DOMAIN argument."
695 (face-property-instance face 'dim domain default no-fallback)) 694 (face-property-instance face 'dim domain default no-fallback))
696 695
697 (defun set-face-dim-p (face dim-p &optional locale tag-set how-to-add) 696 (defun set-face-dim-p (face dim-p &optional locale tag-set how-to-add)
698 "Change whether FACE is dimmed in LOCALE (TTY locales only). 697 "Change whether FACE is dimmed in LOCALE.
699 DIM-P is normally a face-boolean instantiator; see 698 DIM-P is normally a face-boolean instantiator; see
700 `face-boolean-specifier-p'. 699 `face-boolean-specifier-p'.
701 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and 700 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
702 HOW-TO-ADD arguments." 701 HOW-TO-ADD arguments."
703 (interactive (face-interactive "dim-p" "dimmed")) 702 (interactive (face-interactive "dim-p" "dimmed"))
748 See `face-property-instance' for the semantics of the DOMAIN argument." 747 See `face-property-instance' for the semantics of the DOMAIN argument."
749 (if (null domain) (setq domain (selected-window))) 748 (if (null domain) (setq domain (selected-window)))
750 (if (not (valid-specifier-domain-p domain)) 749 (if (not (valid-specifier-domain-p domain))
751 (error "Invalid specifier domain")) 750 (error "Invalid specifier domain"))
752 (let ((device (dfw-device domain)) 751 (let ((device (dfw-device domain))
753 (common-props '(foreground background font display-table underline)) 752 (common-props '(foreground background font display-table underline
753 dim))
754 (win-props '(background-pixmap strikethru)) 754 (win-props '(background-pixmap strikethru))
755 (tty-props '(highlight dim blinking reverse))) 755 (tty-props '(highlight blinking reverse)))
756 756
757 ;; First check the properties which are used in common between the 757 ;; First check the properties which are used in common between the
758 ;; x and tty devices. Then, check those properties specific to 758 ;; x and tty devices. Then, check those properties specific to
759 ;; the particular device type. 759 ;; the particular device type.
760 (and (face-equal-loop common-props face1 face2 domain) 760 (and (face-equal-loop common-props face1 face2 domain)
1254 ;;(default-custom-frame-properties) 1254 ;;(default-custom-frame-properties)
1255 (t 1255 (t
1256 (setq default-custom-frame-properties 1256 (setq default-custom-frame-properties
1257 (extract-custom-frame-properties (selected-frame)))))) 1257 (extract-custom-frame-properties (selected-frame))))))
1258 1258
1259 (defun face-spec-update-all-matching (spec display plist)
1260 "Update all entries in the face spec that could match display to
1261 have the entries from the new plist and return the new spec"
1262 (mapcar
1263 (lambda (e)
1264 (let ((entries (car e))
1265 (options (cadr e))
1266 (match t)
1267 dplist
1268 (new-options plist)
1269 )
1270 (unless (eq display t)
1271 (mapc (lambda (arg)
1272 (setq dplist (plist-put dplist (car arg) (cadr arg))))
1273 display))
1274 (unless (eq entries t)
1275 (mapc (lambda (arg)
1276 (setq match (and match (eq (cadr arg)
1277 (plist-get
1278 dplist (car arg)
1279 (cadr arg))))))
1280 entries))
1281 (if (not match)
1282 e
1283 (while new-options
1284 (setq options
1285 (plist-put options (car new-options) (cadr new-options)))
1286 (setq new-options (cddr new-options)))
1287 (list entries options))))
1288 (copy-sequence spec)))
1289
1290
1291
1259 (defun face-spec-set-match-display (display &optional frame) 1292 (defun face-spec-set-match-display (display &optional frame)
1260 "Return non-nil if DISPLAY matches FRAME. 1293 "Return non-nil if DISPLAY matches FRAME.
1261 DISPLAY is part of a spec such as can be used in `defface'. 1294 DISPLAY is part of a spec such as can be used in `defface'.
1262 If FRAME is nil or omitted, the selected frame is used." 1295 If FRAME is nil or omitted, the selected frame is used."
1263 (if (eq display t) 1296 (if (eq display t)