Mercurial > hg > xemacs-beta

view tests/gtk/gnome-test.el @ 613:023b83f4e54b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2001-06-10 10:42:16 by ben] ------ signal-code changes ------ data.c, device-tty.c, emacs.c, floatfns.c, linuxplay.c, nas.c, process-unix.c, signal.c, sunplay.c, sysdep.c, syssignal.h: use EMACS_SIGNAL everywhere instead of playing preprocessing games with signal(). s\windowsnt.h, s\mingw32.h, syssignal.h: Remove mswindows signal code from s+m headers and move to syssignal.h as one of the five ways of signal handling, instead of playing preprocessing games. fileio.c, sysdep.c: Rename sys_do_signal to qxe_reliable_signal. signal.c, process-unix.c, profile.c: Create set_timeout_signal(); use instead of just EMACS_SIGNAL to establish a signal handler on a timeout signal; this does special things under Cygwin. nt.c: Eliminate term_ntproc(), which is blank; used as a SIGABRT handler, which was wrong anyway. nt.c, win32.c: Move signal code from nt.c to win32.c, since Cygwin needs it too when dealing with timeout signals. s\cygwin32.h: Define CYGWIN_BROKEN_SIGNALS. ------ other changes ------ s\mingw32.h: Fix problems with NOT_C_CODE being in the wrong place and excluding defines needed when building Makefile.in.in. filelock.c, mule-canna.c, mule-ccl.c, mule-ccl.h, ralloc.c, unexalpha.c, unexapollo.c, unexcw.c, unexelfsgi.c, unexnt.c, unexsni.c, s\aix3-1.h, s\bsd4-1.h, s\bsd4-2.h, s\bsd4-3.h, s\cxux.h, s\cygwin32.h, s\dgux.h, s\dgux5-4r2.h, s\dgux5-4r3.h, s\dgux5-4r4.h, s\ewsux5r4.h, s\gnu.h, s\hpux.h, s\iris3-5.h, s\iris3-6.h, s\irix3-3.h, s\linux.h, s\mingw32.h, s\newsos5.h, s\nextstep.h, s\ptx.h, s\riscix1-1.h, s\riscix1-2.h, s\rtu.h, s\sco4.h, s\sco5.h, s\template.h, s\ultrix.h, s\umax.h, s\umips.h, s\unipl5-0.h, s\unipl5-2.h, s\usg5-0.h, s\usg5-2-2.h, s\usg5-2.h, s\usg5-3.h, s\usg5-4.h, s\windowsnt.h, s\xenix.h: Rename 'GNU Emacs' to XEmacs in the copyright and comments. nas.c: Stylistic cleanup. Avoid preprocessing games with names such as play_sound_file. ------ signal-code changes ------ data.c, device-tty.c, emacs.c, floatfns.c, linuxplay.c, nas.c, process-unix.c, signal.c, sunplay.c, sysdep.c, syssignal.h: use EMACS_SIGNAL everywhere instead of playing preprocessing games with signal(). s\windowsnt.h, s\mingw32.h, syssignal.h: Remove mswindows signal code from s+m headers and move to syssignal.h as one of the five ways of signal handling, instead of playing preprocessing games. fileio.c, sysdep.c: Rename sys_do_signal to qxe_reliable_signal. signal.c, process-unix.c, profile.c: Create set_timeout_signal(); use instead of just EMACS_SIGNAL to establish a signal handler on a timeout signal; this does special things under Cygwin. nt.c: Eliminate term_ntproc(), which is blank; used as a SIGABRT handler, which was wrong anyway. nt.c, win32.c: Move signal code from nt.c to win32.c, since Cygwin needs it too when dealing with timeout signals. s\cygwin32.h: Define CYGWIN_BROKEN_SIGNALS. ------ other changes ------ s\mingw32.h: Fix problems with NOT_C_CODE being in the wrong place and excluding defines needed when building Makefile.in.in. filelock.c, mule-canna.c, mule-ccl.c, mule-ccl.h, ralloc.c, unexalpha.c, unexapollo.c, unexcw.c, unexelfsgi.c, unexnt.c, unexsni.c, s\aix3-1.h, s\bsd4-1.h, s\bsd4-2.h, s\bsd4-3.h, s\cxux.h, s\cygwin32.h, s\dgux.h, s\dgux5-4r2.h, s\dgux5-4r3.h, s\dgux5-4r4.h, s\ewsux5r4.h, s\gnu.h, s\hpux.h, s\iris3-5.h, s\iris3-6.h, s\irix3-3.h, s\linux.h, s\mingw32.h, s\newsos5.h, s\nextstep.h, s\ptx.h, s\riscix1-1.h, s\riscix1-2.h, s\rtu.h, s\sco4.h, s\sco5.h, s\template.h, s\ultrix.h, s\umax.h, s\umips.h, s\unipl5-0.h, s\unipl5-2.h, s\usg5-0.h, s\usg5-2-2.h, s\usg5-2.h, s\usg5-3.h, s\usg5-4.h, s\windowsnt.h, s\xenix.h: Rename 'GNU Emacs' to XEmacs in the copyright and comments. nas.c: Stylistic cleanup. Avoid preprocessing games with names such as play_sound_file. xemacs-faq.texi: Update sections on Windows and MacOS availability. alist.el, apropos.el, autoload.el, bytecomp.el, cl-compat.el, cl-extra.el, cl-macs.el, cl-seq.el, cl.el, cmdloop.el, cus-edit.el, derived.el, gpm.el, itimer.el, lisp-mode.el, shadow.el, version.el, wid-browse.el: Rename 'GNU Emacs' to XEmacs in the copyright. Fix other references to GNU Emacs that should be XEmacs or just Emacs. files.el: Fix warning. simple.el: transpose-line-up/down will now move the region up or down by a line if active. cvtmail.c, fakemail.c, gnuserv.c, gnuserv.h, gnuslib.c, make-msgfile.c, make-path.c, pop.c, pop.h, profile.c, tcp.c: Rename 'GNU Emacs' to XEmacs in the copyright. Fix comments in similar ways. digest-doc.c, sorted-doc.c: Fix program and author name to reflect XEmacs.
author ben
date Sun, 10 Jun 2001 10:42:39 +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)))