view lisp/x-misc.el @ 5617:b0d712bbc2a6

The "flush" face property. -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2011-12-23 Didier Verna <didier@xemacs.org> * faces.h (struct Lisp_Face): New 'flush slot. * faces.h (struct face_cachel): New 'flush and 'flush_specified flags. * faces.h (WINDOW_FACE_CACHEL_FLUSH_P): * faces.h (FACE_FLUSH_P): New macros. * faces.c: Declare Qflush. * lisp.h: Externalize it. * faces.c (syms_of_faces): Define it. * faces.c (vars_of_faces): Update built-in face specifiers. * faces.c (complex_vars_of_faces): Update specifier fallbacks. * faces.c (mark_face): * faces.c (face_equal): * faces.c (face_getprop): * faces.c (face_putprop): * faces.c (face_remprop): * faces.c (face_plist): * faces.c (reset_face): * faces.c (update_face_inheritance_mapper): * faces.c (Fmake_face): * faces.c (update_face_cachel_data): * faces.c (merge_face_cachel_data): * faces.c (Fcopy_face): * fontcolor.c (face_boolean_validate): Handle the flush property. * redisplay.h (struct display_line): Rename 'default_findex slot to clearer name 'clear_findex. * redisplay.h (DISPLAY_LINE_INIT): Update accordingly. * redisplay-output.c (compare_display_blocks): * redisplay-output.c (output_display_line): * redisplay-output.c (redisplay_output_window): * redisplay.c (regenerate_window_extents_only_changed): * redisplay.c (regenerate_window_incrementally): Update the comparison tests between the current and desired display lines to cope for different 'clear_findex values. * redisplay.c (create_text_block): Initialize the display line's 'clear_findex slot to DEFAULT_INDEX. Record a new 'clear_findex value when we encounter a newline character displayed in a flushed face. * redisplay.c (create_string_text_block): Record a new 'clear_findex value when we encounter a newline character displayed in a flushed face. lisp/ChangeLog addition: 2011-12-23 Didier Verna <didier@xemacs.org> * cl-macs.el (face-flush-p): New defsetf. * faces.el (set-face-property): Document the flush property. * faces.el (face-flush-p): New function. * faces.el (set-face-flush-p): New function. * faces.el (face-equal): * cus-face.el (custom-face-attributes): * x-faces.el (x-init-face-from-resources): * x-faces.el (make-face-x-resource-internal): Handle the flush property.
author Didier Verna <didier@xemacs.org>
date Fri, 23 Dec 2011 10:56:16 +0100
parents 6506fcb40fcf
children
line wrap: on
line source

;;; x-misc.el --- miscellaneous X functions.

;; Copyright (C) 1997 Free Software Foundation, Inc.
;; Copyright (C) 1995 Sun Microsystems.
;; Copyright (C) 1995, 1996 Ben Wing.

;; Author: Ben Wing <ben@xemacs.org>
;; Maintainer: XEmacs Development Team
;; Keywords: extensions, dumped

;; This file is part of XEmacs.

;; XEmacs is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
;; Free Software Foundation, either version 3 of the License, or (at your
;; option) any later version.

;; XEmacs is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
;; for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file is dumped with XEmacs (when X support is compiled in).

;;; Code:

(globally-declare-fboundp
 '(x-get-resource))

(defun x-bogosity-check-resource (name class type)
  "Check for a bogus resource specification."
  (let ((bogus (x-get-resource
		(concat "__no-such-friggin-locale__." name)
		(concat "__No-such-friggin-widget__." class)
		type 'global nil t)))
    (if bogus
	(display-warning
	 'resource
	 (format "Bad resource specification encountered: something like
     Emacs*%s: %s
You should replace the * with a . in order to get proper behavior when
you use the specifier and/or `set-face-*' functions." name bogus)))))

(defun x-init-specifier-from-resources (specifier type locale
						  &rest resource-list)
  "Initialize a specifier from the resource database.
LOCALE specifies the locale that is to be initialized and should be
a frame, a device, or 'global.  TYPE is the type of the resource and
should be one of 'string, 'boolean, 'integer, or 'natnum.  The
remaining args should be conses of names and classes of resources
to be examined.  The first resource with a value specified becomes
the spec for SPECIFIER in LOCALE. (However, if SPECIFIER already
has a spec in LOCALE, nothing is done.) Finally, if LOCALE is 'global,
a check is done for bogus resource specifications."
  (if (eq locale 'global)
      (mapc #'(lambda (x)
                (x-bogosity-check-resource (car x) (cdr x) type))
            resource-list))
  (if (not (specifier-spec-list specifier locale))
      (catch 'done
	(while resource-list
	  (let* ((name (caar resource-list))
		 (class (cdar resource-list))
		 (resource
		  (x-get-resource name class type locale nil 'warn)))
	    (if resource
		(progn
		  (add-spec-to-specifier specifier resource locale)
		  (throw 'done t))))
	  (setq resource-list (cdr resource-list))))))

(defun x-get-resource-and-bogosity-check (name class type &optional locale)
  (x-bogosity-check-resource name class type)
  (x-get-resource name class type locale nil 'warn))

(defun x-get-resource-and-maybe-bogosity-check (name class type &optional
						     locale)
  (if (eq locale 'global)
      (x-bogosity-check-resource name class type))
  (x-get-resource name class type locale nil 'warn))

(defun device-x-display (&optional device)
  "If DEVICE is an X11 device, return its DISPLAY.

DEVICE defaults to the selected device."
  (and (eq 'x (device-type device)) (device-connection device)))

;;; x-misc.el ends here