--- /dev/null
+"++ UNIX ++*****************************************************************
+
+ This is the MDL half of an interface between EMACS and MDL. An EMACS is
+ created as an inferior of MDL. Stuff marked in EMACS for return to MDL is
+ written to a temporary file when EMACS exits. MDL checks for the existence
+ of this file when control is returned; if the file exists, its content is
+ read into MDL, and then the file is deleted. -Shane
+
+ The other half is /usr/mlisp/medit.ml and /usr/mlisp/mim-mode.ml.
+ (gosling emacs).
+ /a/gnu/emacs/medit.el and /usr/mlisp/mim-mode.el
+ ***************************************************************************"
+
+<PACKAGE "MEDIT">
+
+<PACKAGE "PIPES"> ;"FORKS uses pipes, but I dont."
+
+<RENTRY PIPE>
+
+<ENTRY GET-PIPE READ-DESC WRITE-DESC READ-SAFE-BUFFER>
+
+<ENDPACKAGE>
+
+<RENTRY *MEDIT-EDITOR* *MEDIT-JCL*>
+
+<ENTRY MEDIT MEDIT-RESET MEDIT-QUERY MEDIT-PATH MEDIT-HELP MEDIT-ADD-DEFAULTS
+ *MEDIT-FILENAME*>
+
+<USE "FORKS" "TTY">
+
+<GDECL (*MEDIT-EDITOR* *MEDIT-FILENAME*) STRING
+ (*MEDIT-JCL*) <OR STRING <LIST [REST STRING]> FALSE>
+ (*MEDIT-QUERY?*) <OR ATOM FALSE> (*MEDIT-FORK*) <OR FALSE <CHANNEL 'FORK>>
+ (*MEDIT-DEFAULT-PATH*) <OR FALSE <LIST [REST OBLIST]>>>
+
+<SETG *MEDIT-FORK* <>>
+
+;"*MEDIT-EDITOR* is the name of the exe file for the editor fork."
+
+<OR <GASSIGNED? *MEDIT-EDITOR*>
+ ;<SETG *MEDIT-EDITOR* "GEMACS"> ;"For gosling emacs."
+ <SETG *MEDIT-EDITOR* "GNUMACS">> ;"For gnu emacs."
+
+
+<OR <GASSIGNED? *MEDIT-JCL*>
+ ;<SETG *MEDIT-JCL* "-LMEDIT"> ;"For gosling emacs."
+ <SETG *MEDIT-JCL* ("-L" "/USR/MIM/MEDIT")>> ;"For gnu emacs."
+
+<SETG *MEDIT-QUERY?* <>>
+
+<SETG *MEDIT-DEFAULT-PATH* <>>
+
+;"*MEDIT-FILENAME* is the name of the filename the editor writes as output."
+
+<OR <GASSIGNED? *MEDIT-FILENAME*>
+ <SETG *MEDIT-FILENAME* <STRING "/tmp/" <UNAME> ".medit.mud">>>
+
+<DEFINE MEDIT ("OPT" (F <>) "AUX" (OUTCHAN .OUTCHAN) FN)
+ #DECL ((OUTCHAN) <CHANNEL 'TTY> (F) <OR STRING FALSE> (FN) <CHANNEL 'PARSE>)
+ <CHANNEL-OP .OUTCHAN CLEAR-SCREEN>
+ <PRINTSTRING "[MDL => MEDIT]">
+ <CRLF>
+ <COND (,*MEDIT-FORK*
+ <CONTINUE-FORK ,*MEDIT-FORK* T>)
+ (.F
+ <SET FN <CHANNEL-OPEN PARSE .F>>
+ <SET F <CHANNEL-OP .FN NAME>>
+ <CHANNEL-CLOSE .FN>
+ <COND (<TYPE? ,*MEDIT-JCL* STRING>
+ <SETG *MEDIT-FORK*
+ <RUN-FORK ,*MEDIT-EDITOR* T T ,*MEDIT-JCL* .F>>)
+ (<TYPE? ,*MEDIT-JCL* LIST>
+ <SETG *MEDIT-FORK*
+ <RUN-FORK ,*MEDIT-EDITOR* T T !,*MEDIT-JCL* .F>>)>)
+ (T
+ <COND (<TYPE? ,*MEDIT-JCL* STRING>
+ <SETG *MEDIT-FORK*
+ <RUN-FORK ,*MEDIT-EDITOR* T T ,*MEDIT-JCL*>>)
+ (<TYPE? ,*MEDIT-JCL* LIST>
+ <SETG *MEDIT-FORK*
+ <RUN-FORK ,*MEDIT-EDITOR* T T !,*MEDIT-JCL*>>)>)>
+ <CHANNEL-OP .OUTCHAN CLEAR-SCREEN>
+ <PRINTSTRING "[MDL <= MEDIT]">
+ <CRLF>
+ <MEDIT-READ-FILE>
+ "DONE">
+
+<DEFINE MEDIT-RESET ()
+ <COND (,*MEDIT-FORK*
+ <CLOSE ,*MEDIT-FORK*>
+ <SETG *MEDIT-FORK* <>>)>
+ T>
+
+<DEFINE MEDIT-QUERY ("OPT" (BOOLEAN ,*MEDIT-QUERY?*))
+ #DECL ((BOOLEAN) <OR ATOM FALSE>)
+ <SETG *MEDIT-QUERY?* .BOOLEAN>>
+
+<DEFINE MEDIT-PATH ("OPT" (PATH ,*MEDIT-DEFAULT-PATH*))
+ #DECL ((PATH) <OR FALSE <LIST [REST OBLIST]>>)
+ <SETG *MEDIT-DEFAULT-PATH* .PATH>>
+
+<DEFINE MEDIT-FILENAME () <STRING "/tmp/" <UNAME> ".medit.mud">>
+
+<DEFINE MEDIT-READ-FILE ("AUX" (FILE <OPEN "READ" ,*MEDIT-FILENAME*>)
+ (OUTCHAN .OUTCHAN) (REDEFINE T)
+ (PATH (!<GET-PATH> !.OBLIST)) FN)
+ #DECL ((FILE) <OR <CHANNEL 'DISK> FALSE> (OUTCHAN) <CHANNEL 'TTY>
+ (REDEFINE) <SPECIAL ANY> (FN) STRING (PATH) <LIST [REST OBLIST]>)
+ <COND (.FILE
+ <SET FN <CHANNEL-OP .FILE NAME>>
+ <UNWIND <BIND ()
+ <BLOCK .PATH>
+ <PRINC "Reading from MEDIT:">
+ <REPEAT () <PRINT <EVAL <READ .FILE '<RETURN>>>>>
+ <ENDBLOCK>
+ <CLOSE .FILE>
+ <DELFILE .FN>>
+ <BIND ()
+ <ENDBLOCK>
+ <CLOSE .FILE>
+ <DELFILE .FN>>>)>>
+
+<DEFINE GET-PATH ("AUX" (PATH ()) (OUTCHAN .OUTCHAN) (INCHAN .INCHAN))
+ #DECL ((PATH) <LIST [REST OBLIST]> (INCHAN OUTCHAN) <CHANNEL 'TTY>)
+ <COND
+ (<NOT ,*MEDIT-QUERY?*>
+ <OR ,*MEDIT-DEFAULT-PATH* ()>)
+ (<AND ,*MEDIT-DEFAULT-PATH* <YES-NO "Use default path?">>
+ ,*MEDIT-DEFAULT-PATH*)
+ (<YES-NO "Do you wish to name a package?">
+ <REPEAT (NAME OBL (RESPONSE <QUERY "Package name" .INCHAN>) CH)
+ #DECL ((OBL) OBLIST (NAME) <OR ATOM FALSE> (RESPONSE) STRING
+ (CH) <OR <CHANNEL 'DISK> FALSE>)
+ <COND
+ (<EMPTY? .RESPONSE>
+ <RETURN .PATH>)
+ (<SET NAME <LOOKUP .RESPONSE <MOBLIST PACKAGE>>>
+ <SET PATH (<SET OBL <MOBLIST .NAME>> !.PATH)>
+ <COND (<SET NAME <LOOKUP <STRING !\I .RESPONSE> .OBL>>
+ <SET PATH (<MOBLIST .NAME> !.PATH)>)>)
+ (T
+ <PRINC .RESPONSE>
+ <PRINC " is not loaded.">
+ <CRLF>
+ <COND (<YES-NO <STRING "Load " .RESPONSE "?">>
+ <COND (<SET CH <L-OPEN .RESPONSE>>
+ <LOAD .CH>
+ <CLOSE .CH>)
+ (<NOT <EMPTY? <SET RESPONSE <QUERY "Filename" .INCHAN>>>>
+ <COND (<SET CH <L-OPEN .RESPONSE>>
+ <LOAD .CH>
+ <CLOSE .CH>)>)>
+ <COND (<AND <NOT <EMPTY? .RESPONSE>>
+ <SET NAME <LOOKUP .RESPONSE <MOBLIST PACKAGE>>>>
+ <SET PATH (<SET OBL <MOBLIST .NAME>> !.PATH)>
+ <COND (<SET NAME <LOOKUP <STRING !\I .RESPONSE> .OBL>>
+ <SET PATH (<MOBLIST .NAME> !.PATH)>)>)>)>)>
+ <SET RESPONSE <QUERY "Another package name" .INCHAN>>>)>>
+
+<DEFINE YES-NO (PROMPT "AUX" (INCHAN .INCHAN) (OUTCHAN .OUTCHAN))
+ #DECL ((PROMPT) STRING (INCHAN OUTCHAN) <CHANNEL 'TTY>)
+ <REPEAT (RESPONSE)
+ #DECL ((RESPONSE) CHARACTER)
+ <PRINC .PROMPT>
+ <PRINC " (Y or N): ">
+ <RESET .INCHAN>
+ <SET RESPONSE <TYI>>
+ <CRLF>
+ <COND (<MEMQ .RESPONSE "Yy"> <RETURN>)
+ (<MEMQ .RESPONSE "Nn"> <RETURN <>>)>>>
+
+<DEFINE QUERY (PROMPT "OPT" (INCHAN .INCHAN)
+ "AUX" (OUTCHAN .OUTCHAN) (S <STACK <ISTRING 64>>) N)
+ #DECL ((PROMPT S) STRING (INCHAN OUTCHAN) CHANNEL (N) FIX)
+ <PRINC .PROMPT>
+ <PRINC " (text$): ">
+ <RESET .INCHAN>
+ <SET N <READSTRING .S .INCHAN <STRING <ASCII 27>>>>
+ <CRLF>
+ <COND (<AND <G? .N 0> <==? <ASCII 27> <NTH .S .N>>> <SET N <- .N 1>>)>
+ <REPEAT ((SS:STRING <SUBSTRUC .S 0 .N <ISTRING .N>>))
+ <COND (<OR <EMPTY? .SS>
+ <N==? <ASCII 32> <1 .SS>>
+ <N==? <ASCII 9> <1 .SS>>>
+ <RETURN .SS>)
+ (T
+ <SET SS <REST .SS>>)>>>
+
+<DEFINE MEDIT-ADD-DEFAULTS ("TUPLE" NAMES "AUX" NAME OB (OUTCHAN .OUTCHAN))
+ #DECL ((NAMES) <<PRIMTYPE VECTOR> [REST STRING]> (NAME) <OR ATOM FALSE>
+ (OB) OBLIST (OUTCHAN) <CHANNEL 'TTY>)
+ <MAPF <>
+ <FUNCTION (NEW)
+ #DECL ((NEW) STRING)
+ <COND (<SET NAME <LOOKUP .NEW <SET OB <MOBLIST PACKAGE>>>>
+ <SETG *MEDIT-DEFAULT-PATH*
+ (<SET OB <MOBLIST .NAME>> !,*MEDIT-DEFAULT-PATH*)>
+ <COND (<SET NAME <LOOKUP <STRING !\I .NEW> .OB>>
+ <SETG *MEDIT-DEFAULT-PATH*
+ (<MOBLIST .NAME> !,*MEDIT-DEFAULT-PATH*)>)>
+ <PRINC "Added default ">
+ <PRINC .NEW>)
+ (T
+ <PRINC .NEW>
+ <PRINC " is not loaded.">)>
+ <CRLF>>
+ .NAMES>>
+
+ <DEFINE MEDIT-HELP ("AUX" (OUTCHAN .OUTCHAN))
+ #DECL ((OUTCHAN) <CHANNEL 'TTY>)
+ <CHANNEL-OP .OUTCHAN CLEAR-SCREEN>
+ <PRINTSTRING "
+EMACS: M-z,M-Z: marks the current DEFINE, or the immediately following DEFINE.
+
+ M-^Z: marks the entire buffer.
+
+ ^X Z: exit from MEDIT. Saves the current buffer if modified, then
+ returns to MDL, sending marked stuff to MDL.
+
+ ^X S: exit from MEDIT. Saves the current buffer if modified, then
+ returns to MDL, sending the entire buffer.
+
+MDL: <MEDIT \"OPT\" FN:STRING>
+
+ Enter EMACS. The first time that MEDIT is invoked, if FN is supplied
+ (standard file name defaults), the EMACS will read that file. FN is
+ ignored in subsequent invocations.
+
+ <MEDIT-RESET>
+
+ Kill the current EMACS if one exists. It is nice to call this before
+ killing the MDL.
+
+ <MEDIT-PATH \"OPT\" PATH:<OR FALSE <LIST [REST OBLIST]>>
+
+ PATH will be spliced in front of the normal oblist path during loading
+ from EMACS.
+
+ <MEDIT-QUERY \"OPT\" BOOL:<OR ATOM FALSE>>
+
+ If BOOL is non-false, you will be askeded if you wish to use the default
+ path (if there is one) or if you wish to name packages to be spliced
+ into the path during loading.
+
+ <MEDIT-ADD-DEFAULTS PACKAGES:<TUPLE [REST STRING]>>
+
+ Prepends oblists for PACKAGES to the default path. Each package must be
+ loaded. Prepended proceeding from right to left (leftmost will be first
+ in path).
+
+ If you plan to debug a single package, say, \"FOO\" the best way is
+ simply to do <MEDIT-ADD-DEFAULTS \"FOO\">. If you are editing multiple
+ packages, do <MEDIT-QUERY T> and name the appropriate package(s) on
+ return from EMACS. It is possible for new atoms internal to a package
+ to end up on a wrong oblist if you zap stuff from more than one package
+ at a time (this will occur if you create new functions and the first
+ oblist in the path is different from the package in which the new
+ functions were defined. You can set up the path yourself with
+ MEDIT-PATH, but you must remember to place the internal oblist before
+ the entry oblist.
+
+ <MEDIT-HELP>
+
+ The obvious.
+
+ The following variables control which emacs is used (Gnu or Gosling).
+ Currently, Gnu emacs is used by default.
+
+ *MEDIT-EDITOR* name of editor to use {\"GNUMACS\"}
+ *MEDIT-JCL* command line for editor {(\"-L\" \"/USR/MIM/MEDIT\")}
+ *MEDIT-FILE* - name of zap file {\"/tmp/USER.medit.mud\"}
+">
+ ,NULL>
+
+<ENDPACKAGE>
projects / pdp10-muddle.git / blobdiff