annotate lisp/generic-widgets.el @ 2421:ab71ad6ff3dd

[xemacs-hg @ 2004-12-06 03:50:53 by ben] (none) README.packages: Document use of --package-prefix. Fix error in specifying standard package location. make-docfile.c: Use QXE_PATH_MAX. info.el: Correct doc string giving example package path. menubar-items.el: Move Prefix Rectangle command up one level. xemacs/packages.texi: Add long form of Lisp Reference Manual to links. Add links pointing to Lisp Reference Manual for more detailed package discussion. lispref/range-tables.texi: Document range-table changes. internals/internals.texi: Update history section. elhash.c, elhash.h, profile.c: Create inchash_eq() to allow direct incrementing of hash-table entry. Use in profile.c to try to reduce profiling overhead. Increase initial size of profile hash tables to reduce profiling overhead. buffer.c, device-msw.c, dialog-msw.c, dired-msw.c, editfns.c, event-msw.c, events.c, glyphs-msw.c, keymap.c, objects-msw.c, process-nt.c, syswindows.h, text.c, text.h, unexnt.c: Rename xetcs* -> qxetcs* for consistency with qxestr*. Rename ei*_c(_*) -> ei*_ascii(_*) since they work with ASCII-only strings not "C strings", whatever those are. This is the last place where "c" was incorrectly being used for "ascii". dialog-msw.c, dumper.c, event-msw.c, fileio.c, glyphs-gtk.c, glyphs-x.c, nt.c, process-nt.c, realpath.c, sysdep.c, sysfile.h, unexcw.c, unexnext.c, unexnt.c: Try to avoid differences in systems that do or do not include final null byte in PATH_MAX. Create PATH_MAX_INTERNAL and PATH_MAX_EXTERNAL and use them everywhere. Rewrite code in dumper.c to avoid use of PATH_MAX. When necessary in nt.c, use _MAX_PATH instead of MAX_PATH to be consistent with other places. text.c: Code to short-circuit when binary or Unicode was not working due to EOL wrapping. Fix this code to work when either no EOL autodetection or no CR's or LF's in the text. lisp.h, rangetab.c, rangetab.h, regex.c, search.c: Implement different types of ranges (open/closed start and end). Change default to be start-closed, end-open.
author ben
date Mon, 06 Dec 2004 03:52:23 +0000
parents 7039e6323819
children 308d34e9f07d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1 ;;; generic-widgets.el --- Generic UI building
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
3 ;; Copyright (C) 2000 Free Software Foundation
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
4
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
5 ;; Maintainer: William Perry <wmperry@gnu.org>
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
6 ;; Keywords: extensions, dumped
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
7
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
8 ;; This file is part of XEmacs.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
9
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
10 ;; XEmacs is free software; you can redistribute it and/or modify it
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
11 ;; under the terms of the GNU General Public License as published by
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
13 ;; any later version.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
14
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
15 ;; XEmacs is distributed in the hope that it will be useful, but
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
18 ;; General Public License for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
19
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
23 ;; 02111-1307, USA.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
24
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
25 ;;; Synched up with: Not in FSF
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
26
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
27 ;;; Commentary:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
28
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
29 ;; This file is dumped with XEmacs.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
30
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
31 (globally-declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
32 '(gtk-label-new
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
33 gtk-widget-show-all gtk-signal-connect
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
34 gtk-window-new gtk-container-add gtk-vbox-new gtk-hbox-new
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
35 gtk-box-pack-start gtk-notebook-new
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
36 gtk-notebook-set-homogeneous-tabs gtk-notebook-set-scrollable
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
37 gtk-notebook-set-show-tabs gtk-notebook-set-tab-pos
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
38 gtk-notebook-append-page gtk-text-new gtk-text-set-editable
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
39 gtk-text-set-word-wrap gtk-text-set-line-wrap
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
40 gtk-widget-set-style gtk-text-insert gtk-label-set-line-wrap
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
41 gtk-label-set-justify gtk-radio-button-new
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
42 gtk-radio-button-group gtk-check-button-new
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
43 gtk-toggle-button-new gtk-button-new gtk-progress-bar-new
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
44 gtk-progress-bar-set-orientation gtk-progress-bar-set-bar-style))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
45
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
46 (defun build-ui (ui)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
47 (if (null ui)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
48 (gtk-label-new "[empty]")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
49 (let ((builder-func (intern-soft (format "build-ui::%s" (car ui))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
50 (widget nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
51 (if (and builder-func (fboundp builder-func))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
52 (progn
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
53 (setq widget (funcall builder-func ui))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
54 (setcdr ui (plist-put (cdr ui) :x-internal-widget widget))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
55 widget)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
56 (error "Unknown ui element: %s" (car ui))))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
57
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
58 (defun show-ui (ui)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
59 (let ((widget (plist-get (cdr ui) :x-internal-widget)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
60 (if (not widget)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
61 (error "Attempting to show unrealized UI"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
62 (gtk-widget-show-all widget)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
63 (gtk-signal-connect widget 'destroy
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
64 (lambda (widget ui)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
65 (setcdr ui (plist-put (cdr ui) :x-internal-widget nil))) ui)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
66
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
67
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
68 (defun build-ui::window (spec)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
69 "Create a top-level window for containing other widgets.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
70 Properties:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
71 :items list A list of child UI specs. Only the first is used.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
72 :type toplevel/dialog/popup What type of window to create. Window managers
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
73 can (and usually do) treat each type differently.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
74 "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
75 (let ((plist (cdr spec))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
76 (window nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
77 (child nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
78 (setq window (gtk-window-new (plist-get plist :type 'toplevel))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
79 child (build-ui (car (plist-get plist :items))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
80 (gtk-container-add window child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
81 window))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
82
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
83 (defun build-ui::box (spec)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
84 "Create a box for containing other widgets.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
85 Properties:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
86 :items list A list of child UI specs.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
87 :homogeneous t/nil Whether all children are the same width/height.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
88 :spacing number Spacing between children.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
89 :orientation horizontal/vertical How the widgets are stacked.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
90
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
91 Additional properties on child widgets:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
92 :expand t/nil Whether the new child is to be given extra space
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
93 allocated to box. The extra space will be divided
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
94 evenly between all children of box that use this
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
95 option.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
96 :fill t/nil Whether space given to child by the expand option is
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
97 actually allocated to child, rather than just padding
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
98 it. This parameter has no effect if :expand is set to
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
99 nil. A child is always allocated the full height of a
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
100 horizontal box and the full width of a vertical box.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
101 This option affects the other dimension.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
102 :padding number Extra padding around this widget.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
103 "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
104 (let* ((plist (cdr spec))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
105 (orientation (plist-get plist :orientation 'horizontal))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
106 (children (plist-get plist :items))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
107 (box nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
108 (child-widget nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
109 (child-plist nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
110 (case orientation
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
111 (vertical (setq box (gtk-vbox-new (plist-get plist :homogeneous)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
112 (plist-get plist :spacing))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
113 (horizontal (setq box (gtk-hbox-new (plist-get plist :homogeneous)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
114 (plist-get plist :spacing))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
115 (otherwise (error "Unknown orientation for box: %s" orientation)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
116 (mapc
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
117 (lambda (child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
118 (setq child-plist (cdr child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
119 child-widget (build-ui child))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
120 (if (listp child-widget)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
121 (mapc (lambda (w)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
122 (gtk-box-pack-start box w
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
123 (plist-get child-plist :expand)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
124 (plist-get child-plist :fill)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
125 (plist-get child-plist :padding))) child-widget)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
126 (gtk-box-pack-start box child-widget
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
127 (plist-get child-plist :expand)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
128 (plist-get child-plist :fill)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
129 (plist-get child-plist :padding))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
130 children)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
131 box))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
132
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
133 (defun build-ui::tab-control (spec)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
134 "Create a notebook widget.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
135 Properties:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
136 :items list A list of UI specs to use as notebook pages.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
137 :homogeneous t/nil Whether all tabs are the same width.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
138 :orientation top/bottom/left/right Position of tabs
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
139 :show-tabs t/nil Show the tabs on screen?
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
140 :scrollable t/nil Allow scrolling to view all tab widgets?
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
141
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
142 Additional properties on child widgets:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
143 :tab-label ui A UI spec to use for the tab label.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
144 "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
145 (let* ((plist (cdr spec))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
146 (notebook (gtk-notebook-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
147 (children (plist-get plist :items))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
148 (page-counter 1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
149 (label-widget nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
150 (child-widget nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
151 (child-plist nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
152 ;; Set all the properties
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
153 (gtk-notebook-set-homogeneous-tabs notebook (plist-get plist :homogeneous))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
154 (gtk-notebook-set-scrollable notebook (plist-get plist :scrollable t))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
155 (gtk-notebook-set-show-tabs notebook (plist-get plist :show-tabs t))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
156 (gtk-notebook-set-tab-pos notebook (plist-get plist :orientation 'top))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
157
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
158 ;; Now fill in the tabs
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
159 (mapc
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
160 (lambda (child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
161 (setq child-plist (cdr child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
162 child-widget (build-ui child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
163 label-widget (build-ui (plist-get child-plist :tab-label
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
164 (list 'label :text (format "tab %d" page-counter))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
165 page-counter (1+ page-counter))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
166 (gtk-notebook-append-page notebook child-widget label-widget))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
167 children)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
168 notebook))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
169
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
170 (defun build-ui::text (spec)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
171 "Create a multi-line text widget.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
172 Properties:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
173 :editable t/nil Whether the user can change the contents
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
174 :word-wrap t/nil Automatic word wrapping?
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
175 :line-wrap t/nil Automatic line wrapping?
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
176 :text string Initial contents of the widget
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
177 :file filename File for initial contents (takes precedence over :text)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
178 :face facename XEmacs face to use in the widget.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
179 "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
180 (let* ((plist (cdr spec))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
181 (text (gtk-text-new nil nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
182 (face (plist-get plist :face 'default))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
183 (info (plist-get plist :text))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
184 (file (plist-get plist :file)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
185 (gtk-text-set-editable text (plist-get plist :editable))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
186 (gtk-text-set-word-wrap text (plist-get plist :word-wrap))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
187 (gtk-text-set-line-wrap text (plist-get plist :line-wrap))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
188 (gtk-widget-set-style text 'default)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
189
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
190 ;; Possible convert the file portion
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
191 (if (and file (not (stringp file)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
192 (setq file (eval file)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
193
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
194 (if (and info (not (stringp info)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
195 (setq info (eval info)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
196
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
197 (if (and file (file-exists-p file) (file-readable-p file))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
198 (save-excursion
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
199 (set-buffer (get-buffer-create " *improbable buffer name*"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
200 (insert-file-contents file)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
201 (setq info (buffer-string))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
202
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
203 (gtk-text-insert text
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
204 (face-font face)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
205 (face-foreground face)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
206 (face-background face)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
207 info (length info))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
208 text))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
209
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
210 (defun build-ui::label (spec)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
211 "Create a label widget.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
212 Properties:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
213 :text string Text inside the label
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
214 :face facename XEmacs face to use in the widget.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
215 :justification right/left/center How to justify the text.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
216 "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
217 (let* ((plist (cdr spec))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
218 (label (gtk-label-new (plist-get plist :text))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
219 (gtk-label-set-line-wrap label t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
220 (gtk-label-set-justify label (plist-get plist :justification))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
221 (gtk-widget-set-style label (plist-get plist :face 'default))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
222 label))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
223
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
224 (defun build-ui::pixmap (spec)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
225 "Create a multi-line text widget.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
226 Properties:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
227 :text string Text inside the label
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
228 :face facename XEmacs face to use in the widget.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
229 :justification right/left/center How to justify the text.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
230 "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
231 (let* ((plist (cdr spec))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
232 (label (gtk-label-new (plist-get plist :text))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
233 (gtk-label-set-line-wrap label t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
234 (gtk-label-set-justify label (plist-get plist :justification))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
235 (gtk-widget-set-style label (plist-get plist :face 'default))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
236 label))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
237
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
238 (defun build-ui::radio-group (spec)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
239 "A convenience when specifying a group of radio buttons."
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
240 (declare (special build-ui::radio-group))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
241 (let ((build-ui::radio-group nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
242 (mapcar 'build-ui (plist-get (cdr spec) :items))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
243
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
244 (defun build-ui::button (spec)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
245 "Create a button widget.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
246 Properties:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
247 :type radio/check/toggle/nil What type of button to create.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
248 :text string Text in the button.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
249 :glyph glyph Image in the button.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
250 :label ui A UI spec to use for the label.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
251 :relief normal/half/none How to draw button edges.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
252
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
253 NOTE: Radio buttons must be in a radio-group object for them to work.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
254 "
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
255 (declare (special build-ui::radio-group))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
256 (let* ((plist (cdr spec))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
257 (button nil)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
258 (button-type (plist-get plist :type 'normal)))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
259 (case button-type
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
260 (radio
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
261 (if (not (boundp 'build-ui::radio-group))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
262 (error "Attempt to use a radio button outside a radio-group"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
263 (setq button (gtk-radio-button-new build-ui::radio-group)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
264 build-ui::radio-group (gtk-radio-button-group button)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
265 (check
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
266 (setq button (gtk-check-button-new)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
267 (toggle
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
268 (setq button (gtk-toggle-button-new)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
269 (normal
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
270 (setq button (gtk-button-new)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
271 (otherwise
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
272 (error "Unknown button type: %s" button-type)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
273 (gtk-container-add
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
274 button
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
275 (build-ui (plist-get plist :label
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
276 (list 'label :text
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
277 (plist-get plist
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
278 :text (format "%s button" button-type))))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
279 button))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
280
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
281 (defun build-ui::progress-gauge (spec)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
282 "Create a progress meter.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
283 Properties:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
284 :orientation left-to-right/right-to-left/top-to-bottom/bottom-to-top
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
285 :type discrete/continuous
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
286
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
287 "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
288 (let ((plist (cdr spec))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
289 (gauge (gtk-progress-bar-new)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
290 (gtk-progress-bar-set-orientation gauge (plist-get plist :orientation 'left-to-right))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
291 (gtk-progress-bar-set-bar-style gauge (plist-get plist :type 'continuous))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
292 gauge))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
293
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
294 (provide 'generic-widgets)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
295
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
296 (when (featurep 'gtk) ; just loading this file should be OK
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
297 (gtk-widget-show-all
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
298 (build-ui
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
299 '(window :type dialog
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
300 :items ((tab-control
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
301 :homogeneous t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
302 :orientation bottom
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
303 :items ((box :orientation vertical
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
304 :tab-label (label :text "vertical")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
305 :items ((label :text "Vertical")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
306 (progress-gauge)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
307 (label :text "Box stacking")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
308 (box :orientation horizontal
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
309 :spacing 10
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
310 :items ((label :text "Horizontal box")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
311 (label :text "stacking")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
312
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
313 (box :orientation vertical
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
314 :items
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
315 ((radio-group
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
316 :items ((button :type radio
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
317 :expand nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
318 :fill nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
319 :text "Item 1")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
320 (button :type radio
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
321 :expand nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
322 :fill nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
323 :text "Item 2")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
324 (button :type radio
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
325 :expand nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
326 :fill nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
327 :text "Item 3")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
328 (button :type radio
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
329 :expand nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
330 :fill nil)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
331 (box :orientation vertical
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
332 :items ((button :type check
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
333 :text "Item 1")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
334 (button :type check
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
335 :text "Item 2")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
336 (button :type normal
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
337 :text "Item 3")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
338 (button :type toggle)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
339 (text :editable t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
340 :word-wrap t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
341 :file (locate-data-file "COPYING"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
342 (text :editable t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
343 :face display-time-mail-balloon-enhance-face
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
344 :word-wrap t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
345 :text "Text with a face on it")))))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
346 )