mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-30 11:09:23 +00:00
151 lines
4.7 KiB
Common Lisp
151 lines
4.7 KiB
Common Lisp
;;; -*- Mode: lisp -*-
|
||
|
||
; load in the c functions
|
||
|
||
(removeaddress '_signal)
|
||
(removeaddress '_switch_to_proc)
|
||
(removeaddress '_set_proc_str)
|
||
|
||
(cfasl "/src/mdc/ledit/leditcfns.o" '_switch_to_proc 'emacs)
|
||
|
||
(getaddress '_set_proc_str 'set_proc_str)
|
||
|
||
(declare (special *ledit-infile* ; emacs->lisp tempfile
|
||
*ledit-outfile* ; lisp->emacs tempfile
|
||
*ledit-ppfile* ; pp->emacs tempfile
|
||
*ledit-lisztfile* ; compiler input
|
||
*ledit-objfile* ; compiler output
|
||
*ledit-initialized*) ; flag
|
||
)
|
||
|
||
(setq *ledit-initialized* nil)
|
||
|
||
;;; INIT-LEDIT
|
||
|
||
(defun init-ledit ()
|
||
(let ((user (getenv '|USER|))) ;USER must be uppercase
|
||
(setq
|
||
*ledit-outfile* (concat "/tmp/" user ".l2") ; lisp -> emacs
|
||
*ledit-infile* (concat "/tmp/" user ".l1") ; emacs -> lisp
|
||
*ledit-ppfile* (concat "/tmp/" user ".l3") ; pp output to emacs.
|
||
*ledit-lisztfile* (concat "/tmp/" user ".l4")
|
||
*ledit-objfile* (concat "/tmp/" user ".o")
|
||
*ledit-initialized* t)))
|
||
|
||
;;; LEDIT
|
||
; if 1 arg, arg is taken as a tag name to pass to emacs.
|
||
; if 2 args, second arg is a keyword. If 2nd arg is pp,
|
||
; pp is applied to first arg, and result is sent to emacs
|
||
; to put in a buffer called LEDIT (which is first erased.)
|
||
|
||
(defun ledit fexpr (args)
|
||
(apply #'ledit* args))
|
||
|
||
;;; LEDIT*
|
||
|
||
(defun ledit* n
|
||
(if (not *ledit-initialized*) (init-ledit))
|
||
(ledit-output (listify n))
|
||
(syscall 10. *ledit-infile*) ; syscall 10 is "delete"
|
||
(syscall 10. *ledit-lisztfile*)
|
||
(emacs)
|
||
(ledit-input)
|
||
(syscall 10. *ledit-outfile*)
|
||
(syscall 10. *ledit-ppfile*)
|
||
t)
|
||
|
||
;;; LEDIT-OUTPUT
|
||
;;; Egad, what a mess! Doesn't work for XEMACS yet.
|
||
;;; Here's an example from Mocklisp:
|
||
;;; -> (defun bar (nothing) (bar nothing))
|
||
;;; bar
|
||
;;; -> (ledit bar)
|
||
;;; should produce...
|
||
;;; (progn) (progn tag (setq tag "bar") (&goto-tag))
|
||
;;; and
|
||
;;; -> (ledit bar pp)
|
||
;;; should stuff this to emacs...
|
||
;;; (progn) (switch-to-buffer "LEDIT") (erase-buffer)
|
||
;;; (insert-file "/tmp/walter.l3") (lisp-mode)
|
||
;;; and this...
|
||
;;; (def bar
|
||
;;; (lambda (x)
|
||
;;; (bar nothing)))
|
||
;;; into *LEDIT*
|
||
|
||
(defun ledit-output (args)
|
||
(if args
|
||
(let ((ofile (outfile *ledit-outfile*)))
|
||
(format ofile "(progn)") ; this is necessary.
|
||
|
||
(cond ((null (cdr args)) ; no keyword -> arg is a tag.
|
||
(format ofile "(progn tag (setq tag \"~A\"~
|
||
(&goto-tag))"
|
||
(car args)))
|
||
((eq (cadr args) 'pp) ; pp-> pp first arg to emacs
|
||
(apply 'pp `((|F| ,*ledit-ppfile*) ,(car args)))
|
||
(format ofile "(switch-to-buffer \"LEDIT\")~
|
||
(erase-buffer)")
|
||
(format ofile "(insert-file \"~A\")"
|
||
*ledit-ppfile*)
|
||
(format ofile "(lisp-mode)"))
|
||
|
||
(t (format t "~&~A -- unknown option~%" (cdr args))))
|
||
(close ofile))))
|
||
|
||
;;; LISZT*
|
||
;;; Need this guy to do compile-input.
|
||
;;; Liszt returns 0 if all was well.
|
||
;;; Note that in ordinary use the user will have to get used to looking
|
||
;;; at "%Warning: ... Compiler declared *foo* special" messages, since
|
||
;;; you don't usually want to hunt around in your file, zap in the the
|
||
;;; declarations, then go back to what you were doing.
|
||
;;; Fortunately this doesn't cause the compiler to bomb.
|
||
;;; Some sleepless night I will think of a way to get around this.
|
||
|
||
(defun liszt* (&rest args)
|
||
(apply #'liszt args))
|
||
|
||
;;; LEDIT-INPUT
|
||
;;; Although there are two cases here, in practice
|
||
;;; it is never the case that there is both input to be
|
||
;;; interpreted and input to be compiled.
|
||
|
||
(defun ledit-input ()
|
||
(if (probef *ledit-lisztfile*)
|
||
(cond ((getd #'liszt)
|
||
(format t ";Compiling LEDIT:")
|
||
(and (zerop (liszt* *ledit-lisztfile* '-o *ledit-objfile*))
|
||
(load *ledit-objfile*)))
|
||
(t (format t ";Can't compile LEDIT: No liszt.~%;Reading instead:")
|
||
(let ((ifile (infile *ledit-lisztfile*)))
|
||
(ledit-load ifile)
|
||
(close ifile)))))
|
||
|
||
(if (probef *ledit-infile*)
|
||
(let ((ifile (infile *ledit-infile*)))
|
||
(format t ";Reading from LEDIT:~%")
|
||
(ledit-load ifile)
|
||
(close ifile))))
|
||
|
||
;;; LEDIT-LOAD
|
||
;;; A generally useful form of load
|
||
|
||
(defun ledit-load (ifile)
|
||
(let ((eof-form (list 'eof-form)))
|
||
(do ((form (read ifile eof-form) (read ifile eof-form)))
|
||
((eq form eof-form))
|
||
(format t "; ~A~%" (eval form)))))
|
||
|
||
(setsyntax #/ 'macro 'ledit) ; make ^E = (ledit)<return>
|
||
|
||
;; more robust version of the c function set_proc_str. Does argument checking.
|
||
;; set_proc_str sets the string that is stuffed to the tty after franz pauses
|
||
;; and the csh wakes up. It is usually "%emacs" or "%vemacs" or "%?emacs"
|
||
(defun set-proc-str (arg)
|
||
(if (stringp arg)
|
||
(set_proc_str arg)
|
||
(if (symbolp arg)
|
||
(set_proc_str (get-pname arg))
|
||
(error arg " is illegal argument to set-proc-str"))))
|