![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ledit.l CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / etc|
Return to ledit.l CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / etc |
1.1 root 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"))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.