(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP") (FILECREATED "30-Dec-88 15:59:39" {DSK}<LISPFILES>STORYBOARD>JRCPATCH065.;1 60436 changes to%: (VARS JRCPATCH065COMS) (FNS NC.LinksLegendMenuWMinSizeFn)) (* " Copyright (c) 1988 by Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT JRCPATCH065COMS) (RPAQQ JRCPATCH065COMS ([DECLARE%: FIRST (P (NC.LoadFileFromDirectories 'NCBROWSERCARD] (* ;; "jrc. 12-30-88. This patch changes NCBROWSERCARD FNS so that the association of link types to dashing patterns is the same for all browsers in a given notefile. A master list of linktype/dashing patterns is stored on a Hash Card in the notefile. Just for the hell of it, eight new dashing patterns have been added to NC.DashingStyles. Functions are also included to copy the master list of linktype/dashing patterns to other notefiles (available from the NoteFile Icon Middle Button Menu), and to edit/reassociate linktypes to dashing patterns (also available from the NoteFile Icon Middle Button Menu).") (* ;; "Note: old notefiles should be closed before loading this patch. The first browser brought up in a notefile created before this patch is loaded (and opened after this patch is loaded) will set the linktype/dashing pattern association for the notefile. In order for other browsers in the notefile to be consistent with the notefile's dashing patterns, do a Reconnect nodes from the middle button menu of each of the other browsers, or try (NC.ConnectNodesInBrowser WindowDisplayingBrowser).") (* ;; "new functions for NCBrowsercard for setting up and accessing the linktype/dashing master list. You could use NC.FetchLinkTypeDashingPattern NC.GenerateDashingPatternList NC.GetHashDashCard programmatically.") (FNS NC.AssignLinkTypeToDashingPattern NC.FetchLinkTypeDashingPattern NC.GenerateDashingPatternList NC.GetHashDashCard) (* ;; "new functions for NCBROWSERCARD for copying link legends between notefiles.") (FNS NC.CopyLinkTypeDashingPatternToNF NC.AddCopyLinkTypeDashingPatternToNFIcon) (* ;; "this is a new function by DSJ that needs to be included somewhere if it's not yet part of NoteCards, It now sits in NCNEWPROGINT destined for NCPROGINT, if it's not already there.") (FNS NCP.SelectNoteFile) (* ;; "This is a new, proposed NCPROGINT function for adding a Subitem to the NoteFile Icon Middle Button Menu.") (FNS NCP.AddDefaultNoteFileIconMiddleButtonSubitem) (* ;; "this 'P' adds the %"Copy Links Legend%" option to all NoteFile Icon Middle Button Menus.") (P (NC.AddCopyLinkTypeDashingPatternToNFIcon)) (* ;; "new functions for NCBROWSERCARD for editing link legends in a NoteFile.") (FNS NC.AddEditLinkTypeDashingPatternToNFIcon NC.EditLinkTypeDashingPattern NC.GrabLinksLegendSelection NC.MakeLinkDashingBitmaps NC.ReassignLinkTypeToDashingPattern NC.MakeNewDashingPattern NC.GetLineDashingLocationFromMenu) (* ;; "this 'P' adds the %"Edit Links Legend%" option to all NoteFile Icon Middle Button Menus.") (P (NC.AddEditLinkTypeDashingPatternToNFIcon)) (* ;; "replace these fns in NCBROWSERCARD") (FNS NC.LinksLegendRepaintFn NC.MakeLinksLegendMenu NC.MakeLinksLegend NC.BrowserAddLink NC.DrawFlowerLinks) (* ;; "add this fn to NCBROWSERCARD -- it's needed so that the Links Legend Menu reshapes properly:") (FNS NC.LinksLegendMenuWMinSizeFn) (* ;; "replace this VARS in NCBROWSERCARD") (VARS NC.DashingStyles))) (DECLARE%: FIRST (NC.LoadFileFromDirectories 'NCBROWSERCARD) ) (* ;; "jrc. 12-30-88. This patch changes NCBROWSERCARD FNS so that the association of link types to dashing patterns is the same for all browsers in a given notefile. A master list of linktype/dashing patterns is stored on a Hash Card in the notefile. Just for the hell of it, eight new dashing patterns have been added to NC.DashingStyles. Functions are also included to copy the master list of linktype/dashing patterns to other notefiles (available from the NoteFile Icon Middle Button Menu), and to edit/reassociate linktypes to dashing patterns (also available from the NoteFile Icon Middle Button Menu)." ) (* ;; "Note: old notefiles should be closed before loading this patch. The first browser brought up in a notefile created before this patch is loaded (and opened after this patch is loaded) will set the linktype/dashing pattern association for the notefile. In order for other browsers in the notefile to be consistent with the notefile's dashing patterns, do a Reconnect nodes from the middle button menu of each of the other browsers, or try (NC.ConnectNodesInBrowser WindowDisplayingBrowser)." ) (* ;; "new functions for NCBrowsercard for setting up and accessing the linktype/dashing master list. You could use NC.FetchLinkTypeDashingPattern NC.GenerateDashingPatternList NC.GetHashDashCard programmatically." ) (DEFINEQ (NC.AssignLinkTypeToDashingPattern [LAMBDA (LinkType HashDashCard) (* ; "Edited 6-Dec-88 14:36 by jrc") (* ;; "Assign a dashing pattern to a linktype. We know that there has been no such assignment so far (this routine is only called from NC.FetchLinkTypeDashingPattern. The HashArray is the substance of the HashDashCard. With one exception, the hash keys are linktypes and the hash vals are dashing patterns. The exception is the special key '***Dashing***Pattern***List***, whose value is an assoc list, each item of which has the form (dashing-pattern list-of-linktypes-associated-with-that-dashing-pattern). NC.AssignLinkTypeToDashingPattern assigns the least used dashing pattern to the linktype and updates the DashingPatternList.") (LET* ((HashArray (NCP.CardSubstance HashDashCard)) (DashPatternList (NC.GenerateDashingPatternList HashDashCard)) (DashAssocItem NIL) (DashAssocLength 9999)) (for eachpair linktypecount in DashPatternList do (if (ZEROP (SETQ linktypecount (CADR eachpair))) then (RETURN (SETQ DashAssocItem eachpair)) elseif (LESSP linktypecount DashAssocLength) then (SETQ DashAssocLength linktypecount) (SETQ DashAssocItem eachpair))) [RPLACD DashAssocItem (LIST (ADD1 (CADR DashAssocItem] (* ;; "HashArrays don't accept NIL as a value for a dashing pattern, so do something special") (PUTHASH LinkType (OR (CAR DashAssocItem) 'DefaultDashingPattern) HashArray) (NCP.MarkCardDirty HashDashCard) (CAR DashAssocItem]) (NC.FetchLinkTypeDashingPattern [LAMBDA (LinkType CardOrWindow FetchOnlyFlg) (* ; "Edited 6-Dec-88 13:32 by jrc") (* ;; "The %"Hash Dash Card%" is a hash card stored in the notefile's registry. If it doesn't exist, create it. If it is uncached, cache it. The hash keys are linktypes, the hash value is the dashing pattern associated with the linktype. If the hash returns NIL, then call a function to assign a dashing pattern to the linktype for the notefile.") (* ;; "(OR (NCP.WNF CardOrWindow) (NCP.WNF Card)) is a kludge, necessary when this fn is called from NC.BringUpBrowserCard, because CardOrWindow is a window that hasn't yet been associated with its Card. Luckily, Card, at this point, has been defined on the stack.") (LET* ((NoteFile (OR (AND (WINDOWP CardOrWindow) (NCP.WNF CardOrWindow)) (NCP.CardNoteFile (NCP.CoerceToCard CardOrWindow)) (NCP.CardNoteFile Card))) (HashDashCard (NC.GetHashDashCard NoteFile)) HashArray Labels Dash) (SETQ HashArray (NCP.CardSubstance HashDashCard)) (* ;; "Coerce reverse linktype to forward linktype") [if (EQUAL '← (NTHCHAR LinkType 1)) then (SETQ LinkType (MKATOM (SUBSTRING LinkType 2] [if (SETQ Dash (GETHASH LinkType HashArray)) then (if (EQUAL Dash 'DefaultDashingPattern) then (* PUTHASH won't support a NIL value so the NIL dashing type is stored as (QUOTE DefaultDashingPattern)) (SETQ Dash NIL)) else (SETQ Dash (if FetchOnlyFlg then (* ; "Don't assign") (LIST 0) else (NC.AssignLinkTypeToDashingPattern LinkType HashDashCard] Dash]) (NC.GenerateDashingPatternList [LAMBDA (HashDashCard) (* ; "Edited 7-Dec-88 09:14 by jrc") (* ;; "generates a list of dashing pattern/number of linktypes that use that dashing pattern and stores it on the CardUserDataProp of the HashDashCard") (OR (NCP.CardUserDataProp HashDashCard 'DashingPatternList) (LET ((DashPatternList (for eachdash in (OR (NCP.CardProp HashDashCard 'DashingStyles) (PROGN (NCP.CardProp HashDashCard 'DashingStyles NC.DashingStyles) NC.DashingStyles)) collect (LIST eachdash 0))) (HashArray (NCP.CardSubstance HashDashCard))) (* ;; "But if a pattern isn't in NC.DashingStyles, but is in the HashArray, add it to the end of DashPatternList.") [MAPHASH HashArray (FUNCTION (LAMBDA (VAL KEY) (if [NOT (for eachitem in DashPatternList do (if [OR (EQUAL VAL (CAR eachitem)) (AND (NULL (CAR eachitem)) (EQUAL VAL 'DefaultDashingPattern] then (RETURN (RPLACD eachitem (LIST (ADD1 (CADR eachitem] then (NCONC DashPatternList (LIST (LIST VAL 1] (NCP.CardUserDataProp HashDashCard 'DashingPatternList DashPatternList) DashPatternList]) (NC.GetHashDashCard [LAMBDA (NoteFile) (* ; "Edited 6-Dec-88 13:29 by jrc") (LET* ((HDCName 'HashDashCard) (HashDashCard (NCP.LookupCardByName HDCName NoteFile)) HashArray) (if (NOT (NCP.ValidCardP HashDashCard)) then (SETQ HashDashCard (NCP.CreateCard 'Hash NoteFile HDCName T)) (NCP.MarkAsNotNeedingFiling HashDashCard) (* SETQ HashArray (NCP.CardSubstance HashDashCard)) (* why not this work? HARRAYPROP HashArray (QUOTE SIZE) 64) (NCP.RegisterCardByName HDCName HashDashCard NIL) else (if (NOT (NCP.CardCachedP HashDashCard)) then (NCP.CacheCards HashDashCard))) HashDashCard]) ) (* ;; "new functions for NCBROWSERCARD for copying link legends between notefiles.") (DEFINEQ (NC.CopyLinkTypeDashingPatternToNF [LAMBDA (NF1) (* ; "Edited 7-Dec-88 11:45 by jrc") (* ;; "get first NF -- if no Hash Dash Card, then bomb out.") (* ;; "get 2nd NF (bomb out if 1st NF equals 2nd NF)") (* ;; "Copy Hash Dash Card to 2nd NF. Register it too.") (PROG ((Window (NCP.NoteFileIconWindow NF1)) (HDCName 'HashDashCard) NF2 HashCard1 HashCard2 HashArray1 HashArray2) (if (NOT (NCP.OpenNoteFileP NF1)) then (NCP.PrintMsg Window T "Sorry, " (NCP.FileNameFromNoteFile NF1) " is not open.") (NCP.ClearMsg Window T 3000) (RETURN NIL)) (SETQ HashCard1 (NCP.LookupCardByName HDCName NF1)) (if (NOT (NCP.ValidCardP HashCard1)) then (NCP.PrintMsg Window T "Sorry, there is no Link Legend in " ( NCP.FileNameFromNoteFile NF1) " to copy.") (NCP.ClearMsg Window T 3000) (RETURN NIL)) (if [NOT (SETQ NF2 (NCP.SelectNoteFile NIL "Copy Links Legend To:" Window (LIST NF1] then (RETURN NIL)) (SETQ HashArray1 (NCP.CardSubstance HashCard1)) (SETQ HashCard2 (NC.GetHashDashCard NF2)) (SETQ HashArray2 (NCP.CardSubstance HashCard2)) (NCP.CardUserDataProp HashCard2 'DashingPatternList NIL) (* ;; "preserve any newly created dashing styles.") [NCP.CardProp HashCard2 'DashingStyles (UNION (NCP.CardProp HashCard2 'DashingStyles) (NCP.CardProp HashCard1 'DashingStyles] (* ;; "overwrite common assignments, but preserve assignments unique to NF2") [MAPHASH HashArray1 (FUNCTION (LAMBDA (VAL KEY) (PUTHASH KEY VAL HashArray2] (NCP.MarkCardDirty HashCard2]) (NC.AddCopyLinkTypeDashingPatternToNFIcon [LAMBDA NIL (* ; "Edited 5-Dec-88 12:35 by jrc") (NCP.AddDefaultNoteFileIconMiddleButtonSubitem '(|Link Type Ops| NILL "Link type operations for this notefile" (SUBITEMS (|Copy Link Legend| NC.CopyLinkTypeDashingPatternToNF "Copy the Browser line dashing patterns for all linktypes from this notefile to another notefile." ))) '(|Copy Link Legend| NC.CopyLinkTypeDashingPatternToNF "Copy the Browser line dashing patterns for all linktypes from this notefile to another notefile." ]) ) (* ;; "this is a new function by DSJ that needs to be included somewhere if it's not yet part of NoteCards, It now sits in NCNEWPROGINT destined for NCPROGINT, if it's not already there." ) (DEFINEQ (NCP.SelectNoteFile [LAMBDA (FullNameFlg MenuTitle InterestedWindow NotTheseNoteFiles) (* DSJ%: " 6-Nov-87 00:56") (* * |9/20/87.| dsj. Asks user to select a notefile from those open. Give short name unless FullNameFlg %. (This should be an NCP fn)) (* * |11/5/87.| dsj. This should be replaced with a call to NC.NoticedNoteFileNamesMenu) (SETQ NotTheseNoteFiles (MKLIST NotTheseNoteFiles)) (PROG [(Items (for X in (NCP.ListOfOpenNoteFiles) collect (LIST (if FullNameFlg then ( NCP.FileNameFromNoteFile X) else (NCP.NoteFileName X)) X) unless (MEMBER X NotTheseNoteFiles ] (RETURN (if Items then (MENU (create MENU ITEMS ← Items CENTERFLG ← T MENUFONT ← (FONTCREATE '(HELVETICA 12 BOLD)) MENUBORDERSIZE ← 1 TITLE ← (OR MenuTitle " Which notefile? ") ITEMHEIGHT ← 17)) else (NOT (NCP.PrintMsg InterestedWindow T "No currently open notefiles!"]) ) (* ;; "This is a new, proposed NCPROGINT function for adding a Subitem to the NoteFile Icon Middle Button Menu." ) (DEFINEQ (NCP.AddDefaultNoteFileIconMiddleButtonSubitem [LAMBDA (MainItem SubItem) (* ; "Edited 5-Dec-88 12:34 by jrc") (LET ([MenuItem (for eachitem in NC.DefaultNoteFileIconMiddleButtonItems do (if (EQUAL (CAR eachitem) (CAR MainItem)) then (RETURN eachitem] (SubItems)) (if (NOT MenuItem) then (NCONC NC.DefaultNoteFileIconMiddleButtonItems (LIST MainItem)) (SETQ MenuItem MainItem)) (if [SETQ SubItems (for eachitem in MenuItem do (if (EQUAL (CAR eachitem) 'SUBITEMS) then (RETURN eachitem] then (if [NOT (for eachitem in SubItems do (if (EQUAL (CAR eachitem) (CAR SubItem)) then (RETURN eachitem] then (NCONC SubItems (LIST SubItem)) (* ; "ELSE it's already there")) else (NCONC MenuItem `((SUBITEMS ,SubItem]) ) (* ;; "this 'P' adds the %"Copy Links Legend%" option to all NoteFile Icon Middle Button Menus.") (NC.AddCopyLinkTypeDashingPatternToNFIcon) (* ;; "new functions for NCBROWSERCARD for editing link legends in a NoteFile.") (DEFINEQ (NC.AddEditLinkTypeDashingPatternToNFIcon [LAMBDA NIL (* ; "Edited 5-Dec-88 12:35 by jrc") (NCP.AddDefaultNoteFileIconMiddleButtonSubitem '(|Link Type Ops| NILL "Link type operations for this notefile") '(|Edit Link Legend| NC.EditLinkTypeDashingPattern "Edit the Browser line dashing pattern for a selected linktype in this notefile."]) (NC.EditLinkTypeDashingPattern [LAMBDA (NoteFile) (* ; "Edited 6-Dec-88 18:58 by jrc") (DECLARE (GLOBALVARS NC.LinkDashingInBrowser)) (PROG ((NFWindow (NCP.NoteFileIconWindow NoteFile)) (LTSelection NIL) (LDSelection NIL) Labels Menu OldWhenSelectedFn HashDashCard) (if (NOT (NCP.OpenNoteFileP NoteFile)) then (NCP.PrintMsg Window T "Sorry, " (NCP.FileNameFromNoteFile NoteFile) " is not open.") (NCP.ClearMsg Window T 3000) (RETURN NIL)) (if (NOT NC.LinkDashingInBrowser) then (NCP.PrintMsg NFWindow T "There is no link dashing in browsers. This is a NoteCards parameter that you can set." ) (NCP.ClearMsg Window T 3000) (RETURN NIL)) (NCP.PrintMsg NFWindow T "just a sec ....") (SETQ Labels (NCP.UserLinkTypes NoteFile)) [SETQ MenuWin (WFROMMENU (SETQ Menu (NC.MakeLinksLegendMenu NFWindow Labels T] (SETQ OldWhenSelectedFn (fetch (MENU WHENSELECTEDFN) of Menu)) (replace (MENU WHENSELECTEDFN) of Menu with (FUNCTION NC.GrabLinksLegendSelection)) (CL:UNWIND-PROTECT [PROG ((Region (WINDOWPROP MenuWin 'REGION)) LDMenu MsgWindow) (NCP.PrintMsg NFWindow T "Select the linktype whose dashing pattern you'd like to change.") (if [NOT (do (BLOCK) (if (SETQ LTSelection (GETMENUPROP Menu 'Selection)) then (RETURN LTSelection)) (GETMOUSESTATE) (if (AND (LASTMOUSESTATE (OR LEFT MIDDLE)) (NOT (INSIDEP Region LASTMOUSEX LASTMOUSEY))) then (RETURN NIL] then (RETURN NIL)) (NCP.PrintMsg NFWindow T "just a sec ....") (SETQ HashDashCard (NC.GetHashDashCard NoteFile)) (SETQ DashPatternList (NC.GenerateDashingPatternList HashDashCard)) (SETQ LDMenu (create MENU TITLE ← " Dashing Patterns " CENTERFLG ← T ITEMS ← (NCONC1 (NC.MakeLinkDashingBitmaps DashPatternList (FONTPROP MENUFONT 'HEIGHT) 90) " * Other * "))) (SETQ MsgWindow (NCP.PrintMsg NFWindow T "Select the dashing pattern you'd like to associate with " LTSelection ".")) (if [NOT (SETQ LDSelection (MENU LDMenu (create POSITION XCOORD ← (fetch (REGION RIGHT) of (WINDOWPROP MenuWin 'REGION)) YCOORD ← (fetch (REGION BOTTOM) of (WINDOWPROP MenuWin 'REGION] then (RETURN NIL)) (if (LISTP LDSelection) then (NC.ReassignLinkTypeToDashingPattern LTSelection (CAR LDSelection) HashDashCard) else (* ; "got *Other*") (if [SETQ LDSelection (APPLY (FUNCTION NC.MakeNewDashingPattern) (CONS MsgWindow (CONS MenuWin ( NC.GetLineDashingLocationFromMenu LTSelection Menu] then (NC.ReassignLinkTypeToDashingPattern LTSelection LDSelection HashDashCard] (NCP.ClearMsg Window T) (CLOSEW MenuWin))]) (NC.GrabLinksLegendSelection [LAMBDA (Item Menu Button) (* ; "Edited 6-Dec-88 11:42 by jrc") (PUTMENUPROP Menu 'Selection Item]) (NC.MakeLinkDashingBitmaps [LAMBDA (DashingPatternList Height Width BitsPerPel) (* ; "Edited 6-Dec-88 14:08 by jrc") (* ;; "DashingPatternList is a list of pairs, the first item in each pair is the dashing pattern.") (for eachitem bm (halfheight ← (RSH Height 1)) (Widthminus ← (IDIFFERENCE Width 2)) in DashingPatternList collect (SETQ bm (BITMAPCREATE Width Height BitsPerPel)) (DRAWLINE 2 halfheight Widthminus halfheight 1 'REPLACE (DSPCREATE bm) NIL (CAR eachitem)) (LIST bm (LIST 'QUOTE eachitem]) (NC.ReassignLinkTypeToDashingPattern [LAMBDA (Linktype DashPattern HashDashCard) (* ; "Edited 6-Dec-88 18:57 by jrc") (LET ((HashArray (NCP.CardSubstance HashDashCard)) (DashPatternList (NC.GenerateDashingPatternList HashDashCard)) OldDashPattern) [if (SETQ OldDashPattern (GETHASH Linktype HashArray)) then (for eachitem in DashPatternList do (if [OR (EQUAL (CAR eachitem) OldDashPattern) (AND (NOT (CAR eachitem)) (EQUAL OldDashPattern 'DefaultDashingPattern] then [RPLACD eachitem (LIST (MAX 0 (SUB1 (CADR eachitem] (RETURN NIL] (PUTHASH Linktype (OR DashPattern 'DefaultDashingPattern) HashArray) (NCP.MarkCardDirty HashDashCard) (if [NOT (for eachitem in DashPatternList do (if (EQUAL DashPattern (CAR eachitem)) then [RPLACD eachitem (LIST (ADD1 (CADR eachitem] (RETURN T] then (NCONC DashPatternList (LIST (LIST DashPattern 1]) (NC.MakeNewDashingPattern [LAMBDA (MsgWindow DrawInWindow X1 Y1 X2 Y2) (* ; "Edited 7-Dec-88 09:27 by jrc") (LET ((Pattern (TTYINEDIT NIL MsgWindow NIL "Type in a dashing pattern (list of numbers): ")) TempPattern) (if Pattern then (do (SETQ Pattern (for eachnum in Pattern collect (if (FIXP eachnum) then eachnum else 0))) (DRAWLINE X1 Y1 X2 Y2 1 'REPLACE DrawInWindow) (DRAWLINE X1 Y1 X2 Y2 1 'INVERT DrawInWindow) (DRAWLINE X1 Y1 X2 Y2 1 'REPLACE DrawInWindow NIL Pattern) (SETQ TempPattern (TTYINEDIT Pattern MsgWindow NIL "Return to accept; Clear input to cancel; or Edit: ")) (if (EQUAL TempPattern Pattern) then (RETURN Pattern) elseif (NOT TempPattern) then (RETURN NIL)) (SETQ Pattern TempPattern]) (NC.GetLineDashingLocationFromMenu [LAMBDA (Item Menu) (* ; "Edited 6-Dec-88 16:01 by jrc") (LET ((ItemRegion (MENUITEMREGION Item Menu)) (DashingOffset (GETMENUPROP Menu 'DashingOffset)) X Y) (CREATEREGION (SETQ X (IDIFFERENCE (IPLUS (fetch (REGION WIDTH) of ItemRegion) (fetch (REGION LEFT) of ItemRegion)) (IPLUS DashingOffset 4))) (SETQ Y (IPLUS (QUOTIENT (fetch (REGION HEIGHT) of ItemRegion) 2) (fetch (REGION BOTTOM) of ItemRegion))) (IPLUS X DashingOffset) Y]) ) (* ;; "this 'P' adds the %"Edit Links Legend%" option to all NoteFile Icon Middle Button Menus.") (NC.AddEditLinkTypeDashingPatternToNFIcon) (* ;; "replace these fns in NCBROWSERCARD") (DEFINEQ (NC.LinksLegendRepaintFn [LAMBDA (Win Region) (* ; "Edited 5-Dec-88 18:23 by jrc") (* * Repaint the right-hand column dashing in the browser's links legend menu.) (* * rht 7/15/85%: Added bail out for case of screwy 1.1 files.) (* ;; "jrc 1/dec/88: labelpairs is a list of label/dashingpattern pairs; the menu is now single column only, with ITEMWIDTH padded so there is room for the dashing pattern") (PROG ([Menu (CAR (WINDOWPROP Win 'MENU] (Labelpairs (WINDOWPROP (MAINWINDOW Win) 'NCLABELPAIRS)) DashingOffset Items) (SETQ DashingOffset (GETMENUPROP Menu 'DashingOffset)) (SETQ Items (fetch (MENU ITEMS) of Menu)) (* This little bail out is for case of 1.1 files where label pairs are screwed up and so are menu items.) (if (NULL (CAR Items)) then (RETURN NIL)) (for Item in Items as Labelpair in Labelpairs bind ItemRegion X Y do (SETQ ItemRegion (MENUITEMREGION Item Menu)) (if (NOT (ZEROP (CAADR Labelpair))) then (DRAWLINE (SETQ X (IDIFFERENCE (IPLUS (fetch (REGION WIDTH) of ItemRegion) (fetch (REGION LEFT) of ItemRegion)) (IPLUS DashingOffset 4))) (SETQ Y (IPLUS (QUOTIENT (fetch (REGION HEIGHT) of ItemRegion) 2) (fetch (REGION BOTTOM) of ItemRegion))) (IPLUS X DashingOffset) Y 1 NIL Win NIL (CADR Labelpair]) (NC.MakeLinksLegendMenu [LAMBDA (Win Labels FetchOnlyFlg) (* ; "Edited 30-Dec-88 15:16 by jrc") (* ;; "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.") (* ;; "rht 1/15/86: Added windowprops MINSIZE and MAXSIZE to fix the bug where reshaping browser screws up links legend menu.") (* ;; "rht 3/7/86: Now closes prompt window before attaching menu. Uses ATTACHMENU to attach the menu.") (* ;; "rht 4/5/86: Took out call to NC.MoveWindowOntoScreen. For big browsers it causes redraw of window which is too high a price to pay.") (* ;; "rht 3/20/87: Changed so that ATTACHMENU call is inside of NC.WithWindowsUnattached macro. Also took out closing of prompt window, as it's no longer necessary.") (* ;; "rht 1/16/88: Now does nothing if card has non-nil OmitLinksLegendFlg user data prop.") (* ;; "pmi 8/18/88: No longer puts up a link legend if the browser does not have any links.") (* ;; "jrc 1/dec/88: LabelPairs is now just a list of Labels; the dashing info now comes from the notefile's master dashing list.") (* ;; " jrc 4/dec/88: If the labels are pairwise (from notefiles created before dashing consistency enforement), use only the the label part of the pair.") (* ;; "jrc 5/dec/88: FetchOnlyFlg -- Normally, NC.FetchLinkTypeDashingPattern assigns a dashingpattern to a link type, if one is not found. FetchOnlyFlg = T prevents NC.FetchLinkTypeDashingPattern from assigning a pattern.") (* ;; "jrc 30/dec/88: LinksLegendMenu doesn't reshape correctly when the browser is reshaped because the calculation of the size the reshaped window should be (RESHAPEALLWINDOWS) comes from MENUWMINSIZEFN which seeks out the longest label, ignoring the ITEMWIDTH MENU field. So use a NC.LinksLegendMenuWMinSizeFn that takes the DashingOffset into account.") (DECLARE (GLOBALVARS NC.LinkDashingInBrowser)) (PROG ((Card (NCP.WhichCard Win)) (ItemWidth 0) (DashingOffset 110) Menu MenuWin PromptWin MainWinPromptInfo PromptWinPASSTOMAINCOMS) (if (AND Card (NCP.CardUserDataProp Card 'OmitLinksLegendFlg)) then (RETURN NIL)) (for AttachedWin in (ATTACHEDWINDOWS Win) when (WINDOWPROP AttachedWin 'LINKSLEGENDWINP) do (REMOVEWINDOW AttachedWin)) (if Labels then [if (LISTP (CAR Labels)) then (SETQ Labels (for eachl in Labels collect (CAR eachl] (for eachl width in Labels do (if (GREATERP (SETQ width (STRINGWIDTH eachl MENUFONT)) ItemWidth) then (SETQ ItemWidth width))) (* for Label in Labels join (LIST Label (LIST (QUOTE " ")))) [SETQ Menu (COND (NC.LinkDashingInBrowser (create MENU ITEMS ← Labels TITLE ← 'Links MENUCOLUMNS ← 1 ITEMWIDTH ← (IPLUS ItemWidth DashingOffset))) (T (create MENU ITEMS ← Labels TITLE ← 'Links MENUCOLUMNS ← 1] (* ; "Stick the links legend window at upper right corner.") (PUTMENUPROP Menu 'DashingOffset (IDIFFERENCE DashingOffset 20)) [NC.WithTopWindowsUnattached Win (SETQ MenuWin (ATTACHMENU Menu Win 'RIGHT 'TOP] (* ; "Rig so that close of menu won't close browser.") (WINDOWDELPROP MenuWin 'PASSTOMAINCOMS 'CLOSEW) (WINDOWADDPROP MenuWin 'CLOSEFN [FUNCTION (LAMBDA (W) (DETACHWINDOW W] T) (WINDOWADDPROP MenuWin 'REPAINTFN 'NC.LinksLegendRepaintFn) (WINDOWADDPROP MenuWin 'RESHAPEFN 'NC.LinksLegendReshapeFn) (WINDOWADDPROP MenuWin 'LINKSLEGENDWINP T) [WINDOWPROP Win 'NCLABELPAIRS (for eachl in Labels collect (LIST eachl ( NC.FetchLinkTypeDashingPattern eachl Win FetchOnlyFlg] (if NC.LinkDashingInBrowser then (NC.LinksLegendRepaintFn MenuWin NIL)) (WINDOWPROP MenuWin 'MINSIZE (FUNCTION NC.LinksLegendMenuWMinSizeFn)) (WINDOWPROP MenuWin 'MAXSIZE (FUNCTION NC.LinksLegendMenuWMinSizeFn)) (RETURN Menu]) (NC.MakeLinksLegend [LAMBDA (Graph Win DropVirtualNodesFlg) (* ; "Edited 14-Dec-88 09:41 by Gobbel") (* * For every node in the lattice, there should be properties off of its NODEID for each node it's connected to. The values of these props are lists of linklabels. Change these values to also contain the dashing number by assigning a unique dashing number to each new label we come across. If the global var NC.LinkDashingInBrowser is non-nil, then put out a menu serving as a legend mapping link label names to dashing styles. If not, then the menu just contains names of link labels.) (* * rht 3/9/85%: Modified to use Danny's grapher improvements. Now changes destination nodes to be in the new list format.) (* * rht 11/17/85%: updated to handle new card and notefile formats.) (* ;; "jrc 1/dec/88: Dashing is now determined by a masterlist on the notefile (link dashing is now consistent between browsers), so all this pairing of link labels with dashing numbers is unnecessary.") (PROG (ReferencedNodes NumAppearances OldNumAppearances UnderlyingNodeID LabelsUsed) (* ;; "unmark all nodes first ") [for Node in (fetch (GRAPH GRAPHNODES) of Graph) bind NodeID (LabelNum ← 0) eachtime (BLOCK) do (if DropVirtualNodesFlg then (* Throw away the border indicating a virtual node.) (replace (GRAPHNODE NODEBORDER) of Node with NIL)) (SETQ NodeID (fetch (GRAPHNODE NODEID) of Node)) (NC.GraphNodeIDPutProp (SETQ UnderlyingNodeID (OR (NC.CoerceToGraphNodeID Node) NodeID)) 'NumAppearances (if (SETQ OldNumAppearances (NC.GraphNodeIDGetProp UnderlyingNodeID ' NumAppearances)) then (ADD1 OldNumAppearances) else 1)) (if (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of Node)) then (replace (GRAPHNODE TONODES) of Node with (for DestNode in (fetch (GRAPHNODE TONODES) of Node) eachtime (BLOCK) bind NewLabels Labels DestNodeID NewDestNode NotLabelNodeFlg join (* If already computed a LinkParams list, then rip out the ID.) (if (EQ (CAR DestNode) LINKPARAMS) then (SETQ DestNode (CADR DestNode))) (* Check for virtual nodes.) (SETQ DestNodeID (if (LISTP DestNode) then (CAR DestNode) else DestNode)) (SETQ NewDestNode (if DropVirtualNodesFlg then DestNodeID else DestNode)) (SETQ NotLabelNodeFlg (NC.CardFromBrowserNodeID DestNodeID)) [SETQ NewLabels (if [AND NotLabelNodeFlg (NOT (OR (FMEMB NodeID (NC.GraphNodeIDGetProp DestNodeID 'DashingVisited)) (FMEMB DestNodeID (NC.GraphNodeIDGetProp NodeID 'DashingVisited] then (* Okay to continue since we haven't visited this pair already.) (APPEND (if (SETQ Labels (NC.GraphNodeIDGetProp NodeID DestNodeID)) then [NC.GraphNodeIDPutProp NodeID 'DashingVisited (CONS DestNodeID (NC.GraphNodeIDGetProp NodeID 'DashingVisited] [for eachl in Labels do (if (NOT (FMEMB eachl LabelsUsed)) then (SETQ LabelsUsed (CONS eachl LabelsUsed] Labels) (if (SETQ Labels (NC.GraphNodeIDGetProp DestNodeID NodeID)) then [NC.GraphNodeIDPutProp DestNodeID 'DashingVisited (CONS NodeID (NC.GraphNodeIDGetProp DestNodeID 'DashingVisited] [for eachl in Labels do (if (NOT (FMEMB eachl LabelsUsed)) then (SETQ LabelsUsed (CONS eachl LabelsUsed] Labels] (* Likewise for backward labels.) (if NewLabels then (* Stick this dest node on the referenced list since we know a node points to it.) (if (NOT (FMEMB NewDestNode ReferencedNodes)) then (push ReferencedNodes NewDestNode)) [LIST (COND ((CDR NewLabels) (* There are multiple links joining these two nodes so record nodeids in param list so we can draw flower of links.) (LIST LINKPARAMS NewDestNode 'DRAWLINKFN (FUNCTION NC.BrowserDrawLinkFn) 'NODEID NodeID 'DESTNODEID DestNodeID)) (T (* Only one link, so compute dashing style here.) (* Check whether link is forward or backward and throw in backward flag if appropriate.) (if (NC.GraphNodeIDGetProp NodeID DestNodeID) then (LIST LINKPARAMS NewDestNode 'DRAWLINKFN (FUNCTION NC.BrowserDrawLinkFn) 'DASHING (NC.FetchLinkTypeDashingPattern (CAR NewLabels) Win)) else (LIST LINKPARAMS NewDestNode 'DRAWLINKFN (FUNCTION NC.BrowserDrawLinkFn) 'DASHING (NC.FetchLinkTypeDashingPattern (CAR NewLabels ) Win) 'BACKWARDFLG T] else (* Stick this dest node on the referenced list since we know a node points to it.) (if (NOT (FMEMB DestNodeID ReferencedNodes)) then (push ReferencedNodes DestNodeID)) (if (NOT NotLabelNodeFlg) then (LIST DestNodeID) else NIL] (* * Note that the following loop gains time at the expense of space. The space-efficient version would only generate cons nodes for nodes to be deleted, but would require in general, several walks through the structure.) (* Delete all nodes except the ones that either point to something or are pointed to. But keep those unreferenced nodes that appear exactly once in the graph. They'll wind up being roots.) (replace (GRAPH GRAPHNODES) of Graph with (for Node in (fetch (GRAPH GRAPHNODES) of Graph) eachtime (BLOCK) when (LET* [(UnderlyingNodeID (OR (NC.CoerceToGraphNodeID Node) (fetch (GRAPHNODE NODEID) of Node))) (NumAppearances (NC.GraphNodeIDGetProp UnderlyingNodeID ' NumAppearances] (if (OR (fetch (GRAPHNODE TONODES) of Node) (FMEMB (fetch (GRAPHNODE NODEID) of Node) ReferencedNodes) (EQ NumAppearances 1)) else (* This node is getting deleted.) (NC.GraphNodeIDPutProp UnderlyingNodeID 'NumAppearances (SUB1 NumAppearances)) NIL)) collect Node)) (* Get rid of node borders for virtual nodes that now only appear once in the graph. Also clean off prop list.) [for Node in (fetch (GRAPH GRAPHNODES) of Graph) do (LET [(UnderlyingNodeID (OR (NC.CoerceToGraphNodeID Node) (fetch (GRAPHNODE NODEID) of Node] (if (EQ 1 (NC.GraphNodeIDGetProp UnderlyingNodeID 'NumAppearances)) then (replace (GRAPHNODE NODEBORDER) of Node with NIL)) (NC.GraphNodeIDRemProp UnderlyingNodeID 'NumAppearances] (AND Win (NC.MakeLinksLegendMenu Win LabelsUsed)) (RETURN LabelsUsed]) (NC.BrowserAddLink [LAMBDA (FromNode ToNode Win Graph GlobalLinkFlg LinkType) (* ; "Edited 4-Dec-88 12:32 by jrc") (* ;; "Like grapher's ADD/AND/DISPLAY/LINK except has different checks and builds a real NC Link.") (* ;; "rht 9/20/85: Added GlobalLinkFlg arg to force the link created to be global. Currently, it's global anyway if from node is a sketch card, for example.") (* ;; "rht 11/17/85: updated for new card and notefile object format.") (* ;; "rht 2/7/86: Now sets and gets browser link labels, etc. via fetch/set fns.") (* ;; "rht 1/14/88: Now takes extra LinkType argument and passes to NC.BrowserCreateLink.") (* ;; "jrc 8/sep/88: returns link, if one is created. ") (PROG (Link Card Labels ToNodeID FromNodeID OldDestNode LinkParams ReverseLinkParams SavedDeleteLinkFn NumberOfLinks Dashing) (COND ([NOT (AND (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of FromNode)) (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of ToNode] (NC.PrintMsg NIL T "Can't create link from or to a label node. Try 'Add Edge' instead.") (FLASHW PROMPTWINDOW) (RETURN NIL)) ((SETQ Link (NC.BrowserCreateLink FromNode ToNode Graph Win GlobalLinkFlg LinkType)) (* ; "We successfully created a link. Now undraw existing link and redraw with new one added.") (* ; "First, check whether label for new link is already in graph.") (SETQ Card (NC.CoerceToCard Win)) (SETQ Labels (NC.FetchBrowserLinksLegend Card)) (SETQ LinkType (fetch (Link Label) of Link)) (* ;; "If link label hasn't appeared in the graph, update links legend.") (if (NOT (FMEMB LinkType Labels)) then (SETQ Labels (APPEND Labels (LIST LinkType))) (NC.SetBrowserLinksLegend Card Labels) (NC.MakeLinksLegendMenu Win Labels)) (SETQ Dashing (NC.FetchLinkTypeDashingPattern LinkType Win)) (SETQ FromNodeID (NC.CoerceToGraphNodeID FromNode)) (SETQ ToNodeID (NC.CoerceToGraphNodeID ToNode)) [SETQ NumberOfLinks (PLUS (LENGTH (NC.GraphNodeIDGetProp FromNodeID ToNodeID)) (LENGTH (NC.GraphNodeIDGetProp ToNodeID FromNodeID] (SETQ LinkParams (LINKPARAMETERS FromNode ToNode)) (SETQ ReverseLinkParams (LINKPARAMETERS ToNode FromNode)) [COND [(OR (ZEROP NumberOfLinks) (AND (NULL LinkParams) (NULL ReverseLinkParams))) (if (OR (FMEMB (fetch (GRAPHNODE NODEID) of FromNode) (fetch (GRAPHNODE TONODES) of ToNode)) (FMEMB (fetch (GRAPHNODE NODEID) of ToNode) (fetch (GRAPHNODE TONODES) of FromNode))) then (* ; "There are no links, but there is an edge. Delete it and redisplay.") (SETQ SavedDeleteLinkFn (fetch (GRAPH GRAPH.DELETELINKFN) of Graph)) (replace (GRAPH GRAPH.DELETELINKFN) of Graph with NIL) (DELETE/AND/DISPLAY/LINK FromNode ToNode Win Graph) (NC.PrintMsg NIL T "Replacing existing edge with new link edge.") (FLASHW PROMPTWINDOW)) (* ; "This is first link between these two nodes so compute dashing here.") (replace (GRAPHNODE TONODES) of FromNode with (CONS (LIST LINKPARAMS (fetch (GRAPHNODE NODEID) of ToNode) 'DRAWLINKFN (FUNCTION NC.BrowserDrawLinkFn) 'DASHING Dashing) (fetch (GRAPHNODE TONODES) of FromNode))) (replace (GRAPHNODE FROMNODES) of ToNode with (CONS (fetch (GRAPHNODE NODEID) of FromNode) (fetch (GRAPHNODE FROMNODES) of ToNode] [LinkParams (* ; "There are multiple links. And the link params is on the FromNode.") (DISPLAYLINK FromNode ToNode (CONSTANT (create POSITION XCOORD ← 0 YCOORD ← 0)) Win Graph 1 LinkParams) (* ; "If there was only one link, then change so multi-link indicator.") (if (EQP NumberOfLinks 1) then (RPLACD (CDR LinkParams) (LIST 'NODEID FromNodeID 'DESTNODEID ToNodeID] (T (* ; "There are multiple links. The Link params is on the ToNode.") (DISPLAYLINK ToNode FromNode (CONSTANT (create POSITION XCOORD ← 0 YCOORD ← 0)) Win Graph 1 ReverseLinkParams) (* ; "If there was only one link, then change so multi-link indicator.") (if (EQP NumberOfLinks 1) then (RPLACD (CDR ReverseLinkParams) (LIST 'NODEID ToNodeID 'DESTNODEID FromNodeID] (NC.UIDAddProp FromNodeID ToNodeID LinkType) [NC.GraphNodeIDPutProp FromNodeID 'DashingVisited (CONS ToNodeID (NC.GraphNodeIDGetProp FromNodeID 'DashingVisited] [COND (LinkParams (DISPLAYLINK FromNode ToNode (CONSTANT (create POSITION XCOORD ← 0 YCOORD ← 0)) Win Graph 1 LinkParams)) (ReverseLinkParams (DISPLAYLINK ToNode FromNode (CONSTANT (create POSITION XCOORD ← 0 YCOORD ← 0)) Win Graph 1 ReverseLinkParams)) (T (DISPLAYLINK FromNode ToNode (CONSTANT (create POSITION XCOORD ← 0 YCOORD ← 0)) Win Graph 1 (LINKPARAMETERS FromNode ToNode] (RETURN Link]) (NC.DrawFlowerLinks [LAMBDA (NodeID1 NodeID2 X1 Y1 X2 Y2 Width Operation Stream Color) (* ; "Edited 4-Dec-88 13:23 by jrc") (* * Expects to find a list of pairs on Node1's ID's proplist under the property with name Node2's ID (or vice versa) These are pairs of label and dashing number. For each one, draw a spline with one knot using given dashing number. The more we draw, the farther each gets from the center line. The very first is along the center line. Subsequent splines alternate on either side of the center line.) (* * rht 3/9/85%: Now draws first the forward links and then the backward links.) (* ;; "jrc. 5/dec/88: The pairs are now just a list of labels, since link dashing consistency is enforced from the notefile level.") (PROG ((Count -1) (Win (WFROMDS Stream))) (for Label in (NC.GraphNodeIDGetProp NodeID1 NodeID2) do (NC.DrawFlowerLink X1 Y1 X2 Y2 (LIST 'ROUND Width Color) (NC.FetchLinkTypeDashingPattern Label Win) (SETQ Count (ADD1 Count)) Stream Width Operation Color)) (for Label in (NC.GraphNodeIDGetProp NodeID2 NodeID1) do (NC.DrawFlowerLink X2 Y2 X1 Y1 (LIST 'ROUND Width Color) (NC.FetchLinkTypeDashingPattern Label Win) (SETQ Count (ADD1 Count)) Stream Width Operation Color]) ) (* ;; "add this fn to NCBROWSERCARD -- it's needed so that the Links Legend Menu reshapes properly:") (DEFINEQ (NC.LinksLegendMenuWMinSizeFn [LAMBDA (MENUW) (* ; "Edited 30-Dec-88 15:03 by jrc") (* returns the minimum size of a menu window.) (* jrc 30-dec-88 include the dashing offset for the links legend menus) (PROG ([MENU (CAR (WINDOWPROP MENUW 'MENU] TITLERELATEDVAR BORDERSIZE OUTLINESIZE MINWIDTH) (SETQ BORDERSIZE (ITIMES (fetch (MENU MENUBORDERSIZE) of MENU) 2)) (SETQ OUTLINESIZE (ITIMES (IPLUS (fetch (MENU MENUOUTLINESIZE) of MENU) (WINDOWPROP MENUW 'BORDER)) 2)) (SETQ MINWIDTH (if (GETMENUPROP MENU 'DashingOffset) then (* ; "20 is a fudge factor, see NC.MakeLinksLegendMenu") (IPLUS (GETMENUPROP MENU 'DashingOffset) 20) else 0)) (SETQ MINWIDTH (ITIMES (IPLUS (MAXMENUITEMWIDTH MENU) MINWIDTH BORDERSIZE 2) (fetch (MENU MENUCOLUMNS) of MENU))) (* The minimum width of the window takes into account the contents of the menu and its title) [COND ((SETQ TITLERELATEDVAR (fetch (MENU TITLE) of MENU)) (SETQ MINWIDTH (IMAX MINWIDTH (STRINGWIDTH TITLERELATEDVAR (SETQ TITLERELATEDVAR (MENUTITLEFONT MENU] (RETURN (CONS (IPLUS MINWIDTH OUTLINESIZE) (IPLUS OUTLINESIZE (ITIMES (fetch (MENU MENUROWS) of MENU) (IPLUS BORDERSIZE (MAXMENUITEMHEIGHT MENU))) (COND (TITLERELATEDVAR (FONTPROP TITLERELATEDVAR 'HEIGHT)) (T 0]) ) (* ;; "replace this VARS in NCBROWSERCARD") (RPAQQ NC.DashingStyles (NIL (4 4) (1 4) (4 10) (8 4) (14 4) (4 2 4 10) (4 2 4 2 4 10) (4 2 4 2 4 2 4 10) (10 4 2 4) (10 4 2 4 2 4) (10 4 2 4 2 4 2 4) (5 3 1 10) (1 3 5 3 1 10) (7 8 2 3) (1 3 1 7) (1 3 1 3 1 7))) (PUTPROPS JRCPATCH065 COPYRIGHT ("Xerox Corporation" 1988)) (DECLARE%: DONTCOPY (FILEMAP (NIL (5299 11676 (NC.AssignLinkTypeToDashingPattern 5309 . 7102) ( NC.FetchLinkTypeDashingPattern 7104 . 9103) (NC.GenerateDashingPatternList 9105 . 10684) ( NC.GetHashDashCard 10686 . 11674)) (11770 14904 (NC.CopyLinkTypeDashingPatternToNF 11780 . 13927) ( NC.AddCopyLinkTypeDashingPatternToNFIcon 13929 . 14902)) (15105 16970 (NCP.SelectNoteFile 15115 . 16968)) (17095 18409 (NCP.AddDefaultNoteFileIconMiddleButtonSubitem 17105 . 18407)) (18654 28280 ( NC.AddEditLinkTypeDashingPatternToNFIcon 18664 . 19162) (NC.EditLinkTypeDashingPattern 19164 . 24135) (NC.GrabLinksLegendSelection 24137 . 24316) (NC.MakeLinkDashingBitmaps 24318 . 24959) ( NC.ReassignLinkTypeToDashingPattern 24961 . 26259) (NC.MakeNewDashingPattern 26261 . 27483) ( NC.GetLineDashingLocationFromMenu 27485 . 28278)) (28488 57406 (NC.LinksLegendRepaintFn 28498 . 30389) (NC.MakeLinksLegendMenu 30391 . 36239) (NC.MakeLinksLegend 36241 . 47958) (NC.BrowserAddLink 47960 . 55781) (NC.DrawFlowerLinks 55783 . 57404)) (57517 59896 (NC.LinksLegendMenuWMinSizeFn 57527 . 59894))) )) STOP