code.delx.au - gnu-emacs/blob - etc/ledit.l

   1 ;;; -*- Mode: lisp -*-
   2
   3 ; load in the c functions
   4
   5 (removeaddress '_signal)
   6 (removeaddress '_switch_to_proc)
   7 (removeaddress '_set_proc_str)
   8
   9 (cfasl "/src/mdc/ledit/leditcfns.o" '_switch_to_proc 'emacs)
  10
  11 (getaddress '_set_proc_str 'set_proc_str)
  12
  13 (declare (special *ledit-infile*               ; emacs->lisp tempfile
  14                   *ledit-outfile*              ; lisp->emacs tempfile
  15                   *ledit-ppfile*               ; pp->emacs tempfile
  16                   *ledit-lisztfile*            ; compiler input
  17                   *ledit-objfile*              ; compiler output
  18                   *ledit-initialized*)         ; flag
  19          )
  20
  21 (setq *ledit-initialized* nil)
  22
  23 ;;; INIT-LEDIT
  24
  25 (defun init-ledit ()
  26   (let ((user (getenv '|USER|)))                ;USER must be uppercase
  27        (setq
  28          *ledit-outfile* (concat "/tmp/" user ".l2") ; lisp -> emacs
  29          *ledit-infile*  (concat "/tmp/" user ".l1") ; emacs -> lisp
  30          *ledit-ppfile*  (concat "/tmp/" user ".l3") ; pp output to emacs.
  31          *ledit-lisztfile*  (concat "/tmp/" user ".l4")
  32          *ledit-objfile*  (concat "/tmp/" user ".o")
  33          *ledit-initialized* t)))
  34
  35 ;;; LEDIT
  36 ; if 1 arg, arg is taken as a tag name to pass to emacs.
  37 ; if 2 args, second arg is a keyword.  If 2nd arg is pp,
  38 ; pp is applied to first arg, and result is sent to emacs
  39 ; to put in a buffer called LEDIT (which is first erased.)
  40
  41 (defun ledit fexpr (args)
  42     (apply #'ledit* args))
  43
  44 ;;; LEDIT*
  45
  46 (defun ledit* n
  47     (if (not *ledit-initialized*) (init-ledit))
  48     (ledit-output (listify n))
  49     (syscall 10. *ledit-infile*)        ; syscall 10 is "delete"
  50     (syscall 10. *ledit-lisztfile*)
  51     (emacs)
  52     (ledit-input)
  53     (syscall 10. *ledit-outfile*)
  54     (syscall 10. *ledit-ppfile*)
  55     t)
  56
  57 ;;; LEDIT-OUTPUT
  58 ;;; Egad, what a mess!  Doesn't work for XEMACS yet.
  59 ;;; Here's an example from Mocklisp:
  60 ;;; -> (defun bar (nothing) (bar nothing))
  61 ;;; bar
  62 ;;; -> (ledit bar)
  63 ;;; should produce...
  64 ;;; (progn) (progn tag (setq tag "bar") (&goto-tag))
  65 ;;; and
  66 ;;; -> (ledit bar pp)
  67 ;;; should stuff this to emacs...
  68 ;;; (progn) (switch-to-buffer "LEDIT") (erase-buffer)
  69 ;;; (insert-file "/tmp/walter.l3") (lisp-mode)
  70 ;;; and this...
  71 ;;; (def bar
  72 ;;;   (lambda (x)
  73 ;;;    (bar nothing)))
  74 ;;; into *LEDIT*
  75
  76 (defun ledit-output (args)
  77   (if args
  78       (let ((ofile (outfile *ledit-outfile*)))
  79            (format ofile "(progn)")             ; this is necessary.
  80
  81            (cond ((null (cdr args)) ; no keyword -> arg is a tag.
  82                   (format ofile "(progn tag (setq tag \"~A\"~
  83                                  (&goto-tag))"
  84                                  (car args)))
  85                  ((eq (cadr args) 'pp)       ; pp-> pp first arg to emacs
  86                       (apply 'pp `((|F| ,*ledit-ppfile*) ,(car args)))
  87                       (format ofile "(switch-to-buffer \"LEDIT\")~
  88                                      (erase-buffer)")
  89                       (format ofile "(insert-file \"~A\")"
  90                                      *ledit-ppfile*)
  91                       (format ofile "(lisp-mode)"))
  92
  93                  (t (format t "~&~A -- unknown option~%" (cdr args))))
  94            (close ofile))))
  95
  96 ;;; LISZT*
  97 ;;; Need this guy to do compile-input.
  98 ;;; Liszt returns 0 if all was well.
  99 ;;; Note that in ordinary use the user will have to get used to looking
 100 ;;; at "%Warning: ... Compiler declared *foo* special" messages, since
 101 ;;; you don't usually want to hunt around in your file, zap in the
 102 ;;; declarations, then go back to what you were doing.
 103 ;;; Fortunately this doesn't cause the compiler to bomb.
 104 ;;; Some sleepless night I will think of a way to get around this.
 105
 106 (defun liszt* (&rest args)
 107    (apply #'liszt args))
 108
 109 ;;; LEDIT-INPUT
 110 ;;; Although there are two cases here, in practice
 111 ;;; it is never the case that there is both input to be
 112 ;;; interpreted and input to be compiled.
 113
 114 (defun ledit-input ()
 115   (if (probef *ledit-lisztfile*)
 116       (cond ((getd #'liszt)
 117              (format t ";Compiling LEDIT:")
 118              (and (zerop (liszt* *ledit-lisztfile* '-o *ledit-objfile*))
 119                   (load *ledit-objfile*)))
 120             (t (format t ";Can't compile LEDIT: No liszt.~%;Reading instead:")
 121                (let ((ifile (infile *ledit-lisztfile*)))
 122                  (ledit-load ifile)
 123                  (close ifile)))))
 124
 125   (if (probef *ledit-infile*)
 126       (let ((ifile (infile *ledit-infile*)))
 127         (format t ";Reading from LEDIT:~%")
 128         (ledit-load ifile)
 129         (close ifile))))
 130
 131 ;;; LEDIT-LOAD
 132 ;;; A generally useful form of load
 133
 134 (defun ledit-load (ifile)
 135   (let ((eof-form (list 'eof-form)))
 136     (do ((form (read ifile eof-form) (read ifile eof-form)))
 137       ((eq form eof-form))
 138       (format t ";  ~A~%" (eval form)))))
 139
 140 (setsyntax #/\ 5 'macro 'ledit)                  ; make ^E = (ledit)<return>
 141
 142 ;; more robust version of the c function set_proc_str. Does argument checking.
 143 ;; set_proc_str sets the string that is stuffed to the tty after franz pauses
 144 ;; and the csh wakes up. It is usually "%emacs" or "%vemacs" or "%?emacs"
 145 (defun set-proc-str (arg)
 146   (if (stringp arg)
 147     (set_proc_str arg)
 148     (if (symbolp arg)
 149       (set_proc_str (get-pname arg))
 150       (error arg " is illegal argument to set-proc-str"))))
 151
 152 ;;; arch-tag: 2e76c01f-8d6a-4d04-b9ab-0eaabec96aee