Mercurial > hg > xemacs-beta
view tests/gtk/gnome-test.el @ 1330:4542b72c005e
[xemacs-hg @ 2003-03-01 07:25:26 by ben]
build patch
Makefile.in.in: Move src deletions to src/Makefile.in.in.
dump-paths.el, dumped-lisp.el: Delete. Combine stuff into setup-paths.el.
find-paths.el: Removed.
Make this file contain generic routines only. Move stuff to
compute Emacs roots to setup-paths.el.
startup.el: Removed.
Move these variables into setup-paths.el.
setup-paths.el, startup.el: Removed.
Combine all high-level code for computing the paths into
setup-paths.el. Create new function startup-find-load-path to
encapsulate all logic for computing `load-path'. Eliminate
invocation-directory and invocation-name parameters since
there is no point (false generality) -- the code references
other globals, which cannot be specified. Eliminate some code
duplicated between setup-paths.el and startup.el. Clean up
the debug-paths code and output load-path in addition.
Add logic to paths-emacs-root-p to support separated source
and build trees.
loadup.el, make-docfile.el, update-elc-2.el, update-elc.el: Rewrite to allow for separated source and build trees, as may occur
in MS Windows.
NOTE TO BUILD HACKERS:
loadup.el, make-docfile.el, update-elc.el and update-elc-2.el made two
assumptions that are no longer correct:
(1) The source and build trees are in the same place.
(2) They can make assumptions about where `.' is.
These files now compute the locations of the source and build
roots at the top of the file. *ALL* constant file names or path
snippets must now be made absolute using expand-file-name and one
of these roots.
dumped-lisp.el, packages.el: Removed.
Remove some unused lists of Lisp files. packages-hardcoded-lisp
(empty, in any case) moved to dumped-lisp.el.
startup.el: When a compiled init file is out-of-date wrt the uncompiled
version, load the uncompiled version and issue a nasty warning.
update-elc-2.el: Force touching of auto-autoloads files when REBUILD_AUTOLOADS
was set.
update-elc.el: Fix code that checks whether dumping is necessary to check against
xemacs.dmp, not xemacs.exe, when Unix and pdump.
lwlib-Xm.c: Fix compile warning.
README, config.inc.samp, xemacs.mak: -- Major reorganization and cleanup.
-- Add support for separated build tree and source tree.
-- Delete all support for X Windows building, since it's
totally bit-rotten and will never be fixed up. Instruct
people to use Cygwin if they want such support.
make-build-dir: New script to create a skeleton build tree for use with
separated build and source tree compilation.
m/acorn.h, m/alliant-2800.h, m/alliant.h, m/altos.h, m/amdahl.h, m/arm.h, m/att3b.h, m/aviion.h, m/clipper.h, m/cnvrgnt.h, m/convex.h, m/cydra5.h, m/delta.h, m/delta88k.h, m/dpx2.h, m/elxsi.h, m/ews4800r.h, m/gould.h, m/hp800.h, m/hp9000s300.h, m/i860.h, m/ibmps2-aix.h, m/ibmrs6000.h, m/ibmrt-aix.h, m/ibmrt.h, m/intel386.h, m/iris4d.h, m/iris5d.h, m/iris6d.h, m/irist.h, m/m68k.h, m/masscomp.h, m/mg1.h, m/mips-nec.h, m/mips-siemens.h, m/mips.h, m/nh3000.h, m/nh4000.h, m/ns32000.h, m/plexus.h, m/powerpc.h, m/sequent-ptx.h, m/sequent.h, m/sgi-challenge.h, m/stride.h, m/tad68k.h, m/targon31.h, m/tekxd88.h, m/template.h, m/tower32.h, m/tower32v3.h, m/ustation.h, m/wicat.h, m/xps100.h, data.c, doc.c, editfns.c, emacs.c, lrecord.h, ntheap.c, process-unix.c, sysdep.c, unexec.c: Delete all support for bit-rotten CANNOT_DUMP. Just use pdump.
Makefile.in.in: Lots o' cleanup. Use names like LISP, SRC instead of
lispdir, srcdir, for consistency with xemacs.mak and the
conventions in the rest of the file. Eliminate use of ${...}
in favor of $(...), to make it easier to move code between
this file and xemacs.mak. Fix dependency handling wrt
NEEDTODUMP to eliminate problems some people (e.g. Vin) have
been seeing with non-GNU makes. Write a long section about
the subtle but oh-so-important differences in dependency
processing between nmake, make, and GNU make. Add
unicode-encapsulate target, from xemacs.mak.
chartab.c, lrecord.h: Fix crash due to attempt to free objects across dump/undump.
| author | ben |
|---|---|
| date | Sat, 01 Mar 2003 07:25:56 +0000 |
| parents | 0784d089fdc9 |
| children | db7068430402 |
line wrap: on
line source
(require 'gnome) (gtk-define-test "GNOME Stock Pixmaps" gnome gnome-pixmaps nil (let ((hbox nil) (vbox nil) (widget nil) (label nil) (i 0)) (mapc (lambda (b) (if (= (% i 5) 0) (progn (setq hbox (gtk-hbutton-box-new)) (gtk-box-set-spacing hbox 5) (gtk-container-add window hbox))) (setq widget (gnome-stock-pixmap-widget-new window (car b)) vbox (gtk-vbox-new t 0) label (gtk-label-new (cdr b))) (gtk-container-add hbox vbox) (gtk-container-add vbox widget) (gtk-container-add vbox label) (gtk-widget-show-all vbox) (setq i (1+ i))) gnome-stock-pixmaps))) (gtk-define-test "GNOME Stock Buttons" gnome gnome-buttons nil (let ((hbbox nil) (button nil) (i 0)) (mapc (lambda (b) (setq button (gnome-stock-button (car b))) (gtk-signal-connect button 'clicked (lambda (obj data) (message "Stock GNOME Button: %s" data)) (cdr b)) (if (= (% i 3) 0) (progn (setq hbbox (gtk-hbutton-box-new)) (gtk-button-box-set-spacing hbbox 5) (gtk-container-add window hbbox))) (gtk-container-add hbbox button) (gtk-widget-show button) (setq i (1+ i))) gnome-stock-buttons))) (gtk-define-test "GNOME About" gnome gnome-about t (setq window (gnome-about-new "XEmacs/GTK Test Application" "1.0a" "Copyright (C) 2000 Free Software Foundation" '("William M. Perry <wmperry@gnu.org>" "Ichabod Crane") "This is a comment string... what wonderful commentary you have my dear!" ""))) (gtk-define-test "GNOME File Entry" gnome gnome-file-entry nil (let ((button (gnome-file-entry-new nil "Test browse dialog..."))) (gtk-container-add window button))) (gtk-define-test "GNOME Color Picker" gnome gnome-color-picker nil (let ((picker (gnome-color-picker-new)) (hbox (gtk-hbox-new nil 0)) (label (gtk-label-new "Please choose a color: "))) (gtk-box-pack-start hbox label nil nil 2) (gtk-box-pack-start hbox picker t t 2) (gtk-container-add window hbox) (gtk-widget-show-all hbox))) (gtk-define-test "GNOME Desktop Entry Editor" gnome gnome-dentry-edit nil (let* ((notebook (gtk-notebook-new))) (gnome-dentry-edit-new-notebook notebook) (gtk-container-add window notebook))) (gtk-define-test "GNOME Date Edit" gnome gnome-date-entry nil (let ((date (gnome-date-edit-new 0 t t)) button) (gtk-box-pack-start window date t t 0) (setq button (gtk-check-button-new-with-label "Show time")) (gtk-signal-connect button 'clicked (lambda (button date) (let ((flags (gnome-date-edit-get-flags date))) (if (gtk-toggle-button-get-active button) (push 'show-time flags) (setq flags (delq 'show-time flags))) (gnome-date-edit-set-flags date flags))) date) (gtk-toggle-button-set-active button t) (gtk-box-pack-start window button nil nil 0) (setq button (gtk-check-button-new-with-label "24 Hour format")) (gtk-signal-connect button 'clicked (lambda (button date) (let ((flags (gnome-date-edit-get-flags date))) (if (gtk-toggle-button-get-active button) (push '24-hr flags) (setq flags (delq '24-hr flags))) (gnome-date-edit-set-flags date flags))) date) (gtk-toggle-button-set-active button t) (gtk-box-pack-start window button nil nil 0) (setq button (gtk-check-button-new-with-label "Week starts on monday")) (gtk-signal-connect button 'clicked (lambda (button date) (let ((flags (gnome-date-edit-get-flags date))) (if (gtk-toggle-button-get-active button) (push 'week-starts-on-monday flags) (setq flags (delq 'week-starts-on-monday flags))) (gnome-date-edit-set-flags date flags))) date) (gtk-toggle-button-set-active button t) (gtk-box-pack-start window button nil nil 0))) (gtk-define-test "GNOME Font Picker" gnome gnome-font-picker nil (let ((hbox (gtk-hbox-new nil 5)) (fp (gnome-font-picker-new)) (label (gtk-label-new "Choose a font: ")) (button nil)) (gtk-box-pack-start hbox label t t 0) (gtk-box-pack-start hbox fp nil nil 2) (gnome-font-picker-set-title fp "Select a font...") (gnome-font-picker-set-mode fp 'font-info) (gtk-box-pack-start window hbox t t 0) (setq button (gtk-check-button-new-with-label "Use font in label")) (gtk-signal-connect button 'clicked (lambda (button fp) (gnome-font-picker-fi-set-use-font-in-label fp (gtk-toggle-button-get-active button) 14)) fp) (gtk-box-pack-start window button nil nil 0) (setq button (gtk-check-button-new-with-label "Show size")) (gtk-signal-connect button 'clicked (lambda (button fp) (gnome-font-picker-fi-set-show-size fp (gtk-toggle-button-get-active button))) fp) (gtk-box-pack-start window button nil nil 0))) (gtk-define-test "GNOME Application" gnome gnome-app t (setq window (gnome-app-new "XEmacs" "XEmacs/GNOME")) (let ((menubar (gtk-menu-bar-new)) (contents nil) ;(toolbar-instance (specifier-instance top-toolbar)) (toolbar nil) (item nil) (flushright nil)) (mapc (lambda (node) (if (not node) (setq flushright t) (setq item (gtk-build-xemacs-menu node)) (gtk-widget-show item) (if flushright (gtk-menu-item-right-justify item)) (gtk-menu-append menubar item))) current-menubar) (setq toolbar (gtk-toolbar-new 'horizontal 'both)) (mapc (lambda (x) (let ((button (gtk-button-new)) (pixmap (gnome-stock-pixmap-widget-new toolbar x))) (gtk-container-add button pixmap) (gtk-toolbar-append-widget toolbar button (symbol-name x) nil))) '(open save print cut copy paste undo spellcheck srchrpl mail help)) (setq contents (gtk-hbox-new nil 5)) (let ((hbox contents) (vbox (gtk-vbox-new nil 5)) (frame nil) (label nil)) (gtk-box-pack-start hbox vbox nil nil 0) (setq frame (gtk-frame-new "Normal Label") label (gtk-label-new "This is a Normal label")) (gtk-container-add frame label) (gtk-box-pack-start vbox frame nil nil 0) (setq frame (gtk-frame-new "Multi-line Label") label (gtk-label-new "This is a multi-line label.\nSecond line\nThird line")) (gtk-container-add frame label) (gtk-box-pack-start vbox frame nil nil 0) (setq frame (gtk-frame-new "Left Justified Label") label (gtk-label-new "This is a Left-Justified\nMulti-line label.\nThird line")) (gtk-label-set-justify label 'left) (gtk-container-add frame label) (gtk-box-pack-start vbox frame nil nil 0) (setq frame (gtk-frame-new "Right Justified Label") label (gtk-label-new "This is a Right-Justified\nMulti-line label.\nFourth line, (j/k)")) (gtk-label-set-justify label 'right) (gtk-container-add frame label) (gtk-box-pack-start vbox frame nil nil 0) ;; Start a second row so that we don't make a ridiculously tall window (setq vbox (gtk-vbox-new nil 5)) (gtk-box-pack-start hbox vbox nil nil 0) (setq frame (gtk-frame-new "Line wrapped label") label (gtk-label-new (concat "This is an example of a line-wrapped label. It should not be taking " "up the entire " ;;; big space to test spacing "width allocated to it, but automatically wraps the words to fit. " "The time has come, for all good men, to come to the aid of their party. " "The sixth sheik's six sheep's sick.\n" " It supports multiple paragraphs correctly, and correctly adds " "many extra spaces. "))) (gtk-label-set-line-wrap label t) (gtk-container-add frame label) (gtk-box-pack-start vbox frame nil nil 0) (setq frame (gtk-frame-new "Filled, wrapped label") label (gtk-label-new (concat "This is an example of a line-wrapped, filled label. It should be taking " "up the entire width allocated to it. Here is a seneance to prove " "my point. Here is another sentence. " "Here comes the sun, do de do de do.\n" " This is a new paragraph.\n" " This is another newer, longer, better paragraph. It is coming to an end, " "unfortunately."))) (gtk-label-set-justify label 'fill) (gtk-label-set-line-wrap label t) (gtk-container-add frame label) (gtk-box-pack-start vbox frame nil nil 0) (setq frame (gtk-frame-new "Underlined label") label (gtk-label-new (concat "This label is underlined!\n" "This one is underlined in 日本語の入用quite a funky fashion"))) (gtk-label-set-justify label 'left) (gtk-label-set-pattern label "_________________________ _ _________ _ _____ _ __ __ ___ ____ _____") (gtk-container-add frame label) (gtk-box-pack-start vbox frame nil nil 0)) (gtk-widget-show-all toolbar) (gtk-widget-show-all menubar) (gtk-widget-show-all contents) (gnome-app-set-menus window menubar) (gnome-app-set-toolbar window toolbar) (gnome-app-set-contents window contents)))