Commit | Line | Data |
---|---|---|
711f2352 DL |
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 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")))) |