mim/development/mim/vax/mimlib/medit.mud

   1 "++ UNIX ++*****************************************************************
   2
   3  This is the MDL half of an interface between EMACS and MDL. An EMACS is
   4  created as an inferior of MDL. Stuff marked in EMACS for return to MDL is
   5  written to a temporary file when EMACS exits. MDL checks for the existence
   6  of this file when control is returned; if the file exists, its content is
   7  read into MDL, and then the file is deleted.    -Shane
   8
   9  The other half is /usr/mlisp/medit.ml and /usr/mlisp/mim-mode.ml.
  10  (gosling emacs).
  11                   /a/gnu/emacs/medit.el and /usr/mlisp/mim-mode.el
  12  ***************************************************************************"
  13
  14 <PACKAGE "MEDIT">
  15
  16 <PACKAGE "PIPES">                       ;"FORKS uses pipes, but I dont."
  17
  18 <RENTRY PIPE>
  19
  20 <ENTRY GET-PIPE READ-DESC WRITE-DESC READ-SAFE-BUFFER>
  21
  22 <ENDPACKAGE>
  23
  24 <RENTRY *MEDIT-EDITOR* *MEDIT-JCL*>
  25
  26 <ENTRY MEDIT MEDIT-RESET MEDIT-QUERY MEDIT-PATH MEDIT-HELP MEDIT-ADD-DEFAULTS
  27        *MEDIT-FILENAME*>
  28
  29 <USE "FORKS" "TTY">
  30
  31 <GDECL (*MEDIT-EDITOR* *MEDIT-FILENAME*) STRING
  32        (*MEDIT-JCL*) <OR STRING <LIST [REST STRING]> FALSE>
  33        (*MEDIT-QUERY?*) <OR ATOM FALSE> (*MEDIT-FORK*) <OR FALSE <CHANNEL 'FORK>>
  34        (*MEDIT-DEFAULT-PATH*) <OR FALSE <LIST [REST OBLIST]>>>
  35
  36 <SETG *MEDIT-FORK* <>>
  37
  38 ;"*MEDIT-EDITOR* is the name of the exe file for the editor fork."
  39
  40 <OR <GASSIGNED? *MEDIT-EDITOR*>
  41     ;<SETG *MEDIT-EDITOR* "GEMACS">     ;"For gosling emacs."
  42     <SETG *MEDIT-EDITOR* "GNUMACS">>    ;"For gnu emacs."
  43
  44
  45 <OR <GASSIGNED? *MEDIT-JCL*>
  46     ;<SETG *MEDIT-JCL* "-LMEDIT">               ;"For gosling emacs."
  47     <SETG *MEDIT-JCL* ("-L" "/USR/MIM/MEDIT")>> ;"For gnu emacs."
  48
  49 <SETG *MEDIT-QUERY?* <>>
  50
  51 <SETG *MEDIT-DEFAULT-PATH* <>>
  52
  53 ;"*MEDIT-FILENAME* is the name of the filename the editor writes as output."
  54
  55 <OR <GASSIGNED? *MEDIT-FILENAME*>
  56     <SETG *MEDIT-FILENAME* <STRING "/tmp/" <UNAME> ".medit.mud">>>
  57
  58 <DEFINE MEDIT ("OPT" (F <>) "AUX" (OUTCHAN .OUTCHAN) FN)
  59    #DECL ((OUTCHAN) <CHANNEL 'TTY> (F) <OR STRING FALSE> (FN) <CHANNEL 'PARSE>)
  60    <CHANNEL-OP .OUTCHAN CLEAR-SCREEN>
  61    <PRINTSTRING "[MDL => MEDIT]">
  62    <CRLF>
  63    <COND (,*MEDIT-FORK*
  64           <CONTINUE-FORK ,*MEDIT-FORK* T>)
  65          (.F
  66           <SET FN <CHANNEL-OPEN PARSE .F>>
  67           <SET F <CHANNEL-OP .FN NAME>>
  68           <CHANNEL-CLOSE .FN>
  69           <COND (<TYPE? ,*MEDIT-JCL* STRING>
  70                  <SETG *MEDIT-FORK*
  71                        <RUN-FORK ,*MEDIT-EDITOR* T T ,*MEDIT-JCL* .F>>)
  72                 (<TYPE? ,*MEDIT-JCL* LIST>
  73                  <SETG *MEDIT-FORK*
  74                        <RUN-FORK ,*MEDIT-EDITOR* T T !,*MEDIT-JCL* .F>>)>)
  75          (T
  76           <COND (<TYPE? ,*MEDIT-JCL* STRING>
  77                  <SETG *MEDIT-FORK*
  78                        <RUN-FORK ,*MEDIT-EDITOR* T T ,*MEDIT-JCL*>>)
  79                 (<TYPE? ,*MEDIT-JCL* LIST>
  80                  <SETG *MEDIT-FORK*
  81                        <RUN-FORK ,*MEDIT-EDITOR* T T !,*MEDIT-JCL*>>)>)>
  82    <CHANNEL-OP .OUTCHAN CLEAR-SCREEN>
  83    <PRINTSTRING "[MDL <= MEDIT]">
  84    <CRLF>
  85    <MEDIT-READ-FILE>
  86    "DONE">
  87
  88 <DEFINE MEDIT-RESET ()
  89    <COND (,*MEDIT-FORK*
  90           <CLOSE ,*MEDIT-FORK*>
  91           <SETG *MEDIT-FORK* <>>)>
  92    T>
  93
  94 <DEFINE MEDIT-QUERY ("OPT" (BOOLEAN ,*MEDIT-QUERY?*))
  95    #DECL ((BOOLEAN) <OR ATOM FALSE>)
  96    <SETG *MEDIT-QUERY?* .BOOLEAN>>
  97
  98 <DEFINE MEDIT-PATH ("OPT" (PATH ,*MEDIT-DEFAULT-PATH*))
  99    #DECL ((PATH) <OR FALSE <LIST [REST OBLIST]>>)
 100    <SETG *MEDIT-DEFAULT-PATH* .PATH>>
 101
 102 <DEFINE MEDIT-FILENAME () <STRING "/tmp/" <UNAME> ".medit.mud">>
 103
 104 <DEFINE MEDIT-READ-FILE ("AUX" (FILE <OPEN "READ" ,*MEDIT-FILENAME*>)
 105                                (OUTCHAN .OUTCHAN) (REDEFINE T)
 106                                (PATH (!<GET-PATH> !.OBLIST)) FN)
 107    #DECL ((FILE) <OR <CHANNEL 'DISK> FALSE> (OUTCHAN) <CHANNEL 'TTY>
 108           (REDEFINE) <SPECIAL ANY> (FN) STRING (PATH) <LIST [REST OBLIST]>)
 109    <COND (.FILE
 110           <SET FN <CHANNEL-OP .FILE NAME>>
 111           <UNWIND <BIND ()
 112                      <BLOCK .PATH>
 113                      <PRINC "Reading from MEDIT:">
 114                      <REPEAT () <PRINT <EVAL <READ .FILE '<RETURN>>>>>
 115                      <ENDBLOCK>
 116                      <CLOSE .FILE>
 117                      <DELFILE .FN>>
 118              <BIND ()
 119                 <ENDBLOCK>
 120                 <CLOSE .FILE>
 121                 <DELFILE .FN>>>)>>
 122
 123 <DEFINE GET-PATH ("AUX" (PATH ()) (OUTCHAN .OUTCHAN) (INCHAN .INCHAN))
 124    #DECL ((PATH) <LIST [REST OBLIST]> (INCHAN OUTCHAN) <CHANNEL 'TTY>)
 125    <COND
 126     (<NOT ,*MEDIT-QUERY?*>
 127      <OR ,*MEDIT-DEFAULT-PATH* ()>)
 128     (<AND ,*MEDIT-DEFAULT-PATH* <YES-NO "Use default path?">>
 129      ,*MEDIT-DEFAULT-PATH*)
 130     (<YES-NO "Do you wish to name a package?">
 131      <REPEAT (NAME OBL (RESPONSE <QUERY "Package name" .INCHAN>) CH)
 132         #DECL ((OBL) OBLIST (NAME) <OR ATOM FALSE> (RESPONSE) STRING
 133                (CH) <OR <CHANNEL 'DISK> FALSE>)
 134         <COND
 135          (<EMPTY? .RESPONSE>
 136           <RETURN .PATH>)
 137          (<SET NAME <LOOKUP .RESPONSE <MOBLIST PACKAGE>>>
 138           <SET PATH (<SET OBL <MOBLIST .NAME>> !.PATH)>
 139           <COND (<SET NAME <LOOKUP <STRING !\I .RESPONSE> .OBL>>
 140                  <SET PATH (<MOBLIST .NAME> !.PATH)>)>)
 141          (T
 142           <PRINC .RESPONSE>
 143           <PRINC " is not loaded.">
 144           <CRLF>
 145           <COND (<YES-NO <STRING "Load " .RESPONSE "?">>
 146                  <COND (<SET CH <L-OPEN .RESPONSE>>
 147                         <LOAD .CH>
 148                         <CLOSE .CH>)
 149                        (<NOT <EMPTY? <SET RESPONSE <QUERY "Filename" .INCHAN>>>>
 150                         <COND (<SET CH <L-OPEN .RESPONSE>>
 151                                <LOAD .CH>
 152                                <CLOSE .CH>)>)>
 153                  <COND (<AND <NOT <EMPTY? .RESPONSE>>
 154                              <SET NAME <LOOKUP .RESPONSE <MOBLIST PACKAGE>>>>
 155                         <SET PATH (<SET OBL <MOBLIST .NAME>> !.PATH)>
 156                         <COND (<SET NAME <LOOKUP <STRING !\I .RESPONSE> .OBL>>
 157                                <SET PATH (<MOBLIST .NAME> !.PATH)>)>)>)>)>
 158         <SET RESPONSE <QUERY "Another package name" .INCHAN>>>)>>
 159
 160 <DEFINE YES-NO (PROMPT "AUX" (INCHAN .INCHAN) (OUTCHAN .OUTCHAN))
 161    #DECL ((PROMPT) STRING (INCHAN OUTCHAN) <CHANNEL 'TTY>)
 162    <REPEAT (RESPONSE)
 163       #DECL ((RESPONSE) CHARACTER)
 164       <PRINC .PROMPT>
 165       <PRINC " (Y or N): ">
 166       <RESET .INCHAN>
 167       <SET RESPONSE <TYI>>
 168       <CRLF>
 169       <COND (<MEMQ .RESPONSE "Yy"> <RETURN>)
 170             (<MEMQ .RESPONSE "Nn"> <RETURN <>>)>>>
 171
 172 <DEFINE QUERY (PROMPT "OPT" (INCHAN .INCHAN)
 173                       "AUX" (OUTCHAN .OUTCHAN) (S <STACK <ISTRING 64>>) N)
 174    #DECL ((PROMPT S) STRING (INCHAN OUTCHAN) CHANNEL (N) FIX)
 175    <PRINC .PROMPT>
 176    <PRINC " (text$): ">
 177    <RESET .INCHAN>
 178    <SET N <READSTRING .S .INCHAN <STRING <ASCII 27>>>>
 179    <CRLF>
 180    <COND (<AND <G? .N 0> <==? <ASCII 27> <NTH .S .N>>> <SET N <- .N 1>>)>
 181    <REPEAT ((SS:STRING <SUBSTRUC .S 0 .N <ISTRING .N>>))
 182       <COND (<OR <EMPTY? .SS>
 183                  <N==? <ASCII 32> <1 .SS>>
 184                  <N==? <ASCII 9> <1 .SS>>>
 185              <RETURN .SS>)
 186             (T
 187              <SET SS <REST .SS>>)>>>
 188
 189 <DEFINE MEDIT-ADD-DEFAULTS ("TUPLE" NAMES "AUX" NAME OB (OUTCHAN .OUTCHAN))
 190    #DECL ((NAMES) <<PRIMTYPE VECTOR> [REST STRING]> (NAME) <OR ATOM FALSE>
 191           (OB) OBLIST (OUTCHAN) <CHANNEL 'TTY>)
 192    <MAPF <>
 193       <FUNCTION (NEW)
 194          #DECL ((NEW) STRING)
 195          <COND (<SET NAME <LOOKUP .NEW <SET OB <MOBLIST PACKAGE>>>>
 196                 <SETG *MEDIT-DEFAULT-PATH*
 197                       (<SET OB <MOBLIST .NAME>> !,*MEDIT-DEFAULT-PATH*)>
 198                 <COND (<SET NAME <LOOKUP <STRING !\I .NEW> .OB>>
 199                        <SETG *MEDIT-DEFAULT-PATH*
 200                              (<MOBLIST .NAME> !,*MEDIT-DEFAULT-PATH*)>)>
 201                 <PRINC "Added default ">
 202                 <PRINC .NEW>)
 203                (T
 204                 <PRINC .NEW>
 205                 <PRINC " is not loaded.">)>
 206          <CRLF>>
 207       .NAMES>>
 208
 209  <DEFINE MEDIT-HELP ("AUX" (OUTCHAN .OUTCHAN))
 210     #DECL ((OUTCHAN) <CHANNEL 'TTY>)
 211     <CHANNEL-OP .OUTCHAN CLEAR-SCREEN>
 212     <PRINTSTRING "
 213 EMACS: M-z,M-Z: marks the current DEFINE, or the immediately following DEFINE.
 214
 215        M-^Z:    marks the entire buffer.
 216
 217        ^X Z:    exit from MEDIT.  Saves the current buffer if modified, then
 218                 returns to MDL, sending marked stuff to MDL.
 219
 220        ^X S:    exit from MEDIT.  Saves the current buffer if modified, then
 221                 returns to MDL, sending the entire buffer.
 222
 223 MDL:   <MEDIT \"OPT\" FN:STRING>
 224
 225        Enter EMACS. The first time that MEDIT is invoked, if FN is supplied
 226        (standard file name defaults), the EMACS will read that file. FN is
 227        ignored in subsequent invocations.
 228
 229        <MEDIT-RESET>
 230
 231        Kill the current EMACS if one exists. It is nice to call this before
 232        killing the MDL.
 233
 234        <MEDIT-PATH \"OPT\" PATH:<OR FALSE <LIST [REST OBLIST]>>
 235
 236        PATH will be spliced in front of the normal oblist path during loading
 237        from EMACS.
 238
 239        <MEDIT-QUERY \"OPT\" BOOL:<OR ATOM FALSE>>
 240
 241        If BOOL is non-false, you will be askeded if you wish to use the default
 242        path (if there is one) or if you wish to name packages to be spliced
 243        into the path during loading.
 244
 245        <MEDIT-ADD-DEFAULTS PACKAGES:<TUPLE [REST STRING]>>
 246
 247        Prepends oblists for PACKAGES to the default path. Each package must be
 248        loaded. Prepended proceeding from right to left (leftmost will be first
 249        in path).
 250
 251        If you plan to debug a single package, say, \"FOO\" the best way is
 252        simply to do <MEDIT-ADD-DEFAULTS \"FOO\">. If you are editing multiple
 253        packages, do <MEDIT-QUERY T> and name the appropriate package(s) on
 254        return from EMACS. It is possible for new atoms internal to a package
 255        to end up on a wrong oblist if you zap stuff from more than one package
 256        at a time (this will occur if you create new functions and the first
 257        oblist in the path is different from the package in which the new
 258        functions were defined. You can set up the path yourself with
 259        MEDIT-PATH, but you must remember to place the internal oblist before
 260        the entry oblist.
 261
 262        <MEDIT-HELP>
 263
 264        The obvious.
 265
 266        The following variables control which emacs is used (Gnu or Gosling).
 267        Currently, Gnu emacs is used by default.
 268
 269        *MEDIT-EDITOR* name of editor to use {\"GNUMACS\"}
 270        *MEDIT-JCL* command line for editor {(\"-L\" \"/USR/MIM/MEDIT\")}
 271        *MEDIT-FILE* - name of zap file {\"/tmp/USER.medit.mud\"}
 272 ">
 273     ,NULL>
 274
 275 <ENDPACKAGE>