Mercurial > hg > xemacs-beta
diff etc/ledit.l @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | ac2d302a0011 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/ledit.l Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,150 @@ +;;; -*- 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"))))