(FILECREATED " 5-Dec-86 12:25:40" {QV}<NOTECARDS>1.3K>NEXT>PMIPATCH010.;1
 5329   

      changes to:  (VARS PMIPATCH010COMS)
		   (FNS NC.AskLinkLabel))


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

(PRETTYCOMPRINT PMIPATCH010COMS)

(RPAQQ PMIPATCH010COMS
 ((* * Fixes bug #321 Clicking outside of Link type menu should abort.)
			  (* * Change to NCINTERFACE)
			  (FNS NC.AskLinkLabel)))
(* * Fixes bug #321 Clicking outside of Link type menu should abort.)


(* * Change to NCINTERFACE)


(DEFINEQ

(NC.AskLinkLabel

  (LAMBDA (MainWindow MultipleFlg SystemLinksFlg NewLinkFlg CancelOkayFlg ReverseLinksFlg 
		      OldLinkLabels ReturnListOfListFlg)     (* pmi: " 5-Dec-86 12:01")

                                                             (* Asks for label on notecard links)


          (* * rht 8/2/84: Added double columns for when called by the browser, i.e. ReverseLinksFlg=T.

	  Reverse links have prefix "_".)




          (* * rht 11/19/84: Changed strings from "pointer" to "link" and from "label" to "type".)




          (* * rht 2/14/85: Added extra arg OldLinkLabels in the Multiple selection case to display previous choices.)




          (* * rht 10/11/85: Took out printing to prompt window. It's a waste of screen space.)




          (* * rht 10/22/85: Added ReturnListOfListFlg so caller can tell difference between aborting from Stylesheet and 

	  choosing NULL set of links.)




          (* * fgh 11/14/85 Updated to handle NoteFile and card objects.)




          (* * pmi 12/5/86: Modified so that clicking outside of Link type menu is equivalent to choosing **CANCEL** from 

	  menu.)



    (
PROG
 (Menu Choice Choices LabelsList LinkLabels Position Card NoteFile)
	    (
SETQ
 Card (
NC.CoerceToCard
 MainWindow))
	    (
SETQ
 NoteFile (fetch
 (Card NoteFile) of
 Card))
	    (
SETQ
 LinkLabels (
NC.RetrieveLinkLabels
 NoteFile SystemLinksFlg))
	    (
SETQ
 Position (
AND
 (
WINDOWP
 MainWindow)
				    (create
 POSITION
					      XCOORD _(fetch
 (REGION LEFT)
							 of
 (
WINDOWPROP
 MainWindow (
QUOTE

									      REGION)))
					      YCOORD _(fetch
 (REGION TOP) of
 (
WINDOWREGION

										   MainWindow)))))
	    (
COND

	      (MultipleFlg (
SETQ
 Choices
			     (
STYLESHEET
 (
CREATE.STYLE

					     (
QUOTE
 ITEMS)
					     (
COND

					       (ReverseLinksFlg
						 (
LIST
 (create
 MENU
								   ITEMS _ LinkLabels)
							 (create
 MENU
								   ITEMS _(for
 Link in
 LinkLabels
									     collect

									      (
PACK*
 (
QUOTE

											 _)
										       Link)))))
					       (T (
LIST
 (create
 MENU
								    ITEMS _ LinkLabels))))
					     (
QUOTE
 NEED.NOT.FILL.IN)
					     (
QUOTE
 MULTI)
					     (
QUOTE
 POSITION)
					     Position
					     (
QUOTE
 TITLE)
					     "Link Types?"
					     (
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)))))
			   (
RETURN
 (
COND

				       ((
NULL
 Choices)     (* User aborted from stylesheet.)

					 NIL)
				       ((
AND
 ReverseLinksFlg ReturnListOfListFlg)
					 (
LIST
 (
NCONC
 (
CAR
 Choices)
							  (
CADR
 Choices))))
				       (ReverseLinksFlg (
NCONC
 (
CAR
 Choices)
								 (
CADR
 Choices)))
				       (ReturnListOfListFlg Choices)
				       (T (
CAR
 Choices))))))
	    (
SETQ
 Menu (create
 MENU
				   TITLE _ "Link Type?"
				   ITEMS _(
NCONC
 (
COND

						     (ReverseLinksFlg (for
 Link in
 LinkLabels
									 join
 (
LIST
 Link
											(
CONCAT

											  "_" Link))))
						     (T (
COPY
 LinkLabels)))
						   (
AND
 NewLinkFlg (
LIST
 (
QUOTE
 
									      --New% Link% Type--)))
						   (
AND
 CancelOkayFlg (
LIST
 (
QUOTE
 **CANCEL**)))
						   )
				   MENUPOSITION _ Position
				   MENUCOLUMNS _(
AND
 ReverseLinksFlg 2)))

          (* * Allow user to cancel by selecting outside of Links menu)



	    (
SETQ
 Choice (
OR
 (
MKATOM
 (
MENU
 Menu))
				 (
QUOTE
 **CANCEL**)))
	    (
COND

	      ((
EQ
 Choice (
QUOTE
 **CANCEL**))
		(
SETQ
 Choice))
	      ((
EQ
 Choice (
QUOTE
 --New% Link% Type--))
		(
NC.ClearMsg
 MainWindow NIL)
		(until
 (
COND

			   ((
NOT
 (
FMEMB
 (
U-CASE
 (
SETQ
 Choice
							(
MKATOM
 (
NC.AskUser
 
									  "Enter new link type: "
										NIL NIL NIL 
										MainWindow NIL))))
					    NC.UCASESystemLinkLabels))
			     T)
			   (T (
NC.PrintMsg
 MainWindow T Choice " is a system reserved link type."
					     (
CHARACTER
 13)
					     "Please choose another link type."
					     (
CHARACTER
 13))
			      NIL)))
		(
OR
 Choice (
SETQ
 Choice NC.UnspecifiedLinkLabel))
		(
AND
 (
NOT
 (
FMEMB
 Choice LinkLabels))
		       (
NC.StoreLinkLabels
 NoteFile (
CONS
 Choice LinkLabels)))))
	    (
RETURN
 Choice))))
)
(PUTPROPS PMIPATCH010 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (532 5247 (NC.AskLinkLabel 542 . 5245)))))
STOP