diff options
Diffstat (limited to 'etc/ledit.l')
| -rw-r--r-- | etc/ledit.l | 152 |
1 files changed, 0 insertions, 152 deletions
diff --git a/etc/ledit.l b/etc/ledit.l deleted file mode 100644 index d53c5d26011..00000000000 --- a/etc/ledit.l +++ /dev/null | |||
| @@ -1,152 +0,0 @@ | |||
| 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 #/ '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 | ||