(FILECREATED " 3-Dec-85 15:12:25" {QV}<NOTECARDS>RELEASE1.2I>NCPROGINT.;18 86032
changes to: (FNS NCP.LocalGlobalLink)
previous date: " 7-Oct-85 11:44:03" {QV}<NOTECARDS>RELEASE1.2I>NCPROGINT.;15)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCPROGINTCOMS)
(RPAQQ NCPROGINTCOMS ((E (SETQ NC.SystemDate (DATE))
(PUTPROP (QUOTE NC.SystemDate)
(QUOTE NewestFile)
(ROOTFILENAME (FULLNAME (OUTPUT)))))
(* * Notefile creation and access)
(FNS NCP.CreateNoteFile NCP.OpenNoteFile NCP.CloseNoteFile NCP.RepairNoteFile
NCP.CompactNoteFile NCP.CompactNoteFileInPlace NCP.DeleteNoteFile
NCP.CurrentNoteFileStream NCP.CurrentNoteFile NCP.CheckInNoteFile NCP.CheckOutNoteFile
NCP.LockFileName NCP.AbortSession NCP.CheckpointSession)
(* * 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.CardTypeVar NCP.CardTypeInheritedField NCP.SubstanceTypeFn NCP.SubstanceTypeVar
NCP.ValidCardType NCP.ValidSubstanceType NCP.ValidCardTypeFn NCP.ValidCardTypeVar
NCP.ValidSubstanceTypeFn NCP.ValidSubstanceTypeVar NCP.CardTypeFns NCP.CardTypeVars
NCP.SubstanceTypeFns NCP.SubstanceTypeVars NCP.CardTypeDisplayedInMenu)
(* * Following is for backward compatibility with 1.1.)
(P (MOVD (QUOTE NCP.CardTypeInheritedField)
(QUOTE NCP.CardTypeInheritedFn)
T))
(* * Creating Notecards and fileboxes)
(FNS NCP.CreateCard NCP.CreateTextCard NCP.CreateFileBox NCP.CreateBrowserCard
NCP.CreateStructEditBrowserCard NCP.CreateSketchCard NCP.CreateGraphCard
NCP.CreateStructEditCard 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)
(* * Dealing with card parts dates.)
(RECORDS NOTECARDDATES)
(FNS NCP.GetCardDates)
(* * 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 NCP.RemoveDeletedIconsFromTextCard)
(* * Handy internal functions)
(FNS NCP.ReportError NCP.ReportWarning NCP.ValidID NCP.LinkAnchorDesc NCP.MaxIDNum
NCP.GetTypeRecord NCP.GetSubstanceRecord NCP.AddTitleBarMenuItems NCP.MakeBrowser)
(* * Global variables.)
(VARS (NCP.LinkDisplayModes (QUOTE (Icon Title Label Both)))
(NCP.TypeFieldsAssocLst (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)
(InsertLinkInCardFn . NC.InsertLinkFn)
(TranslateWindowPositionToCardPositionFn .
NC.TranslateWindowPositionFn)
(CardDefaultWidth . NC.DefaultWidthFromType)
(CardDefaultHeight . NC.DefaultHeightFromType))))
(NCP.NoteCardTypeFnsFieldNames (QUOTE (MakeCardFn EditCardFn QuitCardFn GetCardFn
PutCardFn CopyCardFn MarkCardDirtyFn
CardDirtyPFn CollectLinksInCardFn
DeleteLinksInCardFn
UpdateLinkIconsInCardFn
InsertLinkInCardFn
TranslateWindowPositionToCardPositionFn)))
(NCP.NoteCardTypeVarsFieldNames (QUOTE (LinkDisplayMode CardDefaultWidth
CardDefaultHeight
CardLinkAnchorModesSupported
CardDisplayedInMenuFlg)))
(NCP.SubstanceTypeFnsFieldNames (QUOTE (CreateSubstanceFn EditSubstanceFn
QuitSubstanceFn
GetSubstanceFn PutSubstanceFn
CopySubstanceFn
MarkSubstanceDirtyFn
SubstanceDirtyPFn
CollectLinksInSubstanceFn
DeleteLinksInSubstanceFn
UpdateLinkIconsInSubstanceFn
InsertLinkInSubstanceFn
TranslateWindowPositionToSubstancePositionFn)))
(NCP.SubstanceTypeVarsFieldNames (QUOTE (SubstanceDefaultWidth SubstanceDefaultHeight
SubstanceLinkAnchorModesSupported))))
(GLOBALVARS NCP.LinkDisplayModes NCP.TypeFnsAssocLst NCP.SubstanceTypeFnsFieldNames
NCP.NoteCardTypeFnsFieldNames NCP.NoteCardTypeVarsFieldNames
NCP.SubstanceTypeVarsFieldNames NC.MakeDocParameters NC.CardTypes
NC.SubstanceTypes PSA.Database NC.SystemLinkLabels NC.FiledCardLinkLabel
NC.SubBoxLinkLabel NC.RootID NC.OrphanID NC.UnclassifiedID)
(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 NCP.CardTypeDisplayedInMenu)))))
(* * 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.CompactNoteFileInPlace
(LAMBDA (FileName) (* rht: "18-Mar-85 11:53")
(* * Prog's intface function for compacting a notefile in place.)
(PROG ((FileNameWithExt (NC.DatabaseFileName "Name of NoteFile to be compacted in place: " " -- "
T NIL FileName)))
(AND FileNameWithExt (RETURN (NC.CompactDatabaseInPlace 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.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))))
(NCP.AbortSession
(LAMBDA NIL (* rht: "18-Mar-85 16:26")
(* * Abort this Notecards session, losing all work since last checkpoint.)
(NC.AbortSession)))
(NCP.CheckpointSession
(LAMBDA NIL (* rht: "18-Mar-85 16:32")
(* * Checkpoint the current notefile, writing out any dirty cards.)
(NC.CheckpointDatabase)))
)
(* * 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 FnsAssocList VarsAssocList)
(* rht: "20-Mar-85 14:13")
(* * Make a new card type. If there is already a card type by that name, then print message and overwrite.)
(COND
((FMEMB TypeName (NCP.GetCardTypes))
(NCP.ReportWarning "Redefining NoteCard type: " TypeName)))
(NC.AddCardType TypeName SuperType SubstanceType FnsAssocList VarsAssocList)
TypeName))
(NCP.CreateSubstanceType
(LAMBDA (SubstanceName FnsAssocList VarsAssocList) (* rht: " 1-Oct-85 13:55")
(* * Create a new substance type. If already exists, then print message and overwrite.)
(COND
((FMEMB SubstanceName (NCP.SubstanceTypes))
(NCP.ReportWarning "Redefining substance type: " SubstanceName)))
(NC.AddSubstanceType SubstanceName FnsAssocList VarsAssocList)))
(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.CardTypeVar
(LAMBDA (TypeName Var) (* rht: "20-Mar-85 15:47")
(* * Return the variable stored as the Var for TypeName's record.)
(if (NCP.ValidCardType TypeName)
then (if (NCP.ValidCardTypeVar Var)
then (RECORDACCESS Var (NCP.GetTypeRecord TypeName)
NIL
(QUOTE FETCH))
else (NCP.ReportError Var " is not a kind of Var for NoteCard types."))
else (NCP.ReportError TypeName " is not an existing NoteCard type.")
NIL)))
(NCP.CardTypeInheritedField
(LAMBDA (TypeName Field) (* rht: "20-Mar-85 17:27")
(* * Return the function or variable name stored as the Field for TypeName's record if non-nil.
Otherwise, return the inherited one.)
(if (NCP.ValidCardType TypeName)
then (if (APPLY* (OR (CDR (FASSOC Field NCP.TypeFieldsAssocLst))
(QUOTE NILL))
TypeName)
else (NCP.ReportError Field
" is unknown field for NoteCardTypes, or else doesn't inherit.")
NIL)
else (NCP.ReportError TypeName " is not an existing NoteCard type.")
NIL)))
(NCP.SubstanceTypeFn
(LAMBDA (SubstanceName Fn) (* rht: "20-Mar-85 15:53")
(* * Return the function stored as the Fn for SubstanceName's record.)
(if (NCP.ValidSubstanceType SubstanceName)
then (if (NCP.ValidSubstanceTypeFn Fn)
then (RECORDACCESS Fn (NCP.GetSubstanceRecord SubstanceName)
NIL
(QUOTE FETCH))
else (NCP.ReportError Fn " is not a kind of Fn for NoteCard substance types."))
else (NCP.ReportError SubstanceName " is not an existing NoteCard substance type.")
NIL)))
(NCP.SubstanceTypeVar
(LAMBDA (SubstanceName Var) (* rht: "20-Mar-85 15:55")
(* * Return the variable name stored as the Var for SubstanceName's record.)
(if (NCP.ValidSubstanceType SubstanceName)
then (if (NCP.ValidSubstanceTypeVar Var)
then (RECORDACCESS Var (NCP.GetSubstanceRecord SubstanceName)
NIL
(QUOTE FETCH))
else (NCP.ReportError Var " is not a kind of Var for NoteCard substance types."))
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.ValidCardTypeVar
(LAMBDA (CardTypeVar) (* rht: "20-Mar-85 15:56")
(* * Returns non-nil if CardTypeVar is one of the Var fields of the NoteCardType record.)
(AND (FMEMB CardTypeVar NCP.NoteCardTypeVarsFieldNames)
CardTypeVar)))
(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.ValidSubstanceTypeVar
(LAMBDA (SubstanceTypeVar) (* rht: "20-Mar-85 15:58")
(* * Returns non-nil if SubstanceTypeVar is one of the Fn fields of the SubstanceType record.)
(AND (FMEMB SubstanceTypeVar NCP.SubstanceTypeVarsFieldNames)
SubstanceTypeVar)))
(NCP.CardTypeFns
(LAMBDA NIL (* rht: "26-Oct-84 18:25")
(* * Returns list of the fns fields of the NoteCardType record.)
NCP.NoteCardTypeFnsFieldNames))
(NCP.CardTypeVars
(LAMBDA NIL (* rht: "20-Mar-85 15:43")
(* * Returns list of the vars fields of the NoteCardType record.)
NCP.NoteCardTypeVarsFieldNames))
(NCP.SubstanceTypeFns
(LAMBDA NIL (* rht: "26-Oct-84 18:25")
(* * Returns list of the fns fields of the SubstanceType record.)
NCP.SubstanceTypeFnsFieldNames))
(NCP.SubstanceTypeVars
(LAMBDA NIL (* rht: "20-Mar-85 15:44")
(* * Returns list of the vars fields of the SubstanceType record.)
NCP.SubstanceTypeVarsFieldNames))
(NCP.CardTypeDisplayedInMenu
(LAMBDA Args (* rht: " 4-Oct-85 14:59")
(* * Expects one or two args: CardType and optional new value for CardDisplayedInMenuFlg. Always returns the old
value of CardDisplayedInMenuFlg for given card type.)
(LET (CardType CardTypeRecord)
(if (OR (EQ Args 1)
(EQ Args 2))
then (if (NCP.ValidCardType (SETQ CardType (ARG Args 1)))
then (PROG1 (fetch (NoteCardType CardDisplayedInMenuFlg) of (SETQ CardTypeRecord
(NCP.GetTypeRecord
CardType)))
(if (EQ Args 2)
then (replace (NoteCardType CardDisplayedInMenuFlg) of
CardTypeRecord
with (ARG Args 2))
(SETQ NC.NoteCardTypeMenu NIL)))
else (NCP.ReportError CardType " not an existing NoteCard type.")
NIL)
else (NCP.ReportError "Improper number of args to NCP.CardTypeDisplayedInMenu.")
NIL))))
)
(* * Following is for backward compatibility with 1.1.)
(MOVD (QUOTE NCP.CardTypeInheritedField)
(QUOTE NCP.CardTypeInheritedFn)
T)
(* * 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 ParamList NoDisplayFlg Props ParentFileBoxes)
(* rht: "18-Mar-85 16:49")
(* * Creates a new browser notecard with given type, title, props, parents, starting ID and link labels.)
(NCP.MakeBrowser Title ParamList NoDisplayFlg Props ParentFileBoxes NIL)))
(NCP.CreateStructEditBrowserCard
(LAMBDA (Title ParamList NoDisplayFlg Props ParentFileBoxes)
(* rht: "18-Mar-85 16:52")
(* * Creates a browser card in which edits to the structure affect underlying notecards structure.)
(NCP.MakeBrowser Title ParamList NoDisplayFlg Props ParentFileBoxes T)))
(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.CreateStructEditCard
(LAMBDA (Title NoDisplayFlg Props ParentFileBoxes) (* rht: "18-Mar-85 16:54")
(* * Creates a new StructEdit notecard with given title, props and parents. Just like a Graph card except that edits
in the card cause changes to underlying Notecards structure.)
(NCP.CreateCard (QUOTE StructEdit)
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: " 7-Oct-85 11:43")
(* * Uncache all the info for any active cards in IDs.)
(* * rht 10/5/85: Took out call to GIVE.TTY.PROCESS. Can't see why we wanted to give tty process to a card about to
be closed. Also fixed to note value returned by NC.QuitCard.)
(for ID in (MKLIST IDs) bind Win (OldProc ←(TTY.PROCESS))
do (if (NOT (NCP.ValidID ID))
then (NCP.ReportError ID " not an existing card or filebox.")
elseif (AND (NCP.ActiveCardP ID)
(NEQ (NC.QuitCard ID T)
(QUOTE DON'T))
(SETQ Win (NC.FetchWindow ID)))
then (bind (Process ←(WINDOWPROP Win (QUOTE PROCESS))) until (OR (NULL Process)
(PROCESS.FINISHEDP
Process))
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: "12-Sep-85 15:13")
(* * 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. Note that this leaves card active even if inactive when we were called.)
(if (AND (NCP.ValidID ID)
(EQ (NCP.CardTypeSubstance (NCP.CardType ID))
(QUOTE TEXT)))
then (if (NOT (NCP.ActiveCardP ID))
then (NCP.ActivateCards ID))
(LET ((Stream (NC.FetchSubstance ID)))
(SELECTQ Loc
((START 0)
(TEDIT.SETSEL Stream 0 0 (QUOTE RIGHT)))
(END (TEDIT.SETSEL Stream (ADD1 (fetch (TEXTOBJ TEXTLEN) of (TEXTOBJ Stream)))
0
(QUOTE RIGHT)))
NIL)
ID)
else (NCP.ReportError ID " not an existing card or non-TEXT substance type.")
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: " 3-Dec-85 15:10")
(* * Create a link from within the text of the FromID card to the ToID card.)
(* * rht 4/1/85: Changed to handle old-style link display modes.)
(* * rht 12/3/85: Changed call to NC.InsertLinkInText to pass FromLoc arg.)
(PROG (WasActive)
(OR DisplayMode (SETQ DisplayMode (NCP.CardTypeVar (NCP.CardType FromID)
(QUOTE LinkDisplayMode))))
(if (FMEMB DisplayMode NCP.LinkDisplayModes)
then (SETQ DisplayMode (NC.MakeNewDisplayMode DisplayMode))
elseif (NOT (type? LINKDISPLAYMODE DisplayMode))
then (NCP.ReportError DisplayMode " is invalid link display mode." (CHARACTER 13)
"No link created.")
(RETURN NIL))
(if (EQ Label NC.FiledCardLinkLabel)
then (if (AND (NOT (NCP.FileBoxP ToID))
(NCP.FileBoxP FromID))
then (OR (SETQ WasActive (NCP.ActiveCardP FromID))
(NCP.ActivateCards FromID))
(NCP.ChangeLoc FromID FromLoc)
(NCP.FileCards ToID FromID)
(RETURN (PROG1 (CAR (NCP.GetLinks FromID ToID NC.FiledCardLinkLabel))
(OR WasActive (NCP.DeactivateCards 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 (OR (SETQ WasActive (NCP.ActiveCardP FromID))
(NCP.ActivateCards FromID))
(NCP.ChangeLoc FromID FromLoc)
(NCP.FileCards ToID FromID)
(RETURN (PROG1 (CAR (NCP.GetLinks FromID ToID NC.SubBoxLinkLabel))
(OR WasActive (NCP.DeactivateCards FromID))))
else (NCP.ReportError "SubBox link must be from a box to a box." (CHARACTER
13)
"No link created.")
(RETURN NIL))) (* Inserting non-hierarchical link into a filebox.)
(if (NCP.FileBoxP FromID)
then (NCP.ReportError "Local links from fileboxes must be either SubBox or FiledCard."
(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 NIL NIL NIL T))
then (NCP.CreateLinkLabel Label)
else (RETURN NIL)))
(OR (SETQ WasActive (NCP.ActiveCardP FromID))
(NCP.ActivateCards FromID))
(RETURN (PROG1 (NC.InsertLinkInText (NC.FetchSubstance FromID)
Label ToID FromID DisplayMode
(COND
((NUMBERP FromLoc)
FromLoc)
((EQ FromLoc (QUOTE START))
1)
((EQ FromLoc (QUOTE END))
(MAX (fetch (TEXTOBJ TEXTLEN)
of (TEXTOBJ (NC.FetchSubstance FromID)))
1))
(T NIL)))
(OR WasActive (NCP.DeactivateCards FromID)))))))
(NCP.GlobalGlobalLink
(LAMBDA (Label FromID ToID) (* rht: "30-May-85 21:48")
(* * 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 NIL NIL 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: "10-Feb-85 00:18")
(* * 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) of Link)
(if (EQ Args 2)
then (SETQ NewMode (ARG Args 2))
(if (FMEMB NewMode NCP.LinkDisplayModes)
then (SETQ NewMode (NC.MakeNewDisplayMode NewMode)))
(if (type? LINKDISPLAYMODE NewMode)
then (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 NewMode
" is invalid link display mode.")))))
else (NCP.ReportError Link " is not a valid link.")
(RETURN NIL)))))
(NCP.LinkLabel
(LAMBDA Args (* rht: "30-May-85 21:49")
(* * 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.)
(* * rht 2/8/85: Now makes sure source card of link is active before calling NC.RelabelLink.)
(PROG (Link NewLabel ID)
(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 NIL NIL NIL T))
(NCP.CreateLinkLabel NewLabel)))
(if (NCP.ActiveCardP (SETQ ID (fetch (NOTECARDLINK
SOURCEID)
of Link)))
then (NC.RelabelLink Link NIL NewLabel T)
else (NCP.ActivateCards ID)
(NC.RelabelLink Link NIL NewLabel T)
(NCP.DeactivateCards ID)))))))
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))))
)
(* * Dealing with card parts dates.)
[DECLARE: EVAL@COMPILE
(TYPERECORD NOTECARDDATES (SUBSTANCEDATE LINKSDATE TITLEDATE PROPLISTDATE))
]
(DEFINEQ
(NCP.GetCardDates
(LAMBDA (Card) (* rht: "17-Aug-85 21:16")
(* * Returns an instance of the NOTECARDDATES record filled in with the current dates of the card parts of Card.)
(if (NCP.ValidID Card)
then (LET ((WasActive (NCP.ActiveCardP Card)))
(OR WasActive (NCP.ActivateCards Card))
(PROG1 (create NOTECARDDATES
SUBSTANCEDATE ←(NC.FetchItemDate Card)
LINKSDATE ←(NC.FetchLinksDate Card)
TITLEDATE ←(NC.FetchTitleDate Card)
PROPLISTDATE ←(NC.FetchPropListDate Card))
(OR WasActive (NCP.DeactivateCards Card))))
else (NCP.Report Error Card " not an existing card.")
NIL)))
)
(* * 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: "15-Mar-85 19:41")
(* * 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 Prop
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: "20-Mar-85 11:30")
(* * 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.)
(* * rht 3/20/85: Changed to use new GLOBALPARAMETER record, especially the CheckFn field.)
(PROG (OldParams PropVal)
(SETQ OldParams (for Param in NC.NoteCardsParameters
join (SETQ PropVal (GETPROP (QUOTE NC.NoteCardsParameters)
Param))
(LIST Param (EVAL (if (LISTP PropVal)
then (fetch (GLOBALPARAMETER PARAMGLOBALVAR)
of PropVal)
else PropVal)))))
(if NewParams
then (for Params on NewParams by (CDDR NewParams) bind Param NewValue GlobalVar PropVal
do (if (FMEMB (SETQ Param (CAR Params))
NC.NoteCardsParameters)
then (SETQ NewValue (CADR Params))
(SETQ PropVal (GETPROP (QUOTE NC.NoteCardsParameters)
Param))
(SETQ GlobalVar (if (LISTP PropVal)
then (fetch (GLOBALPARAMETER PARAMGLOBALVAR)
of PropVal)
else PropVal))
(if (OR (ATOM PropVal)
(APPLY* (fetch (GLOBALPARAMETER PARAMCHECKFN) of PropVal)
NewValue))
then (SET GlobalVar 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
PROMPTFORWORDFlg) (* rht: "30-May-85 21:49")
(* * Asks a question in the prompt window. Just calls the NC.AskUser function.)
(NC.AskUser Msg Prompt FirstTry ClearFirstFlg MainWindow DontCloseAtEndFlg DontClearAtEndFlg
PROMPTFORWORDFlg)))
(NCP.RemoveDeletedIconsFromTextCard
(LAMBDA (Card) (* rht: "26-Aug-85 12:12")
(* * If Card is of substance type TEXT, then remove all deleted link icons from its substance.)
(if (NCP.ValidID Card)
then (LET (TextStream Type (WasActive (NCP.ActiveCardP Card)))
(OR WasActive (NCP.ActivateCards Card))
(if (EQ (NCP.CardTypeSubstance (SETQ Type (NCP.CardType Card)))
(QUOTE TEXT))
then (SETQ TextStream (NCP.CardSubstance Card))
(for IconPair in (APPLY* (NCP.CardTypeInheritedField Type (QUOTE
CollectLinksInCardFn))
Card NIL PSA.Database T T)
do (TEDIT.DELETE TextStream (CADR IconPair)
1)))
(OR WasActive (NCP.DeactivateCards Card)))
else (NCP.ReportError Card " not an existing card or box.")
NIL)))
)
(* * 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: "31-Jan-85 21:24")
(* * Return the ID # of the highest existing card in current notefile.)
(SUB1 (SUBATOM (NC.GetNewID PSA.Database T)
3))))
(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)))))
(NCP.MakeBrowser
(LAMBDA (Title ParamList NoDisplayFlg Props ParentFileBoxes StructEditFlg)
(* rht: "20-Mar-85 15:10")
(* * 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.)
(* * rht 3/18/85: changed to take all info as a param proplist rather than as separate arguments.
Only checks validity of the Linklabels param. Will create either a StructEditBrowser or a normal Browser depending
on value of StructEditFlg.)
(PROG (ValidLinkLabels LinkLabels NewParamList)
(SETQ ValidLinkLabels (for Label in (SETQ LinkLabels (LISTGET ParamList (QUOTE LINKTYPES)))
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 (* Make a copy of the user's param list since she may
not want it to get rplaca'd.)
(SETQ NewParamList (COPY ParamList))
(LISTPUT NewParamList (QUOTE LINKTYPES)
ValidLinkLabels)
(NCP.CreateCard (if StructEditFlg
then (QUOTE Browser)
else (QUOTE StructEditBrowser))
Title NoDisplayFlg Props ParentFileBoxes NewParamList))))))
)
(* * Global variables.)
(RPAQQ NCP.LinkDisplayModes (Icon Title Label Both))
(RPAQQ NCP.TypeFieldsAssocLst ((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)
(InsertLinkInCardFn . NC.InsertLinkFn)
(TranslateWindowPositionToCardPositionFn .
NC.TranslateWindowPositionFn)
(CardDefaultWidth . NC.DefaultWidthFromType)
(CardDefaultHeight . NC.DefaultHeightFromType)))
(RPAQQ NCP.NoteCardTypeFnsFieldNames (MakeCardFn EditCardFn QuitCardFn GetCardFn PutCardFn CopyCardFn
MarkCardDirtyFn CardDirtyPFn CollectLinksInCardFn
DeleteLinksInCardFn UpdateLinkIconsInCardFn
InsertLinkInCardFn
TranslateWindowPositionToCardPositionFn))
(RPAQQ NCP.NoteCardTypeVarsFieldNames (LinkDisplayMode CardDefaultWidth CardDefaultHeight
CardLinkAnchorModesSupported
CardDisplayedInMenuFlg))
(RPAQQ NCP.SubstanceTypeFnsFieldNames (CreateSubstanceFn EditSubstanceFn QuitSubstanceFn
GetSubstanceFn PutSubstanceFn
CopySubstanceFn MarkSubstanceDirtyFn
SubstanceDirtyPFn CollectLinksInSubstanceFn
DeleteLinksInSubstanceFn
UpdateLinkIconsInSubstanceFn
InsertLinkInSubstanceFn
TranslateWindowPositionToSubstancePositionFn))
(RPAQQ NCP.SubstanceTypeVarsFieldNames (SubstanceDefaultWidth SubstanceDefaultHeight
SubstanceLinkAnchorModesSupported))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NCP.LinkDisplayModes NCP.TypeFnsAssocLst NCP.SubstanceTypeFnsFieldNames
NCP.NoteCardTypeFnsFieldNames NCP.NoteCardTypeVarsFieldNames
NCP.SubstanceTypeVarsFieldNames NC.MakeDocParameters NC.CardTypes NC.SubstanceTypes
PSA.Database NC.SystemLinkLabels NC.FiledCardLinkLabel NC.SubBoxLinkLabel NC.RootID
NC.OrphanID NC.UnclassifiedID)
)
(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
NCP.CardTypeDisplayedInMenu)
)
(PUTPROPS NCPROGINT COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (6114 15340 (NCP.CreateNoteFile 6124 . 6657) (NCP.OpenNoteFile 6659 . 7105) (
NCP.CloseNoteFile 7107 . 7549) (NCP.RepairNoteFile 7551 . 7958) (NCP.CompactNoteFile 7960 . 8370) (
NCP.CompactNoteFileInPlace 8372 . 8814) (NCP.DeleteNoteFile 8816 . 9223) (NCP.CurrentNoteFileStream
9225 . 9464) (NCP.CurrentNoteFile 9466 . 9718) (NCP.CheckInNoteFile 9720 . 12287) (
NCP.CheckOutNoteFile 12289 . 14399) (NCP.LockFileName 14401 . 14864) (NCP.AbortSession 14866 . 15099)
(NCP.CheckpointSession 15101 . 15338)) (15407 25098 (NCP.CardTypes 15417 . 15623) (NCP.SubstanceTypes
15625 . 15932) (NCP.CreateCardType 15934 . 16476) (NCP.CreateSubstanceType 16478 . 16919) (
NCP.CardTypeSuper 16921 . 17309) (NCP.CardTypeSubstance 17311 . 17706) (NCP.CardTypeLinkDisplayMode
17708 . 18119) (NCP.CardTypeFn 18121 . 18692) (NCP.CardTypeVar 18694 . 19272) (
NCP.CardTypeInheritedField 19274 . 19951) (NCP.SubstanceTypeFn 19953 . 20584) (NCP.SubstanceTypeVar
20586 . 21229) (NCP.ValidCardType 21231 . 21504) (NCP.ValidSubstanceType 21506 . 21804) (
NCP.ValidCardTypeFn 21806 . 22109) (NCP.ValidCardTypeVar 22111 . 22420) (NCP.ValidSubstanceTypeFn
22422 . 22747) (NCP.ValidSubstanceTypeVar 22749 . 23079) (NCP.CardTypeFns 23081 . 23311) (
NCP.CardTypeVars 23313 . 23546) (NCP.SubstanceTypeFns 23548 . 23785) (NCP.SubstanceTypeVars 23787 .
24027) (NCP.CardTypeDisplayedInMenu 24029 . 25096)) (25294 32281 (NCP.CreateCard 25304 . 27238) (
NCP.CreateTextCard 27240 . 27580) (NCP.CreateFileBox 27582 . 28122) (NCP.CreateBrowserCard 28124 .
28511) (NCP.CreateStructEditBrowserCard 28513 . 28902) (NCP.CreateSketchCard 28904 . 29208) (
NCP.CreateGraphCard 29210 . 29507) (NCP.CreateStructEditCard 29509 . 29930) (NCP.MakeDocument 29932 .
31132) (NCP.MakeLinkIndex 31134 . 32279)) (32320 52411 (NCP.BringUpCard 32330 . 32874) (NCP.CardType
32876 . 33129) (NCP.ValidCard 33131 . 33383) (NCP.ActiveCardP 33385 . 33606) (NCP.ActivateCards 33608
. 34127) (NCP.DeactivateCards 34129 . 35203) (NCP.CardTitle 35205 . 36059) (NCP.FileCards 36061 .
37021) (NCP.UnfileCards 37023 . 39216) (NCP.CardParents 39218 . 39697) (NCP.FileBoxChildren 39699 .
40186) (NCP.GetLinks 40188 . 42878) (NCP.CardPropList 42880 . 43094) (NCP.CardProp 43096 . 44336) (
NCP.CardAddProp 44338 . 45275) (NCP.CardDelProp 45277 . 46371) (NCP.CardSubstance 46373 . 46909) (
NCP.CardRegion 46911 . 47441) (NCP.CardAddText 47443 . 48448) (NCP.ChangeLoc 48450 . 49551) (
NCP.DeleteCards 49553 . 50034) (NCP.FileBoxP 50036 . 50255) (NCP.AllCards 50257 . 50592) (NCP.AllBoxes
50594 . 50994) (NCP.MapCards 50996 . 51398) (NCP.MapBoxes 51400 . 51817) (NCP.GetContentsFileBox
51819 . 52017) (NCP.GetOrphansFileBox 52019 . 52207) (NCP.GetToBeFiledFileBox 52209 . 52409)) (52453
64159 (NCP.LocalGlobalLink 52463 . 55983) (NCP.GlobalGlobalLink 55985 . 57125) (NCP.GlobalLocalLink
57127 . 57424) (NCP.LocalLocalLink 57426 . 57729) (NCP.LinkDesc 57731 . 58334) (NCP.LinkDisplayMode
58336 . 59840) (NCP.LinkLabel 59842 . 61671) (NCP.GetLinkSource 61673 . 62004) (NCP.GetLinkDestination
62006 . 62352) (NCP.DeleteLinks 62354 . 63076) (NCP.ValidLink 63078 . 63377) (NCP.AllLinks 63379 .
63707) (NCP.MapLinks 63709 . 64157)) (64208 67935 (NCP.CreateLinkLabel 64218 . 64651) (
NCP.DeleteLinkLabel 64653 . 65472) (NCP.RenameLinkLabel 65474 . 66843) (NCP.GetLinkLabels 66845 .
67077) (NCP.GetReverseLinkLabels 67079 . 67403) (NCP.GetUserLinkLabels 67405 . 67681) (
NCP.ValidLinkLabel 67683 . 67933)) (68086 68875 (NCP.GetCardDates 68096 . 68873)) (68902 77885 (
NCP.GetCardTypes 68912 . 69121) (NCP.TitleSearch 69123 . 69596) (NCP.PropSearch 69598 . 70531) (
NCP.WhichCard 70533 . 70951) (NCP.CardFromWindow 70953 . 71200) (NCP.CardWindow 71202 . 71492) (
NCP.SelectCards 71494 . 71848) (NCP.DocumentParameters 71850 . 73517) (NCP.NoteCardsParameters 73519
. 75769) (NCP.PrintMsg 75771 . 76229) (NCP.ClearMsg 76231 . 76493) (NCP.AskUser 76495 . 76910) (
NCP.RemoveDeletedIconsFromTextCard 76912 . 77883)) (77923 83351 (NCP.ReportError 77933 . 78255) (
NCP.ReportWarning 78257 . 78556) (NCP.ValidID 78558 . 78753) (NCP.LinkAnchorDesc 78755 . 79994) (
NCP.MaxIDNum 79996 . 80265) (NCP.GetTypeRecord 80267 . 80603) (NCP.GetSubstanceRecord 80605 . 81004) (
NCP.AddTitleBarMenuItems 81006 . 81496) (NCP.MakeBrowser 81498 . 83349)))))
STOP