(FILECREATED "13-Jan-86 19:16:42" {QV}<NOTECARDS>1.3K>RHTPATCH022.;1
 5471   

      changes to:  (VARS RHTPATCH022COMS))


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

(PRETTYCOMPRINT RHTPATCH022COMS)

(RPAQQ RHTPATCH022COMS
 ((* * Fixed function from NCPROGINT)
			  (FNS NCP.MakeBrowser)
			  (* * Fixed function from NCBROWSERCARD)
			  (FNS NC.MakeLinksLegendMenu)))
(* * Fixed function from NCPROGINT)


(DEFINEQ

(NCP.MakeBrowser

  (LAMBDA (NoteFile Title ParamList NoDisplayFlg Props ParentFileBoxes)
                                                             (* rht: "13-Jan-86 17:41")


          (* * Creates a new browser notecard with given type, title, props, parents, starting ID and link labels.

	  LinkTypes can be atom or list and can contain litatoms ALL and/or ←ALL.)




          (* * rht 3/18/85: changed to take all info as a param proplist rather than as separate arguments.

	  Only checks validity of the Linklabels param. Will create either a StructEditBrowser or a normal Browser depending 

	  on value of StructEditFlg.)




          (* * rht 1/13/86: Fixed so now handles null ParamList.)



    (LET (ValidLinkTypes LinkTypes NewParamList)
         (
SETQ
 ValidLinkTypes (for
 LinkType in
 (
SETQ
 LinkTypes (
LISTGET
 ParamList
										  (
QUOTE
 LINKTYPES))
						       )
				   join
 (
COND

					    ((
EQ
 LinkType (
QUOTE
 ALL))
					      (
NCP.GetLinkTypes
))
					    ((
EQ
 LinkType (
QUOTE
 ←ALL))
					      (
NCP.GetReverseLinkTypes
))
					    ((
NOT
 (
NCP.ValidLinkType
 LinkType))
					      (
NCP.ReportError
 LinkType " not a valid link type.")
					      NIL)
					    (T (
LIST
 LinkType)))))
         (
SETQ
 ValidLinkTypes (
INTERSECTION
 ValidLinkTypes ValidLinkTypes))
         (if
 (
AND
 LinkTypes (
NULL
 ValidLinkTypes))
	     then
 NIL
	   else
                                            (* Make a copy of the user's param list since she may 

							     not want it to get rplaca'd.)

		  (if
 ParamList
		      then
 (
SETQ
 NewParamList (
COPY
 ParamList))
			     (
LISTPUT
 NewParamList (
QUOTE
 LINKTYPES)
					ValidLinkTypes)
		    else
 (
SETQ
 NewParamList (
LIST
 (
QUOTE
 LINKTYPES)
							ValidLinkTypes)))
		  (
NCP.CreateCard
 (
QUOTE
 Browser)
				    NoteFile Title NoDisplayFlg Props ParentFileBoxes NewParamList))))
)
)
(* * Fixed function from NCBROWSERCARD)


(DEFINEQ

(NC.MakeLinksLegendMenu

  (LAMBDA (Win LabelPairs)                                   (* rht: "13-Jan-86 18:32")


          (* * Build a links legend menu and attach to Win)




          (* * rht 1/10/85: Before starting, kill any old links legend menus for Win.)




          (* * rht 1/13/86: Now holds onto value of PASSTOMAINCOMS windowprop of prompt win and restores after reattaching.)



    (
PROG
 (Menu MenuWin PromptWin MainWinPromptInfo PromptWinPASSTOMAINCOMS)
	    (for
 AttachedWin in
 (
ATTACHEDWINDOWS
 Win) when
 (
WINDOWPROP
 AttachedWin
										 (
QUOTE
 
										  LINKSLEGENDWINP))
	       do
 (
CLOSEW
 AttachedWin))
	    (
SETQ
 Menu (
COND

		(NC.LinkDashingInBrowser (create
 MENU
						   ITEMS ←(for
 Pair in
 LabelPairs
							     join
 (
LIST
 (
CAR
 Pair)
									    (
LIST
 (
QUOTE
 "  "))))
						   TITLE ←(
QUOTE
 Links)
						   MENUCOLUMNS ← 2))
		(T (create
 MENU
			     ITEMS ←(for
 Pair in
 LabelPairs collect
 (
CAR
 Pair))
			     TITLE ←(
QUOTE
 Links)
			     MENUCOLUMNS ← 1))))             (* Detach the prompt window for a second, saving the 

							     prompt window info from the main win's props.)

	    (if
 (
SETQ
 PromptWin (
GETPROMPTWINDOW
 Win NIL NIL T))
		then
 (
SETQ
 MainWinPromptInfo (
WINDOWPROP
 Win (
QUOTE
 PROMPTWINDOW)))
		       (
SETQ
 PromptWinPASSTOMAINCOMS (
WINDOWPROP
 PromptWin (
QUOTE
 
										   PASSTOMAINCOMS)))
		       (
DETACHWINDOW
 PromptWin))           (* Stick the links legend window at upper right 

							     corner.)

	    (
ATTACHWINDOW
 (
SETQ
 MenuWin (
ADDMENU
 Menu NIL NC.OffScreenPosition))
			    Win
			    (
QUOTE
 RIGHT)
			    (
QUOTE
 TOP)
			    (
QUOTE
 LOCALCLOSE))
	    (
WINDOWADDPROP
 MenuWin (
QUOTE
 REPAINTFN)
			     (
QUOTE
 NC.LinksLegendRepaintFn))
	    (
WINDOWADDPROP
 MenuWin (
QUOTE
 RESHAPEFN)
			     (
QUOTE
 NC.LinksLegendReshapeFn))
	    (
WINDOWADDPROP
 MenuWin (
QUOTE
 LINKSLEGENDWINP)
			     T)
	    (
WINDOWPROP
 Win (
QUOTE
 NCLABELPAIRS)
			  LabelPairs)                        (* Put back the prompt window if it exists.)

	    (if
 PromptWin
		then
 (
ATTACHWINDOW
 PromptWin Win (
QUOTE
 TOP)
				       (
QUOTE
 LEFT))
		       (
WINDOWPROP
 PromptWin (
QUOTE
 PASSTOMAINCOMS)
				     PromptWinPASSTOMAINCOMS)
		       (
WINDOWPROP
 Win (
QUOTE
 PROMPTWINDOW)
				     MainWinPromptInfo))
	    (
MOVEW
 Win (
MAKEWITHINREGION
 (
WINDOWREGION
 Win)
					     WHOLESCREEN))   (* For some reason, the above MOVEW tends to leave the

							     prompt window open.)

	    (if
 (
OPENWP
 PromptWin)
		then
 (
CLOSEW
 PromptWin))
	    (if
 NC.LinkDashingInBrowser
		then
 (
NC.LinksLegendRepaintFn
 MenuWin NIL))
	NIL)))
)
(PUTPROPS RHTPATCH022 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (444 2458 (NCP.MakeBrowser 454 . 2456)) (2505 5389 (NC.MakeLinksLegendMenu 2515 . 5387))
)))
STOP