(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED "30-Sep-88 16:04:23" {QV}<IDE>1.4>DSJPATCH076.;4 7246
changes to%: (FNS NCP.RenameCrossFileLinksDestination)
(VARS DSJPATCH076COMS)
previous date%: "29-Sep-88 20:26:59" {QV}<IDE>1.4>DSJPATCH076.;1)
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT DSJPATCH076COMS)
(RPAQQ DSJPATCH076COMS [
(* ;;
"New fns that should be added to NCPROGINT in Notecards; if not, then NCNEWPROGINT in IDE.")
(FNS NCP.RenameCrossFileLinksDestination)
(DECLARE%: DONTCOPY (PROPS (DSJPATCH076 MAKEFILE-ENVIRONMENT)
(DSJPATCH076 FILETYPE])
(* ;; "New fns that should be added to NCPROGINT in Notecards; if not, then NCNEWPROGINT in IDE.")
(DEFINEQ
(NCP.RenameCrossFileLinksDestination
[LAMBDA (SourceNFs OldDestNoteFiles NewDestNoteFile MainWindow)
(* ; "Edited 30-Sep-88 16:00 by DSJ")
(* ;;
"dsj. 9/29/88. Rename all OldDestNoteFiles for crossfile links in SourceNF to NewDestNoteFile.")
(if SourceNFs
then
(SETQ NewDestNoteFile (MKATOM NewDestNoteFile))
(PROG (ChangeHost/Filename NewDestNFExtension (UnpackedNewDestNF (UNPACKFILENAME
NewDestNoteFile)))
(* ; "Is new dest a valid name?")
(if (AND (SETQ NewDestNFExtension (LISTGET UnpackedNewDestNF 'EXTENSION))
(NOT (EQ 'NOTEFILE NewDestNFExtension)))
then (* ; "not valid name; goodbye")
(NCP.PrintMsg MainWindow T "Invalid file name given for destination notefile."
"
No notefiles renamed.")
(NCP.ClearMsg MainWindow T 2000)
(RETURN)
else (* ; "valid filename given; go to it.")
(NCP.PrintMsg MainWindow T "Renaming destination notefiles for source notefile...
")
(SETQ SourceNFs (MKLIST SourceNFs))
(SETQ OldDestNoteFiles (MKLIST OldDestNoteFiles))
(* ; "append .notefile ext if needed")
(if NewDestNFExtension
else (LISTPUT UnpackedNewDestNF 'EXTENSION 'NOTEFILE)
(SETQ NewDestNoteFile (PACKFILENAME UnpackedNewDestNF)))
(* ;
"Determine what part of the name to change (do this computation outside the mapcar). ")
(SETQ ChangeHost/Filename (if (LISTGET UnpackedNewDestNF 'HOST)
then (if (LISTGET UnpackedNewDestNF 'NAME)
then (* ; "there's a host and name")
'HostAndName
else (* ; "just a host to change")
(SETQ NewDestNoteFile (LISTGET
UnpackedNewDestNF
'HOST))
'HostOnly)
else (* ; "just a name to change")
'NameOnly))
[for SourceNF in SourceNFs
do
(NCP.PrintMsg MainWindow NIL SourceNF "...
")
(NCP.MapCardsOfType
'CrossFileLink
(NCP.NoteFileFromFileName SourceNF)
(LAMBDA (Card)
(PROG (Substance UnpackedOldDestFileHint NewDestFileHint)
(if (NOT (NCP.CardCachedP Card))
then
(* ;; "cache it; leave it cached ")
(NCP.CacheCards Card))
(if (NCP.ValidCardP Card)
then (SETQ Substance (NC.FetchSubstance Card))
(if (MEMBER (fetch (CrossFileLinkSubstance
CrossFileLinkDestFileHint)
of Substance)
OldDestNoteFiles)
then
(* ;; "Change dest notefile hint ")
(SETQ UnpackedOldDestFileHint
(UNPACKFILENAME (fetch (CrossFileLinkSubstance
CrossFileLinkDestFileHint
) of Substance)))
(SETQ NewDestFileHint
(SELECTQ ChangeHost/Filename
(HostAndName NewDestNoteFile)
(HostOnly (LISTPUT UnpackedOldDestFileHint
'HOST NewDestNoteFile)
(PACKFILENAME UnpackedOldDestFileHint))
(NameOnly (LISTPUT UnpackedNewDestNF 'HOST
(LISTGET UnpackedOldDestFileHint
'HOST))
(PACKFILENAME UnpackedNewDestNF))
(SHOULDNT)))
(replace (CrossFileLinkSubstance
CrossFileLinkDestFileHint) of Substance
with NewDestFileHint)
(* ;; "Mark it dirty")
(NCP.MarkCardDirty Card]
(NCP.PrintMsg MainWindow NIL "done. ")
(RETURN T])
)
(DECLARE%: DONTCOPY
(PUTPROPS DSJPATCH076 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS DSJPATCH076 FILETYPE :TCOMPL)
)
(PUTPROPS DSJPATCH076 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (932 6992 (NCP.RenameCrossFileLinksDestination 942 . 6990)))))
STOP