(FILECREATED "31-Jul-86 14:09:19" {QV}<NOTECARDS>1.3K>KIRKPATCH023.;1
 5298   

      changes to:  (VARS KIRKPATCH023COMS)
		   (FNS NC.AskTraversalSpecs NC.CollectCards))


(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT KIRKPATCH023COMS)

(RPAQQ KIRKPATCH023COMS
 ((* * adds backlinks to traversal specs)
			   (* * changes for NCDATABASE)
			   (VARS (NC.TraversalSpecsStylesheet (CREATE.STYLE (QUOTE ITEMS)
									    (LIST (create MENU ITEMS 
											  ← T)
										  (create MENU ITEMS 
											  ← T))
									    (QUOTE SELECTIONS)
									    (QUOTE (T T))
									    (QUOTE ITEM.TITLES)
									    (QUOTE (Forward% Links
										     Backward% Links 
										     Depth))
									    (QUOTE ITEM.TITLE.FONT)
									    (FONTCOPY MENUFONT
										      (QUOTE WEIGHT)
										      (QUOTE BOLD))
									    (QUOTE NEED.NOT.FILL.IN)
									    (QUOTE (MULTI MULTI NIL 
											  NIL))
									    (QUOTE TITLE)
									    "Include cards at:")))
			   (FNS NC.AskTraversalSpecs NC.CollectCards)))
(* * adds backlinks to traversal specs)


(* * changes for NCDATABASE)



(RPAQ NC.TraversalSpecsStylesheet
 (CREATE.STYLE (QUOTE ITEMS)
						  (LIST (create MENU ITEMS ← T)
							(create MENU ITEMS ← T))
						  (QUOTE SELECTIONS)
						  (QUOTE (T T))
						  (QUOTE ITEM.TITLES)
						  (QUOTE (Forward% Links Backward% Links Depth))
						  (QUOTE ITEM.TITLE.FONT)
						  (FONTCOPY MENUFONT (QUOTE WEIGHT)
							    (QUOTE BOLD))
						  (QUOTE NEED.NOT.FILL.IN)
						  (QUOTE (MULTI MULTI NIL NIL))
						  (QUOTE TITLE)
						  "Include cards at:"))
(DEFINEQ

(NC.AskTraversalSpecs

  (LAMBDA (SourceCard OldLinkLabels OldDepth Don'tAskFlg)    (* kirk: "31-Jul-86 10:55")


          (* * Get a traversal specification from the user.)




          (* * kirk 7/29/86 changed to allow backlinks and position specs above source card)



    (
PROG
 ((LinkLabels (
NC.RetrieveLinkLabels
 (fetch
 (Card NoteFile) of
 SourceCard)
						  T))
	     Choices Position MainWindow)
	    (
OR
 OldLinkLabels (
SETQ
 OldLinkLabels LinkLabels))
	    (if
 Don'tAskFlg
		then
 (
RETURN
 (
LIST
 OldLinkLabels OldDepth)))
	    (
SETQ
 MainWindow (
NC.FetchWindow
 SourceCard))
	    (
SETQ
 Position (
AND
 (
WINDOWP
 MainWindow)
				    (create
 POSITION
					      XCOORD ←
 (fetch
 (REGION LEFT)
							    of
 (
WINDOWPROP
 MainWindow
									       (
QUOTE
 REGION)))
					      YCOORD ←
 (fetch
 (REGION TOP) of
 (
WINDOWREGION

										      MainWindow)))))
	    (
OR
 OldDepth (
SETQ
 OldDepth 99999))
	    (
RESETFORM
 (
CURSOR
 (
QUOTE
 WAITINGCURSOR))
                                                             (* The stylesheet is in a global var.

							     We only need to provide its position, items, and 

							     selections.)

			 (
STYLE.PROP
 NC.TraversalSpecsStylesheet (
QUOTE
 POSITION)
				       Position)
			 (
STYLE.PROP
 NC.TraversalSpecsStylesheet (
QUOTE
 ITEMS)
				       (
LIST
 (create
 MENU
							 ITEMS ←
 LinkLabels)
					       (create
 MENU
							 ITEMS ←
 (for
 Link in
 LinkLabels
								      collect
 (
PACK*

										  (
QUOTE
 ←
)
										  Link)))
					       (create
 MENU
							 ITEMS ←

							 (
QUOTE
 (0 1 2 3 4 5 6 7 8 9 INF)))))
			 (
STYLE.PROP
 NC.TraversalSpecsStylesheet (
QUOTE
 SELECTIONS)
				       (
LIST
 (for
 Label in
 OldLinkLabels
						  when
 (
NEQ
 (
NTHCHAR
 Label 1)
								(
QUOTE
 ←
))
						  collect
 Label)
					       (for
 Label in
 OldLinkLabels
						  when
 (
EQ
 (
NTHCHAR
 Label 1)
							       (
QUOTE
 ←
))
						  collect
 Label)
					       (if
 (
OR
 (
NOT
 (
FIXP
 OldDepth))
							   (
IGREATERP
 OldDepth 9)
							   (
ILESSP
 OldDepth 0))
						   then
 (
QUOTE
 INF)
						 else
 OldDepth))))
	    (
SETQ
 Choices (
STYLESHEET
 NC.TraversalSpecsStylesheet))
	    (
RETURN
 (
COND

			(Choices (create
 TRAVERSALSPECS
					   LinkTypes ←
 (
APPEND
 (
CAR
 Choices)
								   (
CADR
 Choices))
					   Depth ←
 (
OR
 (
FIXP
 (
CAADR
 Choices))
							   MAX.FIXP)))
			(T NIL))))))

(NC.CollectCards

  (LAMBDA (RootCards TraversalSpec)                          (* kirk: "31-Jul-86 10:57")


          (* * converts from a simple traversal spec to FSM path to enumerate cards.)




          (* * kirk changed to use NCP.TransitiveClosure until path stuff is ready)




          (* * kirk 7/29/86 added backlinks)




          (* * (LET (node FSM) (SETQ node (create NCPathFSMNode Predicate ← (NC.MakePredFromTraversalSpec TraversalSpec))) 

	  (replace (NCPathFSMNode NextNodes) of node with (LIST NIL node)) (SETQ FSM (create NCPathFSM InitialState ← node 

	  CurrentState ← node)) (NCPath.GetCardPathListsFromPathCollection (NCPath.FSM.PathCollect FSM FromCard))))



    (
NCP.ComputeTransitiveClosure
 RootCards (fetch
 (TRAVERSALSPECS LinkTypes) of
 TraversalSpec)
				    (fetch
 (TRAVERSALSPECS Depth) of
 TraversalSpec))))
)
(PUTPROPS KIRKPATCH023 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1656 5215 (NC.AskTraversalSpecs 1666 . 4322) (NC.CollectCards 4324 . 5213)))))
STOP