;;; -*- Mode:Zetalisp; Package:TREE; Base:10; Fonts:(MEDFNT HL12B HL12BI) -*-

;;;
;;; The data, information, methods, and concepts contained herein are a valuable
;;; trade secret of Texas Instruments.  They are licensed in confidence by Texas
;;; Instruments and may only be used as permitted under the terms of the
;;; definitive license agreement under which such use is licensed.
;;;
;;;			    RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to restrictions
;;; as set forth in subdivision (b)(3)(ii) of the Rights in Technical Data and
;;; Computer Software clause at 52.227-7013.
;;;
;;;			 TEXAS INSTRUMENTS INCORPORATED
;;;				  P.O. BOX 2909
;;;			       AUSTIN, TEXAS 78769
;;;
;;; Copyright (C) 1987 Texas Instruments Incorporated.  All rights reserved.
;;;

;1;;*
;1;; These are sample accessors for handling data structures that are symbols or lists of symbols.*
;1;; The data is arranged so the car of a list is the current node and the cdr gives the children.  For*
;1;; example, the structure:*
;1;;*
;1;;*	1(This is (a demonstration) (of (the tree editor)))*
;1;;*
;1;; would be displayed as*
;1;;*
;1;;*	1------------ This -----------*
;1;;*	|	      |		1    *|
;1;;*	1is*	      1a*		1   of*
;1;;*		      |		   |
;1;;*		1  demonstration*	1 - the - *
;1;;*				1 *|    |
;1;;*			       1 tree  editor*
;1;;;*
;1;; The symbols can also be strings.*
;1;;*

;1;;*
;1;; *** 1 ****
;1;; The flavor name of your application type must be pushed onto a global list of known applications,*
;1;; called *KNOWN-APPLICATION-TYPES*.  When you build a tree editor if you don't specify the*
;1;; application type, you will be queried from this list.*
;1;;*

(PUSH 'tree:string-display *known-application-types*)


;1;;*
;1;; *** 2 ****
;1;; Next you need to define the keywords for each mouse button.  The constant you store this alist*
;1;; in can have any name you like, since you write the method that retrieves this value.  Make sure*
;1;; the string that is displayed in the who-line prefaces the description for each button with a*
;1;; description like L: L2: M: M2: R: R2:.  This is important because when editing, the only commands*
;1;; you have defined that are still in effect are those attached to the right mouse button, and when*
;1;; the tree program adjusts the who-line documentation it looks for the "R1:" part of your string to*
;1;; reuse.  The form for the alist is as follows:*
;1;;*
;1;;*	1(defconst application-alist-name*
;1;;*		1'((node-type1*
;1;;*		1   (single-left-keyword double-left-keyword*
;1;;*		   1single-middle-keyword double-middle-keyword)*
;1;;*		1   "String to be displayed in who-line for this node type"*
;1;;*		1   (item for right-click menu)*
;1;;*		1   (item for right-click menu)*
;1;;*		1   . . . )*
;1;;*		1 (node-type2*
;1;;*		1   (single-left-keyword double-left-keyword*
;1;;*		1    single-middle-keyword double-middle-keyword)*
;1;;*		1   "String to be displayed in who-line for this node type"*
;1;;*		1   (item for right-click menu)*
;1;;*		1   (item for right-click menu)*
;1;;*		1   . . . )*
;1;;*		1 . . . ))*
;1;;*

(DEFCONST string-display-alist
	  '((non-terminal
	      (exp-cont nil move nil)		;1 in the order (L L2 M M2)*
	      (:mouse-1-1 "Expand or contract the node."
	       :mouse-2-1 "Move the node to front of display"
	       :mouse-3-1 "Menu of examinable data for this node.")
	      ("NODE DATA" :value user-data "Show the user data in selected node.")
	      ("FILE WHERE DEFINED" :value origin
	       :documentation "Show the file name where the displayed string was defined"))
	    (terminal
	      (nil nil move nil)
	      (:mouse-2-1 "Move the node to front of display"
	       :mouse-3-1 "Menu of examinable data for this node.")
	      ("NODE DATA" :value user-data "Show the user data in selected node")
	      ("FILE WHERE DEFINED" :value origin
	       :documentation "Show the file name where the displayed string was defined")
	      ("RETURN THIS NODE" :value return-node "Exit with the value of this node")))
 "2This is the alist that determines what action is taken when a node is clicked on.
Clicking left on non-terminal nodes expands them if they have been contracted, or
contracts them if they were expanded.  Single left on terminal nodes does nothing.
Single middle moves that node to the middle left of the screen if the display is
horizontal, otherwise to the middle top.  Clicking right puts up a menu of things you can
examine.  The one selected will appear in a pop-up scrollable window.  For both
non-terminal and terminal nodes the file where the node data was defined can be shown
if the attribute is* 2there.  Nodes also allow the user data they contain to be examined.*")


;1;;*
;1;; *** 3 ****
;1;; Define the flavor for your application.  This flavor needs no mixins and is used only to collect your*
;1;; application functions into one entity.  It also needs no instance variables.  You can have one*
;1;; called ITEM-TYPE-ALIST if you want, and set that equal to the alist constant you defined above.*
;1;; Or you can have no instance variables and simply write a method called :ITEM-TYPE-ALIST that*
;1;; returns your alist constant.*
;1;;*

(DEFFLAVOR string-display
	   ((item-type-alist string-display-alist))	;1 This can either be an*
							;1 instance variable or you can*
							;1 define a method*
							;1 :ITEM-TYPE-ALIST that*
							;1 returns your alist constant.*
	   ()
  :gettable-instance-variables
  (:documentation "2Collects the user written functions and methods for one application
together into one flavor.  This allows several types of editors to* 2coexist at the same
time though they use different accessors.*"))


;1;;*
;1;; *** 4 ****
;1;; Given the data you originally passed to the tree editor when you called it, extract the amount you*
;1;; want stored in the root node of the tree and return that.  There needs to be enough information*
;1;; in it to be able* 1to find its children.*
;1;;*

(DEFMETHOD (string-display :first-node) (node)
  "2Returns the data to be stored in the root node of the tree.  Since the car of the
tree is the current node and the cdr is the children, all* 2the data needs to be stored in
the first node.  So the whole tree is returned.*"
  node)


;1;;*
;1;; *** 5 ****
;1;; Given the data stored in any node in your tree, return a list of its children. Each element in the*
;1;; list should be the part of your data you want stored in that child. This method will be called again*
;1;; on each element in the list, so there needs to be enough information to be able to find their*
;1;; children as well.*
;1;;*

(DEFMETHOD (string-display :children-from-data) (node)
  "2If node is a list, return the cdr, which is the children.  Otherwise return NIL* 2for
there are no children.*"
  (IF (LISTP node)
      (CDR node)
      nil))


;1;;*
;1;; *** 6 ****
;1;; Given a node, return the print name.  If you return a string, the data will be displayed as a text*
;1;; object showing that string.  Otherwise you must return a list, where the car is the name of this*
;1;; node and the cdr is a list of graphics objects useable by the Graphics Window system (that*
;1;; system is available to you because you couldn't be running this program without it: the tree editor*
;1;; is built on the Graphics Window system).  This example only returns strings.*
;1;;*

(DEFMETHOD (string-display :print-name) (node)
  "2Return the print name for this node.  If the node is a string, return itself.
If an atom, return the string equivalent.  If a list, return the print name* 2of its car.*"
  (LET ((temp-node (IF (LISTP node) (CAR node) node)))
    (COND ((STRINGP temp-node) temp-node)
	  ((ATOM temp-node) (GET-PNAME temp-node))
	  (t (*THROW 'throw-from-handle-node "Illegal data")))))


;1;;*
;1;; *** 7 ****
;1;; This method is only applicable is you are returning string print names in the above method,*
;1;; :PRINT-NAME.  If you are defining your own graphics objects instead of using text objects, this*
;1;; can just return NIL.*
;1;;*

(DEFMETHOD (string-display :font-type) (node)
  "2Returns the font that a given node is to be displayed in.  If the node has* 2children,
the font is bolder than a terminal font.*"
  (COND ((ATOM  node) 'gwin:hl12-font)
	(t	      'gwin:hl12b-font)))


;1;;*
;1;; *** 8 ****
;1;;*

(DEFMETHOD (string-display :highlight-function) (node)
 "2Returns whether or not the node should be highlighted when drawn (that is, should
have a background color).  If NIL, it is not highlighted, otherwise it is.  Every time the
tree is redrawn, what this function returns is evaled.  For this example, any nodes with
children, a type defined as* 2non-terminal, will be highlighted.*"
1   *node					;1 to prevent compiler* 1warnings*
  '(IF (EQ type 'non-terminal)
       t
       nil))  


;1;;*
;1;; *** 9 ****
;1;;*

(DEFMETHOD (string-display :find-type) (node)
  "2Every node in the tree has an associated type.  The type of a node dictates whether
or not the node is mouse sensitive, and what action is taken when a node is moused.  In
this example, two types are defined: terminal or non-terminal.  Any node* 2with children is
non-terminal, otherwise it is terminal.*"
  (IF (ATOM node)
      'terminal
      'non-terminal))


;1;;*
;1;; *** 10 ****
;1;; This method handles all the keywords you defined in your alist constant.  Since you defined*
;1;; different keywords for the different node types, you need to check the CHOICE parameter*
;1;; according to the TYPE parameter and take the appropriate action.  NODE is the data you have*
;1;; stored in the current tree node instance.  The whole node flavor instance is in INSTANCE, in case*
;1;; you need it.*
;1;;*
;1;; Returning T from this method means you have done whatever was needed, and to take no further*
;1;; action.  NIL means nothing was done and the monitor will beep.  Returning 'NEW-TREE will cause a*
;1;; new tree to be displayed using whatever is in the special variable *TREE as the new root node.*
;1;; So be sure to put the new tree value there before returning 'NEW-TREE.  Returning anything else*
;1;; will cause whatever was returned to be displayed in a scrollable window.  You can also throw to*
;1;; THROW-FROM-HANDLE-NODE.  This makes the tree editor exit with whatever value you throw.*
;1;;*
;1;; If you want to add or delete any nodes, here is a list of the editing functions that are also called*
;1;; by the editor.  They take care of getting a new node (if you are inserting), and calling all the*
;1;; necessary functions to update the tree structure and redraw the tree.*
;1;;*	1delete-node (node-to-delete)*
;1;;*	1delete-subtree (node-heading-subtree)*
;1;;*	1add-brother-node (selected-node)*
;1;;*	1add-node-before (selected-node)*
;1;;*	1add-node-after  (selected-node)*
;1;;*

(DEFMETHOD (string-display :handle-node) (node type choice instance)
  "2This function handles the item types defined in the STRING-DISPLAY-ALIST.
If 'EXP-CONT was returned, the user clicked left once and wants the selected node
expanded or contracted.  'USER-DATA signifies that the data in the selected node is to
be displayed in a scrollable window, while 'TREE-DATA means the flavor instance of the
node should be described.  'USER-DATA and 'TREE-DATA are item types returned from
single right clicks.  'MOVE means the user clicked single middle, and wants this node
moved to the root node position.  'RETURN-NODE means to exit the tree with this node
value, and 'DELETE means to remove this node from the tree.*"
  (DECLARE (special *root-node))
  (CASE type
    (non-terminal
     (CASE choice
       (exp-cont  (expand-contract-with-redraw instance 1 t t)
		  t)
       (move	  (move-to-front instance)
		  t)
       (user-data (LIST nil 
			(string-item "NODE DATA:")
			(string-item " ")
			(grind-item node)))
       (origin	  (LIST nil
			(string-item "Defining source file:")
			(string-item " ")
			(string-item (IF (AND (ARRAYP (CAR node))
					      (ARRAY-HAS-LEADER-P (CAR node)))
					 (ARRAY-LEADER (CAR node) 0)
					 "Source file attribute not applicable"))))))
    (terminal
     (CASE choice
       (move	    (move-to-front instance)
		    t)
       (user-data   (LIST nil 
			  (string-item "NODE DATA:")
			  (string-item " ")
			  (grind-item node)))
       (origin	    (LIST nil
			  (string-item "Defining source file:")
			  (string-item " ")
			  (string-item (IF (AND (ARRAYP node)
						(ARRAY-HAS-LEADER-P node))
					   (ARRAY-LEADER node 0)
					   "Source file attribute not applicable"))))
       (return-node (*THROW 'throw-from-handle-node node))))
    (otherwise nil)))


;1;;*
;1;; *** 11 ****
;1;; Get more data for this application in whatever manner you desire, so it is in the same form as*
;1;; data given to the tree editor when you first call it.  Return that data, and a new tree will be*
;1;; displayed with it.  This is called by the "New Tree" menu option.  If you don't want this feature,*
;1;; return NIL and the tree editor will give the user a warning beep if he tries to execute this.*
;1;;*

(DEFMETHOD (string-display :get-new-tree) ()
  "2Returns new user data to be displayed in tree form.  If you don't want this* 2feature
return NIL.*"
  (LET (new-tree)
    (DO-FOREVER
      (SETQ new-tree
	    (tv:get-line-from-keyboard
	      "Enter a new tree made of symbols, strings, or lists of symbols and strings"
	      tv:mouse-sheet #'READ '(:mouse)))
      (IF (OR (LISTP new-tree)
	      (STRINGP new-tree)
	      (ATOM new-tree))
	  (RETURN new-tree)))))


(DEFUN user:run-string-displayer (&optional (tree nil))
  "2Run a sample tree editor interface, that displays strings or symbols and* 2lists of
strings and symbols.*"
  (display (IF tree
	       tree
	       '("S" ("NP" ("N" "Mary"))
		     ("VP" ("V" "had")
			   ("NP" ("ART" "a")
				 ("NP" ("ADJ" "little")
				       ("N" "lamb"))))))
	   :vertical? t :application-type 'string-display :edit? t))