home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 2 / FFMCD02.bin / useful / lib / emacs / 18.59 / etc / ledit.l < prev    next >
Text File  |  1985-04-17  |  5KB  |  151 lines
  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 Moclisp:
  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 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 #/ '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.