home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / Programming / Source / winterp-1.13 / examples / w_ctrlpnl.lsp < prev   
Encoding:
Text File  |  1991-10-06  |  19.1 KB  |  561 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         w_ctrlpnl.lsp
  5. ; RCS:          $Header: w_ctrlpnl.lsp,v 1.10 91/10/05 20:46:03 mayer Exp $
  6. ; Description:  A control panel for WINTERP, including a rudimentary way to edit
  7. ;               and send lisp to winterp's xlisp evaluator without having to use
  8. ;               the gnuemacs interface (src-client/winterp.el) or src-client/wl.c.
  9. ; Author:       Niels Mayer, HPLabs
  10. ; Created:      Thu Jun 14 17:26:59 1990
  11. ; Modified:     Sat Oct  5 20:36:51 1991 (Niels Mayer) mayer@hplnpm
  12. ; Language:     Lisp
  13. ; Package:      N/A
  14. ; Status:       X11r5 contrib tape release
  15. ;
  16. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  17. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  18. ;
  19. ; Permission to use, copy, modify, distribute, and sell this software and its
  20. ; documentation for any purpose is hereby granted without fee, provided that
  21. ; the above copyright notice appear in all copies and that both that
  22. ; copyright notice and this permission notice appear in supporting
  23. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  24. ; used in advertising or publicity pertaining to distribution of the software
  25. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  26. ; makes no representations about the suitability of this software for any
  27. ; purpose.  It is provided "as is" without express or implied warranty.
  28. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29.  
  30. ;;; Example resource settings to put in ~/.Xdefaults or xrdb(1):
  31. ;;; WinterpCtrlPnl.title: Winterp Control Panel
  32. ;;; WinterpCtrlPnl.iconName: WinCtrlPnl
  33. ;;; WinterpCtrlPnl.geometry: -1+1
  34. ;;; WinterpCtrlPnl*edit*rows: 5
  35. ;;; WinterpCtrlPnl*edit*columns: 80
  36. ;;; WinterpCtrlPnl*files*listVisibleItemCount: 5
  37. ;;; WinterpCtrlPnl*files.foreground: white
  38. ;;; WinterpCtrlPnl*files.background:  dimgrey
  39. ;;; WinterpCtrlPnl*controlpanel.foreground: black
  40. ;;; WinterpCtrlPnl*controlpanel.background: lightgrey
  41. ;;; ! WinterpCtrlPnl*XmText*fontList: 6x10
  42. ;;; ! WinterpCtrlPnl*XmList*fontList: 6x10
  43. ;;; ! WinterpCtrlPnl*XmToggleButtonGadget*fontList: 6x10
  44. ;;; ! WinterpCtrlPnl*XmToggleButton*fontList: 6x10
  45. ;;; ! WinterpCtrlPnl*XmPushButtonGadget*fontList: 6x10
  46. ;;; ! WinterpCtrlPnl*XmPushButton*fontList: 6x10
  47.  
  48. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  49. ;;;  TO-DO --
  50. ;;;
  51. ;;; Recode callbacks for <--, -->, and "eval @ point" such that they use
  52. ;;; in ivar on editor_w holding the string-contents displayed in text widget,
  53. ;;; instead of calling :get_string each time needed. set up a modify callback
  54. ;;; such that if text is modified in the te widget, then ivar is set to NIL.
  55. ;;; any procs needing the text-str will note the NIL,  and replace it w/
  56. ;;; with current result of :get_string.
  57. ;;;
  58. ;;; Don't scan to end of file if parens mismatched... use heuristics
  59. ;;;
  60. ;;; keybindings in editor:
  61. ;;; C-M-X == 'Eval@Point'
  62. ;;; C-M-F == forward-list
  63. ;;; C-M-B == backward-list
  64. ;;;
  65. ;;; get evaluator working right -- goes astray if file has #\( or #\)
  66. ;;; 
  67. ;;; get forw and prev working right -- gives out of bounds error unless
  68. ;;; cursor is in sexp, can't move between sexp's as in emacs C-M-F, C-M-B.
  69. ;;; 
  70. ;;; add eval-current-buffer.
  71. ;;; 
  72. ;;; add quit button (or change string "close" in wm-pulldown to indicate that
  73. ;;; it will quit WINTERP (due to using application-shell...)
  74. ;;; 
  75. ;;; allow saving of file in texteditor
  76. ;;; 
  77. ;;; recode :FIND_FILE and :SAVE_FILE in C for efficiency
  78. ;;;
  79. ;;; BUG: if the code you're evaluating via "eval defun" button causes an error,
  80. ;;; you will end up seeing a backtrace going all the way back to the callback.
  81. ;;; Need to hotwire this so that evaluation actually calls the same evaluator
  82. ;;; loop in winterp.c:main(). Totally grody. (Note -- this is partially fixed by
  83. ;;; Motif 1.1 recursive eventloop bug workaround...)
  84.  
  85. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  86. ;;; *SYSTEM-EDITOR*:
  87. ;;; if NIL, then edit functionality will use editor set in environment variable 
  88. ;;; $EDITOR. If set to a string, then that string will be used as the name of
  89. ;;; the editor to use for the "Edit" button.
  90. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  91. (defvar *SYSTEM-EDITOR* nil)
  92.  
  93. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  94. ;;; *TEMP-LOAD-FILE-NAME*:
  95. ;;; Temporary file to store lisp forms selected by "Eval@Point" button before
  96. ;;; passing the file onto '(system "wl '(load <filename>)'")' in
  97. ;;; function eval_string_and_print.
  98. ;;;
  99. ;;; This is only used in Motif 1.1, as part of hack/kludge needed to work around
  100. ;;; problems in X11r4's handling of destroyed widgets within recursive event
  101. ;;; loops. The problem would occur if you get an error during the evaluation
  102. ;;; and have *breakenable* set...
  103. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  104. (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 1))
  105.     (defvar *TEMP-LOAD-FILE-NAME* "/tmp/winterp.tmp")
  106.   )
  107.  
  108. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  109. ;; Add a :FIND_FILE method to the Motif Text widget.
  110. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  111. (send XM_TEXT_WIDGET_CLASS :answer :FIND_FILE '(filename linenum)
  112.       '(
  113.     (let*
  114.         (;; loc vars
  115.          (fp
  116.           (open filename :direction :input)
  117.           )
  118.          inspos
  119.          text_line
  120.          )
  121.  
  122.       (if (null fp)
  123.           (error "Can't open file." filename))
  124.  
  125.       (send self :set_string "")    ;clear out old text
  126.       (send self :disable_redisplay NIL) ;don't show changes till done
  127.       (loop
  128.        (if (null (setq text_line (read-line fp)))
  129.            (return))
  130.        (setq inspos (send self :get_insertion_position))
  131.        (send self :replace inspos inspos (strcat text_line "\n"))
  132.        )
  133.  
  134.       (send self :scroll linenum)    ;make <linenum> be the top of screen
  135.  
  136.       (send self :enable_redisplay)    ;now show changes...
  137.  
  138.       (close fp)
  139.       )
  140.     )
  141.       )
  142.  
  143. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  144. ;; 
  145. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  146. (defun prev_paren(str pos)
  147.   (let*                    
  148.       ;; local loop vars
  149.       (
  150.        (i pos)
  151.        cur_char
  152.        (paren_count 0)
  153.        )
  154.  
  155.     (loop
  156.  
  157.      (setq cur_char (char str i))
  158.  
  159.      (cond 
  160.       ((char= cur_char #\) ) 
  161.        (setq paren_count (1+ paren_count))
  162.        )
  163.       ((and (> paren_count 0) (char= cur_char #\( ))
  164.        (setq paren_count (1- paren_count))
  165.        )
  166.       )
  167.  
  168.      (if (and (zerop paren_count) (char= cur_char #\( ))
  169.      (return i))
  170.  
  171.      (setq i (1- i))
  172.  
  173.      (if (< i 0)
  174.      (return 'error))
  175.      )
  176.     )
  177.   )
  178.  
  179.  
  180. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  181. ;; 
  182. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  183. (defun next_paren(str pos)
  184.   (let*                    
  185.       ;; local loop vars
  186.       (
  187.        (i pos)
  188.        cur_char
  189.        (paren_count 0)
  190.        (str_length (length str))
  191.        )
  192.  
  193.     (loop
  194.  
  195.      (setq cur_char (char str i))
  196.  
  197.      (if (and (zerop paren_count) (char= cur_char #\) ))
  198.      (return (1+ i)))
  199.  
  200.      (cond 
  201.       ((char= cur_char #\( ) 
  202.        (setq paren_count (1+ paren_count))
  203.        )
  204.       ((and (> paren_count 0) (char= cur_char #\) ))
  205.        (setq paren_count (1- paren_count))
  206.        )
  207.       )
  208.  
  209.      (setq i (1+ i))
  210.  
  211.      (if (> i str_length)
  212.      (return 'error))
  213.      )
  214.     )
  215.   )
  216.  
  217. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  218. ;; 
  219. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  220. (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 1))
  221.     ;; Motif 1.1 Callback for "Eval @ Point" -- partial work around to X11r4 recursive event loop bugs
  222.     (defun eval_string_and_print (str)
  223.       (let (f)
  224.     (setq f (open *TEMP-LOAD-FILE-NAME* :direction :output))
  225.     (princ str f)
  226.     (close f)
  227.     (system (strcat "wl '(load \"" *TEMP-LOAD-FILE-NAME* "\" :verbose nil :print t)'"))
  228.     ))
  229.   ;; Motif 1.0 Callback for "Eval @ Point"
  230.   (defun eval_string_and_print (str)
  231.     (format T "~A\n" (eval (read (make-string-input-stream str))))
  232.     )
  233.   )
  234.  
  235. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  236. ;; 
  237. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  238. (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 1))
  239.     ;; Motif 1.1 Callback for "Load File" -- partial work around to X11r4 recursive event loop bugs
  240.     (defun load_file (filename)
  241.       (system (strcat "wl '(load \"" filename "\" :verbose t :print t)'"))
  242.       )
  243.   ;; Motif 1.0 Callback for "Load File"
  244.   (defun load_file (filename)
  245.     (load filename :verbose t :print t)
  246.     (format T "; Done Loading\n\n")
  247.     )
  248.   )
  249.  
  250. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  251. ;; 
  252. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  253. (let* (top_w 
  254.        paned_w
  255.        fsb_w
  256.        controlpanel_w
  257.        editor_w
  258.        editfile_button_w
  259.        loadfile_button_w
  260.        savefile_button_w
  261.        eval_button_w
  262.        prev_button_w
  263.        next_button_w
  264.        debug_togglebutton_w
  265.        trace_togglebutton_w
  266.        gcmsg_togglebutton_w
  267.        continue_button_w
  268.        go_prevlevel_button_w
  269.        go_toplevel_button_w)
  270.  
  271.   (setq top_w
  272.     (send APPLICATION_SHELL_WIDGET_CLASS :new "winterpCtrlPnl" "WinterpCtrlPnl"
  273.           ))
  274.   (setq paned_w
  275.     (send XM_PANED_WINDOW_WIDGET_CLASS :new :managed top_w
  276.           ))
  277.   (setq fsb_w
  278.     (send XM_FILE_SELECTION_BOX_WIDGET_CLASS :new :managed "files" paned_w
  279.           :XMN_DIR_MASK "*.lsp"
  280.           :XMN_ALLOW_RESIZE t    ;paned_w constraint resource
  281.           :XMN_SKIP_ADJUST nil    ;paned_w constraint resource
  282.           ))
  283.   ;;
  284.   ;; we don't want these fileselbox widgets around because they take up
  285.   ;; too much space and don't provide useful functionality.
  286.   ;; Unfortunately, if :DIALOG_APPLY_BUTTON and :DIALOG_OK_BUTTON are
  287.   ;; not managed, the fsb_w's "Ok" and "Filter" actions will not be available
  288.   ;; through the "Directories" and "Files" list widgets, nor through the 
  289.   ;; "Filter" and "Selection" text widgets. This is lameness on the part of
  290.   ;; Motif
  291.   ;;
  292.   (send (send fsb_w :get_child :DIALOG_OK_BUTTON) :unmanage)
  293.   (send (send fsb_w :get_child :DIALOG_APPLY_BUTTON) :unmanage)
  294.   (send (send fsb_w :get_child :DIALOG_CANCEL_BUTTON) :unmanage)
  295.   (send (send fsb_w :get_child :DIALOG_HELP_BUTTON) :unmanage)
  296.   (send (send fsb_w :get_child :DIALOG_SEPARATOR) :unmanage)
  297.  
  298.   (setq controlpanel_w
  299.     (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed "controlpanel" paned_w
  300.           :XMN_ADJUST_LAST      T
  301.           :XMN_ENTRY_ALIGNMENT  :ALIGNMENT_CENTER
  302.           :XMN_ORIENTATION      :HORIZONTAL
  303.           :XMN_PACKING          :PACK_COLUMN
  304.           :XMN_NUM_COLUMNS      2
  305.           ))
  306.   (setq editor_w
  307.     (send XM_TEXT_WIDGET_CLASS :new :managed :scrolled "edit" paned_w
  308.           :XMN_EDIT_MODE :MULTI_LINE_EDIT
  309.           ))
  310.   (setq editfile_button_w
  311.     (send XM_PUSH_BUTTON_GADGET_CLASS :new :managed controlpanel_w
  312.           :XMN_LABEL_STRING "Edit($EDITOR)"
  313.           ))
  314.   (setq loadfile_button_w
  315.     (send XM_PUSH_BUTTON_GADGET_CLASS :new :managed controlpanel_w
  316.           :XMN_LABEL_STRING "Load File"
  317.           ))
  318.   (setq savefile_button_w
  319.     (send XM_PUSH_BUTTON_GADGET_CLASS :new :managed controlpanel_w
  320.           :XMN_LABEL_STRING "Save File"
  321.           :XMN_SENSITIVE nil
  322.           ))
  323.   (setq debug_togglebutton_w
  324.     (send XM_TOGGLE_BUTTON_GADGET_CLASS :new :managed controlpanel_w
  325.           :XMN_LABEL_STRING "Debug"
  326.           :XMN_SET *breakenable*
  327.           ))
  328.   (setq trace_togglebutton_w
  329.     (send XM_TOGGLE_BUTTON_GADGET_CLASS :new :managed controlpanel_w
  330.           :XMN_LABEL_STRING "Trace"
  331.           :XMN_SET *tracenable*
  332.           ))
  333.   (setq gcmsg_togglebutton_w
  334.     (send XM_TOGGLE_BUTTON_GADGET_CLASS :new :managed controlpanel_w
  335.           :XMN_LABEL_STRING "GC Msgs"
  336.           :XMN_SET *gc-flag*
  337.           ))
  338.   (setq eval_button_w
  339.     (send XM_PUSH_BUTTON_GADGET_CLASS :new :managed controlpanel_w
  340.           :XMN_LABEL_STRING "Eval @ Point"
  341.           ))
  342.   (setq prev_button_w
  343.     (send XM_ARROW_BUTTON_GADGET_CLASS :new :managed controlpanel_w
  344.           :XMN_ARROW_DIRECTION :arrow_left
  345.           ))
  346.   (setq next_button_w
  347.     (send XM_ARROW_BUTTON_GADGET_CLASS :new :managed controlpanel_w
  348.           :XMN_ARROW_DIRECTION :arrow_right
  349.           ))
  350.   (setq continue_button_w
  351.     (send XM_PUSH_BUTTON_GADGET_CLASS :new :managed controlpanel_w
  352.           :XMN_LABEL_STRING "Err-Cont"
  353.           ))
  354.   (setq go_prevlevel_button_w
  355.     (send XM_PUSH_BUTTON_GADGET_CLASS :new :managed controlpanel_w
  356.           :XMN_LABEL_STRING "Err-^Level"
  357.           ))
  358.   (setq go_toplevel_button_w
  359.     (send XM_PUSH_BUTTON_GADGET_CLASS :new :managed controlpanel_w
  360.           :XMN_LABEL_STRING "Err-~Level"
  361.           ))
  362.  
  363.   (send top_w :realize)
  364.  
  365.   ;;
  366.   ;; set constraint resources on controlpanel so that paned window
  367.   ;; doesn't give it resize sashes.
  368.   ;;
  369.   (let (height)
  370.     (send controlpanel_w :get_values :xmn_height 'height)
  371.  
  372.     ;; In the code below, the kludgery
  373.     ;; "(if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0)) ...)"
  374.     ;; is there to work around a name change between Motif 1.0 and 1.1:
  375.     ;; :XMN_MAXIMUM --> :XMN_PANE_MAXIMUM and :XMN_MINIMUM -->:XMN_PANE_MINIMUM
  376.     (send controlpanel_w :set_values
  377.       (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0))
  378.           :XMN_MAXIMUM :XMN_PANE_MAXIMUM)
  379.       height
  380.       (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0))
  381.           :XMN_MINIMUM :XMN_PANE_MINIMUM)
  382.       height
  383.        ))
  384.   (let (height)
  385.     (send editor_w :get_values :xmn_height 'height)
  386.     (send editor_w :set_values
  387.       (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0))
  388.           :XMN_MAXIMUM :XMN_PANE_MAXIMUM)
  389.       height
  390.       (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0))
  391.           :XMN_MINIMUM :XMN_PANE_MINIMUM)
  392.       height
  393.       ))
  394.  
  395.   ;; Since the "Ok" button is unmanaged, you can't get the default action
  396.   ;; of the file selection box widget, nor the selection text. (The
  397.   ;; "Ok" button is unmanaged because it takes up too much space in my
  398.   ;; opinion...)
  399.   ;; These callbacks come as close to that as possible:
  400.   (let (
  401.     (callback_sexp            ;share same callback code bet two cbs
  402.      `((send ,editor_w :find_file
  403.          (xm_string_get_l_to_r (car (send ,fsb_w :get_values :XMN_TEXT_STRING nil)))
  404.          0))
  405.      ))
  406.     ;; a double click in the "files" list widget inside fsb_w
  407.     ;; will cause the file to be shown in the viewer (editor_w).
  408.     (send (send fsb_w :get_child :DIALOG_LIST) :set_callback
  409.       :xmn_default_action_callback '()
  410.       callback_sexp
  411.       )
  412.     ;; <Return> in the selection text widget inside fsb_w
  413.     ;; will cause the file to be show in the viewer (editor_w).
  414.     (send (send fsb_w :get_child :DIALOG_TEXT) :set_callback
  415.       :xmn_activate_callback '()
  416.       callback_sexp
  417.       )
  418.     )
  419.  
  420.   ;; Since the "Apply" button is unmanaged, you can't get access it's callback
  421.   ;; which causes the files list to get refreshed with new data corresponding
  422.   ;; to the filter text string and the chosen directory.... (The
  423.   ;; "Apply" button is unmanaged because it takes up too much space in my
  424.   ;; opinion...)
  425.   ;; These callbacks come as close to that as possible:
  426.   (let (
  427.     (callback_sexp            ;share same callback code bet two cbs
  428.      `((send ,fsb_w :do_search))
  429.      ))
  430.     ;; Don't set up :DIALOG_DIR_LIST callback unless using
  431.     ;; Motif 1.1 or greater. Motif 1.0 doesn't have :DIALOG_DIR_LIST
  432.     ;; in the file selection box...
  433.     (if (and (eq *MOTIF_VERSION* 1) (>= *MOTIF_REVISION* 1))
  434.     ;; a double click in the "files" list widget inside fsb_w
  435.     ;; will cause the file to be show in the viewer (editor_w).
  436.     (send (send fsb_w :get_child :DIALOG_DIR_LIST) :set_callback
  437.           :xmn_default_action_callback '()
  438.           callback_sexp
  439.           )
  440.       )
  441.     ;; <Return> in the selection text widget inside fsb_w
  442.     ;; will cause the file to be show in the viewer (editor_w).
  443.     (send (send fsb_w :get_child :DIALOG_FILTER_TEXT) :set_callback
  444.        :xmn_activate_callback '()
  445.        callback_sexp
  446.        )
  447.     )
  448.  
  449.   ;; Callback for "Edit File"
  450.   (send editfile_button_w :set_callback :xmn_activate_callback '()
  451.     '(
  452.       (system (strcat
  453.            (if *SYSTEM-EDITOR* *SYSTEM-EDITOR* "$EDITOR")
  454.            " "
  455.            (xm_string_get_l_to_r (car (send fsb_w :get_values :XMN_TEXT_STRING nil)))
  456.            " &"            ;run it in the background so that winterp don't block...
  457.            ))
  458.       ))
  459.  
  460.   ;; Callback for "Load File"
  461.   (send loadfile_button_w :set_callback :xmn_activate_callback '()
  462.     '(                ;Note: load_file is within "global" lexical scope
  463.       (load_file (xm_string_get_l_to_r (car (send fsb_w :get_values :XMN_TEXT_STRING nil))))
  464.       ))
  465.  
  466.   ;; Callback for "Save file"
  467.   (send savefile_button_w :set_callback :xmn_activate_callback '()
  468.     '(
  469.       (format T ";\007Save File not implemented\n")
  470.       ))
  471.  
  472.   ;; Callback for "Evaluate 'defun'"
  473.   (send eval_button_w :set_callback :xmn_activate_callback '()
  474.     '(
  475.       (let*
  476.           ((str (send editor_w :get_string))
  477.            (cur_pos (send editor_w :GET_INSERTION_POSITION))
  478.            (begin_pos (prev_paren str cur_pos))
  479.            (end_pos (next_paren str cur_pos))
  480.            )
  481.         (send editor_w :SET_SELECTION begin_pos end_pos)
  482.         (eval_string_and_print (subseq str begin_pos end_pos)) ; NOTE: def'd in global lexical scope
  483.         (send editor_w :SET_INSERTION_POSITION cur_pos)
  484.         )))
  485.  
  486.   ;; Callback for "( <--"
  487.   (send prev_button_w :set_callback :xmn_activate_callback '()
  488.     '(
  489.       (send editor_w :SET_INSERTION_POSITION
  490.         (prev_paren 
  491.          (send editor_w :get_string)
  492.          (1- (send editor_w :GET_INSERTION_POSITION))))
  493.       ))
  494.  
  495.   ;; Callback for "--> )"
  496.   (send next_button_w :set_callback :xmn_activate_callback '()
  497.     '(
  498.       (send editor_w :SET_INSERTION_POSITION
  499.         (next_paren 
  500.          (send editor_w :get_string)
  501.          (1+ (send editor_w :GET_INSERTION_POSITION))))
  502.       ))
  503.  
  504.   ;; Callback for "Debug"
  505.   (send debug_togglebutton_w :set_callback :xmn_value_changed_callback '(callback_set)
  506.     '(
  507.       (setq *breakenable* callback_set)
  508.       ))
  509.  
  510.   ;; Callback for "Trace"
  511.   (send trace_togglebutton_w :set_callback :xmn_value_changed_callback '(callback_set)
  512.     '(
  513.       (setq *tracenable* callback_set)
  514.       ))
  515.  
  516.   ;; Callback for "GC Msgs"
  517.   (send gcmsg_togglebutton_w :set_callback :xmn_value_changed_callback '(callback_set)
  518.     '(
  519.       (setq *gc-flag* callback_set)
  520.       ))
  521.  
  522.   (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 1))
  523.       ;; Motif 1.1 Callback for "Err-Cont" -- partial work around to X11r4 recursive event loop bugs
  524.       (send continue_button_w :set_callback :xmn_activate_callback '()
  525.         '(
  526.           (system "wl '(continue)'") ;assumes 'wl' is on path...
  527.           ))
  528.     ;; Motif 1.0 Callback for "Err-Cont".
  529.     (send continue_button_w :set_callback :xmn_activate_callback '()
  530.       '(
  531.         (continue)
  532.         ))
  533.     )
  534.  
  535.   (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 1))
  536.       ;; Motif 1.1 Callback for "Err-^Level" -- partial work around to X11r4 recursive event loop bugs
  537.       (send go_prevlevel_button_w :set_callback :xmn_activate_callback '()
  538.         '(
  539.           (system "wl '(clean-up)'") ;assumes 'wl' is on path...
  540.           ))
  541.     ;; Motif 1.0 Callback for "Err-^Level"
  542.     (send go_prevlevel_button_w :set_callback :xmn_activate_callback '()
  543.       '(
  544.         (clean-up)
  545.         ))
  546.     )
  547.  
  548.   (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 1))
  549.       ;; Motif 1.1 Callback for "Err-~Level" -- partial work around to X11r4 recursive event loop bugs
  550.       (send go_toplevel_button_w :set_callback :xmn_activate_callback '()
  551.         '(
  552.           (system "wl '(top-level)'") ;assumes 'wl' is on path...
  553.           ))
  554.     ;; Motif 1.0 Callback for "Err-~Level".
  555.     (send go_toplevel_button_w :set_callback :xmn_activate_callback '()
  556.       '(
  557.         (top-level)
  558.         ))
  559.     )
  560.   )
  561.