annotate lisp/widgets-gtk.el @ 5157:1fae11d56ad2

redo memory-usage mechanism, add way of dynamically initializing Lisp objects -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-03-18 Ben Wing <ben@xemacs.org> * diagnose.el (show-memory-usage): Rewrite to take into account API changes in memory-usage functions. src/ChangeLog addition: 2010-03-18 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (disksave_object_finalization_1): * alloc.c (lisp_object_storage_size): * alloc.c (listu): * alloc.c (listn): * alloc.c (Fobject_memory_usage_stats): * alloc.c (compute_memusage_stats_length): * alloc.c (Fobject_memory_usage): * alloc.c (Ftotal_object_memory_usage): * alloc.c (malloced_storage_size): * alloc.c (common_init_alloc_early): * alloc.c (reinit_alloc_objects_early): * alloc.c (reinit_alloc_early): * alloc.c (init_alloc_once_early): * alloc.c (syms_of_alloc): * alloc.c (reinit_vars_of_alloc): * buffer.c: * buffer.c (struct buffer_stats): * buffer.c (compute_buffer_text_usage): * buffer.c (compute_buffer_usage): * buffer.c (buffer_memory_usage): * buffer.c (buffer_objects_create): * buffer.c (syms_of_buffer): * buffer.c (vars_of_buffer): * console-impl.h (struct console_methods): * dynarr.c (Dynarr_memory_usage): * emacs.c (main_1): * events.c (clear_event_resource): * extents.c: * extents.c (compute_buffer_extent_usage): * extents.c (extent_objects_create): * extents.h: * faces.c: * faces.c (compute_face_cachel_usage): * faces.c (face_objects_create): * faces.h: * general-slots.h: * glyphs.c: * glyphs.c (compute_glyph_cachel_usage): * glyphs.c (glyph_objects_create): * glyphs.h: * lisp.h: * lisp.h (struct usage_stats): * lrecord.h: * lrecord.h (enum lrecord_type): * lrecord.h (struct lrecord_implementation): * lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE): * lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT): * lrecord.h (MAKE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT): * lrecord.h (MAKE_MODULE_LISP_OBJECT): * lrecord.h (INIT_LISP_OBJECT): * lrecord.h (INIT_MODULE_LISP_OBJECT): * lrecord.h (UNDEF_LISP_OBJECT): * lrecord.h (UNDEF_MODULE_LISP_OBJECT): * lrecord.h (DECLARE_LISP_OBJECT): * lrecord.h (DECLARE_MODULE_API_LISP_OBJECT): * lrecord.h (DECLARE_MODULE_LISP_OBJECT): * lstream.c: * lstream.c (syms_of_lstream): * lstream.c (vars_of_lstream): * marker.c: * marker.c (compute_buffer_marker_usage): * mc-alloc.c (mc_alloced_storage_size): * mc-alloc.h: * mule-charset.c: * mule-charset.c (struct charset_stats): * mule-charset.c (compute_charset_usage): * mule-charset.c (charset_memory_usage): * mule-charset.c (mule_charset_objects_create): * mule-charset.c (syms_of_mule_charset): * mule-charset.c (vars_of_mule_charset): * redisplay.c: * redisplay.c (compute_rune_dynarr_usage): * redisplay.c (compute_display_block_dynarr_usage): * redisplay.c (compute_glyph_block_dynarr_usage): * redisplay.c (compute_display_line_dynarr_usage): * redisplay.c (compute_line_start_cache_dynarr_usage): * redisplay.h: * scrollbar-gtk.c (gtk_compute_scrollbar_instance_usage): * scrollbar-msw.c (mswindows_compute_scrollbar_instance_usage): * scrollbar-x.c (x_compute_scrollbar_instance_usage): * scrollbar.c (compute_scrollbar_instance_usage): * scrollbar.h: * symbols.c: * symbols.c (reinit_symbol_objects_early): * symbols.c (init_symbols_once_early): * symbols.c (reinit_symbols_early): * symbols.c (defsymbol_massage_name_1): * symsinit.h: * ui-gtk.c: * ui-gtk.c (emacs_gtk_object_getprop): * ui-gtk.c (emacs_gtk_object_putprop): * ui-gtk.c (ui_gtk_objects_create): * unicode.c (compute_from_unicode_table_size_1): * unicode.c (compute_to_unicode_table_size_1): * unicode.c (compute_from_unicode_table_size): * unicode.c (compute_to_unicode_table_size): * window.c: * window.c (struct window_stats): * window.c (compute_window_mirror_usage): * window.c (compute_window_usage): * window.c (window_memory_usage): * window.c (window_objects_create): * window.c (syms_of_window): * window.c (vars_of_window): * window.h: Redo memory-usage mechanism, make it general; add way of dynamically initializing Lisp object types -- OBJECT_HAS_METHOD(), similar to CONSOLE_HAS_METHOD(). (1) Create OBJECT_HAS_METHOD(), OBJECT_HAS_PROPERTY() etc. for specifying that a Lisp object type has a particular method or property. Call such methods with OBJECT_METH, MAYBE_OBJECT_METH, OBJECT_METH_OR_GIVEN; retrieve properties with OBJECT_PROPERTY. Methods that formerly required a DEFINE_*GENERAL_LISP_OBJECT() to specify them (getprop, putprop, remprop, plist, disksave) now instead use the dynamic-method mechanism. The main benefit of this is that new methods or properties can be added without requiring that the declaration statements of all existing methods be modified. We have to make the `struct lrecord_implementation' non-const, but I don't think this should have any effect on speed -- the only possible method that's really speed-critical is the mark method, and we already extract those out into a separate (non-const) array for increased cache locality. Object methods need to be reinitialized after pdump, so we put them in separate functions such as face_objects_create(), extent_objects_create() and call them appropriately from emacs.c The only current object property (`memusage_stats_list') that objects can specify is a Lisp object and gets staticpro()ed so it only needs to be set during dump time, but because it references symbols that might not exist in a syms_of_() function, we initialize it in vars_of_(). There is also an object property (`num_extra_memusage_stats') that is automatically initialized based on `memusage_stats_list'; we do that in reinit_vars_of_alloc(), which is called after all vars_of_() functions are called. `disksaver' method was renamed `disksave' to correspond with the name normally given to the function (e.g. disksave_lstream()). (2) Generalize the memory-usage mechanism in `buffer-memory-usage', `window-memory-usage', `charset-memory-usage' into an object-type- specific mechanism called by a single function `object-memory-usage'. (Former function `object-memory-usage' renamed to `total-object-memory-usage'). Generalize the mechanism of different "slices" so that we can have different "classes" of memory described and different "slices" onto each class; `t' separates classes, `nil' separates slices. Currently we have three classes defined: the memory of an object itself, non-Lisp-object memory associated with the object (e.g. arrays or dynarrs stored as fields in the object), and Lisp-object memory associated with the object (other internal Lisp objects stored in the object). This isn't completely finished yet and we might need to further separate the "other internal Lisp objects" class into two classes. The memory-usage mechanism uses a `struct usage_stats' (renamed from `struct overhead_stats') to describe a malloc-view onto a set of allocated memory (listing how much was requested and various types of overhead) and a more general `struct generic_usage_stats' (with a `struct usage_stats' in it) to hold all statistics about object memory. `struct generic_usage_stats' contains an array of 32 Bytecounts, which are statistics of unspecified semantics. The intention is that individual types declare a corresponding struct (e.g. `struct window_stats') with the same structure but with specific fields in place of the array, corresponding to specific statistics. The number of such statistics is an object property computed from the list of tags (Lisp symbols describing the statistics) stored in `memusage_stats_list'. The idea here is to allow particular object types to customize the number and semantics of the statistics where completely avoiding consing. This doesn't matter so much yet, but the intention is to have the memory usage of all objects computed at the end of GC, at the same time as other statistics are currently computed. The values for all statistics for a single type would be added up to compute aggregate values for all objects of a specific type. To make this efficient, we can't allow any memory allocation at all. (3) Create some additional functions for creating lists that specify the elements directly as args rather than indirectly through an array: listn() (number of args given), listu() (list terminated by Qunbound). (4) Delete a bit of remaining unused C window_config stuff, also unused lrecord_type_popup_data.
author Ben Wing <ben@xemacs.org>
date Thu, 18 Mar 2010 10:50:06 -0500
parents ecf1ebac70d8
children 308d34e9f07d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1 ;;; widgets-gtk.el --- Embedded widget support for XEmacs w/GTK primitives
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) 2001 Free Software Foundation, Inc.
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 M. Perry <wmperry@gnu.org>
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
6 ;; Keywords: extensions, internal, dumped
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
7
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
8 ;; This file is part of XEmacs.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
9
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
10 ;; XEmacs is free software; you can redistribute it and/or modify it
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
11 ;; under the terms of the GNU General Public License as published by
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
13 ;; any later version.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
14
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
15 ;; XEmacs is distributed in the hope that it will be useful, but
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
18 ;; General Public License for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
19
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
21 ;; along with XEmacs; see the file COPYING. If not, write to the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
23 ;; Boston, MA 02111-1307, USA.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
24
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
25 ;;; Synched up with: Not in FSF.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
26
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
27 ;;; Commentary:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
28
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
29 ;; This file is dumped with XEmacs (when embedded widgets are compiled in).
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
30
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
31 (globally-declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
32 '(gtk-button-new-with-label
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
33 gtk-signal-connect
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
34 gtk-radio-button-new-with-label gtk-radio-button-group
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
35 gtk-toggle-button-set-active gtk-check-button-new-with-label
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
36 gtk-widget-show-all gtk-notebook-new gtk-notebook-append-page
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
37 gtk-vbox-new gtk-label-new gtk-adjustment-new
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
38 gtk-progress-bar-new-with-adjustment gtk-adjustment-set-value
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
39 gtk-entry-new gtk-entry-set-text gtk-widget-set-style
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
40 gtk-widget-get-style))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
41
738
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
42 (defun gtk-widget-get-callback (widget plist instance)
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
43 (let ((cb (plist-get plist :callback))
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
44 (ex (plist-get plist :callback-ex))
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
45 (real-cb nil))
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
46 (cond
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
47 (ex
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
48 (gtk-signal-connect widget 'button-release-event
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
49 (lambda (widget event data)
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
50 (put widget 'last-event event)))
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
51 `(lambda (widget &rest ignored)
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
52 (funcall ,ex ,instance (get widget 'last-event))))
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
53 (cb
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
54 `(lambda (widget &rest ignored)
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
55 (if (functionp ,real-cb)
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
56 (funcall ,real-cb)
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
57 (eval ,real-cb))))
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
58 (t
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
59 nil))))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
60
738
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
61 (defun gtk-widget-instantiate-button-internal (plist instance)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
62 (let* ((type (or (plist-get plist :style) 'button))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
63 (label (or (plist-get plist :descriptor) (symbol-name type)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
64 (widget nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
65 (case type
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
66 (button
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
67 (setq widget (gtk-button-new-with-label label))
738
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
68 (gtk-signal-connect widget 'clicked
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
69 (gtk-widget-get-callback widget plist instance)))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
70 (radio
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
71 (let ((aux nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
72 (selected-p (plist-get plist :selected)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
73 (setq widget (gtk-radio-button-new-with-label nil label)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
74 aux (gtk-radio-button-new-with-label
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
75 (gtk-radio-button-group widget)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
76 "bogus sibling"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
77 (gtk-toggle-button-set-active widget (eval selected-p))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
78 (gtk-signal-connect widget 'toggled
738
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
79 (gtk-widget-get-callback widget plist instance) aux)))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
80 (otherwise
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
81 ;; Check boxes
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
82 (setq widget (gtk-check-button-new-with-label label))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
83 (gtk-toggle-button-set-active widget
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
84 (eval (plist-get plist :selected)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
85 (gtk-signal-connect widget 'toggled
738
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
86 (gtk-widget-get-callback widget plist instance))))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
87 (gtk-widget-show-all widget)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
88 widget))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
89
738
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
90 (defun gtk-widget-instantiate-notebook-internal (plist instance)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
91 (let ((widget (gtk-notebook-new))
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2168
diff changeset
92 ;(items (plist-get plist :items))
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2168
diff changeset
93 )
2168
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 738
diff changeset
94 ; (while items
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 738
diff changeset
95 ; (gtk-notebook-append-page widget
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 738
diff changeset
96 ; (gtk-vbox-new nil 3)
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 738
diff changeset
97 ; (gtk-label-new (aref (car items) 0)))
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 738
diff changeset
98 ; (setq items (cdr items)))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
99 widget))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
100
738
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
101 (defun gtk-widget-instantiate-progress-internal (plist instance)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
102 (let* ((adj (gtk-adjustment-new 0.0 0.0 100.0 1.0 5.0 5.0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
103 (widget (gtk-progress-bar-new-with-adjustment adj)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
104 (gtk-adjustment-set-value adj (or (plist-get plist :value) 0.0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
105 widget))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
106
738
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
107 (defun gtk-widget-instantiate-entry-internal (plist instance)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
108 (let* ((widget (gtk-entry-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
109 (default (plist-get plist :descriptor)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
110 (cond
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
111 ((stringp default)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
112 nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
113 ((sequencep default)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
114 (setq default (mapconcat 'identity default "")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
115 (t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
116 (error "Invalid default value: %S" default)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
117 (gtk-entry-set-text widget default)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
118 widget))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
119
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
120 (put 'button 'instantiator 'gtk-widget-instantiate-button-internal)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
121 (put 'tab-control 'instantiator 'gtk-widget-instantiate-notebook-internal)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
122 (put 'progress-gauge 'instantiator 'gtk-widget-instantiate-progress-internal)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
123 (put 'tree-view 'instantiator 'ignore)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
124 (put 'edit-field 'instantiator 'gtk-widget-instantiate-entry-internal)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
125 (put 'combo-box 'instantiator 'ignore)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
126 (put 'label 'instantiator 'ignore)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
127 (put 'layout 'instantiator 'ignore)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
128
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
129 (defun gtk-widget-instantiate-internal (instance
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
130 instantiator
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
131 pointer-fg
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
132 pointer-bg
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
133 domain)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
134 "The lisp side of widget/glyph instantiation code."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
135 (let* ((type (aref instantiator 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
136 (plist (cdr (map 'list 'identity instantiator)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
137 (widget (funcall (or (get type 'instantiator) 'ignore)
738
5039859429c5 [xemacs-hg @ 2002-02-02 13:39:59 by wmperry]
wmperry
parents: 523
diff changeset
138 plist instance)))
2168
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 738
diff changeset
139 ; (add-timeout 0.1 (lambda (obj)
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 738
diff changeset
140 ; (gtk-widget-set-style obj
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 738
diff changeset
141 ; (gtk-widget-get-style
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 738
diff changeset
142 ; (frame-property nil 'text-widget))))
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 738
diff changeset
143 ; widget)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
144 widget))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
145
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
146 (defun gtk-widget-property-internal ()
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
147 nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
148
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
149 (defun gtk-widget-redisplay-internal ()
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
150 nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
151
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
152 (provide 'widgets-gtk)