(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")

(FILECREATED "30-May-88 16:42:29" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH323.;1
 7559   

      changes to%:  (VARS RHTPATCH323COMS))


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

(PRETTYCOMPRINT RHTPATCH323COMS)

(RPAQQ RHTPATCH323COMS
 ((DECLARE%: DONTCOPY (PROPS (RHTPATCH323 MAKEFILE-ENVIRONMENT)
                                                   (RHTPATCH323 FILETYPE)))
                        
          
          (* ;; 

        "Fixes problem reported by John Tang whereby link types menu wasn't coming up at cursor pos.")


                        
          
          (* ;; "Change to NCINTERFACE")


                        (FNS NC.AskLinkLabel)))
(DECLARE%: DONTCOPY 

(PUTPROPS RHTPATCH323 MAKEFILE-ENVIRONMENT
 (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))

(PUTPROPS RHTPATCH323 FILETYPE
 :TCOMPL)
)



(* ;; "Fixes problem reported by John Tang whereby link types menu wasn't coming up at cursor pos.")





(* ;; "Change to NCINTERFACE")


(DEFINEQ

(NC.AskLinkLabel

  [LAMBDA (MainWindow MultipleFlg SystemLinksFlg NewLinkFlg CancelOkayFlg ReverseLinksFlg 
                 OldLinkLabels ReturnListOfListFlg)
          (* ; "Edited 30-May-88 16:41 by Trigg")

                                                             (* ; "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.")

          
          (* ;; "pmi 3/25/87: Added NC.MenuFont to all menus")

          
          (* ;; 

       "rht 5/30/88: Link typess menu now comes up at cursorpos rather than in corner of MainWindow.")


    (DECLARE
 (GLOBALVARS NC.MenuFont NC.UCASESystemLinkLabels NC.UnspecifiedLinkLabel))
    (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
                                                                             'REGION))
                                     YCOORD ← (fetch
 (REGION TOP) of
 (WINDOWREGION MainWindow]
          [COND
             (MultipleFlg [SETQ Choices
                           (STYLESHEET (CREATE.STYLE
                                        'ITEMS
                                        [COND
                                           [ReverseLinksFlg
                                            (LIST (create
 MENU
                                                         ITEMS ← LinkLabels)
                                                  (create
 MENU
                                                         ITEMS ← (for
 Link in
 LinkLabels
                                                                    collect
 (PACK* '← Link]
                                           (T (LIST (create
 MENU
                                                           ITEMS ← LinkLabels]
                                        'NEED.NOT.FILL.IN
                                        'MULTI
                                        'POSITION Position 'TITLE "Link Types?" 'SELECTIONS
                                        (LIST (for
 Label in
 OldLinkLabels
                                                 when
 (NEQ (NTHCHAR Label 1)
                                                           '←) collect
 Label)
                                              (for
 Label in
 OldLinkLabels
                                                 when
 (EQ (NTHCHAR Label 1)
                                                          '←) 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 '|--New Link Type--|))
                                           (AND CancelOkayFlg (LIST '**CANCEL**]
                            CENTERFLG ← T
                            MENUCOLUMNS ← (AND ReverseLinksFlg 2)
                            MENUFONT ← NC.MenuFont
                            ITEMHEIGHT ← (IPLUS (FONTPROP NC.MenuFont 'HEIGHT)
                                                1)))

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


          (SETQ Choice (OR (MKATOM (MENU Menu))
                           '**CANCEL**))
          [COND
             ((EQ Choice '**CANCEL**)
              (SETQ Choice))
             ((EQ Choice '|--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 RHTPATCH323 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1075 7476 (NC.AskLinkLabel 1085 . 7474)))))
STOP