1 ;;; gui.el --- Basic GUI functions for SXEmacs.
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1996 Ben Wing
6 ;; Maintainer: SXEmacs Development Team
7 ;; Keywords: internal, dumped
9 ;; This file is part of SXEmacs.
11 ;; SXEmacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; SXEmacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Synched up with: Not in FSF
28 ;; This file is dumped with SXEmacs (when window system support is compiled in).
32 (defcustom dialog-frame-plist '(width 60 height 20)
33 "Plist of frame properties for initially creating a dialog frame.
34 Properties specified here supersede the values given in
35 `default-frame-plist'."
39 (defun make-dialog-frame (&optional props parent)
40 "Create a frame suitable for use as a dialog box.
41 The frame is made a child of PARENT (defaults to the selected frame),
42 and has additional properties PROPS, as well as `dialog-frame-plist'.
43 Normally it also has no modelines, menubars, or toolbars."
44 (or parent (setq parent (selected-frame)))
45 (let* ((ftop (frame-property parent 'top))
46 (fleft (frame-property parent 'left))
47 (fwidth (frame-pixel-width parent))
48 (fheight (frame-pixel-height parent))
49 (fonth (font-height (face-font 'default)))
50 (fontw (font-width (face-font 'default)))
51 (props (append props dialog-frame-plist))
52 (dfheight (plist-get props 'height))
53 (dfwidth (plist-get props 'width))
54 ;; under FVWM at least, if I don't specify the initial position,
55 ;; it ends up always at (0, 0). xwininfo doesn't tell me
56 ;; that there are any program-specified position hints, so
57 ;; it must be an FVWM bug. So just be smashing and position
58 ;; in the center of the selected frame.
61 `(popup ,parent initially-unmapped t
64 default-toolbar-visible-p nil
65 default-gutter-visible-p nil
66 modeline-shadow-thickness 0
67 left ,(+ fleft (- (/ fwidth 2)
70 top ,(+ ftop (- (/ fheight 2)
73 (set-face-foreground 'modeline [default foreground] frame)
74 (set-face-background 'modeline [default background] frame)
75 (make-frame-visible frame)
78 (defvar gui-button-shadow-thickness 2)
80 (defun gui-button-p (object)
81 "True if OBJECT is a GUI button."
84 (eq 'button (aref object 0))))
86 (make-face 'gui-button-face "Face used for gui buttons")
87 (if (not (face-differs-from-default-p 'gui-button-face))
89 (set-face-reverse-p 'gui-button-face t)
90 (set-face-background 'gui-button-face '(((x color) . "grey75")))
91 (set-face-foreground 'gui-button-face '(((x color) . "black")))))
94 (defun gui-button-action (instance action user-data)
95 (let ((domain (image-instance-domain instance)))
96 (with-current-buffer (if (windowp domain)
97 (window-buffer domain) nil)
98 (funcall action user-data))))
100 (defun make-gui-button (string &optional action user-data)
101 "Make a GUI button whose label is STRING and whose action is ACTION.
102 If the button is inserted in a buffer and then clicked on, and ACTION
103 is non-nil, ACTION will be called with one argument, USER-DATA.
104 When ACTION is called, the buffer containing the button is made current."
107 :face 'gui-button-face
108 :callback-ex `(lambda (image-instance event)
109 (gui-button-action image-instance
111 (quote ,user-data)))))
113 (defun insert-gui-button (button &optional pos buffer)
114 "Insert GUI button BUTTON at POS in BUFFER."
115 (check-argument-type 'gui-button-p button)
116 (declare-fboundp (make-annotation (make-glyph button)
117 pos 'text buffer nil)))