annotate tests/gtk/gtk-test.el @ 1292:f3437b56874d

[xemacs-hg @ 2003-02-13 09:57:04 by ben] profile updates profile.c: Major reworking. Keep track of new information -- total function timing (includes descendants), GC usage, total GC usage (includes descendants). New functions to be called appropriately from eval.c, alloc.c to keep track of this information. Keep track of when we're actually in a function vs. in its profile, for more accurate timing counts. Track profile overhead separately. Create new mechanism for specifying "internal sections" that are tracked just like regular Lisp functions and even appear in the backtrace if `backtrace-with-internal-sections' is non-nil (t by default for error-checking builds). Add some KKCC information for the straight (non-Elisp) hash table used by profile, which contains Lisp objects in its keys -- but not used yet. Remove old ad-hoc methods for tracking garbage collection, redisplay (which was incorrect anyway when Lisp was called within these sections). Don't record any tick info when blocking under MS Windows, since the timer there is in real time rather than in process time. Make `start-profiling', `stop-profiling' interactive. Be consistent wrt. recursive functions and functions currently on the stack when starting or stopping -- together these make implementing the `total' values extremely difficult. When we start profiling, we act as if we just entered all the functions currently on the stack. Likewise when exiting. Create vars in_profile for tracking time spent inside of profiling, and profiling_lock for setting exclusive access to the main hash table when reading from it or modifying it. (protects against getting screwed up by the signal handle going off at the same time. profile.h: New file. Create macros for declaring internal profiling sections. lisp.h: Move profile-related stuff to profile.h. alloc.c: Keep track of total consing, for profile. Tell profile when we are consing. Use new profile-section method for noting garbage-collection. alloc.c: Abort if we attempt to call the allocator reentrantly. backtrace.h, eval.c: Add info for use by profile in the backtrace frame and transfer PUSH_BACKTRACE/POP_BACKTRACE from eval.c, for use with profile. elhash.c: Author comment. eval.c, lisp.h: New Lisp var `backtrace-with-internal-sections'. Set to t when error-checking is on. eval.c: When unwinding, eval.c: Report to profile when we are about-to-call and just-called wrt. a function. alloc.c, eval.c: Allow for "fake" backtrace frames, for internal sections (used by profile and `backtrace-with-internal-sections'. event-Xt.c, event-gtk.c, event-msw.c, event-tty.c: Record when we are actually blocking on an event, for profile's sake. event-stream.c: Record internal profiling sections for getting, dispatching events. extents.c: Record internal profiling sections for map_extents. hash.c, hash.h: Add pregrow_hash_table_if_necessary(). (Used in profile code since the signal handler is the main grower but can't allow a realloc(). We make sure, at critical points, that the table is large enough.) lread.c: Create internal profiling sections for `load' (which may be triggered internally by autoload, etc.). redisplay.c: Remove old profile_redisplay_flag. Use new macros to declare internal profiling section for redisplay. text.c: Use new macros to declare internal profiling sections for char-byte conversion and internal-external conversion. SEMI-UNRELATED CHANGES: ----------------------- text.c: Update the long comments.
author ben
date Thu, 13 Feb 2003 09:57:08 +0000
parents 0784d089fdc9
children 5efbd1253905
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 ;;; gtk-test.el --- Test harness for GTK widgets
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: tests
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 (require 'font)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
30
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
31 (setq GTK_TOPLEVEL (lsh 1 4)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
32 GTK_NO_WINDOW (lsh 1 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
33 GTK_REALIZED (lsh 1 6)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
34 GTK_MAPPED (lsh 1 7)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
35 GTK_VISIBLE (lsh 1 8)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
36 GTK_SENSITIVE (lsh 1 9)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
37 GTK_PARENT_SENSITIVE (lsh 1 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
38 GTK_CAN_FOCUS (lsh 1 11)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
39 GTK_HAS_FOCUS (lsh 1 12)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
40 GTK_CAN_DEFAULT (lsh 1 13)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
41 GTK_HAS_DEFAULT (lsh 1 14)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
42 GTK_HAS_GRAB (lsh 1 15)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
43 GTK_RC_STYLE (lsh 1 16)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
44 GTK_COMPOSITE_CHILD (lsh 1 17)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
45 GTK_NO_REPARENT (lsh 1 18)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
46 GTK_APP_PAINTABLE (lsh 1 19)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
47 GTK_RECEIVES_DEFAULT (lsh 1 20))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
48
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
49 (defun gtk-widget-visible (widget)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
50 (= (logand (gtk-object-flags widget) GTK_VISIBLE) GTK_VISIBLE))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
51
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
52 (defvar gtk-defined-tests nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
53 "A list describing the defined tests.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
54 Each element is of the form (DESCRIPTION TYPE FUNCTION)")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
55
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
56 (defvar gtk-test-directory nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
57 (defun gtk-test-directory ()
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
58 (if (not gtk-test-directory)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
59 (mapc (lambda (c)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
60 (if (and (not gtk-test-directory)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
61 (string= (file-name-nondirectory (car c)) "gtk-test.el"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
62 (setq gtk-test-directory (file-name-directory (car c)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
63 load-history))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
64 gtk-test-directory)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
65
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
66 (defvar gtk-test-categories '((container . "Containers")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
67 (basic . "Basic Widgets")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
68 (composite . "Composite Widgets")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
69 (gimp . "Gimp Widgets")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
70 (misc . "Miscellaneous")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
71 (extra . "GTK+ Extra")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
72 (gdk . "GDK Primitives")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
73 (gnome . "GNOME tests"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
74 "An assoc list mapping test categories to friendly names.")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
75
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
76 (defvar gtk-test-open-glyph
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
77 (make-glyph [xpm :data "/* XPM */\nstatic char * book_open_xpm[] = {\n\"16 16 4 1\",\n\" c None s None\",\n\". c black\",\n\"X c #808080\",\n\"o c white\",\n\" \",\n\" .. \",\n\" .Xo. ... \",\n\" .Xoo. ..oo. \",\n\" .Xooo.Xooo... \",\n\" .Xooo.oooo.X. \",\n\" .Xooo.Xooo.X. \",\n\" .Xooo.oooo.X. \",\n\" .Xooo.Xooo.X. \",\n\" .Xooo.oooo.X. \",\n\" .Xoo.Xoo..X. \",\n\" .Xo.o..ooX. \",\n\" .X..XXXXX. \",\n\" ..X....... \",\n\" .. \",\n\" \"};"]))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
78
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
79 (defvar gtk-test-closed-glyph
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
80 (make-glyph [xpm :data "/* XPM */\nstatic char * book_closed_xpm[] = {\n\"16 16 6 1\",\n\" c None s None\",\n\". c black\",\n\"X c red\",\n\"o c yellow\",\n\"O c #808080\",\n\"# c white\",\n\" \",\n\" .. \",\n\" ..XX. \",\n\" ..XXXXX. \",\n\" ..XXXXXXXX. \",\n\".ooXXXXXXXXX. \",\n\"..ooXXXXXXXXX. \",\n\".X.ooXXXXXXXXX. \",\n\".XX.ooXXXXXX.. \",\n\" .XX.ooXXX..#O \",\n\" .XX.oo..##OO. \",\n\" .XX..##OO.. \",\n\" .X.#OO.. \",\n\" ..O.. \",\n\" .. \",\n\" \"};\n"]))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
81
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
82 (defvar gtk-test-mini-page-glyph
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
83 (make-glyph [xpm :data "/* XPM */\nstatic char * mini_page_xpm[] = {\n\"16 16 4 1\",\n\" c None s None\",\n\". c black\",\n\"X c white\",\n\"o c #808080\",\n\" \",\n\" ....... \",\n\" .XXXXX.. \",\n\" .XoooX.X. \",\n\" .XXXXX.... \",\n\" .XooooXoo.o \",\n\" .XXXXXXXX.o \",\n\" .XooooooX.o \",\n\" .XXXXXXXX.o \",\n\" .XooooooX.o \",\n\" .XXXXXXXX.o \",\n\" .XooooooX.o \",\n\" .XXXXXXXX.o \",\n\" ..........o \",\n\" oooooooooo \",\n\" \"};\n"]))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
84
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
85 (defvar gtk-test-mini-gtk-glyph
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
86 (make-glyph [xpm :data "/* XPM */\nstatic char * gtk_mini_xpm[] = {\n\"15 20 17 1\",\n\" c None\",\n\". c #14121F\",\n\"+ c #278828\",\n\"@ c #9B3334\",\n\"# c #284C72\",\n\"$ c #24692A\",\n\"% c #69282E\",\n\"& c #37C539\",\n\"* c #1D2F4D\",\n\"= c #6D7076\",\n\"- c #7D8482\",\n\"; c #E24A49\",\n\"> c #515357\",\n\", c #9B9C9B\",\n\"' c #2FA232\",\n\") c #3CE23D\",\n\"! c #3B6CCB\",\n\" \",\n\" ***> \",\n\" >.*!!!* \",\n\" ***....#*= \",\n\" *!*.!!!**!!# \",\n\" .!!#*!#*!!!!# \",\n\" @%#!.##.*!!$& \",\n\" @;%*!*.#!#')) \",\n\" @;;@%!!*$&)'' \",\n\" @%.%@%$'&)$+' \",\n\" @;...@$'*'*)+ \",\n\" @;%..@$+*.')$ \",\n\" @;%%;;$+..$)# \",\n\" @;%%;@$$$'.$# \",\n\" %;@@;;$$+))&* \",\n\" %;;;@+$&)&* \",\n\" %;;@'))+> \",\n\" %;@'&# \",\n\" >%$$ \",\n\" >= \"};"]))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
87
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
88
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
89 (defun build-option-menu (items history obj)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
90 (let (omenu menu menu-item group i)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
91 (setq omenu (gtk-option-menu-new)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
92 menu (gtk-menu-new)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
93 i 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
94
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
95 (while items
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
96 (setq menu-item (gtk-radio-menu-item-new-with-label group (car (car items))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
97 (gtk-signal-connect menu-item 'activate (cdr (car items)) obj)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
98 (setq group (gtk-radio-menu-item-group menu-item))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
99 (gtk-menu-append menu menu-item)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
100 (if (= i history)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
101 (gtk-check-menu-item-set-active menu-item t))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
102 (gtk-widget-show menu-item)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
103 (setq items (cdr items))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
104 (incf i))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
105
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
106 (gtk-option-menu-set-menu omenu menu)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
107 (gtk-option-menu-set-history omenu history)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
108 omenu))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
109
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
110 (defun gtk-test-notice-destroy (object symbol)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
111 ;; Set variable to NIL to aid in object destruction.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
112 (set symbol nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
113
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
114 (defun gtk-test-make-sample-buttons (box maker)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
115 ;; Create buttons and pack them in a premade BOX.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
116 (mapcar (lambda (name)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
117 (let ((button (funcall maker name)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
118 (gtk-box-pack-start box button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
119 (gtk-widget-show button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
120 button)) '("button1" "button2" "button3")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
121
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
122 (make-face 'gtk-test-face-large "A face with a large font, for use in GTK test cases")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
123 (font-set-face-font 'gtk-test-face-large
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
124 (make-font :family '("LucidaBright" "Utopia" "Helvetica" "fixed")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
125 :weight :normal
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
126 :size "36pt"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
127
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
128 (defvar gtk-test-shell nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
129 "Where non-dialog tests should realize their widgets.")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
130
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
131 (defmacro gtk-define-test (title type name-stub dialog-p &rest body)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
132 "Define a GTK demo/test.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
133 TITLE is the friendly name of the test to show to the user.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
134 TYPE is used to sort the items.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
135 NAME-STUB is used to create the function definition.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
136 DIALOG-P must be non-nil for demos that create their own top-level window.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
137 BODY are the forms that actually create the demo.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
138
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
139 They must pack their widgets into the dynamically bound WINDOW variable,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
140 which is a GtkVBox.
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 `(progn
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
143 (if (not (assoc ,title gtk-defined-tests))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
144 (push (list ,title (quote ,type)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
145 (quote ,(intern (format "gtk-test-%s" name-stub)))) gtk-defined-tests))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
146 (defun ,(intern (format "gtk-test-%s" name-stub)) ()
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
147 (let ((main-widget (if (not gtk-test-shell)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
148 (gtk-window-new 'toplevel)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
149 (gtk-frame-new ,title)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
150 (window nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
151 (if gtk-test-shell
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
152 (progn
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
153 (mapc 'gtk-widget-destroy (gtk-container-children gtk-test-shell))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
154 (gtk-box-pack-start gtk-test-shell main-widget nil nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
155 (gtk-window-set-title main-widget ,title))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
156 (if ,dialog-p
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
157 (let ((button (gtk-button-new-with-label ,title))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
158 (blank (gtk-event-box-new)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
159 (setq window (gtk-hbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
160 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
161 (lambda (&rest ignored)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
162 (let ((window nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
163 ,@body
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
164 (gtk-widget-show-all window))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
165 (gtk-box-pack-start window
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
166 (gtk-label-new
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
167 (concat "This demo creates an external dialog.\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
168 "Activate the button to see the demo."))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
169 nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
170 (gtk-box-pack-start window button nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
171 (gtk-box-pack-start window blank t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
172 (gtk-widget-show-all main-widget))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
173 (setq window (gtk-vbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
174 ,@body)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
175 (gtk-container-add main-widget window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
176 (gtk-widget-show-all (or main-widget window))))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
177
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
178
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
179 ;;;; Pixmaps
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
180 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
181 "Pixmaps" misc pixmap nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
182 (let* ((button (gtk-button-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
183 (pixmap (gtk-pixmap-new xemacs-logo nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
184 (label (gtk-label-new "Pixmap test"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
185 (hbox (gtk-hbox-new nil 0)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
186 (gtk-box-pack-start window button nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
187 (gtk-widget-show button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
188 (gtk-container-set-border-width hbox 2)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
189 (gtk-container-add hbox pixmap)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
190 (gtk-container-add hbox label)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
191 (gtk-container-add button hbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
192 (gtk-widget-show pixmap)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
193 (gtk-widget-show label)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
194 (gtk-widget-show hbox)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
195
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 ;;;; Scrolled windows
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
198 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
199 "Scrolled windows" container create-scrolled-windows nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
200 (let* ((scrolled-win (gtk-scrolled-window-new nil nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
201 (viewport (gtk-viewport-new
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
202 (gtk-scrolled-window-get-hadjustment scrolled-win)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
203 (gtk-scrolled-window-get-vadjustment scrolled-win)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
204 (table (gtk-table-new 20 20 nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
205 (button nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
206 (gtk-container-set-border-width window 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
207 (gtk-container-set-border-width scrolled-win 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
208 (gtk-scrolled-window-set-policy scrolled-win 'automatic 'automatic)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
209 (gtk-box-pack-start window scrolled-win t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
210 (gtk-table-set-row-spacings table 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
211 (gtk-table-set-col-spacings table 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
212 (gtk-scrolled-window-add-with-viewport scrolled-win table)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
213 (gtk-container-set-focus-hadjustment
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
214 table (gtk-scrolled-window-get-hadjustment scrolled-win))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
215 (gtk-container-set-focus-vadjustment
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
216 table (gtk-scrolled-window-get-vadjustment scrolled-win))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
217 (loop for i from 0 to 19 do
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
218 (loop for j from 0 to 19 do
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
219 (setq button (gtk-button-new-with-label (format "button (%d, %d)\n" i j)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
220 (gtk-table-attach-defaults table button i (1+ i) j (1+ j))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
221 (gtk-widget-show-all scrolled-win)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
222
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 ;;;; Lists
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
225 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
226 "List" basic create-list nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
227 (let ((list-items '("hello"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
228 "world"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
229 "blah"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
230 "foo"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
231 "bar"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
232 "argh"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
233 "wmperry"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
234 "is a"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
235 "wussy"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
236 "programmer"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
237 (scrolled-win (gtk-scrolled-window-new nil nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
238 (lyst (gtk-list-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
239 (add (gtk-button-new-with-label "add"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
240 (remove (gtk-button-new-with-label "remove")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
241
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
242 (gtk-scrolled-window-set-policy scrolled-win 'automatic 'automatic)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
243 (gtk-box-pack-start window scrolled-win t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
244 (gtk-widget-show scrolled-win)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
245
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
246 (gtk-list-set-selection-mode lyst 'multiple)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
247 (gtk-list-set-selection-mode lyst 'browse)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
248 (gtk-scrolled-window-add-with-viewport scrolled-win lyst)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
249 (gtk-widget-show lyst)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
250
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
251 (mapc (lambda (i)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
252 (let ((list-item (gtk-list-item-new-with-label i)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
253 (gtk-container-add lyst list-item)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
254 (gtk-widget-show list-item)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
255 list-items)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
256
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
257 (gtk-signal-connect add 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
258 (lambda (obj data) (message "Should add to the list")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
259 (gtk-box-pack-start window add nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
260 (gtk-widget-show add)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
261
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
262 (gtk-signal-connect remove 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
263 (lambda (obj list)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
264 (if (gtk-list-selection list)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
265 (gtk-list-remove-items list (gtk-list-selection list)))) lyst)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
266 (gtk-box-pack-start window remove nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
267 (gtk-widget-show remove)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
268
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
269 (gtk-signal-connect lyst 'select_child
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
270 (lambda (lyst child ignored)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
271 (message "selected %S %d" child (gtk-list-child-position lyst child))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
272
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
273 (gtk-widget-set-usize scrolled-win 200 75)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
274
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
275 (gtk-signal-connect lyst 'unselect_child (lambda (lyst child ignored)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
276 (message "unselected %S" child)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
277
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
278
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
279 ;;;; Tooltips
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
280 (defvar gtk-test-tooltips nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
281
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
282 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
283 "Tooltips" composite create-tooltips nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
284 (if (not gtk-test-tooltips)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
285 (setq gtk-test-tooltips (gtk-tooltips-new)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
286 (let ((buttons (gtk-test-make-sample-buttons window 'gtk-toggle-button-new-with-label))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
287 (tips '("This is button 1"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
288 "This is button 2"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
289 "This is button 3. This is also a really long tooltip which probably won't fit on a single line and will therefore need to be wrapped. Hopefully the wrapping will work correctly.")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
290 (while buttons
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
291 (gtk-tooltips-set-tip gtk-test-tooltips (pop buttons) (pop tips) ""))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
292
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 ;;;; Panes
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
295 (defun toggle-resize (widget child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
296 (let* ((paned (gtk-widget-parent child))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
297 (is-child1 (eq child (gtk-paned-child1 paned)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
298 resize shrink)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
299 (setq resize (if is-child1
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
300 (gtk-paned-child1-resize paned)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
301 (gtk-paned-child2-resize paned))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
302 shrink (if is-child1
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
303 (gtk-paned-child1-shrink paned)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
304 (gtk-paned-child2-shrink paned)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
305
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
306 (gtk-widget-ref child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
307 (gtk-container-remove paned child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
308 (if is-child1
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
309 (gtk-paned-pack1 paned child (not resize) shrink)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
310 (gtk-paned-pack2 paned child (not resize) shrink))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
311 (gtk-widget-unref child)))
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 (defun toggle-shrink (widget child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
314 (let* ((paned (gtk-widget-parent child))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
315 (is-child1 (eq child (gtk-paned-child1 paned)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
316 resize shrink)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
317 (setq resize (if is-child1
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
318 (gtk-paned-child1-resize paned)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
319 (gtk-paned-child2-resize paned))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
320 shrink (if is-child1
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
321 (gtk-paned-child1-shrink paned)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
322 (gtk-paned-child2-shrink paned)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
323
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
324 (gtk-widget-ref child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
325 (gtk-container-remove paned child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
326 (if is-child1
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
327 (gtk-paned-pack1 paned child resize (not shrink))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
328 (gtk-paned-pack2 paned child resize (not shrink)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
329 (gtk-widget-unref child)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
330
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
331 (defun create-pane-options (widget frame-label label1 label2)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
332 (let (frame table label check-button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
333 (setq frame (gtk-frame-new frame-label))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
334 (gtk-container-set-border-width frame 4)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
335
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
336 (setq table (gtk-table-new 3 2 4))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
337 (gtk-container-add frame table)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
338
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
339 (setq label (gtk-label-new label1))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
340 (gtk-table-attach-defaults table label 0 1 0 1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
341
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
342 (setq check-button (gtk-check-button-new-with-label "Resize"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
343 (gtk-table-attach-defaults table check-button 0 1 1 2)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
344 (gtk-signal-connect check-button 'toggled 'toggle-resize (gtk-paned-child1 widget))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
345
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
346 (setq check-button (gtk-check-button-new-with-label "Shrink"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
347 (gtk-table-attach-defaults table check-button 0 1 2 3)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
348 (gtk-toggle-button-set-active check-button t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
349 (gtk-signal-connect check-button 'toggled 'toggle-shrink (gtk-paned-child1 widget))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
350
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
351 (setq label (gtk-label-new label2))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
352 (gtk-table-attach-defaults table label 1 2 0 1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
353
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
354 (setq check-button (gtk-check-button-new-with-label "Resize"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
355 (gtk-table-attach-defaults table check-button 1 2 1 2)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
356 (gtk-toggle-button-set-active check-button t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
357 (gtk-signal-connect check-button 'toggled 'toggle-resize (gtk-paned-child2 widget))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
358
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
359 (setq check-button (gtk-check-button-new-with-label "Shrink"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
360 (gtk-table-attach-defaults table check-button 1 2 2 3)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
361 (gtk-toggle-button-set-active check-button t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
362 (gtk-signal-connect check-button 'toggled 'toggle-shrink (gtk-paned-child2 widget))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
363 frame))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
364
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
365 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
366 "Panes" container panes nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
367 (let (frame hpaned vpaned button vbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
368 (gtk-container-set-border-width window 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
369
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
370 (setq vpaned (gtk-vpaned-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
371 (gtk-box-pack-start window vpaned t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
372 (gtk-container-set-border-width vpaned 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
373
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
374 (setq hpaned (gtk-hpaned-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
375 (gtk-paned-add1 vpaned hpaned)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
376
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
377 (setq frame (gtk-frame-new nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
378 (gtk-frame-set-shadow-type frame 'in)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
379 (gtk-widget-set-usize frame 60 60)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
380 (gtk-paned-add1 hpaned frame)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
381
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
382 (setq button (gtk-button-new-with-label "Hi there"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
383 (gtk-container-add frame button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
384
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
385 (setq frame (gtk-frame-new nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
386 (gtk-frame-set-shadow-type frame 'in)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
387 (gtk-widget-set-usize frame 80 60)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
388 (gtk-paned-add2 hpaned frame)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
389
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
390 (setq frame (gtk-frame-new nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
391 (gtk-frame-set-shadow-type frame 'in)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
392 (gtk-widget-set-usize frame 60 80)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
393 (gtk-paned-add2 vpaned frame)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
394
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
395 ;; Now create toggle buttons to control sizing
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
396 (gtk-box-pack-start window (create-pane-options hpaned "Horizontal" "Left" "Right") nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
397 (gtk-box-pack-start window (create-pane-options vpaned "Vertical" "Top" "Bottom") nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
398 (gtk-widget-show-all window)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
399
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
400
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
401 ;;;; Entry
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
402 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
403 "Entry" basic entry nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
404 (let ((box1 nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
405 (box2 nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
406 (editable-check nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
407 (sensitive-check nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
408 (entry nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
409 (cb nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
410 (button nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
411 (separator nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
412 (cbitems '("item0"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
413 "item1 item1"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
414 "item2 item2 item2"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
415 "item3 item3 item3 item3"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
416 "item4 item4 item4 item4 item4"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
417 "item5 item5 item5 item5 item5 item5"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
418 "item6 item6 item6 item6 item6"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
419 "item7 item7 item7 item7"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
420 "item8 item8 item8"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
421 "item9 item9")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
422 (gtk-container-set-border-width window 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
423
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
424 (setq box1 (gtk-vbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
425 (gtk-container-add window box1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
426 (gtk-widget-show box1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
427
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
428 (setq box2 (gtk-vbox-new nil 10))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
429 (gtk-container-set-border-width box2 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
430 (gtk-box-pack-start box1 box2 t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
431 (gtk-widget-show box2)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
432
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
433 (setq entry (gtk-entry-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
434 (gtk-entry-set-text entry "hello world")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
435 (gtk-editable-select-region entry 0 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
436 (gtk-box-pack-start box2 entry t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
437 (gtk-widget-show entry)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
438
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
439 (setq cb (gtk-combo-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
440 (gtk-combo-set-popdown-strings cb cbitems)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
441 (gtk-entry-set-text (gtk-combo-entry cb) "hellow world")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
442 (gtk-editable-select-region (gtk-combo-entry cb) 0 -1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
443 (gtk-box-pack-start box2 cb t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
444 (gtk-widget-show cb)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
445
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
446 (setq editable-check (gtk-check-button-new-with-label "Editable"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
447 (gtk-box-pack-start box2 editable-check nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
448 (gtk-signal-connect editable-check 'toggled
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
449 (lambda (obj data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
450 (gtk-entry-set-editable
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
451 data
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
452 (gtk-toggle-button-get-active obj))) entry)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
453 (gtk-toggle-button-set-active editable-check t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
454 (gtk-widget-show editable-check)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
455
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
456 (setq editable-check (gtk-check-button-new-with-label "Visible"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
457 (gtk-box-pack-start box2 editable-check nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
458 (gtk-signal-connect editable-check 'toggled
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
459 (lambda (obj data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
460 (gtk-entry-set-visibility data
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
461 (gtk-toggle-button-get-active obj))) entry)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
462 (gtk-toggle-button-set-active editable-check t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
463 (gtk-widget-show editable-check)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
464
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
465 (setq sensitive-check (gtk-check-button-new-with-label "Sensitive"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
466 (gtk-box-pack-start box2 sensitive-check nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
467 (gtk-signal-connect sensitive-check 'toggled
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
468 (lambda (obj data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
469 (gtk-widget-set-sensitive data
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
470 (gtk-toggle-button-get-active obj))) entry)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
471 (gtk-toggle-button-set-active sensitive-check t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
472 (gtk-widget-show sensitive-check)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
473
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
474
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
475 ;;;; Various built-in dialog types
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
476 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
477 "Font Dialog" composite font-selection t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
478 (setq window (gtk-font-selection-dialog-new "font selection dialog"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
479 (gtk-font-selection-dialog-set-preview-text window "Set from Emacs Lisp!")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
480 (gtk-signal-connect
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
481 (gtk-font-selection-dialog-cancel-button window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
482 'clicked (lambda (button dlg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
483 (gtk-widget-destroy dlg))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
484 window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
485 (gtk-signal-connect
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
486 (gtk-font-selection-dialog-ok-button window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
487 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
488 (lambda (button dlg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
489 (message "Font selected: %s" (gtk-font-selection-dialog-get-font-name dlg)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
490 window))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
491
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
492 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
493 "File Selection Dialog" composite file-selection t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
494 (let (button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
495 (setq window (gtk-file-selection-new "file selection"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
496 (gtk-signal-connect
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
497 (gtk-file-selection-ok-button window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
498 'clicked (lambda (obj dlg) (message "You clicked ok: %s"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
499 (gtk-file-selection-get-filename dlg)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
500 window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
501
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
502 (gtk-signal-connect
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
503 (gtk-file-selection-cancel-button window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
504 'clicked (lambda (obj dlg) (gtk-widget-destroy dlg)) window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
505
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
506 (gtk-file-selection-hide-fileop-buttons window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
507
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
508 (setq button (gtk-button-new-with-label "Hide Fileops"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
509 (gtk-signal-connect
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
510 button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
511 (lambda (obj dlg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
512 (gtk-file-selection-hide-fileop-buttons dlg)) window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
513
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
514 (gtk-box-pack-start (gtk-file-selection-action-area window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
515 button nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
516 (gtk-widget-show button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
517
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
518 (setq button (gtk-button-new-with-label "Show Fileops"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
519 (gtk-signal-connect
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
520 button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
521 (lambda (obj dlg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
522 (gtk-file-selection-show-fileop-buttons dlg)) window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
523 (gtk-box-pack-start (gtk-file-selection-action-area window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
524 button nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
525 (gtk-widget-show button)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
526
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
527 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
528 "Color selection" composite color t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
529 (setq window (gtk-color-selection-dialog-new "GTK color selection"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
530 (gtk-signal-connect (gtk-color-selection-dialog-cancel-button window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
531 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
532 (lambda (button data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
533 (gtk-widget-destroy data)) window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
534 (gtk-signal-connect (gtk-color-selection-dialog-ok-button window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
535 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
536 (lambda (button data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
537 (let ((rgba (gtk-color-selection-get-color
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
538 (gtk-color-selection-dialog-colorsel data)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
539 r g b a)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
540 (setq r (pop rgba)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
541 g (pop rgba)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
542 b (pop rgba)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
543 a (pop rgba))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
544 (gtk-widget-destroy data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
545 (message-box
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
546 "You selected color: red (%04x) blue (%04x) green (%04x) alpha (%g)"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
547 (* 65535 r) (* 65535 g) (* 65535 b) a)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
548 window))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
549
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
550
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
551 ;;;; Dialog
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
552 (defun gtk-container-specific-children (parent predicate &optional data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
553 (let ((children nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
554 (mapc (lambda (w)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
555 (if (funcall predicate w data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
556 (push w children)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
557 (gtk-container-children parent))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
558 children))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
559
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
560 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
561 "Dialog" basic dialog t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
562 (let ((button nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
563 (label nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
564 (setq window (gtk-dialog-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
565 (gtk-container-set-border-width window 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
566 (gtk-widget-set-usize window 200 110)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
567
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
568 (setq button (gtk-button-new-with-label "OK"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
569 (gtk-box-pack-start (gtk-dialog-action-area window) button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
570 (gtk-widget-show button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
571 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
572 (lambda (obj data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
573 (gtk-widget-destroy data))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
574 window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
575
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
576 (setq button (gtk-button-new-with-label "Toggle"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
577 (gtk-signal-connect
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
578 button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
579 (lambda (button dlg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
580 (if (not (gtk-container-specific-children (gtk-dialog-vbox dlg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
581 (lambda (w ignored)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
582 (= (gtk-object-type w) (gtk-label-get-type)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
583 (let ((label (gtk-label-new "Dialog Test")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
584 (gtk-box-pack-start (gtk-dialog-vbox dlg) label t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
585 (gtk-widget-show label))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
586 (mapc 'gtk-widget-destroy
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
587 (gtk-container-specific-children (gtk-dialog-vbox dlg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
588 (lambda (w ignored)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
589 (= (gtk-object-type w) (gtk-label-get-type)))))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
590 window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
591 (gtk-box-pack-start (gtk-dialog-action-area window) button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
592 (gtk-widget-show button)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
593
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
594
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
595 ;;;; Range controls
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
596 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
597 "Range Controls" basic range-controls nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
598 (let* ((adjustment (gtk-adjustment-new 0.0 0.0 101.0 0.1 1.0 1.0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
599 (scale (gtk-hscale-new adjustment))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
600 (scrollbar (gtk-hscrollbar-new adjustment)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
601 (gtk-widget-set-usize scale 150 30)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
602 (gtk-range-set-update-policy scale 'delayed)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
603 (gtk-scale-set-digits scale 2)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
604 (gtk-scale-set-draw-value scale t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
605 (gtk-box-pack-start window scale t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
606 (gtk-widget-show scale)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
607
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
608 (gtk-range-set-update-policy scrollbar 'continuous)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
609 (gtk-box-pack-start window scrollbar t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
610 (gtk-widget-show scrollbar)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
611
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
612
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
613 ;;;; Ruler
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
614 '(gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
615 "Rulers" gimp rulers nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
616 (let* ((table (gtk-table-new 2 2 nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
617 (hruler nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
618 (vruler nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
619 (ebox (gtk-event-box-new)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
620
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
621 (gtk-widget-set-usize ebox 300 300)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
622 (gtk-widget-set-events ebox '(pointer-motion-mask pointer-motion-hint-mask))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
623 (gtk-container-set-border-width ebox 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
624
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
625 (gtk-container-add window ebox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
626 (gtk-container-add ebox table)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
627 (gtk-widget-show table)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
628
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
629 (setq hruler (gtk-hruler-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
630 (gtk-ruler-set-metric hruler 'centimeters)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
631 (gtk-ruler-set-range hruler 100 0 0 20)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
632 (gtk-table-attach table hruler 1 2 0 1 '(expand fill) 'fill 0 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
633 (gtk-widget-show hruler)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
634
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
635 (setq vruler (gtk-vruler-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
636 (gtk-ruler-set-range vruler 5 15 0 20)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
637 (gtk-table-attach table vruler 0 1 1 2 'fill '(expand fill) 0 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
638 (gtk-widget-show vruler)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
639
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
640 (gtk-signal-connect
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
641 ebox 'motion_notify_event
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
642 (lambda (object ev data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
643 (gtk-widget-event (car data) ev)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
644 (gtk-widget-event (cdr data) ev))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
645 (cons hruler vruler))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
646
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
647
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
648 ;;;; Toggle button types
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
649 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
650 "Toggle Buttons" basic toggle-buttons nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
651 (gtk-container-set-border-width window 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
652 (gtk-test-make-sample-buttons window 'gtk-toggle-button-new-with-label))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
653
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
654 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
655 "Check Buttons" basic check-buttons nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
656 (gtk-container-set-border-width window 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
657 (gtk-test-make-sample-buttons window 'gtk-check-button-new-with-label))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
658
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
659 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
660 "Radio Buttons" basic radio-buttons nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
661 (gtk-container-set-border-width window 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
662 (let ((group nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
663 (gtk-test-make-sample-buttons window
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
664 (lambda (label)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
665 (let ((button (gtk-radio-button-new-with-label group label)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
666 (setq group (gtk-radio-button-group button))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
667 button)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
668
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
669
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
670 ;;;; Button weirdness
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
671 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
672 "Buttons" basic buttons nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
673 (let ((box1 nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
674 (box2 nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
675 (table nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
676 (buttons nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
677 (separator nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
678 (connect-buttons (lambda (button1 button2)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
679 (gtk-signal-connect button1 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
680 (lambda (obj data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
681 (if (gtk-widget-visible data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
682 (gtk-widget-hide data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
683 (gtk-widget-show data))) button2))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
684
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
685 (gtk-container-set-border-width window 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
686
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
687 (setq box1 (gtk-vbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
688 (gtk-container-add window box1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
689
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
690 (setq table (gtk-table-new 3 3 nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
691 (gtk-table-set-row-spacings table 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
692 (gtk-table-set-col-spacings table 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
693 (gtk-container-set-border-width table 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
694 (gtk-box-pack-start box1 table t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
695
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
696 (push (gtk-button-new-with-label "button9") buttons)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
697 (push (gtk-button-new-with-label "button8") buttons)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
698 (push (gtk-button-new-with-label "button7") buttons)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
699 (push (gtk-button-new-with-label "button6") buttons)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
700 (push (gtk-button-new-with-label "button5") buttons)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
701 (push (gtk-button-new-with-label "button4") buttons)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
702 (push (gtk-button-new-with-label "button3") buttons)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
703 (push (gtk-button-new-with-label "button2") buttons)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
704 (push (gtk-button-new-with-label "button1") buttons)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
705
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
706 (funcall connect-buttons (nth 0 buttons) (nth 1 buttons))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
707 (funcall connect-buttons (nth 1 buttons) (nth 2 buttons))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
708 (funcall connect-buttons (nth 2 buttons) (nth 3 buttons))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
709 (funcall connect-buttons (nth 3 buttons) (nth 4 buttons))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
710 (funcall connect-buttons (nth 4 buttons) (nth 5 buttons))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
711 (funcall connect-buttons (nth 5 buttons) (nth 6 buttons))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
712 (funcall connect-buttons (nth 6 buttons) (nth 7 buttons))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
713 (funcall connect-buttons (nth 7 buttons) (nth 8 buttons))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
714 (funcall connect-buttons (nth 8 buttons) (nth 0 buttons))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
715
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
716 (gtk-table-attach table (nth 0 buttons) 0 1 0 1 '(expand fill) '(expand fill) 0 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
717 (gtk-table-attach table (nth 1 buttons) 1 2 1 2 '(expand fill) '(expand fill) 0 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
718 (gtk-table-attach table (nth 2 buttons) 2 3 2 3 '(expand fill) '(expand fill) 0 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
719 (gtk-table-attach table (nth 3 buttons) 0 1 2 3 '(expand fill) '(expand fill) 0 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
720 (gtk-table-attach table (nth 4 buttons) 2 3 0 1 '(expand fill) '(expand fill) 0 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
721 (gtk-table-attach table (nth 5 buttons) 1 2 2 3 '(expand fill) '(expand fill) 0 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
722 (gtk-table-attach table (nth 6 buttons) 1 2 0 1 '(expand fill) '(expand fill) 0 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
723 (gtk-table-attach table (nth 7 buttons) 2 3 1 2 '(expand fill) '(expand fill) 0 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
724 (gtk-table-attach table (nth 8 buttons) 0 1 1 2 '(expand fill) '(expand fill) 0 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
725 ))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
726
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
727
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
728 ;;;; Testing labels and underlining
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
729 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
730 "Labels" basic labels nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
731 (let ((hbox (gtk-hbox-new nil 5))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
732 (vbox (gtk-vbox-new nil 5))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
733 (frame nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
734 (label nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
735 (gtk-container-add window hbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
736 (gtk-box-pack-start hbox vbox nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
737 (gtk-container-set-border-width window 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
738
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
739 (setq frame (gtk-frame-new "Normal Label")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
740 label (gtk-label-new "This is a Normal label"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
741 (gtk-container-add frame label)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
742 (gtk-box-pack-start vbox frame nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
743
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
744 (setq frame (gtk-frame-new "Multi-line Label")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
745 label (gtk-label-new "This is a multi-line label.\nSecond line\nThird line"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
746 (gtk-container-add frame label)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
747 (gtk-box-pack-start vbox frame nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
748
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
749 (setq frame (gtk-frame-new "Left Justified Label")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
750 label (gtk-label-new "This is a Left-Justified\nMulti-line label.\nThird line"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
751 (gtk-label-set-justify label 'left)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
752 (gtk-container-add frame label)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
753 (gtk-box-pack-start vbox frame nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
754
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
755 (setq frame (gtk-frame-new "Right Justified Label")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
756 label (gtk-label-new "This is a Right-Justified\nMulti-line label.\nFourth line, (j/k)"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
757 (gtk-label-set-justify label 'right)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
758 (gtk-container-add frame label)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
759 (gtk-box-pack-start vbox frame nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
760
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
761 ;; Start a second row so that we don't make a ridiculously tall window
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
762 (setq vbox (gtk-vbox-new nil 5))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
763 (gtk-box-pack-start hbox vbox nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
764
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
765 (setq frame (gtk-frame-new "Line wrapped label")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
766 label (gtk-label-new
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
767 (concat "This is an example of a line-wrapped label. It should not be taking "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
768 "up the entire " ;;; big space to test spacing
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
769 "width allocated to it, but automatically wraps the words to fit. "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
770 "The time has come, for all good men, to come to the aid of their party. "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
771 "The sixth sheik's six sheep's sick.\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
772 " It supports multiple paragraphs correctly, and correctly adds "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
773 "many extra spaces. ")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
774 (gtk-label-set-line-wrap label t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
775 (gtk-container-add frame label)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
776 (gtk-box-pack-start vbox frame nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
777
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
778 (setq frame (gtk-frame-new "Filled, wrapped label")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
779 label (gtk-label-new
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
780 (concat
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
781 "This is an example of a line-wrapped, filled label. It should be taking "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
782 "up the entire width allocated to it. Here is a seneance to prove "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
783 "my point. Here is another sentence. "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
784 "Here comes the sun, do de do de do.\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
785 " This is a new paragraph.\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
786 " This is another newer, longer, better paragraph. It is coming to an end, "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
787 "unfortunately.")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
788 (gtk-label-set-justify label 'fill)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
789 (gtk-label-set-line-wrap label t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
790 (gtk-container-add frame label)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
791 (gtk-box-pack-start vbox frame nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
792
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
793 (setq frame (gtk-frame-new "Underlined label")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
794 label (gtk-label-new (concat "This label is underlined!\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
795 "This one is underlined in ÆüËܸì¤ÎÆþÍÑquite a funky fashion")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
796 (gtk-label-set-justify label 'left)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
797 (gtk-label-set-pattern label "_________________________ _ _________ _ _____ _ __ __ ___ ____ _____")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
798 (gtk-container-add frame label)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
799 (gtk-box-pack-start vbox frame nil nil 0)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
800
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
801
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
802 ;;;; Progress gauges
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
803 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
804 "Progress bars" basic progress nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
805 (let* ((timer nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
806 (adj (gtk-adjustment-new 1 0 100 1 1 1))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
807 (label (gtk-label-new "progress..."))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
808 (pbar (gtk-progress-bar-new-with-adjustment adj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
809 (button nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
810 (timer (make-itimer)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
811
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
812 ;; The original test used GTK timers, but XEmacs already has
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
813 ;; perfectly good timer support, that ends up mapping onto GTK
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
814 ;; timers anyway, so we'll use those instead.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
815 (set-itimer-function
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
816 timer
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
817 (lambda (bar adj)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
818 (let ((val (gtk-adjustment-value adj)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
819 (setq val (+ 1 (if (>= val 100) 0 val)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
820 (gtk-adjustment-set-value adj val)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
821 (gtk-widget-queue-draw bar))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
822
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
823 (set-itimer-function-arguments timer (list pbar adj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
824 (set-itimer-uses-arguments timer t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
825 (set-itimer-restart timer 0.1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
826 (set-itimer-value timer 0.1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
827 (set-itimer-is-idle timer nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
828
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
829 (gtk-progress-set-format-string pbar "%v%%")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
830 (gtk-signal-connect pbar 'destroy (lambda (obj timer)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
831 (delete-itimer timer)) timer)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
832
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
833 (gtk-misc-set-alignment label 0 0.5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
834 (gtk-box-pack-start window label nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
835 (gtk-widget-show label)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
836 (gtk-widget-set-usize pbar 200 20)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
837 (gtk-box-pack-start window pbar t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
838
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
839 (setq button (gtk-check-button-new-with-label "Show text"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
840 (gtk-box-pack-start window button nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
841 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
842 (lambda (button bar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
843 (gtk-progress-set-show-text
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
844 bar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
845 (gtk-toggle-button-get-active button))) pbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
846 (gtk-widget-show button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
847
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
848 (setq button (gtk-check-button-new-with-label "Discrete blocks"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
849 (gtk-box-pack-start window button nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
850 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
851 (lambda (button bar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
852 (gtk-progress-bar-set-bar-style
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
853 bar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
854 (if (gtk-toggle-button-get-active button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
855 'discrete
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
856 'continuous))) pbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
857 (gtk-widget-show button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
858
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
859 (gtk-widget-show pbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
860
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
861 (activate-itimer timer)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
862
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
863 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
864 "Gamma Curve" gimp gamma-curve nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
865 (let ((curve (gtk-gamma-curve-new)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
866 (gtk-container-add window curve)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
867 (gtk-widget-show-all curve)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
868 (gtk-curve-set-range (gtk-gamma-curve-curve curve) 0 255 0 255)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
869 (gtk-curve-set-gamma (gtk-gamma-curve-curve curve) 2)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
870
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
871
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
872 ;;;; Testing various button boxes and layout strategies.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
873 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
874 "Button Box" container button-box nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
875 (let ((main-vbox (gtk-vbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
876 (vbox (gtk-vbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
877 (hbox (gtk-hbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
878 (frame-horz (gtk-frame-new "Horizontal Button Boxes"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
879 (frame-vert (gtk-frame-new "Vertical Button Boxes"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
880 (create-bbox (lambda (horizontal title spacing child-w child-h layout)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
881 (let ((frame (gtk-frame-new title))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
882 (bbox (if horizontal
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
883 (gtk-hbutton-box-new)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
884 (gtk-vbutton-box-new))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
885 (gtk-container-set-border-width bbox 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
886 (gtk-container-add frame bbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
887 (gtk-button-box-set-layout bbox layout)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
888 (gtk-button-box-set-spacing bbox spacing)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
889 (gtk-button-box-set-child-size bbox child-w child-h)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
890 (gtk-container-add bbox (gtk-button-new-with-label "OK"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
891 (gtk-container-add bbox (gtk-button-new-with-label "Cancel"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
892 (gtk-container-add bbox (gtk-button-new-with-label "Help"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
893 frame))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
894
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
895 (gtk-container-set-border-width window 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
896 (gtk-container-add window main-vbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
897
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
898 (gtk-box-pack-start main-vbox frame-horz t t 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
899 (gtk-container-set-border-width vbox 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
900 (gtk-container-add frame-horz vbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
901
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
902 (gtk-box-pack-start main-vbox frame-vert t t 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
903 (gtk-container-set-border-width hbox 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
904 (gtk-container-add frame-vert hbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
905
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
906 (gtk-box-pack-start vbox (funcall create-bbox t "Spread" 40 85 20 'spread) t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
907 (gtk-box-pack-start vbox (funcall create-bbox t "Edge" 40 85 20 'edge) t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
908 (gtk-box-pack-start vbox (funcall create-bbox t "Start" 40 85 20 'start) t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
909 (gtk-box-pack-start vbox (funcall create-bbox t "End" 40 85 20 'end) t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
910
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
911 (gtk-box-pack-start hbox (funcall create-bbox nil "Spread" 40 85 20 'spread) t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
912 (gtk-box-pack-start hbox (funcall create-bbox nil "Edge" 40 85 20 'edge) t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
913 (gtk-box-pack-start hbox (funcall create-bbox nil "Start" 40 85 20 'start) t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
914 (gtk-box-pack-start hbox (funcall create-bbox nil "End" 40 85 20 'end) t t 0)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
915
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
916
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
917 ;;;; Cursors
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
918 '(gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
919 "Cursors" cursors nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
920 (let ((cursors '(x-cursor arrow based-arrow-down based-arrow-up boat bogosity
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
921 bottom-left-corner bottom-right-corner bottom-side bottom-tee
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
922 box-spiral center-ptr circle clock coffee-mug cross cross-reverse
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
923 crosshair diamond-cross dot dotbox double-arrow draft-large
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
924 draft-small draped-box exchange fleur gobbler gumby hand1 hand2 heart
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
925 icon iron-cross left-ptr left-side left-tee leftbutton ll-angle
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
926 lr-angle man middlebutton mouse pencil pirate plus question-arrow
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
927 right-ptr right-side right-tee rightbutton rtl-logo sailboat
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
928 sb-down-arrow sb-h-double-arrow sb-left-arrow sb-right-arrow
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
929 sb-up-arrow sb-v-double-arrow shuttle sizing spider spraycan star
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
930 target tcross top-left-arrow top-left-corner top-right-corner top-side
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
931 top-tee trek ul-angle umbrella ur-angle watch xterm last-cursor))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
932 (cursor-area nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
933 (adjustment nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
934 (spinner nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
935 (setq cursor-area (gtk-event-box-new)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
936 adjustment (gtk-adjustment-new 0 0 (length cursors) 1 1 1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
937 spinner (gtk-spin-button-new adjustment 1 3))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
938 (gtk-widget-set-usize cursor-area 200 100)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
939 (gtk-box-pack-start window cursor-area t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
940 (gtk-box-pack-start window spinner nil nil 0)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
941
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
942
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
943 ;;;; Toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
944 (defun gtk-test-toolbar-create ()
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
945 (let ((toolbar (gtk-toolbar-new 'horizontal 'both)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
946 (gtk-toolbar-set-button-relief toolbar 'none)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
947
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
948 (gtk-toolbar-append-item toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
949 "Horizonal" "Horizontal toolbar layout" "Toolbar/Horizontal"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
950 (gtk-pixmap-new gtk-test-open-glyph nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
951 (lambda (tbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
952 (gtk-toolbar-set-orientation tbar 'horizontal)) toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
953 (gtk-toolbar-append-item toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
954 "Vertical" "Vertical toolbar layout" "Toolbar/Vertical"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
955 (gtk-pixmap-new gtk-test-open-glyph nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
956 (lambda (tbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
957 (gtk-toolbar-set-orientation tbar 'vertical)) toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
958
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
959 (gtk-toolbar-append-space toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
960 (gtk-toolbar-append-item toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
961 "Icons" "Only show toolbar icons" "Toolbar/IconsOnly"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
962 (gtk-pixmap-new gtk-test-open-glyph nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
963 (lambda (tbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
964 (gtk-toolbar-set-style tbar 'icons)) toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
965 (gtk-toolbar-append-item toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
966 "Text" "Only show toolbar text" "Toolbar/TextOnly"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
967 (gtk-pixmap-new gtk-test-open-glyph nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
968 (lambda (tbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
969 (gtk-toolbar-set-style tbar 'text)) toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
970 (gtk-toolbar-append-item toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
971 "Both" "Show toolbar icons and text" "Toolbar/Both"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
972 (gtk-pixmap-new gtk-test-open-glyph nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
973 (lambda (tbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
974 (gtk-toolbar-set-style tbar 'both)) toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
975
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
976 (gtk-toolbar-append-space toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
977 (gtk-toolbar-append-item toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
978 "Small" "Use small spaces" ""
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
979 (gtk-pixmap-new gtk-test-open-glyph nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
980 (lambda (tbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
981 (gtk-toolbar-set-space-size tbar 5)) toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
982 (gtk-toolbar-append-item toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
983 "Big" "Use big spaces" ""
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
984 (gtk-pixmap-new gtk-test-open-glyph nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
985 (lambda (tbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
986 (gtk-toolbar-set-space-size tbar 10)) toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
987
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
988 (gtk-toolbar-append-space toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
989 (gtk-toolbar-append-item toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
990 "Enable" "Enable tooltips" ""
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
991 (gtk-pixmap-new gtk-test-open-glyph nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
992 (lambda (tbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
993 (gtk-toolbar-set-tooltips tbar t)) toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
994 (gtk-toolbar-append-item toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
995 "Disable" "Disable tooltips" ""
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
996 (gtk-pixmap-new gtk-test-open-glyph nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
997 (lambda (tbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
998 (gtk-toolbar-set-tooltips tbar nil)) toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
999
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1000 (gtk-toolbar-append-space toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1001 (gtk-toolbar-append-item toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1002 "Borders" "Show borders" ""
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1003 (gtk-pixmap-new gtk-test-open-glyph nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1004 (lambda (tbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1005 (gtk-toolbar-set-button-relief tbar 'normal)) toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1006 (gtk-toolbar-append-item toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1007 "Borderless" "Hide borders" ""
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1008 (gtk-pixmap-new gtk-test-open-glyph nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1009 (lambda (tbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1010 (gtk-toolbar-set-button-relief tbar 'none)) toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1011
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1012 (gtk-toolbar-append-space toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1013 (gtk-toolbar-append-item toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1014 "Empty" "Empty spaces" ""
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1015 (gtk-pixmap-new gtk-test-open-glyph nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1016 (lambda (tbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1017 (gtk-toolbar-set-space-style tbar 'empty)) toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1018 (gtk-toolbar-append-item toolbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1019 "Lines" "Lines in spaces" ""
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1020 (gtk-pixmap-new gtk-test-open-glyph nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1021 (lambda (tbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1022 (gtk-toolbar-set-space-style tbar 'line)) toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1023 (gtk-widget-show-all toolbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1024 toolbar))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1025
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1026 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1027 "Toolbar" container toolbar nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1028 (gtk-box-pack-start window (gtk-test-toolbar-create) t t 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1029
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1030
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1031 ;;;; Text
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1032 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1033 "Text" composite text nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1034 (let ((text (gtk-text-new nil nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1035 (scrolled (gtk-scrolled-window-new nil nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1036 (bbox (gtk-hbutton-box-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1037 (button nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1038 (gtk-box-pack-start window scrolled t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1039 (gtk-box-pack-start window bbox nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1040 (gtk-widget-set-usize text 500 500)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1041 (gtk-container-add scrolled text)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1042
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1043 (setq button (gtk-check-button-new-with-label "Editable"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1044 (gtk-signal-connect button 'toggled
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1045 (lambda (button text)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1046 (gtk-text-set-editable text (gtk-toggle-button-get-active button))) text)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1047 (gtk-container-add bbox button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1048
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1049 (setq button (gtk-check-button-new-with-label "Wrap words"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1050 (gtk-signal-connect button 'toggled
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1051 (lambda (button text)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1052 (gtk-text-set-word-wrap text (gtk-toggle-button-get-active button))) text)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1053 (gtk-container-add bbox button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1054
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1055 ;; put some default text in there.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1056 (gtk-widget-set-style text 'default)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1057 (let ((faces '(blue bold bold-italic gtk-test-face-large red text-cursor))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1058 (string nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1059 (mapc (lambda (face)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1060 (setq string (format "Sample text in the `%s' face\n" face))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1061 (gtk-text-insert text
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1062 (face-font face)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1063 (face-foreground face)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1064 (face-background face)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1065 string (length string))) faces))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1066
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1067
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1068 ;; Tell the user their rights...
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1069 (let ((file (locate-data-file "COPYING")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1070 (gtk-text-freeze text)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1071 (save-excursion
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1072 (set-buffer (get-buffer-create " *foo*"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1073 (insert-file-contents file)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1074 (gtk-text-insert text nil nil nil (buffer-string) (point-max))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1075 (kill-buffer (current-buffer))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1076 (gtk-text-thaw text)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1077
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1078
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1079 ;;;; handle box
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1080 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1081 "Handle box" container handles nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1082 (let ((handle nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1083 (hbox (gtk-hbox-new nil 0)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1084
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1085 (gtk-box-pack-start window (gtk-label-new "Above") nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1086 (gtk-box-pack-start window (gtk-hseparator-new) nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1087 (gtk-box-pack-start window hbox t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1088 (gtk-box-pack-start window (gtk-hseparator-new) nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1089 (gtk-box-pack-start window (gtk-label-new "Below") nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1090
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1091 (setq handle (gtk-handle-box-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1092 (gtk-container-add handle (gtk-test-toolbar-create))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1093 (gtk-widget-show-all handle)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1094 (gtk-box-pack-start hbox handle nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1095 (gtk-signal-connect handle 'child_attached
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1096 (lambda (box child data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1097 (message "Child widget (%s) attached" child)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1098 (gtk-signal-connect handle 'child_detached
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1099 (lambda (box child data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1100 (message "Child widget (%s) detached" child)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1101
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1102 (setq handle (gtk-handle-box-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1103 (gtk-container-add handle (gtk-label-new "Fooo!!!"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1104 (gtk-box-pack-start hbox handle nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1105 (gtk-signal-connect handle 'child_attached
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1106 (lambda (box child data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1107 (message "Child widget (%s) attached" child)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1108 (gtk-signal-connect handle 'child_detached
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1109 (lambda (box child data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1110 (message "Child widget (%s) detached" child)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1111
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1112
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1113 ;;;; Menus
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1114 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1115 "Menus" basic menus nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1116 (let ((menubar (gtk-menu-bar-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1117 (item nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1118 (right-justify nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1119 (gtk-box-pack-start window menubar nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1120 (mapc (lambda (menudesc)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1121 (if (not menudesc)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1122 (setq right-justify t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1123 (setq item (gtk-build-xemacs-menu menudesc))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1124 (gtk-widget-show item)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1125 (if right-justify
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1126 (gtk-menu-item-right-justify item))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1127 (gtk-menu-bar-append menubar item)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1128 default-menubar)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1129
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1130
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1131 ;;;; Spinbutton
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1132 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1133 "Spinbutton" composite spinbutton nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1134 (let (frame vbox vbox2 hbox label spin adj spin2 button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1135
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1136 (gtk-container-set-border-width window 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1137
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1138 (setq frame (gtk-frame-new "Not accelerated")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1139 hbox (gtk-hbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1140
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1141 (gtk-box-pack-start window frame t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1142 (gtk-container-add frame hbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1143
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1144 (setq vbox (gtk-vbox-new nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1145 label (gtk-label-new "Day:")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1146 adj (gtk-adjustment-new 1.0 1.0 31.0 1.0 5.0 0.0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1147 spin (gtk-spin-button-new adj 0 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1148
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1149 (gtk-misc-set-alignment label 0 0.5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1150 (gtk-spin-button-set-wrap spin t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1151 (gtk-spin-button-set-shadow-type spin 'out)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1152 (gtk-box-pack-start hbox vbox t t 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1153 (gtk-box-pack-start vbox label nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1154 (gtk-box-pack-start vbox spin nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1155
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1156 (setq vbox (gtk-vbox-new nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1157 label (gtk-label-new "Month:")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1158 adj (gtk-adjustment-new 1.0 1.0 12.0 1.0 5.0 0.0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1159 spin (gtk-spin-button-new adj 0 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1160 (gtk-misc-set-alignment label 0 0.5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1161 (gtk-spin-button-set-wrap spin t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1162 (gtk-spin-button-set-shadow-type spin 'out)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1163 (gtk-box-pack-start hbox vbox t t 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1164 (gtk-box-pack-start vbox label nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1165 (gtk-box-pack-start vbox spin nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1166
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1167 (setq vbox (gtk-vbox-new nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1168 label (gtk-label-new "Year:")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1169 adj (gtk-adjustment-new 1998.0 0.0 2100.0 1.0 100.0 0.0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1170 spin (gtk-spin-button-new adj 0 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1171 (gtk-misc-set-alignment label 0 0.5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1172 (gtk-spin-button-set-wrap spin t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1173 (gtk-spin-button-set-shadow-type spin 'out)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1174 (gtk-widget-set-usize spin 55 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1175 (gtk-box-pack-start hbox vbox t t 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1176 (gtk-box-pack-start vbox label nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1177 (gtk-box-pack-start vbox spin nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1178
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1179 (setq frame (gtk-frame-new "Accelerated")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1180 vbox (gtk-vbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1181
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1182 (gtk-box-pack-start window frame t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1183 (gtk-container-add frame vbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1184
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1185 (setq hbox (gtk-hbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1186 (gtk-box-pack-start vbox hbox nil t 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1187
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1188 (setq vbox2 (gtk-vbox-new nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1189 label (gtk-label-new "Value:")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1190 adj (gtk-adjustment-new 0.0 -10000.0 10000.0 0.5 100.0 0.0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1191 spin (gtk-spin-button-new adj 1.0 2))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1192 (gtk-misc-set-alignment label 0 0.5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1193 (gtk-spin-button-set-wrap spin t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1194 (gtk-widget-set-usize spin 100 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1195 (gtk-box-pack-start vbox2 label nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1196 (gtk-box-pack-start vbox2 spin nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1197 (gtk-box-pack-start hbox vbox2 t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1198
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1199 (setq vbox2 (gtk-vbox-new nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1200 label (gtk-label-new "Digits:")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1201 adj (gtk-adjustment-new 2 1 5 1 1 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1202 spin2 (gtk-spin-button-new adj 0 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1203 (gtk-misc-set-alignment label 0 0.5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1204 (gtk-spin-button-set-wrap spin2 t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1205 (gtk-widget-set-usize spin2 100 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1206 (gtk-box-pack-start vbox2 label nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1207 (gtk-box-pack-start vbox2 spin2 nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1208 (gtk-box-pack-start hbox vbox2 t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1209 (gtk-signal-connect adj 'value_changed
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1210 (lambda (adj spinners)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1211 (gtk-spin-button-set-digits
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1212 (car spinners)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1213 (gtk-spin-button-get-value-as-int (cdr spinners))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1214 (cons spin spin2))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1215
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1216 (setq button (gtk-check-button-new-with-label "Snap to 0.5-ticks"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1217 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1218 (lambda (button spin)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1219 (gtk-spin-button-set-snap-to-ticks
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1220 spin
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1221 (gtk-toggle-button-get-active button)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1222 spin)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1223 (gtk-box-pack-start vbox button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1224 (gtk-toggle-button-set-active button t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1225
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1226 (setq button (gtk-check-button-new-with-label "Numeric only input mode"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1227 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1228 (lambda (button spin)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1229 (gtk-spin-button-set-numeric
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1230 spin
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1231 (gtk-toggle-button-get-active button)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1232 spin)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1233 (gtk-box-pack-start vbox button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1234 (gtk-toggle-button-set-active button t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1235
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1236 (setq label (gtk-label-new ""))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1237
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1238 (setq hbox (gtk-hbutton-box-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1239 (gtk-box-pack-start vbox hbox nil t 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1240 (gtk-box-pack-start vbox label nil nil 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1241
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1242 (setq button (gtk-button-new-with-label "Value as int"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1243 (gtk-container-add hbox button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1244 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1245 (lambda (obj data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1246 (let ((spin (car data))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1247 (label (cdr data)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1248 (gtk-label-set-text label
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1249 (format "%d"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1250 (gtk-spin-button-get-value-as-int spin)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1251 (cons spin label))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1252
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1253 (setq button (gtk-button-new-with-label "Value as float"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1254 (gtk-container-add hbox button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1255 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1256 (lambda (obj data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1257 (let ((spin (car data))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1258 (label (cdr data)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1259 (gtk-label-set-text label
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1260 (format "%g"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1261 (gtk-spin-button-get-value-as-float spin)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1262 (cons spin label))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1263
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1264
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1265 ;;;; Reparenting
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1266 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1267 "Reparenting" misc reparenting nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1268 (let ((label (gtk-label-new "Hello World"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1269 (frame-1 (gtk-frame-new "Frame 1"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1270 (frame-2 (gtk-frame-new "Frame 2"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1271 (button nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1272 (hbox (gtk-hbox-new nil 5))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1273 (vbox-1 nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1274 (vbox-2 nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1275 (reparent-func (lambda (button data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1276 (let ((label (car data))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1277 (new-parent (cdr data)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1278 (gtk-widget-reparent label new-parent)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1279
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1280 (gtk-box-pack-start window hbox t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1281 (gtk-box-pack-start hbox frame-1 t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1282 (gtk-box-pack-start hbox frame-2 t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1283
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1284 (setq vbox-1 (gtk-vbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1285 (gtk-container-add frame-1 vbox-1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1286 (setq vbox-2 (gtk-vbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1287 (gtk-container-add frame-2 vbox-2)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1288
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1289 (setq button (gtk-button-new-with-label "switch"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1290 (gtk-box-pack-start vbox-1 button nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1291 (gtk-signal-connect button 'clicked reparent-func (cons label vbox-2))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1292
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1293 (setq button (gtk-button-new-with-label "switch"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1294 (gtk-box-pack-start vbox-2 button nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1295 (gtk-signal-connect button 'clicked reparent-func (cons label vbox-1))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1296
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1297 (gtk-box-pack-start vbox-2 label nil t 0)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1298
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1299
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1300 ;;;; StatusBar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1301 (defvar statusbar-counter 1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1302
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1303 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1304 "Statusbar" composite statusbar nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1305 (let ((bar (gtk-statusbar-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1306 (vbox nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1307 (button nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1308
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1309 (setq vbox (gtk-vbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1310 (gtk-box-pack-start window vbox t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1311 (gtk-box-pack-end window bar t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1312
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1313 (setq button (gtk-button-new-with-label "push something"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1314 (gtk-box-pack-start-defaults vbox button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1315 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1316 (lambda (button bar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1317 (gtk-statusbar-push bar 1 (format "something %d" (incf statusbar-counter))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1318 bar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1319
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1320 (setq button (gtk-button-new-with-label "pop"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1321 (gtk-box-pack-start-defaults vbox button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1322 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1323 (lambda (button bar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1324 (gtk-statusbar-pop bar 1)) bar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1325
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1326 (setq button (gtk-button-new-with-label "steal #4"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1327 (gtk-box-pack-start-defaults vbox button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1328 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1329 (lambda (button bar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1330 (gtk-statusbar-remove bar 1 4)) bar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1331
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1332 (setq button (gtk-button-new-with-label "dump stack"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1333 (gtk-box-pack-start-defaults vbox button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1334 (gtk-widget-set-sensitive button nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1335
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1336 (setq button (gtk-button-new-with-label "test contexts"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1337 (gtk-box-pack-start-defaults vbox button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1338 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1339 (lambda (button bar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1340 (let ((contexts '("any context" "idle messages" "some text"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1341 "hit the mouse" "hit the mouse2")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1342 (message-box "%s"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1343 (mapconcat
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1344 (lambda (ctx)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1345 (format "context=\"%s\", context_id=%d"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1346 ctx (gtk-statusbar-get-context-id bar ctx)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1347 contexts "\n")))) bar)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1348
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1349
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1350 ;;;; Columned List
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1351 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1352 "Columnar List" composite clist nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1353 (let ((titles '("auto resize" "not resizeable" "max width 100" "min width 50"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1354 "hide column" "Title 5" "Title 6" "Title 7" "Title 8" "Title 9"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1355 "Title 10" "Title 11"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1356 hbox clist button separator scrolled-win check undo-button label)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1357
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1358 (gtk-container-set-border-width window 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1359
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1360 (setq scrolled-win (gtk-scrolled-window-new nil nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1361 (gtk-container-set-border-width scrolled-win 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1362 (gtk-scrolled-window-set-policy scrolled-win 'automatic 'automatic)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1363
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1364 ;; create GtkCList here so we have a pointer to throw at the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1365 ;; button callbacks -- more is done with it later
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1366 (setq clist (gtk-clist-new-with-titles (length titles) titles))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1367 (gtk-container-add scrolled-win clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1368
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1369 ;; Make the columns live up to their titles.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1370 (gtk-clist-set-column-auto-resize clist 0 t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1371 (gtk-clist-set-column-resizeable clist 1 nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1372 (gtk-clist-set-column-max-width clist 2 100)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1373 (gtk-clist-set-column-min-width clist 3 50)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1374
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1375 (gtk-signal-connect clist 'click-column
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1376 (lambda (clist column data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1377 (cond
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1378 ((= column 4)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1379 (gtk-clist-set-column-visibility clist column nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1380 ((= column (gtk-clist-sort-column clist))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1381 (gtk-clist-set-sort-type
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1382 clist (if (eq (gtk-clist-sort-type clist) 'ascending)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1383 'descending
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1384 'ascending)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1385 (t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1386 (gtk-clist-set-sort-column clist column)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1387 (gtk-clist-sort clist)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1388
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1389 ;; control buttons
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1390 (setq hbox (gtk-hbox-new nil 5))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1391 (gtk-container-set-border-width hbox 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1392 (gtk-box-pack-start window hbox nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1393
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1394 (setq button (gtk-button-new-with-label "Insert Row"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1395 (gtk-box-pack-start hbox button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1396 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1397 (lambda (button clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1398 (gtk-clist-append clist
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1399 (list (format "CListRow %05d" (random 10000))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1400 "Column 1"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1401 "Column 2"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1402 "Column 3"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1403 "Column 4"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1404 "Column 5"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1405 "Column 6"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1406 "Column 7"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1407 "Column 8"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1408 "Column 0"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1409 "Column 10"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1410 "Column 11"))) clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1411
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1412 (setq button (gtk-button-new-with-label "Add 1,000 Rows with Pixmaps"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1413 (gtk-box-pack-start hbox button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1414 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1415 (lambda (button clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1416 (let ((row 0) i)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1417 (gtk-clist-freeze clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1418 (loop for i from 0 to 1000 do
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1419 (setq row
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1420 (gtk-clist-append clist
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1421 (list
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1422 (format "CListRow %05d" (random 10000))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1423 "Column 1"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1424 "Column 2"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1425 "Column 3"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1426 "Column 4"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1427 "Column 5"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1428 "Column 6"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1429 "Column 7"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1430 "Column 8"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1431 "Column 0"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1432 "Column 10"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1433 "Column 11")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1434 (gtk-clist-set-pixtext clist row 3 "gtk+" 5
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1435 gtk-test-mini-gtk-glyph
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1436 nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1437 (gtk-clist-thaw clist))) clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1438
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1439 (setq button (gtk-button-new-with-label "Add 10,000 Rows"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1440 (gtk-box-pack-start hbox button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1441 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1442 (lambda (button clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1443 (gtk-clist-freeze clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1444 (loop for i from 0 to 10000 do
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1445 (gtk-clist-append clist
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1446 (list
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1447 (format "CListRow %05d" (random 10000))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1448 "Column 1"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1449 "Column 2"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1450 "Column 3"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1451 "Column 4"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1452 "Column 5"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1453 "Column 6"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1454 "Column 7"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1455 "Column 8"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1456 "Column 0"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1457 "Column 10"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1458 "Column 11")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1459 (gtk-clist-thaw clist)) clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1460
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1461 ;; Second layer of buttons
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1462 (setq hbox (gtk-hbox-new nil 5))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1463 (gtk-container-set-border-width hbox 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1464 (gtk-box-pack-start window hbox nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1465
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1466 (setq button (gtk-button-new-with-label "Clear List"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1467 (gtk-box-pack-start hbox button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1468 (gtk-signal-connect button 'clicked (lambda (button clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1469 (gtk-clist-clear clist)) clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1470
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1471 (setq button (gtk-button-new-with-label "Remove Selection"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1472 (gtk-box-pack-start hbox button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1473 (gtk-signal-connect button 'clicked (lambda (button clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1474 (error "Do not know how to do this yet.")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1475 (gtk-widget-set-sensitive button nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1476
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1477 (setq button (gtk-button-new-with-label "Undo Selection"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1478 (gtk-box-pack-start hbox button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1479 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1480 (lambda (button clist) (gtk-clist-undo-selection clist)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1481
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1482 (setq button (gtk-button-new-with-label "Warning Test"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1483 (gtk-box-pack-start hbox button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1484 (gtk-signal-connect button 'clicked 'ignore)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1485 (gtk-widget-set-sensitive button nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1486
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1487 ;; Third layer of buttons
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1488 (setq hbox (gtk-hbox-new nil 5))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1489 (gtk-container-set-border-width hbox 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1490 (gtk-box-pack-start window hbox nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1491
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1492 (setq button (gtk-check-button-new-with-label "Show Title Buttons"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1493 (gtk-box-pack-start hbox button nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1494 (gtk-signal-connect button 'clicked (lambda (button clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1495 (if (gtk-toggle-button-get-active button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1496 (gtk-clist-column-titles-show clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1497 (gtk-clist-column-titles-hide clist))) clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1498 (gtk-toggle-button-set-active button t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1499
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1500 (setq button (gtk-check-button-new-with-label "Reorderable"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1501 (gtk-box-pack-start hbox check nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1502 (gtk-signal-connect button 'clicked (lambda (button clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1503 (gtk-clist-set-reorderable
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1504 clist
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1505 (gtk-toggle-button-get-active button))) clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1506 (gtk-toggle-button-set-active button t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1507
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1508 (setq label (gtk-label-new "Selection Mode :"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1509 (gtk-box-pack-start hbox label nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1510
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1511 (gtk-box-pack-start hbox (build-option-menu
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1512 '(("Single" .
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1513 (lambda (item clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1514 (gtk-clist-set-selection-mode clist 'single)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1515 ("Browse" .
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1516 (lambda (item clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1517 (gtk-clist-set-selection-mode clist 'browse)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1518 ("Multiple" .
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1519 (lambda (item clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1520 (gtk-clist-set-selection-mode clist 'multiple)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1521 ("Extended" .
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1522 (lambda (item clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1523 (gtk-clist-set-selection-mode clist 'extended))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1524 3 clist) nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1525
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1526 ;; The rest of the clist configuration
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1527 (gtk-box-pack-start window scrolled-win t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1528 (gtk-clist-set-row-height clist 18)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1529 (gtk-widget-set-usize clist -1 300)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1530
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1531 (loop for i from 0 to 11 do
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1532 (gtk-clist-set-column-width clist i 80))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1533
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1534
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1535 ;;;; Notebook
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1536 (defun set-tab-label (notebook page selected-p)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1537 (if page
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1538 (let (label label-box pixwid)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1539 (setq label-box (gtk-hbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1540 (setq pixwid (gtk-pixmap-new
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1541 (if selected-p gtk-test-open-glyph gtk-test-closed-glyph) nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1542 (gtk-box-pack-start label-box pixwid nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1543 (gtk-misc-set-padding pixwid 3 1) ;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1544 (setq label (gtk-label-new
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1545 (format "Page %d" (1+ (gtk-notebook-page-num notebook page)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1546 (gtk-box-pack-start label-box label nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1547 (gtk-widget-show-all label-box)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1548 (gtk-notebook-set-tab-label notebook page label-box))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1549
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1550 (defun page-switch (widget page page-num data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1551 (let ((oldpage (gtk-notebook-get-current-page widget))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1552 (label nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1553 (label-box nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1554 (pixwid nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1555 (if (eq page-num oldpage)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1556 nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1557 (set-tab-label widget (gtk-notebook-get-nth-page widget oldpage) nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1558 (set-tab-label widget (gtk-notebook-get-nth-page widget page-num) t))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1559
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1560 (defun create-pages (notebook start end)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1561 (let (child button label hbox vbox label-box menu-box pixwid i)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1562 (setq i start)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1563 (while (<= i end)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1564 (setq child (gtk-frame-new (format "Page %d" i)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1565 (gtk-container-set-border-width child 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1566
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1567 (setq vbox (gtk-vbox-new t 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1568 (gtk-container-set-border-width vbox 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1569 (gtk-container-add child vbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1570
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1571 (setq hbox (gtk-hbox-new t 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1572 (gtk-box-pack-start vbox hbox nil t 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1573
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1574 (setq button (gtk-check-button-new-with-label "Fill Tab"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1575 (gtk-box-pack-start hbox button t t 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1576 (gtk-toggle-button-set-active button t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1577 (gtk-signal-connect
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1578 button 'toggled
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1579 (lambda (button data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1580 (let ((packing (gtk-notebook-query-tab-label-packing (car data) (cdr data))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1581 (gtk-notebook-set-tab-label-packing (car data) (cdr data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1582 (nth 0 packing)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1583 (gtk-toggle-button-get-active button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1584 (nth 2 packing))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1585 (cons notebook child))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1586
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1587 (setq button (gtk-check-button-new-with-label "Expand Tab"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1588 (gtk-box-pack-start hbox button t t 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1589 (gtk-signal-connect
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1590 button 'toggled
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1591 (lambda (button data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1592 (let ((packing (gtk-notebook-query-tab-label-packing (car data) (cdr data))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1593 (gtk-notebook-set-tab-label-packing (car data) (cdr data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1594 (gtk-toggle-button-get-active button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1595 (nth 1 packing) (nth 2 packing))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1596 (cons notebook child))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1597
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1598 (setq button (gtk-check-button-new-with-label "Pack End"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1599 (gtk-box-pack-start hbox button t t 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1600 (gtk-signal-connect
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1601 button 'toggled
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1602 (lambda (button data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1603 (let ((packing (gtk-notebook-query-tab-label-packing (car data) (cdr data))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1604 (gtk-notebook-set-tab-label-packing (car data) (cdr data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1605 (nth 0 packing) (nth 1 packing)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1606 (if (gtk-toggle-button-get-active button) 'end 'start))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1607 (cons notebook child))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1608
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1609 (setq button (gtk-button-new-with-label "Hide Page"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1610 (gtk-box-pack-end vbox button nil nil 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1611 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1612 (lambda (ignored child) (gtk-widget-hide child)) child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1613
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1614 (gtk-widget-show-all child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1615
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1616 (setq label-box (gtk-hbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1617 (setq pixwid (gtk-pixmap-new gtk-test-closed-glyph nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1618 (gtk-box-pack-start label-box pixwid nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1619 (gtk-misc-set-padding pixwid 3 1);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1620 (setq label (gtk-label-new (format "Page %d" i)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1621 (gtk-box-pack-start label-box label nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1622 (gtk-widget-show-all label-box)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1623
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1624 (setq menu-box (gtk-hbox-new nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1625 (setq pixwid (gtk-pixmap-new gtk-test-closed-glyph nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1626 (gtk-box-pack-start menu-box pixwid nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1627 (gtk-misc-set-padding pixwid 3 1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1628 (setq label (gtk-label-new (format "Page %d" i)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1629 (gtk-box-pack-start menu-box label nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1630 (gtk-widget-show-all menu-box)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1631 (gtk-notebook-append-page-menu notebook child label-box menu-box)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1632 (incf i))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1633
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1634 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1635 "Notebook" container notebook nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1636 (let (box1 box2 button separator omenu transparent label sample-notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1637 (gtk-container-set-border-width window 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1638
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1639 (setq sample-notebook (gtk-notebook-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1640 (gtk-signal-connect sample-notebook 'switch_page 'page-switch)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1641 (gtk-notebook-set-tab-pos sample-notebook 'top)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1642 (gtk-box-pack-start window sample-notebook t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1643 (gtk-container-set-border-width sample-notebook 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1644
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1645 (create-pages sample-notebook 1 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1646
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1647 (setq separator (gtk-hseparator-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1648 (gtk-box-pack-start window separator nil t 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1649
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1650 (setq box2 (gtk-hbox-new nil 5))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1651 (gtk-container-set-border-width box2 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1652 (gtk-box-pack-start window box2 nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1653
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1654 (setq button (gtk-check-button-new-with-label "popup menu"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1655 (gtk-box-pack-start box2 button t nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1656 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1657 (lambda (button notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1658 (if (gtk-toggle-button-get-active button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1659 (gtk-notebook-popup-enable notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1660 (gtk-notebook-popup-disable notebook))) sample-notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1661
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1662 (setq button (gtk-check-button-new-with-label "homogeneous tabs"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1663 (gtk-box-pack-start box2 button t nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1664 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1665 (lambda (button notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1666 (gtk-notebook-set-homogeneous-tabs
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1667 notebook
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1668 (gtk-toggle-button-get-active button))) sample-notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1669
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1670 (setq box2 (gtk-hbox-new nil 5))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1671 (gtk-container-set-border-width box2 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1672 (gtk-box-pack-start window box2 nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1673
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1674 (setq label (gtk-label-new "Notebook Style :"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1675 (gtk-box-pack-start box2 label nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1676
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1677 (setq omenu (build-option-menu '(("Standard" .
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1678 (lambda (b n)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1679 (gtk-notebook-set-show-tabs n t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1680 (gtk-notebook-set-scrollable n nil)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1681 ("No tabs" .
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1682 (lambda (b n)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1683 (gtk-notebook-set-show-tabs n nil)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1684 ("Scrollable" .
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1685 (lambda (b n)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1686 (gtk-notebook-set-show-tabs n t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1687 (gtk-notebook-set-scrollable n t))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1688 0
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1689 sample-notebook))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1690 (gtk-box-pack-start box2 omenu nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1691
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1692 (setq button (gtk-button-new-with-label "Show all pages"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1693 (gtk-box-pack-start box2 button nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1694 (gtk-signal-connect
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1695 button 'clicked (lambda (button notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1696 (mapc 'gtk-widget-show (gtk-container-children notebook)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1697 sample-notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1698
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1699 (setq box2 (gtk-hbox-new t 10))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1700 (gtk-container-set-border-width box2 10)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1701 (gtk-box-pack-start window box2 nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1702
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1703 (setq button (gtk-button-new-with-label "prev"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1704 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1705 (lambda (button notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1706 (gtk-notebook-prev-page notebook)) sample-notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1707 (gtk-box-pack-start box2 button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1708
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1709 (setq button (gtk-button-new-with-label "next"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1710 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1711 (lambda (button notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1712 (gtk-notebook-next-page notebook)) sample-notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1713 (gtk-box-pack-start box2 button t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1714
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1715 (setq button (gtk-button-new-with-label "rotate"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1716 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1717 (lambda (button notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1718 (gtk-notebook-set-tab-pos
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1719 notebook
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1720 (case (gtk-notebook-tab-pos notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1721 (top 'right)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1722 (right 'bottom)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1723 (bottom 'left)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1724 (left 'top))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1725 sample-notebook)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1726
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1727 (gtk-box-pack-start box2 button t t 0)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1728
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1729
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1730 ;;;; Glade interfaces
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1731 (if (and (featurep 'glade)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1732 (file-exists-p (expand-file-name "gtk-test.glade" (gtk-test-directory))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1733 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1734 "Glade Interface" misc libglade t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1735 (glade-init)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1736 (glade-xml-get-type)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1737 (let ((xml (glade-xml-new (expand-file-name "gtk-test.glade" (gtk-test-directory))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1738 nil)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1739 (setq window (glade-xml-get-widget xml "main_window"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1740 (glade-xml-signal-autoconnect xml)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1741 (fmakunbound 'gtk-test-libglade))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1742
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1743
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1744 ;;;; CTree
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1745 (defvar gtk-test-ctree-hash nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1746
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1747 (defun gtk-test-ctree-expand-directory (ctree dir parent)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1748 (ignore-errors
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1749 (let ((dirs (directory-files dir t nil nil 5))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1750 (files (directory-files dir t nil nil t))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1751 (node nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1752 (mapc (lambda (d)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1753 (if (or (string-match "/\\.$" d)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1754 (string-match "/\\.\\.$" d))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1755 nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1756 (setq node
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1757 (gtk-ctree-insert-node ctree parent nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1758 (list (file-name-nondirectory d) "")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1759 0 nil nil nil nil nil t))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1760 (puthash node d gtk-test-ctree-hash)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1761 (gtk-ctree-insert-node ctree node nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1762 (list "" "")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1763 0 nil nil nil nil nil nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1764 (gtk-ctree-collapse ctree node)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1765 dirs)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1766 (mapc (lambda (f)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1767 (gtk-ctree-insert-node ctree parent nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1768 (list (file-name-nondirectory f)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1769 (user-login-name (nth 2 (file-attributes f))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1770 0 nil nil nil nil t nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1771 files)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1772 (gtk-clist-columns-autosize ctree))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1773
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1774 (defun gtk-spin-button-new-with-label (label adjustment climb-rate digits)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1775 (let ((box (gtk-hbox-new nil 2))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1776 (spin (gtk-spin-button-new adjustment climb-rate digits))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1777 (lbl (gtk-label-new label)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1778 (gtk-box-pack-start box lbl nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1779 (gtk-box-pack-start box spin t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1780 (cons box spin)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1781
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1782 (gtk-define-test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1783 "Columnar Tree" composite ctree nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1784 (let ((scrolled (gtk-scrolled-window-new nil nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1785 (ctree (gtk-ctree-new-with-titles 2 0 '("File" "Owner")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1786 (box (gtk-hbutton-box-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1787 (button nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1788 (setq gtk-test-ctree-hash (make-hash-table :test 'equal))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1789 (put scrolled 'child ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1790 (put scrolled 'height 400)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1791 (put ctree 'line_style 'solid)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1792 (put ctree 'expander_style 'square)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1793
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1794 (gtk-box-pack-start window scrolled t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1795 (gtk-box-pack-start window box nil nil 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1796
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1797 (gtk-clist-freeze ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1798 (gtk-test-ctree-expand-directory ctree "/" nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1799 (gtk-clist-thaw ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1800
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1801 (setq button (gtk-button-new-with-label "Expand all"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1802 (put box 'child button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1803 (gtk-signal-connect button 'clicked (lambda (button tree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1804 (gtk-ctree-expand-recursive tree nil)) ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1805
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1806 (setq button (gtk-button-new-with-label "Collaps all"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1807 (put box 'child button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1808 (gtk-signal-connect button 'clicked (lambda (button tree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1809 (gtk-ctree-collapse-recursive tree nil)) ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1810
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1811 (setq button (gtk-button-new-with-label "Change style"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1812 (put box 'child button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1813 (put button 'sensitive nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1814
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1815 (setq box (gtk-hbox-new t 5))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1816 (gtk-box-pack-start window box nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1817
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1818 (setq button (gtk-button-new-with-label "Select all"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1819 (put box 'child button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1820 (gtk-signal-connect button 'clicked (lambda (button tree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1821 (gtk-ctree-select-recursive tree nil)) ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1822
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1823 (setq button (gtk-button-new-with-label "Unselect all"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1824 (put box 'child button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1825 (gtk-signal-connect button 'clicked (lambda (button tree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1826 (gtk-ctree-unselect-recursive tree nil)) ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1827
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1828 (setq button (gtk-button-new-with-label "Remove all"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1829 (put box 'child button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1830 (gtk-signal-connect button 'clicked (lambda (button tree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1831 (gtk-clist-freeze tree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1832 (gtk-ctree-recurse
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1833 tree nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1834 (lambda (tree subnode data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1835 (gtk-ctree-remove-node tree subnode)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1836 (gtk-clist-thaw tree)) ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1837
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1838 (setq button (gtk-check-button-new-with-label "Reorderable"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1839 (put box 'child button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1840 (gtk-signal-connect button 'clicked (lambda (button tree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1841 (put tree 'reorderable
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1842 (gtk-toggle-button-get-active button))) ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1843
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1844 (setq box (gtk-hbox-new t 5))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1845 (gtk-box-pack-start window box nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1846
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1847 (gtk-box-pack-start box (build-option-menu
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1848 '(("Dotted" . (lambda (item ctree) (put ctree 'line_style 'dotted)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1849 ("Solid" . (lambda (item ctree) (put ctree 'line_style 'solid)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1850 ("Tabbed" . (lambda (item ctree) (put ctree 'line_style 'tabbed)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1851 ("None" . (lambda (item ctree) (put ctree 'line_style 'none))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1852 0 ctree) nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1853 (gtk-box-pack-start box (build-option-menu
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1854 '(("Square" . (lambda (item ctree) (put ctree 'expander_style 'square)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1855 ("Triangle" . (lambda (item ctree) (put ctree 'expander_style 'triangle)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1856 ("Circular" . (lambda (item ctree) (put ctree 'expander_style 'circular)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1857 ("None" . (lambda (item ctree) (put ctree 'expander_style 'none))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1858 0 ctree) nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1859 (gtk-box-pack-start box (build-option-menu
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1860 '(("Left" . (lambda (item ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1861 (gtk-clist-set-column-justification
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1862 ctree (get ctree 'tree_column) 'left)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1863 ("Right" . (lambda (item ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1864 (gtk-clist-set-column-justification
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1865 ctree (get ctree 'tree_column) 'right))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1866 0 ctree) nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1867 (gtk-box-pack-start box (build-option-menu
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1868 '(("Single" .
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1869 (lambda (item clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1870 (gtk-clist-set-selection-mode clist 'single)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1871 ("Browse" .
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1872 (lambda (item clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1873 (gtk-clist-set-selection-mode clist 'browse)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1874 ("Multiple" .
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1875 (lambda (item clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1876 (gtk-clist-set-selection-mode clist 'multiple)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1877 ("Extended" .
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1878 (lambda (item clist)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1879 (gtk-clist-set-selection-mode clist 'extended))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1880 3 ctree) nil t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1881
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1882 (setq box (gtk-hbox-new t 5))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1883 (gtk-box-pack-start window box nil nil 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1884
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1885 (let (adj spinner)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1886 (setq adj (gtk-adjustment-new (get ctree 'indent) 0 999 1 5 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1887 spinner (gtk-spin-button-new-with-label "Indent: " adj 1 3))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1888 (put box 'child (car spinner))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1889 (gtk-signal-connect adj 'value-changed
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1890 (lambda (adj tree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1891 (put tree 'indent (truncate (gtk-adjustment-value adj)))) ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1892
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1893 (setq adj (gtk-adjustment-new (get ctree 'spacing) 0 999 1 5 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1894 spinner (gtk-spin-button-new-with-label "Spacing: " adj 1 3))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1895 (put box 'child (car spinner))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1896 (gtk-signal-connect adj 'value-changed
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1897 (lambda (adj tree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1898 (put tree 'spacing (truncate (gtk-adjustment-value adj)))) ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1899
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1900 (setq adj (gtk-adjustment-new (get ctree 'row_height) 0 999 1 5 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1901 spinner (gtk-spin-button-new-with-label "Row Height: " adj 1 3))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1902 (put box 'child (car spinner))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1903 (gtk-signal-connect adj 'value-changed
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1904 (lambda (adj tree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1905 (put tree 'row_height (truncate (gtk-adjustment-value adj)))) ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1906
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1907 (setq button (gtk-check-button-new-with-label "Show logical root"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1908 (put box 'child button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1909 (gtk-signal-connect button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1910 (lambda (button tree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1911 (put tree 'show_stub (gtk-toggle-button-get-active button))) ctree))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1912
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1913 (gtk-signal-connect ctree 'tree-expand
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1914 (lambda (ctree node user-data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1915 (gtk-clist-freeze ctree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1916 (gtk-ctree-recurse
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1917 ctree node
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1918 (lambda (tree subnode user-data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1919 (if (not (equal subnode node))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1920 (gtk-ctree-remove-node tree subnode))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1921 (gtk-test-ctree-expand-directory ctree
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1922 (gethash node gtk-test-ctree-hash)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1923 node)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1924 (gtk-clist-thaw ctree)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1925
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1926
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1927 ;;;; The main interface
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1928
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1929 (defun gtk-test-view-source (test)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1930 ;; View the source for this test in a XEmacs window.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1931 (if test
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1932 (let ((path (expand-file-name "gtk-test.el" (gtk-test-directory))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1933 (if (not (file-exists-p path))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1934 (error "Could not find source for gtk-test.el"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1935 (find-file path)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1936 (widen)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1937 (goto-char (point-min))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1938 (if (not (re-search-forward (concat "(gtk-define-test[ \t\n]*\"" test "\"") nil t))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1939 (error "Could not find test: %s" test)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1940 (narrow-to-page)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1941 (goto-char (point-min))))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1942
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1943 (defvar gtk-test-selected-test nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1944
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1945 (defun gtk-test ()
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1946 (interactive)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1947 (let ((items nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1948 (box nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1949 (window nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1950 (category-trees nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1951 (tree nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1952 (pane nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1953 (scrolled nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1954 (src-button nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1955 (gc-button nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1956 (standalone-p (not (default-gtk-device)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1957 (close-button nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1958 (gtk-init (list invocation-name))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1959 (if standalone-p
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1960 (progn
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1961 (gtk-object-destroy (gtk-adjustment-new 0 0 0 0 0 0))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1962 (ignore-errors
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1963 (or (fboundp 'gtk-test-gnome-pixmaps)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1964 (load-file (expand-file-name "gnome-test.el" (gtk-test-directory))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1965 (or (fboundp 'gtk-test-color-combo)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1966 (load-file (expand-file-name "gtk-extra-test.el" (gtk-test-directory)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1967 (unwind-protect
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1968 (progn
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1969 (setq window (gtk-dialog-new)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1970 box (gtk-vbox-new nil 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1971 pane (gtk-hpaned-new)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1972 scrolled (gtk-scrolled-window-new nil nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1973 tree (gtk-tree-new)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1974 src-button (gtk-button-new-with-label "View source")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1975 gc-button (gtk-button-new-with-label "Garbage Collect")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1976 close-button (gtk-button-new-with-label "Quit"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1977 (gtk-window-set-title window
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1978 (format "%s/GTK %d.%d.%d"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1979 (if (featurep 'infodock) "InfoDock" "XEmacs")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1980 emacs-major-version emacs-minor-version
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1981 (or emacs-patch-level emacs-beta-version)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1982
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1983 (gtk-scrolled-window-set-policy scrolled 'automatic 'automatic)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1984 (gtk-scrolled-window-add-with-viewport scrolled tree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1985 (gtk-widget-set-usize scrolled 200 600)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1986
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1987 (gtk-box-pack-start (gtk-dialog-vbox window) pane t t 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1988 (gtk-paned-pack1 pane scrolled t nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1989 (gtk-paned-pack2 pane box t nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1990 (setq gtk-test-shell box)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1991 (gtk-widget-show-all box)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1992
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1993 (gtk-container-add (gtk-dialog-action-area window) close-button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1994 (gtk-container-add (gtk-dialog-action-area window) src-button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1995 (gtk-container-add (gtk-dialog-action-area window) gc-button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1996
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1997 (gtk-signal-connect gc-button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1998 (lambda (obj data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1999 (garbage-collect)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2000 (gtk-signal-connect close-button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2001 (lambda (obj data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2002 (gtk-widget-destroy data)) window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2003 (gtk-signal-connect src-button 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2004 (lambda (obj data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2005 (gtk-test-view-source gtk-test-selected-test)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2006
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2007 ;; Try to be a nice person and sort the tests
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2008 (setq gtk-defined-tests
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2009 (sort gtk-defined-tests
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2010 (lambda (a b)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2011 (string-lessp (car a) (car b)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2012
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2013 ;; This adds all of the buttons to the window.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2014 (mapcar (lambda (test)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2015 (let* ((desc (nth 0 test))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2016 (type (nth 1 test))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2017 (func (nth 2 test))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2018 (parent (cdr-safe (assoc type category-trees)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2019 (item (gtk-tree-item-new-with-label desc)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2020 (put item 'test-function func)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2021 (put item 'test-description desc)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2022 (put item 'test-type type)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2023 (gtk-widget-show item)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2024 (if (not parent)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2025 (let ((subtree (gtk-tree-new)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2026 (setq parent (gtk-tree-item-new-with-label
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2027 (or (cdr-safe (assoc type gtk-test-categories))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2028 (symbol-name type))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2029 (gtk-signal-connect subtree 'select-child
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2030 (lambda (tree widget data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2031 (setq gtk-test-selected-test (get widget 'test-description))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2032 (funcall (get widget 'test-function))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2033 (gtk-tree-append tree parent)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2034 (gtk-tree-item-set-subtree parent subtree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2035 (setq parent subtree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2036 (push (cons type parent) category-trees)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2037 (gtk-tree-append parent item)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2038 gtk-defined-tests)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2039 (gtk-widget-show-all window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2040 (if standalone-p
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2041 (progn
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2042 (gtk-signal-connect window 'destroy (lambda (w d)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2043 (gtk-main-quit)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2044 (gtk-main)))))))