(FILECREATED " 3-Jan-85 03:03:28" {PHYLUM}<NOTECARDS>RELEASE1.1>NCPROGINT.;10 73922 changes to: (VARS NCPROGINTCOMS) (FNS NCP.AddTitleBarMenuItems) previous date: "19-Dec-84 20:25:37" {PHYLUM}<NOTECARDS>RELEASE1.1>NCPROGINT.;9) (* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.) (PRETTYCOMPRINT NCPROGINTCOMS) (RPAQQ NCPROGINTCOMS ((* * Notefile creation and access) (FNS NCP.CreateNoteFile NCP.OpenNoteFile NCP.CloseNoteFile NCP.RepairNoteFile NCP.CompactNoteFile NCP.DeleteNoteFile NCP.FloppyRestoreNoteFile NCP.FloppyBackupNoteFile NCP.CurrentNoteFileStream NCP.CurrentNoteFile NCP.CheckInNoteFile NCP.CheckOutNoteFile NCP.LockFileName) (* * Creating and accessing NoteCard types and substances.) (FNS NCP.CardTypes NCP.SubstanceTypes NCP.CreateCardType NCP.CreateSubstanceType NCP.CardTypeSuper NCP.CardTypeSubstance NCP.CardTypeLinkDisplayMode NCP.CardTypeFn NCP.CardTypeInheritedFn NCP.SubstanceTypeFn NCP.ValidCardType NCP.ValidSubstanceType NCP.ValidCardTypeFn NCP.ValidSubstanceTypeFn NCP.CardTypeFns NCP.SubstanceTypeFns) (* * Creating Notecards and fileboxes) (FNS NCP.CreateCard NCP.CreateTextCard NCP.CreateFileBox NCP.CreateBrowserCard NCP.CreateSketchCard NCP.CreateGraphCard NCP.MakeDocument NCP.MakeLinkIndex) (* * Accessing cards and boxes) (FNS NCP.BringUpCard NCP.CardType NCP.ValidCard NCP.ActiveCardP NCP.ActivateCards NCP.DeactivateCards NCP.CardTitle NCP.FileCards NCP.UnfileCards NCP.CardParents NCP.FileBoxChildren NCP.GetLinks NCP.CardPropList NCP.CardProp NCP.CardAddProp NCP.CardDelProp NCP.CardSubstance NCP.CardRegion NCP.CardAddText NCP.ChangeLoc NCP.DeleteCards NCP.FileBoxP NCP.AllCards NCP.AllBoxes NCP.MapCards NCP.MapBoxes NCP.GetContentsFileBox NCP.GetOrphansFileBox NCP.GetToBeFiledFileBox) (* * Creating and accessing links) (FNS NCP.LocalGlobalLink NCP.GlobalGlobalLink NCP.GlobalLocalLink NCP.LocalLocalLink NCP.LinkDesc NCP.LinkDisplayMode NCP.LinkLabel NCP.GetLinkSource NCP.GetLinkDestination NCP.DeleteLinks NCP.ValidLink NCP.AllLinks NCP.MapLinks) (* * Creating and accessing link labels.) (FNS NCP.CreateLinkLabel NCP.DeleteLinkLabel NCP.RenameLinkLabel NCP.GetLinkLabels NCP.GetReverseLinkLabels NCP.GetUserLinkLabels NCP.ValidLinkLabel) (* * Miscellaneous) (FNS NCP.GetCardTypes NCP.TitleSearch NCP.PropSearch NCP.WhichCard NCP.CardFromWindow NCP.CardWindow NCP.SelectCards NCP.DocumentParameters NCP.NoteCardsParameters NCP.PrintMsg NCP.ClearMsg NCP.AskUser) (* * Handy internal functions) (FNS NCP.ReportError NCP.ReportWarning NCP.ValidID NCP.LinkAnchorDesc NCP.MaxIDNum NCP.GetTypeRecord NCP.GetSubstanceRecord NCP.AddTitleBarMenuItems) (* * Global variables.) (VARS (NCP.LinkDisplayModes (QUOTE (Icon Title Label Both))) (NCP.TypeFnsAssocLst (QUOTE ((MakeCardFn . NC.MakeCardFn) (EditCardFn . NC.EditFn) (QuitCardFn . NC.QuitCardFn) (GetCardFn . NC.GetSubstanceFn) (PutCardFn . NC.PutSubstanceFn) (CopyCardFn . NC.SubstanceCopyFn) (MarkCardDirtyFn . NC.MarkCardDirtyFn) (CardDirtyPFn . NC.SubstanceDirtyPFn) (CollectLinksInCardFn . NC.CollectReferencesFn) (DeleteLinksInCardFn . NC.DelReferencesFn) (UpdateLinkIconsInCardFn . NC.UpdateLinkIconsFn)))) (NCP.NoteCardTypeFnsFieldNames (QUOTE (MakeCardFn EditCardFn QuitCardFn GetCardFn PutCardFn CopyCardFn MarkCardDirtyFn CardDirtyPFn CollectLinksInCardFn DeleteLinksInCardFn UpdateLinkIconsInCardFn))) (NCP.SubstanceTypeFnsFieldNames (QUOTE (UpdateLinkIconsInSubstanceFn DeleteLinksInSubstanceFn CollectLinksInSubstanceFn SubstanceDirtyPFn MarkSubstanceDirtyFn CopySubstanceFn PutSubstanceFn GetSubstanceFn QuitSubstanceFn EditSubstanceFn CreateSubstanceFn)))) (GLOBALVARS NCP.LinkDisplayModes NCP.TypeFnsAssocLst NCP.SubstanceTypeFnsFieldNames NCP.NoteCardTypeFnsFieldNames) (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA NCP.ReportWarning NCP.ReportError NCP.PrintMsg NCP.PropSearch NCP.TitleSearch NCP.LinkLabel NCP.LinkDisplayMode NCP.CardProp NCP.CardTitle))))) (* * Notefile creation and access) (DEFINEQ (NCP.CreateNoteFile (LAMBDA (FileName) (* rht: "17-Oct-84 14:35") (* * Prog intface function for creating a notefile.) (PROG ((FileNameWithExt (NC.DatabaseFileName NIL NIL NIL NIL FileName))) (COND ((INFILEP FileNameWithExt) (NCP.ReportError "Filename " FileNameWithExt " already exists.") (RETURN NIL)) (T (NC.CreateDatabaseFile FileNameWithExt NIL NIL NIL) (RETURN FileNameWithExt)))))) (NCP.OpenNoteFile (LAMBDA (FileName Don'tCreateFlg Convertw/oConfirmFlg) (* rht: "30-Nov-84 17:22") (* * Prog's intface version of opening a notefile.) (PROG ((FileNameWithExt (NC.DatabaseFileName "Name of NoteFile to open:" " -- " T NIL FileName))) (AND FileNameWithExt (RETURN (NC.OpenDatabaseFile FileNameWithExt NIL NIL NIL Don'tCreateFlg Convertw/oConfirmFlg)))))) (NCP.CloseNoteFile (LAMBDA (NoteFileStream) (* rht: "18-Oct-84 11:39") (* * Prog's intface function for closing a notefile.) (if (AND NoteFileStream (NEQ (NCP.CurrentNoteFileStream) NoteFileStream)) then (NCP.ReportError "Argument Stream " NoteFileStream " is not the currently open stream.") NIL else (NC.CloseDatabaseFile)))) (NCP.RepairNoteFile (LAMBDA (FileName) (* rht: "18-Oct-84 11:42") (* * Prog's intface function for repairing a notefile.) (PROG ((FileNameWithExt (NC.DatabaseFileName "Name of NoteFile to repair: " " -- " T NIL FileName) )) (AND FileNameWithExt (RETURN (NC.ScavengeDatabaseFile FileNameWithExt)))))) (NCP.CompactNoteFile (LAMBDA (FileName) (* rht: "18-Oct-84 11:44") (* * Prog's intface function for compacting a notefile.) (PROG ((FileNameWithExt (NC.DatabaseFileName "Name of NoteFile to be compacted: " " -- " T NIL FileName))) (AND FileNameWithExt (RETURN (NC.CompactDatabase FileNameWithExt)))))) (NCP.DeleteNoteFile (LAMBDA (FileName) (* rht: "18-Oct-84 11:45") (* * Prog's intface function for deleting a notefile.) (PROG ((FileNameWithExt (NC.DatabaseFileName "Name of Notefile to be deleted:" " -- " T NIL FileName))) (AND FileNameWithExt (RETURN (NC.DeleteDatabaseFile FileNameWithExt)))))) (NCP.FloppyRestoreNoteFile (LAMBDA (FileName) (* rht: "18-Oct-84 11:50") (* * Prog's intface function for restoring a notefile from floppy disk.) (PROG ((FileNameWithExt (NC.DatabaseFileName "Name of NoteFile to be copied from floppy: " " -- " T T FileName))) (AND FileNameWithExt (RETURN (NC.FloppyArchive FileNameWithExt T)))))) (NCP.FloppyBackupNoteFile (LAMBDA (FileName) (* rht: "18-Oct-84 11:52") (* * Prog's intface function for backing up a notefile to floppy disk.) (PROG ((FileNameWithExt (NC.DatabaseFileName "Name of NoteFile to be copied to floppy: " " -- " T NIL FileName))) (AND FileNameWithExt (RETURN (NC.FloppyArchive FileNameWithExt NIL)))))) (NCP.CurrentNoteFileStream (LAMBDA NIL (* rht: " 7-Oct-84 13:58") (* * Returns the stream corresponding to the current notefile, or nil, if none.) PSA.Database)) (NCP.CurrentNoteFile (LAMBDA NIL (* rht: " 7-Oct-84 13:59") (* * Returns the current notefile, or nil, if none.) (if PSA.Database then (FULLNAME PSA.Database)))) (NCP.CheckInNoteFile (LAMBDA (FromFile ToFile) (* rht: "19-Dec-84 20:22") (* * Check lock file for ToFile. If none, then just copy FromFile to ToFile. If there is one, then must be owned by us. If date of ToFile is more recent than date of lock file, then ask for user confirmation.) (PROG (LockFile User) (SETQ ToFile (NC.DatabaseFileName "Name of file to check in to: " "--" T T ToFile)) (COND ((SETQ LockFile (INFILEP (NCP.LockFileName ToFile))) (* lock file exists.) (COND ((EQ (GETFILEINFO LockFile (QUOTE LENGTH)) 0) (* Lock file is empty so delete it.) (DELFILE LockFile)) ((NEQ (USERNAME NIL T) (SETQ User (READ (SETQ LockFile (OR (OPENP LockFile (QUOTE INPUT)) (OPENFILE LockFile (QUOTE INPUT) (QUOTE OLD))))))) (* someone else is playing with it.) (PRIN1 (CONCAT "Can't check in because file was locked by " User " at " (GETFILEINFO LockFile (QUOTE WRITEDATE)) (CHARACTER 13) "To override, delete lock file and try again." (CHARACTER 13))) (CLOSEF LockFile) (RETURN NIL)) ((ILESSP (GETFILEINFO LockFile (QUOTE IWRITEDATE)) (GETFILEINFO ToFile (QUOTE IWRITEDATE))) (* Someone wrote the file since we locked it.) (PRIN1 (CONCAT "Can't check in because file was locked by " User " at " (GETFILEINFO LockFile (QUOTE WRITEDATE)) " but written by someone at " (GETFILEINFO ToFile (QUOTE WRITEDATE)) (CHARACTER 13) "To override, delete lock file and try again." (CHARACTER 13))) (RETURN NIL)) (T (* It's the lock file we wrote when checking out so just delete it.) (CLOSEF LockFile) (DELFILE LockFile))))) (SETQ FromFile (NC.DatabaseFileName "Name of file to check in from: " "--" T T FromFile)) (PRIN1 (CONCAT "Copying " FromFile " to " ToFile " ... ")) (COPYFILE FromFile ToFile) (PRIN1 (CONCAT "Done." (CHARACTER 13))) (RETURN (FULLNAME ToFile))))) (NCP.CheckOutNoteFile (LAMBDA (FromFile ToFile) (* rht: "19-Dec-84 20:12") (* * Copy FromFile to ToFile unless FromFile is locked. Create a lock file in FromFile's directory.) (PROG (LockFile User) (SETQ FromFile (NC.DatabaseFileName "Name of file to check out: " "--" T T FromFile)) LP (SETQ LockFile (NCP.LockFileName FromFile)) (COND ((INFILEP LockFile) (* lock file already exists.) (COND ((EQ (GETFILEINFO LockFile (QUOTE LENGTH)) 0) (* Lock file is empty. Delete and start over.) (DELFILE LockFile) (GO LP)) (T (* someone else already is playing with it.) (SETQ LockFile (OR (OPENP LockFile (QUOTE INPUT)) (OPENFILE LockFile (QUOTE INPUT) (QUOTE OLD)))) (SETQ User (READ LockFile)) (PRIN1 (CONCAT "File is locked by: " User (CHARACTER 13))) (CLOSEF LockFile) (RETURN NIL)))) ((SETQ LockFile (OPENFILE LockFile (QUOTE OUTPUT))) (COND ((EQ (VERSIONNUMBER LockFile) 1) (PRINT (USERNAME NIL T) LockFile) (CLOSEF LockFile)) (T (* someone else created one before us. Delete this one and try again.) (DELFILE (CLOSEF LockFile)) (GO LP)))) (T (* something when wrong) (PRIN1 (CONCAT "Trouble in NC.CheckOutNoteFile." (CHARACTER 13))) (RETURN NIL))) (SETQ ToFile (NC.DatabaseFileName "Name of file to check out to: " "--" T T ToFile)) (PRIN1 (CONCAT "Copying " FromFile " to " ToFile " ... ")) (COPYFILE FromFile ToFile) (PRIN1 (CONCAT "Done." (CHARACTER 13))) (RETURN (FULLNAME ToFile))))) (NCP.LockFileName (LAMBDA (FileName) (* rht: "19-Dec-84 12:09") (* returns the name of the lock file associated with FileName) (PACKFILENAME (LIST (QUOTE EXTENSION) (PACK* (FILENAMEFIELD FileName (QUOTE EXTENSION)) "LOCKFILE") (QUOTE VERSION) 1 (QUOTE BODY) FileName)))) ) (* * Creating and accessing NoteCard types and substances.) (DEFINEQ (NCP.CardTypes (LAMBDA NIL (* rht: "26-Oct-84 17:06") (* * Return list of all known card type names.) (NC.ListOfCardTypes))) (NCP.SubstanceTypes (LAMBDA NIL (* rht: "26-Oct-84 17:08") (* * Return list of all known substance type names.) (for Substance in NC.SubstanceTypes collect (fetch (SubstanceType SubstanceName) of Substance)))) (NCP.CreateCardType (LAMBDA (TypeName SuperType SubstanceType MakeCardFn EditCardFn QuitCardFn GetCardFn PutCardFn CopyCardFn MarkCardDirtyFn CardDirtyPFn CollectLinksInCardFn DeleteLinksInCardFn UpdateLinkIconsInCardFn LinkDisplayMode) (* rht: "29-Oct-84 00:25") (* * Make a new card type. If there is already a card type by that name, then print message and overwrite.) (if (FMEMB TypeName (NCP.GetCardTypes)) then (NCP.ReportWarning "Redefining NoteCard type: " TypeName)) (NC.AddCardType TypeName SuperType SubstanceType MakeCardFn EditCardFn QuitCardFn GetCardFn PutCardFn CopyCardFn MarkCardDirtyFn CardDirtyPFn CollectLinksInCardFn DeleteLinksInCardFn UpdateLinkIconsInCardFn LinkDisplayMode) TypeName)) (NCP.CreateSubstanceType (LAMBDA (SubstanceName CreateSubstanceFn EditSubstanceFn QuitSubstanceFn GetSubstanceFn PutSubstanceFn CopySubstanceFn MarkSubstanceDirtyFn SubstanceDirtyPFn CollectLinksInSubstanceFn DeleteLinksInSubstanceFn UpdateLinkIconsInSubstanceFn) (* rht: "26-Oct-84 12:39") (* * Create a new substance type. If already exists, then print message and overwrite.) (if (FMEMB SubstanceName (NCP.GetSubstancesTypes)) then (NCP.ReportWarning "Redefining substance type: " SubstanceName)) (NC.AddSubstanceType SubstanceName CreateSubstanceFn EditSubstanceFn QuitSubstanceFn GetSubstanceFn PutSubstanceFn CopySubstanceFn MarkSubstanceDirtyFn SubstanceDirtyPFn CollectLinksInSubstanceFn DeleteLinksInSubstanceFn UpdateLinkIconsInSubstanceFn))) (NCP.CardTypeSuper (LAMBDA (Type) (* rht: "26-Oct-84 17:36") (* * Return the super type for this type.) (if (NCP.ValidCardType Type) then (fetch (NoteCardType SuperType) of (NCP.GetTypeRecord Type)) else (NCP.ReportError Type " is not an existing NoteCard type.") NIL))) (NCP.CardTypeSubstance (LAMBDA (Type) (* rht: "26-Oct-84 17:37") (* * Return the substance for this type.) (if (NCP.ValidCardType Type) then (fetch (NoteCardType SubstanceType) of (NCP.GetTypeRecord Type)) else (NCP.ReportError Type " is not an existing NoteCard type.") NIL))) (NCP.CardTypeLinkDisplayMode (LAMBDA (Type) (* rht: "26-Oct-84 17:37") (* * Return the link display mode for this type.) (if (NCP.ValidCardType Type) then (fetch (NoteCardType LinkDisplayMode) of (NCP.GetTypeRecord Type)) else (NCP.ReportError Type " is not an existing NoteCard type.") NIL))) (NCP.CardTypeFn (LAMBDA (TypeName Fn) (* rht: "26-Oct-84 18:17") (* * Return the function stored as the Fn for TypeName's record.) (if (NCP.ValidCardType TypeName) then (if (NCP.ValidCardTypeFn Fn) then (RECORDACCESS Fn (NCP.GetTypeRecord TypeName) NIL (QUOTE FETCH)) else (NCP.ReportError Fn " is not a kind of Fn for NoteCard types.")) else (NCP.ReportError TypeName " is not an existing NoteCard type.") NIL))) (NCP.CardTypeInheritedFn (LAMBDA (TypeName Fn) (* rht: "26-Oct-84 18:03") (* * Return the function stored as the Fn for TypeName's record if non-nil. Otherwise, return the inherited one.) (if (NCP.ValidCardType TypeName) then (if (APPLY* (OR (CDR (FASSOC Fn NCP.TypeFnsAssocLst)) (QUOTE NILL)) TypeName) else (NCP.ReportError Fn " is unknown kind of fn for NoteCardTypes") NIL) else (NCP.ReportError TypeName " is not an existing NoteCard type.") NIL))) (NCP.SubstanceTypeFn (LAMBDA (SubstanceName Fn) (* rht: "26-Oct-84 18:07") (* * Return the function stored as the Fn for SubstanceName's record.) (if (NCP.ValidSubstanceType SubstanceName) then (RECORDACCESS Fn (NCP.GetSubstanceRecord SubstanceName) NIL (QUOTE FETCH)) else (NCP.ReportError SubstanceName " is not an existing NoteCard substance type.") NIL))) (NCP.ValidCardType (LAMBDA (TypeName) (* rht: "26-Oct-84 17:48") (* * Returns non-nil if this TypeName is an existing NoteCard type.) (AND (FMEMB TypeName (NC.ListOfCardTypes)) TypeName))) (NCP.ValidSubstanceType (LAMBDA (SubstanceName) (* rht: "26-Oct-84 17:50") (* * Returns non-nil if this SubstanceName is an existing NoteCard substance.) (AND (FMEMB SubstanceName (NCP.SubstanceTypes)) SubstanceName))) (NCP.ValidCardTypeFn (LAMBDA (CardTypeFn) (* rht: "26-Oct-84 18:21") (* * Returns non-nil if CardTypeFn is one of the Fn fields of the NoteCardType record.) (AND (FMEMB CardTypeFn NCP.NoteCardTypeFnsFieldNames) CardTypeFn))) (NCP.ValidSubstanceTypeFn (LAMBDA (SubstanceTypeFn) (* rht: "26-Oct-84 18:22") (* * Returns non-nil if SubstanceTypeFn is one of the Fn fields of the SubstanceType record.) (AND (FMEMB SubstanceTypeFn NCP.SubstanceTypeFnsFieldNames) SubstanceTypeFn))) (NCP.CardTypeFns (LAMBDA NIL (* rht: "26-Oct-84 18:25") (* * Returns list of the fns fields of the NoteCardType record.) NCP.NoteCardTypeFnsFieldNames)) (NCP.SubstanceTypeFns (LAMBDA NIL (* rht: "26-Oct-84 18:25") (* * Returns list of the fns fields of the SubstanceType record.) NCP.SubstanceTypeFnsFieldNames)) ) (* * Creating Notecards and fileboxes) (DEFINEQ (NCP.CreateCard (LAMBDA (Type Title NoDisplayFlg Props ParentFileBoxes TypeSpecificArgs) (* rht: "20-Nov-84 12:49") (* * Creates a new notecard with given type, title, props and parents. Any of those args can be nil. Type being NIL will cause user to be asked. Makes a card with initially empty substance.) (* * rht 11/20/84: Had to add a horrible kluge: if creating a document card in which embedded links may be copied, then need to have document card visible on screen. This is because ID is currently unattainable from just the Textstream - need to have a window. Until that is fixed, we temporarily bring up the document card while it's being filled in.) (PROG (IDOrWindow ID (DocKlugeFlg (AND (EQ Type (QUOTE Document)) NoDisplayFlg))) (if (AND Type (NOT (FMEMB Type (NC.ListOfCardTypes)))) then (NCP.ReportError "Unknown card type: " Type) (RETURN NIL)) (OR (SETQ IDOrWindow (NC.MakeNoteCard Type Title (if DocKlugeFlg then NIL else NoDisplayFlg) TypeSpecificArgs)) (RETURN NIL)) (SETQ ID (if (WINDOWP IDOrWindow) then (NC.IDFromWindow IDOrWindow) else IDOrWindow)) (NC.MarkCardDirty ID) (if Props then (NC.SetPropList ID Props) (NC.SetPropListDirtyFlg ID T)) (for Box in (MKLIST ParentFileBoxes) do (if (NCP.FileBoxP Box) then (NCP.FileCards ID Box) else (NCP.ReportError Box " not an existing filebox."))) (if DocKlugeFlg then (NCP.DeactivateCards ID) (NCP.ActivateCards ID)) (RETURN ID)))) (NCP.CreateTextCard (LAMBDA (Title NoDisplayFlg Props ParentFileBoxes) (* rht: "30-Oct-84 16:40") (* * Creates a new TEXT notecard with given title, props and parents. Makes a card with initially empty textstream.) (NCP.CreateCard (QUOTE Text) Title NoDisplayFlg Props ParentFileBoxes))) (NCP.CreateFileBox (LAMBDA (Title NoDisplayFlg Props ChildCardsBoxes ParentFileBoxes) (* rht: " 2-Dec-84 16:58") (* * Creates a new Filebox with given title, props, children and parents. Does not display the card, but does give it an initial textstream) (PROG ((ID (NCP.CreateCard (QUOTE FileBox) Title NoDisplayFlg Props ParentFileBoxes))) (NCP.FileCards ChildCardsBoxes ID) (RETURN ID)))) (NCP.CreateBrowserCard (LAMBDA (Title RootID LinkLabels NoDisplayFlg Props ParentFileBoxes) (* rht: "15-Nov-84 20:03") (* * Creates a new browser notecard with given type, title, props, parents, starting ID and link labels. LinkLabels can be atom or list and can contain litatoms ALL and/or ←ALL.) (PROG (ValidLinkLabels) (SETQ ValidLinkLabels (for Label in (MKLIST LinkLabels) join (COND ((EQ Label (QUOTE ALL)) (NCP.GetLinkLabels)) ((EQ Label (QUOTE ←ALL)) (NCP.GetReverseLinkLabels)) ((NOT (NCP.ValidLinkLabel Label)) (NCP.ReportError Label " not a valid link label.") NIL) (T (LIST Label))))) (SETQ ValidLinkLabels (INTERSECTION ValidLinkLabels ValidLinkLabels)) (RETURN (if (AND LinkLabels (NULL ValidLinkLabels)) then NIL else (NCP.CreateCard (QUOTE Browser) Title NoDisplayFlg Props ParentFileBoxes (LIST RootID ValidLinkLabels))))) )) (NCP.CreateSketchCard (LAMBDA (Title NoDisplayFlg Props ParentFileBoxes) (* rht: "30-Oct-84 16:41") (* * Creates a new SKETCH/MAP notecard with given title, props and parents.) (NCP.CreateCard (QUOTE Sketch) Title NoDisplayFlg Props ParentFileBoxes))) (NCP.CreateGraphCard (LAMBDA (Title NoDisplayFlg Props ParentFileBoxes) (* rht: "30-Oct-84 16:42") (* * Creates a new GRAPH notecard with given title, props and parents.) (NCP.CreateCard (QUOTE Graph) Title NoDisplayFlg Props ParentFileBoxes))) (NCP.MakeDocument (LAMBDA (RootID ParamProps NoDisplayFlg Props ParentFileBoxes) (* rht: "15-Nov-84 20:00") (* * Do a MakeDocument starting from RootID according to parameters in ParamProps if non-nil. Otherwise use the default parameters. Note that ParamProps are *only* used for the duration of this MakeDocument and do not affect the default parameter values.) (PROG (CurParams DocID WasActive) (if (NCP.ValidID RootID) then (AND (NOT (SETQ WasActive (NCP.ActiveCardP RootID))) (NCP.ActivateCards RootID)) (if ParamProps then (SETQ CurParams (NCP.DocumentParameters ParamProps))) (SETQ DocID (NCP.CreateCard (QUOTE Document) NIL NoDisplayFlg Props ParentFileBoxes RootID)) (if ParamProps then (SETPROPLIST (QUOTE NC.MakeDocParameters) CurParams)) (AND (NOT WasActive) (NCP.DeactivateCards RootID)) (RETURN DocID) else (NCP.ReportError RootID " not a valid card or filebox.") (RETURN NIL))))) (NCP.MakeLinkIndex (LAMBDA (LinkLabels BackPointersP NoDisplayFlg Props ParentFileBoxes) (* rht: "15-Nov-84 19:57") (* * Do a MakeLinkIndex on LinkLabels inserting backpointers according to BackPointersP.) (PROG (ValidLinkLabels) (SETQ ValidLinkLabels (for Label in (MKLIST LinkLabels) join (COND ((EQ Label (QUOTE ALL)) (NCP.GetLinkLabels)) ((EQ Label (QUOTE ←ALL)) (NCP.GetReverseLinkLabels)) ((NOT (NCP.ValidLinkLabel Label)) (NCP.ReportError Label " not a valid link label.") NIL) (T (LIST Label))))) (SETQ ValidLinkLabels (INTERSECTION ValidLinkLabels ValidLinkLabels)) (RETURN (if (AND LinkLabels (NULL ValidLinkLabels)) then NIL else (NCP.CreateCard (QUOTE LinkIndex) NIL NoDisplayFlg Props ParentFileBoxes (LIST ValidLinkLabels BackPointersP))))) )) ) (* * Accessing cards and boxes) (DEFINEQ (NCP.BringUpCard (LAMBDA (ID Region/Position) (* rht: "17-Oct-84 17:44") (* * Brings up a window for ID using Region/Position or asks user to place.) (PROG (Win (OldProc (TTY.PROCESS))) (if (NCP.ValidID ID) then (SETQ Win (NC.EditNoteCard ID Region/Position)) else (NCP.ReportError ID " not an existing card or box.")) (AND (PROCESSP OldProc) (TTY.PROCESS OldProc)) (RETURN Win)))) (NCP.CardType (LAMBDA (ID) (* rht: "18-Oct-84 12:36") (* * Return the type of ID or NIL if no such ID.) (AND (NCP.ValidID ID) (NC.RetrieveType ID PSA.Database)))) (NCP.ValidCard (LAMBDA (ID) (* rht: "25-Oct-84 16:19") (* * Non-nil if ID corresponds to extant card in current notefile. Returns type of card or nil.) (NCP.CardType ID))) (NCP.ActiveCardP (LAMBDA (ID) (* rht: " 3-Oct-84 12:16") (* * Returns non-nil if contents of ID are currently cached.) (NC.ActiveCardP ID))) (NCP.ActivateCards (LAMBDA (IDs) (* rht: "15-Nov-84 11:30") (* * Cache all the info for any inactive cards in IDs.) (for ID in (MKLIST IDs) unless (if (NOT (NCP.ValidID ID)) then (NCP.ReportError ID " not an existing card or filebox.") T) do (if (NOT (NCP.ActiveCardP ID)) then (NC.GetNoteCard ID PSA.Database)) finally (RETURN ID)))) (NCP.DeactivateCards (LAMBDA (IDs) (* rht: "15-Nov-84 11:42") (* * Uncache all the info for any active cards in IDs.) (for ID in (MKLIST IDs) bind Win (OldProc ←(TTY.PROCESS)) unless (COND ((NOT (NCP.ValidID ID)) (NCP.ReportError ID " not an existing card or filebox.") T)) do (if (NCP.ActiveCardP ID) then (SETQ Win (NC.FetchWindow ID)) (NC.QuitCard ID T) (AND Win (while (OPENWP Win) do (BLOCK)))) finally (AND (PROCESSP OldProc) (TTY.PROCESS OldProc)) (RETURN ID)))) (NCP.CardTitle (LAMBDA Args (* rht: "16-Oct-84 14:59") (* * Expects one or two args, the ID and an optional new title. If the latter is present then change the title of ID. In any case, return the old title.) (PROG (ID OldTitle) (if (AND (NEQ Args 1) (NEQ Args 2)) then (NCP.ReportError "Improper number of arguments to NCP.CardBoxTitle.") (RETURN NIL)) (if (NCP.ValidID (SETQ ID (ARG Args 1))) then (SETQ OldTitle (NC.RetrieveTitle ID PSA.Database)) (if (EQ Args 2) then (NC.AssignTitle ID NIL (ARG Args 2))) (RETURN OldTitle) else (NCP.ReportError ID " not an existing card or box.") (RETURN NIL))))) (NCP.FileCards (LAMBDA (CardBoxList BoxList) (* rht: "29-Oct-84 01:33") (* * File every card or box in CardBoxList in every box in BoxList. Either arg can be an atom or list. Check for cycles.) (SETQ CardBoxList (for ID in (MKLIST CardBoxList) unless (if (NOT (NCP.ValidID ID)) then (NCP.ReportError ID " not an existing card or box. Can't file.") T) collect ID)) (SETQ BoxList (for ID in (MKLIST BoxList) unless (if (NOT (NCP.FileBoxP ID)) then (NCP.ReportError ID " not an existing filebox. Can't be filed into.") T) collect ID)) (if (AND BoxList CardBoxList) then (for Box in BoxList when (NC.FileBoxCollectChildren NIL Box CardBoxList T) collect Box) else NIL))) (NCP.UnfileCards (LAMBDA (CardBoxList BoxList) (* rht: "18-Oct-84 12:33") (* * Unfile every card or box in CardBoxList from every box in BoxList. Either arg can be a litatom ID. Either can also be the litatom ALL. If CardBoxList is ALL then clear out all children from every element of BoxList. If BoxList is ALL then unlink all parents of every element of CardBoxList.) (if (NEQ CardBoxList (QUOTE ALL)) then (SETQ CardBoxList (for ID in (MKLIST CardBoxList) unless (if (NOT (NCP.ValidID ID)) then (NCP.ReportError ID " not an existing card or box. Can't unfile.") T) collect ID))) (if (NEQ BoxList (QUOTE ALL)) then (SETQ BoxList (for ID in (MKLIST BoxList) unless (if (NOT (NCP.FileBoxP ID)) then (NCP.ReportError ID " not an existing filebox.") T) collect ID))) (if (NEQ CardBoxList (QUOTE ALL)) then (if (EQ BoxList (QUOTE ALL)) then (* Unfile every element of CardBoxList from all its parents.) (for ID in CardBoxList do (NCP.DeleteLinks (NCP.GetLinks NIL ID (LIST NC.FiledCardLinkLabel NC.SubBoxLinkLabel)))) else (* Unfile every element of CardBoxList from a selection of its parents.) (for ID in CardBoxList do (for Box in BoxList do (NCP.DeleteLinks (NCP.GetLinks Box ID (LIST NC.FiledCardLinkLabel NC.SubBoxLinkLabel))))) ) else (if (EQ BoxList (QUOTE ALL)) then (SETQ BoxList (NCP.AllBoxes))) (for Box in BoxList do (NCP.DeleteLinks (NCP.GetLinks Box NIL (LIST NC.FiledCardLinkLabel NC.SubBoxLinkLabel))))) (AND CardBoxList BoxList))) (NCP.CardParents (LAMBDA (ID) (* rht: "13-Oct-84 15:45") (* * Return the list of fileboxes in which ID has been filed.) (if (NCP.ValidID ID) then (for Link in (NCP.GetLinks NIL ID (LIST NC.FiledCardLinkLabel NC.SubBoxLinkLabel)) collect (fetch (NOTECARDLINK SOURCEID) of Link)) else (NCP.ReportError ID " is not an existing card or filebox.")))) (NCP.FileBoxChildren (LAMBDA (BoxID) (* rht: "13-Oct-84 15:45") (* * Return the list of children of BoxID in proper order.) (if (NCP.FileBoxP BoxID) then (for Link in (NCP.GetLinks BoxID NIL (LIST NC.FiledCardLinkLabel NC.SubBoxLinkLabel)) collect (fetch (NOTECARDLINK DESTINATIONID) of Link)) else (NCP.ReportError BoxID " is not an existing filebox.")))) (NCP.GetLinks (LAMBDA (IDs DestinationIDs Labels) (* rht: "29-Oct-84 02:47") (* * Returns a list of all links from IDs to DestinationIDs whose link label is one of Labels. Labels can be nil, in which case all such links are returned. IDs and DestinationIDs can each be atomic. Each can also be nil. For example, if DestinationIDs is nil, then all links pointing from IDs to anywhere with given labels are returned. Note that if both IDs and DestinationIDs are nil, then will return all links whose label is one of Labels. If all three args are nil, then return all links in the current notefile.) (PROG (ValidIDs ValidDestinationIDs) (SETQ Labels (MKLIST Labels)) (SETQ ValidIDs (for ID in (MKLIST IDs) unless (if (NOT (NCP.ValidID ID)) then (NCP.ReportError ID " not an existing card or box.") T) collect ID)) (SETQ ValidDestinationIDs (for ID in (MKLIST DestinationIDs) unless (if (NOT (NCP.ValidID ID)) then (NCP.ReportError ID " not an existing card or box.") T) collect ID)) (if IDs then (RETURN (for ID in ValidIDs join (for Link in (NC.RetrieveToLinks ID PSA.Database) when (if DestinationIDs then (FMEMB (fetch (NOTECARDLINK DESTINATIONID) of Link) ValidDestinationIDs) else T) when (if Labels then (FMEMB (fetch (NOTECARDLINK LINKLABEL) of Link) Labels) else T) collect Link)))) (if DestinationIDs then (RETURN (for ID in ValidDestinationIDs join (for Link in (NC.RetrieveFromLinks ID PSA.Database) when (if Labels then (FMEMB (fetch (NOTECARDLINK LINKLABEL) of Link) Labels) else T) collect Link)))) (RETURN (for ID# from 1 to (NCP.MaxIDNum) bind ID when (NCP.ValidID (SETQ ID ( NC.IDFromNumber ID#))) join (for Link in (NC.RetrieveToLinks ID PSA.Database) when (if Labels then (FMEMB (fetch (NOTECARDLINK LINKLABEL) of Link) Labels) else T) collect Link)))))) (NCP.CardPropList (LAMBDA (ID) (* rht: "30-Sep-84 14:44") (* * Return the ID's property list) (NC.RetrievePropList ID PSA.Database))) (NCP.CardProp (LAMBDA Args (* rht: "29-Oct-84 16:49") (* * Expects two or three arguments: ID, Property, and optional new value. Returns the old value. Assigns the new value if given. Semantics are just like WINDOWPROP.) (PROG (ID PropList) (if (AND (NEQ Args 2) (NEQ Args 3)) then (NCP.ReportError "Improper number of args to NCP.CardBoxProp.") (RETURN NIL)) (SETQ ID (ARG Args 1)) (if (NCP.ValidID ID) then (RETURN (PROG1 (LISTGET (SETQ PropList (NC.RetrievePropList ID PSA.Database)) (ARG Args 2)) (if (EQ Args 3) then (if PropList then (LISTPUT PropList (ARG Args 2) (ARG Args 3)) else (NC.SetPropList ID (LIST (ARG Args 2) (ARG Args 3)))) (if (NOT (NCP.ActiveCardP ID)) then (NC.PutPropList ID PSA.Database) else (NC.SetPropListDirtyFlg ID T))))) else (NCP.ReportError ID " not an existing card or box.") (RETURN NIL))))) (NCP.CardAddProp (LAMBDA (ID Property ItemToAdd) (* rht: "29-Oct-84 16:51") (* * Adds ItemToAdd to the value of ID's Property property. Returns the old value. Same semantics as WINDOWADDPROP.) (PROG (PropList OldPropValue) (if (NCP.ValidID ID) then (SETQ PropList (NC.RetrievePropList ID PSA.Database)) (SETQ OldPropValue (LISTGET PropList Property)) (if (NOT (FMEMB ItemToAdd (MKLIST OldPropValue))) then (LISTPUT PropList Property (APPEND (MKLIST OldPropValue) (LIST ItemToAdd))) (if (NOT (NCP.ActiveCardP ID)) then (NC.PutPropList ID PSA.Database) else (NC.SetPropListDirtyFlg ID T))) (RETURN OldPropValue) else (NCP.ReportError ID " not an existing card or box.") (RETURN NIL))))) (NCP.CardDelProp (LAMBDA (ID Property ItemToDelete) (* rht: "29-Oct-84 16:50") (* * Deletes ItemToDelete from the Property prop of ID if it is there, returning the previous list. If it's not there, then return NIL. Same semantics as WINDOWDELPROP.) (PROG (PropList OldPropValue) (if (NCP.ValidID ID) then (SETQ PropList (NC.RetrievePropList ID PSA.Database)) (SETQ OldPropValue (LISTGET PropList Property)) (RETURN (COND ((NLISTP OldPropValue) NIL) ((FMEMB ItemToDelete OldPropValue) (LISTPUT PropList Property (for Item in OldPropValue unless (EQ Item ItemToDelete) collect Item)) (if (NOT (NCP.ActiveCardP ID)) then (NC.PutPropList ID PSA.Database) else (NC.SetPropListDirtyFlg ID T)) OldPropValue) (T NIL))) else (NCP.ReportError ID " not an existing card or box.") (RETURN NIL))))) (NCP.CardSubstance (LAMBDA (ID) (* rht: "30-Oct-84 14:46") (* * Return the substance for this card.) (if (NCP.ValidID ID) then (PROG (WasActive) (OR (SETQ WasActive (NCP.ActiveCardP ID)) (NCP.ActivateCards ID)) (RETURN (PROG1 (NC.FetchSubstance ID) (OR WasActive (NCP.DeactivateCards ID))))) else (NCP.ReportError ID " not an existing card.") NIL))) (NCP.CardRegion (LAMBDA (ID) (* rht: "31-Oct-84 03:24") (* * Return the substance for this card.) (if (NCP.ValidID ID) then (PROG (WasActive) (OR (SETQ WasActive (NCP.ActiveCardP ID)) (NCP.ActivateCards ID)) (RETURN (PROG1 (NC.FetchRegion ID) (OR WasActive (NCP.DeactivateCards ID))))) else (NCP.ReportError ID " not an existing card.") NIL))) (NCP.CardAddText (LAMBDA (ID Text Loc) (* rht: "28-Oct-84 15:53") (* * Adds the Text to ID's window at the given Loc. Loc defaults to the current cursor position.) (PROG (WasActiveP) (if (NOT (NCP.ValidID ID)) then (NCP.ReportError ID " is not an existing card or filebox.") (RETURN NIL)) (if (NOT (EQ (NCP.CardTypeSubstance (NCP.CardType ID)) (QUOTE TEXT))) then (NCP.ReportError "Can only add text to cards with TEXT substance type.") (RETURN NIL)) (if (NOT (SETQ WasActiveP (NCP.ActiveCardP ID))) then (NCP.ActivateCards ID)) (NCP.ChangeLoc ID Loc) (TEDIT.INSERT (NC.FetchSubstance ID) Text) (NC.MarkCardDirty ID) (if (NOT WasActiveP) then (NCP.DeactivateCards ID)) (RETURN ID)))) (NCP.ChangeLoc (LAMBDA (ID Loc) (* rht: "29-Oct-84 02:01") (* * Changes the location within ID's textstream to the new loc Loc. Loc can be the litatoms START or END, a number, or nil. The latter indicates to use the current cursor position. Note that we don't mark card as dirty just because its selection changed.) (PROG (Stream (Pointer (QUOTE RIGHT))) (if (AND (NCP.ValidID ID) (EQ (NCP.CardTypeSubstance (NCP.CardType ID)) (QUOTE TEXT))) then (if (NOT (NCP.ActiveCardP ID)) then (NCP.ActivateCards ID)) (SETQ Stream (NC.FetchSubstance ID)) (if (NULL Loc) then (RETURN ID)) (if (EQ Loc (QUOTE START)) then (SETQ Loc 0)) (if (EQ Loc (QUOTE END)) then (SETQ Loc (fetch (TEXTOBJ TEXTLEN) of (TEXTOBJ Stream)))) (if (ZEROP Loc) then (SETQ Pointer (QUOTE LEFT))) (TEDIT.SETSEL Stream Loc 0 Pointer) (RETURN ID) else (NCP.ReportError ID " not an existing card or non-TEXT substance type.") (RETURN NIL))))) (NCP.DeleteCards (LAMBDA (IDs) (* rht: "16-Nov-84 12:09") (* * Delete the given cards and boxes. Or just one, if IDs is atomic.) (SETQ IDs (for ID in (MKLIST IDs) unless (if (NOT (NCP.ValidID ID)) then (NCP.ReportError ID " is not an existing card or box.") T) collect ID)) (AND IDs (NC.DeleteNoteCards IDs T)))) (NCP.FileBoxP (LAMBDA (ID) (* rht: "25-Oct-84 16:29") (* * Return T if ID is a Filebox.) (EQ (NCP.CardType ID) (QUOTE FileBox)))) (NCP.AllCards (LAMBDA NIL (* rht: "17-Oct-84 11:28") (* * Return a list of IDs of all cards and boxes.) (for ID# from 1 to (NCP.MaxIDNum) bind ID when (NCP.ValidID (SETQ ID (NC.IDFromNumber ID#))) collect ID))) (NCP.AllBoxes (LAMBDA NIL (* rht: "25-Oct-84 16:29") (* * Return a list of all existing fileboxes.) (for ID# from 1 to (NCP.MaxIDNum) bind ID when (NCP.ValidID (SETQ ID (NC.IDFromNumber ID#))) when (EQ (NCP.CardType ID) (QUOTE FileBox)) collect ID))) (NCP.MapCards (LAMBDA (CardFn) (* rht: "29-Oct-84 02:08") (* * Map down all notecards (including fileboxes) in the current notefile, performing CardFn to each.) (for ID# from 1 to (NCP.MaxIDNum) bind ID when (NCP.ValidID (SETQ ID (NC.IDFromNumber ID#))) do (APPLY* CardFn ID)))) (NCP.MapBoxes (LAMBDA (BoxFn) (* rht: "29-Oct-84 02:09") (* * Map down all fileboxes in the current notefile, performing BoxFn to each.) (for ID# from 1 to (NCP.MaxIDNum) bind ID when (AND (NCP.ValidID (SETQ ID (NC.IDFromNumber ID#))) (NCP.FileBoxP ID)) do (APPLY* BoxFn ID)))) (NCP.GetContentsFileBox (LAMBDA NIL (* rht: "19-Sep-84 22:09") (* * Return the top level contents file box.) NC.RootID)) (NCP.GetOrphansFileBox (LAMBDA NIL (* rht: "19-Sep-84 22:10") (* * Return the orphans file box.) NC.OrphanID)) (NCP.GetToBeFiledFileBox (LAMBDA NIL (* rht: "19-Sep-84 22:11") (* * Return the to-be-filed file box.) NC.UnclassifiedID)) ) (* * Creating and accessing links) (DEFINEQ (NCP.LocalGlobalLink (LAMBDA (Label FromID ToID FromLoc DisplayMode) (* rht: "30-Nov-84 17:25") (* * Create a link from within the text of the FromID card to the ToID card.) (PROG (WasActive) (if (EQ Label NC.FiledCardLinkLabel) then (if (AND (NOT (NCP.FileBoxP ToID)) (NCP.FileBoxP FromID)) then (NCP.ChangeLoc FromID FromLoc) (RETURN (CAR (NCP.FileCards ToID FromID))) else (NCP.ReportError "FiledCard link must be from a box to a card." (CHARACTER 13) "No link created.") (RETURN NIL))) (if (EQ Label NC.SubBoxLinkLabel) then (if (AND (NCP.FileBoxP ToID) (NCP.FileBoxP FromID)) then (NCP.ChangeLoc FromID FromLoc) (RETURN (CAR (NCP.FileCards ToID FromID))) else (NCP.ReportError "SubBox link must be from a box to a box." (CHARACTER 13) "No link created.") (RETURN NIL))) (if (NOT (FMEMB Label (NCP.GetLinkLabels))) then (if (NC.YesP (NC.AskUser (CONCAT "That label hasn't been used in this NoteFile." (CHARACTER 13) "Want to create a new label: " Label "? ") "--" NIL T)) then (NCP.CreateLinkLabel Label) else (RETURN NIL))) (OR (SETQ WasActive (NCP.ActiveCardP FromID)) (NCP.ActivateCards FromID)) (AND FromLoc (NCP.ChangeLoc FromID FromLoc)) (RETURN (PROG1 (NC.InsertLinkInText (NC.FetchSubstance FromID) Label ToID FromID DisplayMode) (OR WasActive (NCP.DeactivateCards FromID))))))) (NCP.GlobalGlobalLink (LAMBDA (Label FromID ToID) (* rht: " 3-Oct-84 11:28") (* * This builds a global link of type Label between FromID and ToID. Complains if link type is system-defined with restricted semantics. If Label is brand new, then asks if user wants to create a new label by that name.) (PROG ((LinkLabels (NCP.GetUserLinkLabels)) (DatabaseStream PSA.Database)) (COND ((OR (EQ Label NC.SourceLinkLabel) (FMEMB Label LinkLabels))) ((FMEMB (U-CASE Label) NC.UCASESystemLinkLabels) (NCP.ReportError "Can't make a global-to-global link of type " Label ".") (RETURN NIL)) ((NC.YesP (NC.AskUser (CONCAT "That label hasn't been used in this NoteFile." (CHARACTER 13) "Want to create a new label: " Label "? ") "--" NIL T)) (NCP.CreateLinkLabel Label)) (T (RETURN NIL))) (* * Label type is okay so create the link.) (RETURN (NC.MakeGlobalLink NIL Label ToID FromID))))) (NCP.GlobalLocalLink (LAMBDA (Label FromID ToID ToLoc) (* rht: " 6-Sep-84 15:01") (* * Builds a link from the FromID card as a whole to within the text of the ToID card.) (NCP.ReportError "Sorry, can't make global to local links yet."))) (NCP.LocalLocalLink (LAMBDA (Label FromID ToID FromLoc ToLoc) (* rht: " 6-Sep-84 15:02") (* * Builds a link from within the text of the FromID card to within the text of the ToID card.) (NCP.ReportError "Sorry, can't make local to local links yet."))) (NCP.LinkDesc (LAMBDA (Link) (* rht: " 8-Oct-84 10:42") (* * Return a list structure which describes Link. It consists of (label <fromdesc> <todesc>) where <fromdesc> and <todesc> describe the anchoring of the link at each end. They each have the form: (<anchormode> <ID> <loc>)) (if (NCP.ValidLink Link) then (LIST (fetch (NOTECARDLINK LINKLABEL) of Link) (NCP.LinkAnchorDesc Link NIL) (NCP.LinkAnchorDesc Link T)) else (NCP.ReportError "No such link: " Link)))) (NCP.LinkDisplayMode (LAMBDA Args (* rht: "16-Oct-84 11:25") (* * Takes either 1 or 2 args. The first is a link, the second an optional new link display mode. Return old display mode in any case; change mode if the second arg is present.) (PROG (Link NewMode WasActive SourceID) (if (AND (NEQ Args 1) (NEQ Args 2)) then (NCP.ReportError "Improper number of args to NCP.LinkDisplayMode.") (RETURN NIL)) (if (NCP.ValidLink (SETQ Link (ARG Args 1))) then (RETURN (PROG1 (fetch (NOTECARDLINK DISPLAYMODE) Link) (if (EQ Args 2) then (SETQ NewMode (ARG Args 2)) (if (NOT (FMEMB NewMode NCP.LinkDisplayModes)) then (NCP.ReportError NewMode " is invalid link display mode. Should be one of Icon, Title, Label, or Both.") else (OR (SETQ WasActive (NCP.ActiveCardP (SETQ SourceID (fetch (NOTECARDLINK SOURCEID) of Link)))) (NCP.ActivateCards SourceID)) (NC.ChangeLinkDisplayMode Link NIL NewMode) (OR WasActive (NCP.DeactivateCards SourceID)))))) else (NCP.ReportError Link " is not a valid link.") (RETURN NIL))))) (NCP.LinkLabel (LAMBDA Args (* rht: " 1-Nov-84 15:23") (* * Takes either 1 or 2 args. The first is a link, the second an optional new label. Return old label in any case; change label if the second arg is present.) (PROG (Link NewLabel) (if (AND (NEQ Args 1) (NEQ Args 2)) then (NCP.ReportError "Improper number of args to NCP.LinkLabel.") (RETURN NIL)) (if (NCP.ValidLink (SETQ Link (ARG Args 1))) then (RETURN (PROG1 (fetch (NOTECARDLINK LINKLABEL) Link) (if (EQ Args 2) then (COND ((FMEMB (SETQ NewLabel (ARG Args 2)) NC.SystemLinkLabels) (NCP.ReportError "Can't change label to a system label: " NewLabel)) ((OR (FMEMB NewLabel (NCP.GetLinkLabels)) (AND (NC.YesP (NC.AskUser (CONCAT "That label hasn't been used in this NoteFile." (CHARACTER 13) "Want to create a new label: " NewLabel "? ") "--" NIL T)) (NCP.CreateLinkLabel NewLabel))) (NC.RelabelLink Link NIL NewLabel T)))))) else (NCP.ReportError Link " is not a valid link.") (RETURN NIL))))) (NCP.GetLinkSource (LAMBDA (Link) (* rht: " 1-Nov-84 12:40") (* * Return the SOURCEID of Link.) (if (NCP.ValidLink Link) then (fetch (NOTECARDLINK SOURCEID) of Link) else (NCP.ReportError Link " not an existing link.")))) (NCP.GetLinkDestination (LAMBDA (Link) (* rht: " 1-Nov-84 12:40") (* * Return the DESTINATIONID of Link.) (if (NCP.ValidLink Link) then (fetch (NOTECARDLINK DESTINATIONID) of Link) else (NCP.ReportError Link " not an existing link.")))) (NCP.DeleteLinks (LAMBDA (Links) (* rht: " 1-Nov-84 12:37") (* * Delete each link in Links. If Links is one link, then just delete that one.) (for Link in (if (type? NOTECARDLINK Links) then (LIST Links) else Links) unless (if (NOT (NCP.ValidLink Link)) then (NCP.ReportError "No such link: " Link) T) do (NC.DelReferencesToCard (fetch (NOTECARDLINK SOURCEID) of Link) Link PSA.Database) (NC.DelFromLink Link PSA.Database) (NC.DelToLink Link PSA.Database) (replace (NOTECARDLINK LINKID) of Link with -1)))) (NCP.ValidLink (LAMBDA (Link) (* rht: " 1-Nov-84 12:29") (* * True if Link is an extant link in current database.) (AND (type? NOTECARDLINK Link) (NEQ (fetch (NOTECARDLINK LINKID) of Link) -1)))) (NCP.AllLinks (LAMBDA NIL (* rht: "17-Oct-84 16:10") (* * Return a list of all links in the current database.) (for ID# from 1 to (NCP.MaxIDNum) join (NC.RetrieveToLinks (NC.IDFromNumber ID#) PSA.Database)))) (NCP.MapLinks (LAMBDA (LinkFn) (* rht: "29-Oct-84 15:52") (* * Map down all links in the current notefile, performing LinkFn to each.) (for ID# from 1 to (NCP.MaxIDNum) bind ID when (NCP.ValidID (SETQ ID (NC.IDFromNumber ID#))) do (for Link in (NC.RetrieveToLinks ID PSA.Database) do (APPLY* LinkFn Link))))) ) (* * Creating and accessing link labels.) (DEFINEQ (NCP.CreateLinkLabel (LAMBDA (Label) (* rht: "29-Oct-84 15:48") (* * Create a new link label unless already defined.) (if (FMEMB Label (NCP.GetLinkLabels)) then (NCP.ReportError "Link label already defined: " Label ".") NIL else (NC.PutLinkLabels PSA.Database (CONS Label (NCP.GetUserLinkLabels))) Label))) (NCP.DeleteLinkLabel (LAMBDA (Label) (* rht: "29-Oct-84 15:48") (* * Checks for any instance of Label in the current database. If can't find any then delete the link label, otherwise error out.) (COND ((NOT (FMEMB Label (NCP.GetLinkLabels))) (NCP.ReportError "No such link label: " Label ".") NIL) ((FMEMB Label NC.SystemLinkLabels) (NCP.ReportError "Can't delete system link label: " Label ".") NIL) ((for Link in (NCP.AllLinks) thereis (EQ Label (fetch LINKLABEL of Link))) (NCP.ReportError "Label currently in use: " Label ". Can't delete.") NIL) (T (NC.PutLinkLabels PSA.Database (REMOVE Label (NCP.GetUserLinkLabels))) Label)))) (NCP.RenameLinkLabel (LAMBDA (OldLabel NewLabel) (* rht: "29-Oct-84 15:49") (* * Renames all instances of links with OldLabel to be NewLabel. And deletes the old label OldLabel. If NewLabel doesn't exist, create it.) (DECLARE (SPECVARS OldLabel NewLabel)) (PROG ((Labels (NCP.GetLinkLabels))) (RETURN (COND ((NOT (FMEMB OldLabel Labels)) (NCP.ReportError "No such link label: " OldLabel ".") NIL) ((FMEMB OldLabel NC.SystemLinkLabels) (NCP.ReportError "Can't rename system link label: " OldLabel ".") NIL) ((FMEMB NewLabel NC.SystemLinkLabels) (NCP.ReportError "Can't rename with a system link label: " NewLabel ".") NIL) (T (if (NOT (FMEMB NewLabel Labels)) then (NCP.CreateLinkLabel NewLabel)) (* Map down all links, relabeling as appropriate.) (NCP.MapLinks (FUNCTION (LAMBDA (Link) (if (EQ OldLabel (fetch (NOTECARDLINK LINKLABEL) of Link)) then (NCP.LinkLabel Link NewLabel))))) (NC.PutLinkLabels PSA.Database (REMOVE OldLabel (NCP.GetUserLinkLabels))) NewLabel)))))) (NCP.GetLinkLabels (LAMBDA NIL (* rht: "24-Oct-84 23:57") (* * Return all link labels including system ones.) (NC.RetrieveLinkLabels PSA.Database T))) (NCP.GetReverseLinkLabels (LAMBDA NIL (* rht: "24-Oct-84 23:56") (* * Return all reverse link labels including system ones.) (for Lab in (NC.RetrieveLinkLabels PSA.Database T) collect (PACK* (QUOTE ←) Lab)))) (NCP.GetUserLinkLabels (LAMBDA NIL (* rht: " 6-Sep-84 15:25") (* * Return list of only the user defined link labels appearing in the current notefile.) (NC.RetrieveLinkLabels PSA.Database NIL))) (NCP.ValidLinkLabel (LAMBDA (Label) (* rht: " 1-Oct-84 14:57") (* * True if Label is a currently defined user or system link label.) (FMEMB Label (NCP.GetLinkLabels)))) ) (* * Miscellaneous) (DEFINEQ (NCP.GetCardTypes (LAMBDA NIL (* rht: "25-Oct-84 16:15") (* * Return list of all extant notecard types.) (NC.ListOfCardTypes))) (NCP.TitleSearch (LAMBDA Args (* rht: "25-Oct-84 16:31") (* * Return a list of all IDs which contain each string of Args within their titles.) (for ID in (NCP.AllCards) bind Title when (PROGN (SETQ Title (NCP.CardTitle ID)) (for i from 1 to Args always (STRPOS (ARG Args i) Title))) collect ID))) (NCP.PropSearch (LAMBDA Args (* rht: "30-Oct-84 14:39") (* * Return a list of all IDs which contain each property or property pair appearing in Args. For each atomic element in Args, there must be a property by that name with non-nil value. For each pair (list of length 2) in Args, there must be a property and value matching that pair.) (for ID in (NCP.AllCards) bind PropList when (PROGN (SETQ PropList (NCP.CardPropList ID)) (for i from 1 to Args always (if (ATOM (SETQ Prop (ARG Args i))) then (LISTGET PropList Prop) elseif (AND (LISTP Prop) (EQ (LENGTH Prop) 2)) then (EQ (LISTGET PropList (CAR Prop)) (CADR Prop))))) collect ID))) (NCP.WhichCard (LAMBDA (WindowOrx y) (* rht: "26-Nov-84 13:03") (* * Return the ID of the card at a position determined as follows: If WindowOrx is a position, then use that, if WindowOrx and y are numbers then use (WindowOrx,y), else use cursor position.) (NC.IDFromWindow (OR (WINDOWP WindowOrx) (WHICHW WindowOrx y))))) (NCP.CardFromWindow (LAMBDA (Win) (* rht: "31-Oct-84 03:31") (* * Return the ID of the card corresponding to Win, if Win is a notecard window.) (NC.IDFromWindow Win))) (NCP.CardWindow (LAMBDA (ID) (* rht: "19-Oct-84 15:56") (* * Returns T if card corresponding to ID is currently on the screen, i.e. has an active window.) (AND (NCP.ValidID ID) (NC.FetchWindow ID)))) (NCP.SelectCards (LAMBDA NIL (* rht: "28-Oct-84 23:42") (* * Return a list of cards selected. A menu pops up near the prompt window with "DONE" and "CANCEL" buttons. User selects by clicking in card's title bar.) (NC.SelectNoteCards NIL NIL NC.SelectingCardsMenu))) (NCP.DocumentParameters (LAMBDA (NewProps) (* rht: "28-Oct-84 22:17") (* * Returns the old value of the MakeDocument default parameters. If NewProps is non-nil then it should be a prop list which will be used to change some or all of the current MakeDocument parameters. Only those props whose names are valid MakeDocument parameters and whose values are permissible values for that name are used.) (PROG ((OldParams (COPY (GETPROPLIST (QUOTE NC.MakeDocParameters))))) (if NewProps then (for Params on NewProps by (CDDR NewProps) bind Param NewValue LegalValues do (SETQ Param (CAR Params)) (COND ((NULL (SETQ LegalValues (CDR (FASSOC Param NC.MakeDocParameters)))) (NCP.ReportError Param " not a document parameter name.")) ((OR (AND (FMEMB (SETQ NewValue (CADR Params)) LegalValues) (NEQ NewValue (QUOTE Select))) (AND (LISTP NewValue) (FMEMB (QUOTE Select) LegalValues) (SETQ NewValue (for Label in NewValue unless (if (NOT (NCP.ValidLinkLabel Label)) then (NCP.ReportError Label " is not a valid link label. Ignored.") T) collect Label)))) (PUTPROP (QUOTE NC.MakeDocParameters) Param NewValue)) (T (NCP.ReportError NewValue " is not a permissible value for " Param ".")) ))) (RETURN OldParams)))) (NCP.NoteCardsParameters (LAMBDA (NewParams) (* rht: "28-Oct-84 22:15") (* * Returns the old value of the Notecards parameters. If NewParams is non-nil then it should be a prop list which will be used to change some or all of the current Notecards parameters. Only those props whose names are valid Notecards parameters and whose values are permissible values for that name are used. On NC.NoteCardsParameters's prop list under the parameter name is a list of one or two items. The first is the name of the global var. The second if present, is a function of no args which returns a list of legal values for that parameter. We only do type checking if that function is present.) (PROG (OldParams) (SETQ OldParams (for Param in NC.NoteCardsParameters join (LIST Param (EVAL (CAR (GETPROP (QUOTE NC.NoteCardsParameters) Param)))))) (if NewParams then (for Params on NewParams by (CDDR NewParams) bind Param NewValue LegalValuesFn LegalValues PropVal do (if (FMEMB (SETQ Param (CAR Params)) NC.NoteCardsParameters) then (SETQ NewValue (CADR Params)) (SETQ PropVal (GETPROP (QUOTE NC.NoteCardsParameters) Param)) (SETQ LegalValues (AND (SETQ LegalValuesFn (CADR PropVal)) (APPLY* LegalValuesFn))) (if (OR (NULL LegalValues) (FMEMB NewValue LegalValues)) then (SET (CAR PropVal) NewValue) else (NCP.ReportError NewValue " is not a permissible value for " Param ".")) else (NCP.ReportError Param " not a Notecards parameter name.")))) (RETURN OldParams)))) (NCP.PrintMsg (LAMBDA Args (* rht: "27-Nov-84 17:57") (* * Expects args of form (<window> <clearFirstFlg> <arg1> <arg2> ...) and prints the <arg>s to <window>'s prompt window or to the lisp prompt window if <window> is nil. Will clear first if second arg is non-nil.) (APPLY (QUOTE NC.PrintMsg) (for i from 1 to Args collect (ARG Args i))))) (NCP.ClearMsg (LAMBDA (Window ClosePromptWinFlg) (* rht: "27-Nov-84 17:53") (* * Clears the prompt window for Window. Will close if ClosePromptWinFlg is non-nil.) (NC.ClearMsg Window ClosePromptWinFlg))) (NCP.AskUser (LAMBDA (Msg Prompt FirstTry ClearFirstFlg MainWindow DontCloseAtEndFlg DontClearAtEndFlg) (* rht: "27-Nov-84 20:36") (* * Asks a question in the prompt window. Just calls the NC.AskUser function.) (NC.AskUser Msg Prompt FirstTry ClearFirstFlg MainWindow DontCloseAtEndFlg DontClearAtEndFlg))) ) (* * Handy internal functions) (DEFINEQ (NCP.ReportError (LAMBDA Args (* rht: "28-Oct-84 18:17") (* * Print out the various elements of Args to the terminal.) (PRIN1 "*** " T) (for i from 1 to Args do (PRIN1 (ARG Args i) T)) (TERPRI T))) (NCP.ReportWarning (LAMBDA Args (* rht: " 2-Oct-84 12:33") (* * Print out the various elements of Args to the terminal.) (for i from 1 to Args do (PRIN1 (ARG Args i) T)) (TERPRI T))) (NCP.ValidID (LAMBDA (ID) (* rht: " 1-Dec-84 15:30") (* * Is ID a currently extant card or box?) (NC.ValidID ID))) (NCP.LinkAnchorDesc (LAMBDA (Link ToFlg) (* rht: "29-Oct-84 02:27") (* * Return a description of the anchoring of Link at one of its endpoints. The description has the form (<anchormode> <ID> <loc>) If ToFlg is non-nil, then look at the "To" end of the link, otherwise, its "From" end.) (PROG (ID WasActiveP (LinkID (fetch (NOTECARDLINK LINKID) of Link))) (SETQ ID (if ToFlg then (fetch (NOTECARDLINK DESTINATIONID) of Link) else (fetch (NOTECARDLINK SOURCEID) of Link))) (RETURN (if (OR (NC.GlobalLinkP Link) ToFlg) then (LIST (QUOTE GLOBAL) ID NIL) else (if (NOT (SETQ WasActiveP (NCP.ActiveCardP ID))) then (NCP.ActivateCards ID)) (for Obj in (CAR (NC.CollectReferences ID NIL PSA.Database NIL T)) when (EQUAL LinkID (fetch (NOTECARDLINK LINKID) of (CAR Obj))) do (if (NOT WasActiveP) then (NCP.DeactivateCards ID)) (RETURN (LIST (QUOTE LOCAL) ID (CDR Obj))))))))) (NCP.MaxIDNum (LAMBDA NIL (* rht: "13-Oct-84 15:50") (* * Return the ID # of the highest existing card in current notefile.) (SUB1 (SUBATOM (NC.GetNewID PSA.Database T) 4)))) (NCP.GetTypeRecord (LAMBDA (TypeName) (* rht: "26-Oct-84 17:40") (* * Return the record corresponding to this type name.) (for Type in NC.CardTypes when (EQ TypeName (fetch (NoteCardType TypeName) of Type)) do (RETURN Type)))) (NCP.GetSubstanceRecord (LAMBDA (SubstanceName) (* rht: "26-Oct-84 17:43") (* * Return the record corresponding to this substance name.) (for SubstanceRec in NC.SubstanceTypes when (EQ SubstanceName (fetch (SubstanceType SubstanceName) of SubstanceRec)) do (RETURN SubstanceRec)))) (NCP.AddTitleBarMenuItems (LAMBDA (Window NewMenuItems) (* rht: " 3-Jan-85 00:12") (* * Add the given menu items to the left button menu of Window.) (PROG ((MenuItems (fetch (MENU ITEMS) of (WINDOWPROP Window (QUOTE NoteCardsLeftButtonMenu))))) (replace (MENU ITEMS) of (WINDOWPROP Window (QUOTE NoteCardsLeftButtonMenu)) with (APPEND MenuItems NewMenuItems))))) ) (* * Global variables.) (RPAQQ NCP.LinkDisplayModes (Icon Title Label Both)) (RPAQQ NCP.TypeFnsAssocLst ((MakeCardFn . NC.MakeCardFn) (EditCardFn . NC.EditFn) (QuitCardFn . NC.QuitCardFn) (GetCardFn . NC.GetSubstanceFn) (PutCardFn . NC.PutSubstanceFn) (CopyCardFn . NC.SubstanceCopyFn) (MarkCardDirtyFn . NC.MarkCardDirtyFn) (CardDirtyPFn . NC.SubstanceDirtyPFn) (CollectLinksInCardFn . NC.CollectReferencesFn) (DeleteLinksInCardFn . NC.DelReferencesFn) (UpdateLinkIconsInCardFn . NC.UpdateLinkIconsFn))) (RPAQQ NCP.NoteCardTypeFnsFieldNames (MakeCardFn EditCardFn QuitCardFn GetCardFn PutCardFn CopyCardFn MarkCardDirtyFn CardDirtyPFn CollectLinksInCardFn DeleteLinksInCardFn UpdateLinkIconsInCardFn)) (RPAQQ NCP.SubstanceTypeFnsFieldNames (UpdateLinkIconsInSubstanceFn DeleteLinksInSubstanceFn CollectLinksInSubstanceFn SubstanceDirtyPFn MarkSubstanceDirtyFn CopySubstanceFn PutSubstanceFn GetSubstanceFn QuitSubstanceFn EditSubstanceFn CreateSubstanceFn) ) (DECLARE: DOEVAL@COMPILE DONTCOPY (GLOBALVARS NCP.LinkDisplayModes NCP.TypeFnsAssocLst NCP.SubstanceTypeFnsFieldNames NCP.NoteCardTypeFnsFieldNames) ) (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA NCP.ReportWarning NCP.ReportError NCP.PrintMsg NCP.PropSearch NCP.TitleSearch NCP.LinkLabel NCP.LinkDisplayMode NCP.CardProp NCP.CardTitle) ) (PUTPROPS NCPROGINT COPYRIGHT ("Xerox Corporation" 1984 1985)) (DECLARE: DONTCOPY (FILEMAP (NIL (4456 13646 (NCP.CreateNoteFile 4466 . 4999) (NCP.OpenNoteFile 5001 . 5447) ( NCP.CloseNoteFile 5449 . 5891) (NCP.RepairNoteFile 5893 . 6300) (NCP.CompactNoteFile 6302 . 6712) ( NCP.DeleteNoteFile 6714 . 7121) (NCP.FloppyRestoreNoteFile 7123 . 7562) (NCP.FloppyBackupNoteFile 7564 . 8003) (NCP.CurrentNoteFileStream 8005 . 8244) (NCP.CurrentNoteFile 8246 . 8498) ( NCP.CheckInNoteFile 8500 . 11067) (NCP.CheckOutNoteFile 11069 . 13179) (NCP.LockFileName 13181 . 13644 )) (13713 20493 (NCP.CardTypes 13723 . 13929) (NCP.SubstanceTypes 13931 . 14238) (NCP.CreateCardType 14240 . 15103) (NCP.CreateSubstanceType 15105 . 15949) (NCP.CardTypeSuper 15951 . 16339) ( NCP.CardTypeSubstance 16341 . 16736) (NCP.CardTypeLinkDisplayMode 16738 . 17149) (NCP.CardTypeFn 17151 . 17722) (NCP.CardTypeInheritedFn 17724 . 18334) (NCP.SubstanceTypeFn 18336 . 18813) ( NCP.ValidCardType 18815 . 19088) (NCP.ValidSubstanceType 19090 . 19388) (NCP.ValidCardTypeFn 19390 . 19693) (NCP.ValidSubstanceTypeFn 19695 . 20020) (NCP.CardTypeFns 20022 . 20252) (NCP.SubstanceTypeFns 20254 . 20491)) (20539 27560 (NCP.CreateCard 20549 . 22483) (NCP.CreateTextCard 22485 . 22825) ( NCP.CreateFileBox 22827 . 23367) (NCP.CreateBrowserCard 23369 . 24604) (NCP.CreateSketchCard 24606 . 24910) (NCP.CreateGraphCard 24912 . 25209) (NCP.MakeDocument 25211 . 26411) (NCP.MakeLinkIndex 26413 . 27558)) (27599 47552 (NCP.BringUpCard 27609 . 28153) (NCP.CardType 28155 . 28408) (NCP.ValidCard 28410 . 28662) (NCP.ActiveCardP 28664 . 28885) (NCP.ActivateCards 28887 . 29406) (NCP.DeactivateCards 29408 . 30155) (NCP.CardTitle 30157 . 31011) (NCP.FileCards 31013 . 31973) (NCP.UnfileCards 31975 . 34168) (NCP.CardParents 34170 . 34649) (NCP.FileBoxChildren 34651 . 35138) (NCP.GetLinks 35140 . 37830 ) (NCP.CardPropList 37832 . 38046) (NCP.CardProp 38048 . 39288) (NCP.CardAddProp 39290 . 40227) ( NCP.CardDelProp 40229 . 41323) (NCP.CardSubstance 41325 . 41861) (NCP.CardRegion 41863 . 42393) ( NCP.CardAddText 42395 . 43400) (NCP.ChangeLoc 43402 . 44692) (NCP.DeleteCards 44694 . 45175) ( NCP.FileBoxP 45177 . 45396) (NCP.AllCards 45398 . 45733) (NCP.AllBoxes 45735 . 46135) (NCP.MapCards 46137 . 46539) (NCP.MapBoxes 46541 . 46958) (NCP.GetContentsFileBox 46960 . 47158) ( NCP.GetOrphansFileBox 47160 . 47348) (NCP.GetToBeFiledFileBox 47350 . 47550)) (47594 57106 ( NCP.LocalGlobalLink 47604 . 49428) (NCP.GlobalGlobalLink 49430 . 50556) (NCP.GlobalLocalLink 50558 . 50855) (NCP.LocalLocalLink 50857 . 51160) (NCP.LinkDesc 51162 . 51765) (NCP.LinkDisplayMode 51767 . 53189) (NCP.LinkLabel 53191 . 54618) (NCP.GetLinkSource 54620 . 54951) (NCP.GetLinkDestination 54953 . 55299) (NCP.DeleteLinks 55301 . 56023) (NCP.ValidLink 56025 . 56324) (NCP.AllLinks 56326 . 56654) ( NCP.MapLinks 56656 . 57104)) (57155 60882 (NCP.CreateLinkLabel 57165 . 57598) (NCP.DeleteLinkLabel 57600 . 58419) (NCP.RenameLinkLabel 58421 . 59790) (NCP.GetLinkLabels 59792 . 60024) ( NCP.GetReverseLinkLabels 60026 . 60350) (NCP.GetUserLinkLabels 60352 . 60628) (NCP.ValidLinkLabel 60630 . 60880)) (60909 68640 (NCP.GetCardTypes 60919 . 61128) (NCP.TitleSearch 61130 . 61603) ( NCP.PropSearch 61605 . 62610) (NCP.WhichCard 62612 . 63030) (NCP.CardFromWindow 63032 . 63279) ( NCP.CardWindow 63281 . 63571) (NCP.SelectCards 63573 . 63927) (NCP.DocumentParameters 63929 . 65596) ( NCP.NoteCardsParameters 65598 . 67510) (NCP.PrintMsg 67512 . 67970) (NCP.ClearMsg 67972 . 68234) ( NCP.AskUser 68236 . 68638)) (68678 72253 (NCP.ReportError 68688 . 69010) (NCP.ReportWarning 69012 . 69311) (NCP.ValidID 69313 . 69508) (NCP.LinkAnchorDesc 69510 . 70749) (NCP.MaxIDNum 70751 . 71020) ( NCP.GetTypeRecord 71022 . 71358) (NCP.GetSubstanceRecord 71360 . 71759) (NCP.AddTitleBarMenuItems 71761 . 72251))))) STOP