(DEFINE-FILE-INFO PACKAGE "USER") (FILECREATED " 8-Oct-87 13:23:05" {POGO:AISNORTH:XEROX}<CUTTING>LISP>SEDIT-COMPILE.;5 3107 changes to: (FUNCTIONS USERSEDIT-COMPILE) (VARS SEDIT-COMPILECOMS) previous date: " 8-Oct-87 13:20:36" {POGO:AISNORTH:XEROX}<CUTTING>LISP>SEDIT-COMPILE.;4) (* " Copyright (c) 1987 by Douglass Read Cutting. All rights reserved. ") (PRETTYCOMPRINT SEDIT-COMPILECOMS) (RPAQQ SEDIT-COMPILECOMS ((* ;; "Hack to add Compile commands to Lyric SEdit") (* ;; "Note: post-Lyric SEdit already has these commands. Loading this file into a post-Lyric sysout is a no-op.") (DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) SEDIT-DECLS)) (FUNCTIONS USERSEDIT-COMPILE USERSEDIT-EXIT) (ADDVARS (\\command.table.spec (USERSEDIT-COMPILE ("Compile C-C" "Exit & compile (if editing a function)") ↑C) ((USERSEDIT-COMPILE T) NIL 1,↑C) ((USERSEDIT-EXIT NIL) NIL 1,↑X))) (P (SEDIT.RESET)) (PROP (MAKEFILE-ENVIRONMENT FILETYPE) SEDIT-COMPILE)) ) (* ;; "Hack to add Compile commands to Lyric SEdit") (* ;; "Note: post-Lyric SEdit already has these commands. Loading this file into a post-Lyric sysout is a no-op." ) (DECLARE: EVAL@COMPILE DONTCOPY (FILESLOAD (LOADCOMP) SEDIT-DECLS) ) (CLDEFUN USERSEDIT-COMPILE (USERCONTEXT USERCHARCODE &OPTIONAL USERCLOSE?) (LET ((TYPE (FETCH (EditContext EditType) OF USERCONTEXT)) (USERNAME (FETCH (EditContext IconTitle) OF USERCONTEXT)) (CLSTRUCTURE (FETCH (EditNode Structure) OF (CLSECOND (FETCH (EditNode SubNodes) OF (FETCH (EditContext Root) OF USERCONTEXT))))) (USERPROMPT-STREAM (GETSTREAM (\\get.prompt.window USERCONTEXT) (QUOTE OUTPUT)))) (CASE TYPE ((Expression VARS PROPS RECORDS) (CLFORMAT USERPROMPT-STREAM "~%%Can't compile things of type ~S." TYPE)) (T (\\complete USERCONTEXT USERCHARCODE T) (CLFORMAT USERPROMPT-STREAM "~%%Compiling ...") (CLIF (CLCONSP (ERSETQ (LET ((*STANDARD-OUTPUT* (GETSTREAM PROMPTWINDOW) (QUOTE OUTPUT))) (DECLARE (GLOBAL PROMPTWINDOW)) (CASE TYPE (FNS (CLCOMPILE USERNAME CLSTRUCTURE)) (FUNCTIONS (CLIF (AND (CLFBOUNDP USERNAME) (NOT (CLCOMPILED-FUNCTION-P (CLSYMBOL-FUNCTION USERNAME)))) (CLCOMPILE USERNAME (CLSYMBOL-FUNCTION USERNAME)) (CLFUNCALL (CLCOMPILE NIL (BQUOTE (CLLAMBDA NIL (\, CLSTRUCTURE))))))) (T (CLFUNCALL (CLCOMPILE NIL (BQUOTE (CLLAMBDA NIL (\, CLSTRUCTURE)))))))))) (CLIF USERCLOSE? (CLOSEW (FETCH (EditContext DisplayWindow) OF USERCONTEXT)) (CLFORMAT USERPROMPT-STREAM " done.")) (CLFORMAT USERPROMPT-STREAM " aborted."))))) T) (CLDEFUN USERSEDIT-EXIT (USERCONTEXT USERCHARCODE) (CLOSEW (FETCH (EditContext DisplayWindow) OF USERCONTEXT)) T) (ADDTOVAR \\command.table.spec (USERSEDIT-COMPILE ("Compile C-C" "Exit & compile (if editing a function)") ↑C) ((USERSEDIT-COMPILE T) NIL 1,↑C) ((USERSEDIT-EXIT NIL) NIL 1,↑X)) (SEDIT.RESET) (PUTPROPS SEDIT-COMPILE MAKEFILE-ENVIRONMENT (PACKAGE "USER")) (PUTPROPS SEDIT-COMPILE FILETYPE COMPILE-FILE) (PUTPROPS SEDIT-COMPILE COPYRIGHT ("Douglass Read Cutting" 1987)) (DECLARE: DONTCOPY (FILEMAP (NIL))) STOP