sda@edc.UUCP (Stephen Ayers) (03/09/90)
This may not be the correct group....
I am just starting to look into using Motif. I have a copy of the
Motif window manager (mwm), libraries and .h files from IXI. Unfortunatly
they did not include any sample programs.
Does anyone know of some small sample programs publicly available in source
form?
I only have e-mail/UUCP access.
Thanks in advance
--
Stephen Ayers, Atex EDC, A Kodak Company
{sun,uunet,kodak}!atexnet!sda | ..uknet!hwcs!edc!sda
+44 506 41 6778mayer@hplabsz.HPL.HP.COM (Niels Mayer) (03/11/90)
In article <1073@mango.edc.UUCP> sda@edc.UUCP (Stephen D Ayers) writes: >I am just starting to look into using Motif. I have a copy of the >Motif window manager (mwm), libraries and .h files from IXI. Unfortunatly >they did not include any sample programs. > >Does anyone know of some small sample programs publicly available in source >form? (1) For examples in C syntax, Doug Young has made the examples from his Motif/Xt book (from prentice hall) available via anonymous ftp from expo.lcs.mit.edu in directory contrib: -rw-rw-rw- 1 ftp 157103 Feb 3 19:28 young.motif.tar.Z (2) Below, you'll find a couple of simple Motif example programs using WINTERP, which is an interpretive, interactive envrionment for prototyping Motif applications. It uses XLISP as the embedded interpreter. WINTERP is available on the X11r4 tape and also via anon ftp from expo.lcs.mit.edu in directory contrib/winterp you'll find: -rw-rw-rw- 1 ftp 59023 Mar 7 00:12 winterp-slides.PS -rw-rw-rw- 1 ftp 6252 Dec 19 08:57 winterp.README drwxrwxrwx 2 ftp 512 Jan 29 13:13 winterp.binary -rw-rw-rw- 1 ftp 605837 Dec 19 08:57 winterp.tar.Z If you have the motif documentation, you'll note that all the motif calls used in the program below have the same names as the C version, except that 1) the name FooBar in C becomes FOO_BAR in WINTERP 2) WINTERP uses XLISP's object oriented programming syntax, which is a much cleaner way of interfacing to the Motif widgets... e.g (send <widget_instance> :realize) is equivalent to XtRealizeWidget(). ============================================================================== ; -*-Lisp-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; File: bitmap-br.lsp ; RCS: $Header: bitmap-br.lsp,v 1.1 89/11/25 04:00:07 mayer Exp $ ; Description: Given a directory of X11 bitmaps at location ; <bitmap_directory_path>, the function ; (BROWSE-BITMAP-DIRECTORY <bitmap_directory_path>) ; will put up a browser that will allow you to change your root ; pixmap pattern by clicking on a bitmap image in the browser. ; Author: Niels Mayer, HPLabs ; Created: Sat Nov 25 00:53:06 1989 ; Modified: Sat Nov 25 01:00:31 1989 (Niels Mayer) mayer@hplnpm ; Language: Lisp ; Package: N/A ; Status: X11r4 contrib tape release ; ; (c) Copyright 1989, Hewlett-Packard Company. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun browse-bitmap-directory (dir) (let* ( (top_w (send TOP_LEVEL_SHELL_WIDGET_CLASS :new :XMN_GEOMETRY "=360x720+0+0" :XMN_TITLE (strcat "Bitmap browser: " dir) :XMN_ICON_NAME (strcat "Bitmaps[" dir "]"))) (sc_w (send XM_SCROLLED_WINDOW_WIDGET_CLASS :new :managed "sc" top_w :XMN_SCROLLING_POLICY :AUTOMATIC)) (rc_w (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed "rc" sc_w :XMN_ORIENTATION :vertical :XMN_PACKING :pack_tight :XMN_ENTRY_ALIGNMENT :alignment_center :XMN_FOREGROUND "Black" :XMN_BACKGROUND "LightGray")) ) (do* ((fp (popen (strcat "/bin/ls " dir) :direction :input)) (name (read-line fp) (read-line fp)) bitmap-file ) ((null name) (pclose fp) (send top_w :realize) ) (setq bitmap-file (strcat dir "/" name)) (format T "name=~A\n" name) (send XM_LABEL_GADGET_CLASS :new :managed "filename" rc_w :XMN_LABEL_TYPE :STRING :XMN_LABEL_STRING name) (send (send XM_PUSH_BUTTON_GADGET_CLASS :new :managed "image" rc_w :XMN_LABEL_TYPE :PIXMAP :XMN_LABEL_PIXMAP bitmap-file) :add_callback :XMN_ARM_CALLBACK '() `((xsetroot ,bitmap-file)) ) (send XM_SEPARATOR_GADGET_CLASS :new :managed "sep" rc_w :XMN_SEPARATOR_TYPE :DOUBLE_LINE) ) ) ) (defun xsetroot (filename) (system (format nil "xsetroot -bitmap ~A -fg Black -bg DimGrey" filename))) ============================================================================== ; -*-Lisp-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; File: mail-browser.lsp ; RCS: $Header: mail-br.lsp,v 1.1 89/11/25 04:00:24 mayer Exp $ ; Description: A simple MH mail browser written mostly to show the power of ; subclassing the Motif list widget in WINTERP. Load this file ; to get a browser of the last 30 MH messages in your inbox. ; This assumes that (1) you have MH, (2) you have folder +inbox, ; (3) "scan" is on your $PATH. (4) various other things I forgot. ; Author: Niels Mayer, HPLabs ; Created: Mon Nov 20 18:13:23 1989 ; Modified: Sat Nov 25 01:11:51 1989 (Niels Mayer) mayer@hplnpm ; Language: Lisp ; Package: N/A ; Status: X11r4 contrib tape release ; ; (c) Copyright 1989, Hewlett-Packard Company. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Make a subclass of XM_LIST_WIDGET_CLASS which holds an additional ;; instance variable 'items'. 'items' is an array of arbitrary objects ;; (BROWSER_OBJECT) to be displayed in a browser made from the list widget. ;; ;; BROWSER-OBJECT can be any arbitrary xlisp object that respond to ;; the messages :display_string and :default_action: ;; ;; Message :display_string must return a string which is used as the ;; textual representation of the object in the browser display. ;; ;; Message :default_action is sent to the object whenever the ;; list widget's default action, a double-click, is performed on the item ;; corresponding to the object. ;; (setq List_Browser (send Class :new '(items) ;new instance vars '() ;no class vars XM_LIST_WIDGET_CLASS)) ;superclass ;; ;; We override the XM_LIST_WIDGET_CLASS's object initializer ;; so that we can process the items list and hand off the ;; browser items to the list widget. ;; ;; (send List_Browser :new <items_list> <args-for-the-list-widget>) ;; <items_list> is a list of BROWSER_OBJECTs as described above. ;; <args-for-the-list-widget> -- these are the arguments that ;; will be passed on to the list widget ;; (send List_Browser :answer :isnew '(items_list &rest args) '( (let* ( (items_end_idx (length items_list)) (display_items (make-array items_end_idx))) ;; initialize the 'items' instance variable so that it ;; holds all the BROWSER_OBJECTs passed in <items_list> (setq items (make-array items_end_idx)) ;create the array (do ( ;copy elts from list to array (i 0 (1+ i)) (elts items_list (cdr elts))) ;; loop till no more elts ((null elts)) ;; loop body (setf (aref items i) (car elts)) (setf (aref display_items i) (send (car elts) :display_string)) ) ;; initialize the widget, passing in the browser items. (apply 'send-super `(:isnew ,@args :xmn_selection_policy :browse_select :xmn_items ,display_items :xmn_item_count ,items_end_idx )) ) ;; set up a callback on the list widget initialized above such that ;; a double click on the browser-item will send the message ;; :default_action to the BROWSER_OBJECT. (send-super :set_callback :xmn_default_action_callback '(callback_item_position) '((send (aref items (1- callback_item_position)) :default_action)) ) ) ) ;; ;; override methods on XM_LIST_WIDGET_CLASS so that they work properly ;; with the list browser. Note that all other list methods work fine ;; on the list browser ;; (send List_Browser :answer :ADD_ITEM '(item position) '( (setq items (array-insert-pos items (1- position) item)) (send-super :add_item (send item :display_string) position) ) ) (send List_Browser :answer :ADD_ITEM_UNSELECTED '(item position) '( (setq items (array-insert-pos items (1- position) item)) (send-super :add_item_unselected (send item :display_string) position) ) ) (send List_Browser :answer :DELETE_ITEM '(item) '( ;; this is too lame to implement... requires that we compare ;; item with the result of :display_string done on every element ;; of ivar 'items' (error "Message :DELETE_ITEM not supported in List_Browser") ) ) (send List_Browser :answer :DELETE_POS '(position) '( (setq items (array-delete-pos items (1- position))) (send-super :delete_pos position) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Define a BROWSER_OBJECT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Each BROWSER_OBJECT holds the information summarizing one mail message. ;; the information is split up into individual fields because we may want ;; to be able to sort on one field, or search for mathes on one field. ;; (setq Mail_Message_Class (send Class :new '(folder num anno month date no-date size sender subject) )) ;; this string is passed to the mh 'scan' and 'inc' commands to determine ;; the formatting of the output of the message info summary. Each entry ;; here corresponds to an instance variable in Mail_Message_Class (setq FOLDER_SCAN_FORMAT (strcat "%(msg)" ;output the message number "%<{replied}A%|" ;IF msg answered output "A" ELSE "%<{forwarded}F%|" ;IF msg forwarded output "F" ELSE "%<{resent}R%|" ;IF msg redisted output "R" ELSE "%<{printed}P%|" ;IF msg printed output "P" " %>%>%>%>" ;ELSE output " " "%02(mon{date})/%02(mday{date})" ;output mon/date "%<{date} %|*%>" ;IF no date output "*" else " " "%(size) " ;output the message's size "%<(mymbox{from})To:%14(friendly{to})%|" ;IF my message, output "To: <recipient>" "%17(friendly{from})%> " ;ELSE output sender field "%{subject}<<" ;output subject followed by ">>" "%{body}" ;output beginning of body, limited by SCAN_OUTPUT_WIDTH ) ) ;; this method will read a single line summary of a mail message as produced ;; by the mh 'scan' or 'inc' commands and sets the instance variables in the ;; BROWSER_OBJECT to the individual fields of the message summary. (send Mail_Message_Class :answer :read-msg-info '(pipe fldr) '( (if (and (setq folder fldr) (setq num (fscanf-fixnum pipe "%ld")) (setq anno (fscanf-string pipe "%c")) (setq month (fscanf-fixnum pipe "%2ld")) (setq date (fscanf-fixnum pipe "/%2ld")) (setq no-date (fscanf-string pipe "%c")) (setq size (fscanf-fixnum pipe "%d%*c")) (setq sender (fscanf-string pipe "%17[\001-\177]%*c")) (setq subject (fscanf-string pipe "%[^\n]\n")) ) self ;return self if succesful NIL ;return NIL if hit EOF ) ) ) (send Mail_Message_Class :answer :display_string '() '( (format nil "~A ~A ~A/~A~A ~A ~A ~A" num anno month date no-date size sender subject) )) (send Mail_Message_Class :answer :default_action '() '((find-file (format nil "~A/~A/~A" MAILPATH folder num)))) ;; ;; i'm too lazy to add a getenv() interface to WINTERP... this'll do for now. ;; (setq MAILPATH (let* ((pipe (popen "/bin/echo $HOME" "r")) (home (read-line pipe)) ) (pclose pipe) (strcat home "/Mail")) ;this is the default directory ;for MH... this assumes you haven't ;put the MH directory elsewhere ;via a ~/.mh_profile entry. ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; This returns a list of Mail_Message_Class instances corresponding ;; to the mail messages scanned from <foldername> over range <msgs>. ;; (defun mh-scan (foldername msgs) (do* ((fp (popen (strcat "scan " "+" foldername " " msgs " -noclear -noheader -reverse -width 80" " -format '" FOLDER_SCAN_FORMAT "'") :direction :input)) (msg (send (send Mail_Message_Class :new) :read-msg-info fp foldername) (send (send Mail_Message_Class :new) :read-msg-info fp foldername)) (result NIL) ) ((null msg) ;:read-msg-info returns NIL on EOF (pclose fp) (cdr result) ;last msg was EOF, remove it ) (setq result (cons msg result)) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq top_w (send TOP_LEVEL_SHELL_WIDGET_CLASS :new ; :XMN_GEOMETRY "500x700+1+1" :XMN_TITLE "Mail Browser" :XMN_ICON_NAME "Mail Browser" )) (setq paned_w (send XM_PANED_WINDOW_WIDGET_CLASS :new :managed top_w )) (setq objs-list (mh-scan "inbox" "last:30")) (setq list_w (send List_Browser :new objs-list :managed :scrolled "browser" paned_w :xmn_visible_item_count 20 )) (setq label_w (send XM_LABEL_WIDGET_CLASS :new :managed "label" paned_w :xmn_label_string "None" )) ;; ;; set contraint resources on label widget so that paned window ;; doesn't give it resize sashes. ;; (let (height) (send label_w :get_values :xmn_height 'height) (send label_w :set_values :xmn_maximum height :xmn_minimum height ) ) (setq textedit_w (send XM_TEXT_WIDGET_CLASS :new :managed :scrolled "view" paned_w :XMN_EDIT_MODE :MULTI_LINE_EDIT :XMN_HEIGHT 400 :XMN_EDITABLE nil ;don't allow user to change text. )) (send top_w :realize) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun find-file (file) (let* (;; loc vars (fp (open file :direction :input) ) inspos text_line ) (if (null fp) (error "Can't open file." file)) (send label_w :set_values :xmn_label_string file) (send textedit_w :set_string "") ;clear out old text (send paned_w :update_display) ;incase reading file takes long time (send textedit_w :disable_redisplay NIL) ;don't show changes till done (send textedit_w :replace 0 0 (read-line fp)) (loop (if (null (setq text_line (read-line fp))) (return)) (setq inspos (send textedit_w :get_insertion_position)) (send textedit_w :replace inspos inspos (strcat "\n" text_line)) ) (send textedit_w :enable_redisplay) ;now show changes... (close fp) ) ) ============================================================================== ; -*-Lisp-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; File: radiobox2.lsp ; RCS: $Header: radiobox2.lsp,v 1.1 89/11/25 04:00:36 mayer Exp $ ; Description: A better (?) way of creating a radio box, using subclassing of ; togglebutton. Note that this version doesn't waste as much ; memory as radiobox1.lsp because it defines a single ; entry-callback on the rowcolumn widget instead of forcing each ; toggle-button to have separate copies of very similar ; callback-closures. Just load this file to see the example. ; Author: Niels Mayer, HPLabs ; Created: Sat Nov 25 01:24:00 1989 ; Modified: Sat Nov 25 01:26:42 1989 (Niels Mayer) mayer@hplnpm ; Language: Lisp ; Package: N/A ; Status: X11r4 contrib tape release ; ; (c) Copyright 1989, Hewlett-Packard Company. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq toplevel_w (send TOP_LEVEL_SHELL_WIDGET_CLASS :new :XMN_GEOMETRY "500x500+1+1" :XMN_TITLE "Radio-Box-Test #2" :XMN_ICON_NAME "Radio-Box-Test #2" )) (setq rowcol_w (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed :radio_box "rc" toplevel_w )) (send toplevel_w :realize) (send rowcol_w :set_callback :xmn_entry_callback '(CALLBACK_ENTRY_WIDGET CALLBACK_ENTRY_SET) '( (if CALLBACK_ENTRY_SET (send CALLBACK_ENTRY_WIDGET :print-which-button) ) )) ;; make a subclass of XM_TOGGLE_BUTTON_GADGET_CLASS (setq My_Toggle_Button (send Class :new '(button_name) ;a new ivar for this subclass '() ;no class variables for subclass XM_TOGGLE_BUTTON_GADGET_CLASS)) ;; override XM_TOGGLE_BUTTON_GADGET_CLASS's instance initializer (send My_Toggle_Button :answer :isnew '(name &rest args) '( (setq button_name name) (apply 'send-super `(:isnew ,@args :xmn_label_string ,name)) )) ;; add a method that prints which button (send My_Toggle_Button :answer :print-which-button '() '( (format T "option ~A selected\n" button_name) )) ;;; a loop to put up 20 toggle buttons "Button 0" ... "Button 19". (do* (;; local vars (i 0 (1+ i)) ) (;; test and return (eql i 20) ) ;; body (send My_Toggle_Button :new (format nil "Button ~A" i) :managed rowcol_w) ) ------------------------------------------------------------------------------- Niels Mayer -- hplabs!mayer -- mayer@hplabs.hp.com Human-Computer Interaction Department Hewlett-Packard Laboratories Palo Alto, CA. *