(DEFINE-FILE-INFO PACKAGE "XCL-USER" READTABLE "XCL" BASE 10) (il:filecreated " 5-May-88 10:47:42" il:|{EG:PARC:XEROX}LISP>MEDLEY>SEDIT-PROFILE.;2| 5216 il:|changes| il:|to:| (il:fns sedit::setup-profile) il:|previous| il:|date:| " 5-May-88 09:59:40" il:|{EG:PARC:XEROX}LISP>MEDLEY>SEDIT-PROFILE.;1|) ; Copyright (c) 1988 by Xerox Corporation. All rights reserved. (il:prettycomprint il:sedit-profilecoms) (il:rpaqq il:sedit-profilecoms ((il:* il:|;;;| "Patch to SEdit that makes SEdit use the package and readtable for the file that contains an item, rather than the package of the name of the item and the current readtable.") (il:functions sedit::profile-package sedit::profile-readtable) (il:* il:|;;| "A hacked version of an SEdit function that uses the above functions") (il:fns sedit::setup-profile) (il:* il:|;;| "") (il:declare\: il:donteval@load il:eval@compile il:dontcopy (il:files il:sedit-decls) (il:globalvars il:*default-makefile-environment*)) (il:* il:|;;| "") (il:declare\: il:dontcopy (il:props (il:sedit-profile il:makefile-environment) (il:sedit-profile il:filetype))))) (il:* il:|;;;| "Patch to SEdit that makes SEdit use the package and readtable for the file that contains an item, rather than the package of the name of the item and the current readtable." ) (defun sedit::profile-package (il:name type) "What package should be used when editing the item?" (labels ((il:coerce-to-package (il:x) (cond ((null il:x) nil) ((packagep il:x) il:x) ((consp il:x) (il:coerce-to-package (eval il:x))) ((or (stringp il:x) (symbolp il:x)) (find-package il:x)) (t nil))) (il:makefile-environment-package (il:mfe) (cond (il:mfe (il:coerce-to-package (getf il:mfe :package))) (t nil)))) (or (ignore-errors (or (and il:name (not (il:memb type (quote (il:proplst il:|Expression|)))) (let ((il:files (il:whereis il:name type))) (cond (il:files (or (dolist (il:file (il:whereis il:name type)) (let ((il:file-package (il:makefile-environment-package (get il:file (quote il:makefile-environment))))) (cond (il:file-package (return il:file-package)) (t nil)))) (il:if (il:litatom il:name) il:then (symbol-package il:name) il:else nil) (il:makefile-environment-package il:*default-makefile-environment*)))))) (and il:name (symbolp il:name) (symbol-package il:name)) (il:makefile-environment-package il:*default-makefile-environment*))) *package*))) (defun sedit::profile-readtable (il:name type) "What readtable should be used when editing the item?" (labels ((il:coerce-to-readtable (il:x) (cond ((null il:x) nil) ((readtablep il:x) il:x) ((consp il:x) (il:coerce-to-readtable (eval il:x))) ((or (stringp il:x) (symbolp il:x)) (il:find-readtable il:x)) (t nil)))) (or (and il:name (not (il:memb type (quote (il:proplst il:|Expression|)))) (let ((il:files (il:whereis il:name type))) (when il:files (il:coerce-to-readtable (getf (or (get (first il:files) (quote il:makefile-environment)) il:*default-makefile-environment*) :readtable))))) *readtable*))) (il:* il:|;;| "A hacked version of an SEdit function that uses the above functions") (il:defineq (sedit::setup-profile (il:lambda (sedit::profile sedit::context) (il:* il:\; "Edited 5-May-88 10:46 by Rao") (il:* il:|;;;| "here we set up the specifics about the profile of the world we're editing in, based on what we're editing. this function must be called under WITH-PROFILE, so that the current bindings reflect the profile, because we update the profile by changing the binding as necessary and then re-saving the profile.") (il:* il:|;;;| "Use current readtable, print-base, print-case, print-level, print-length.") (il:* il:|;;;| "Set package based on name of structure editing. Maybe should be changed to reflect package of profile of file function lives in.") (il:* il:|;;;| "The rest get forced to appropriate values for editing.") (let ((sedit::name (il:|fetch| sedit::icon-title il:of sedit::context)) (type (il:fetch sedit::edit-type il:of sedit::context))) (il:setq *read-base* 10) (il:setq *read-suppress* nil) (il:* il:|;;| "Set package and readtable as determined by the file that the item lives in.") (il:setq *package* (sedit::profile-package sedit::name type)) (il:setq *readtable* (sedit::profile-readtable sedit::name type)) (il:* il:|;;| "") (il:setq *print-escape* t) (il:* il:\; "shouldn't matter") (il:setq *print-pretty* nil) (il:setq *print-circle* nil) (il:setq *print-radix* (il:neq *print-base* 10)) (il:* il:\; "interlisp semantics ") (il:setq *print-gensym* t) (il:setq *print-array* nil) (il:* il:\; "until we can edit ") (il:setq *print-structure* nil) (il:* il:\; "the structures.") (save-profile sedit::profile))) ) ) (il:* il:|;;| "") (il:declare\: il:donteval@load il:eval@compile il:dontcopy (il:filesload il:sedit-decls) (il:declare\: il:doeval@compile il:dontcopy (il:globalvars il:*default-makefile-environment*) ) ) (il:* il:|;;| "") (il:declare\: il:dontcopy (il:putprops il:sedit-profile il:makefile-environment (:package "XCL-USER" :readtable "XCL" :base 10)) (il:putprops il:sedit-profile il:filetype :compile-file) ) (il:putprops il:sedit-profile il:copyright ("Xerox Corporation" 1988)) (il:declare\: il:dontcopy (il:filemap (nil (3105 4681 (sedit::setup-profile 3118 . 4679))))) il:stop