view lisp/x-misc.el @ 4506:bd28481bb0e1

Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions. lisp/ChangeLog addition: 2008-08-31 Aidan Kehoe <kehoea@parhasard.net> * window.el (only-window-p): New. Check if WINDOW is the only window in some context, normally its frame. (one-window-p): Implemented this in terms of #'only-window-p, calling it on the selected window. (window-buffer-height): Uncomment this, make it work. (count-screen-lines): Support a BUFFER argument. (fit-window-to-buffer): Uncomment this, correct its implementation to work with XEmacs. * help.el (temp-buffer-resize-mode): New. Name taken from GNU, implementation our own. * (resize-temp-buffer-window): New. GNU-compatible alias for #'shrink-window-if-larger-than-buffer. * dumped-lisp.el (preloaded-file-list): Move easy-mmode before help, now that the latter uses #'define-minor-mode. * frame.el: Point to #'temp-buffer-resize-mode in a comment. Some of this code is from GNU; help.el CVS version 1.327 of 2007-03-21, window.el CVS version 1.122, of 2007-06-24. Both these are GPLV2 or later.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 31 Aug 2008 12:26:46 +0200
parents 7039e6323819
children e29fcfd8df5f
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 2, 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; see the file COPYING.  If not, write to the 
;; Free Software Foundation, 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; 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)
      (mapcar #'(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))

;;; x-misc.el ends here