*** empty log message ***
[emacs.git] / etc / ledit.l
blobd53c5d260118b2b8aae67edddacccfab71eb66d2
1 ;;; -*- Mode: lisp -*-
3 ; load in the c functions
5 (removeaddress '_signal)
6 (removeaddress '_switch_to_proc)
7 (removeaddress '_set_proc_str)
9 (cfasl "/src/mdc/ledit/leditcfns.o" '_switch_to_proc 'emacs)
11 (getaddress '_set_proc_str 'set_proc_str)
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          )
21 (setq *ledit-initialized* nil)
23 ;;; INIT-LEDIT
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)))
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.)
41 (defun ledit fexpr (args)
42     (apply #'ledit* args))
44 ;;; LEDIT*
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)
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*
76 (defun ledit-output (args)
77   (if args
78       (let ((ofile (outfile *ledit-outfile*)))
79            (format ofile "(progn)")             ; this is necessary.
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)"))
93                  (t (format t "~&~A -- unknown option~%" (cdr args))))
94            (close ofile))))
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.
106 (defun liszt* (&rest args)
107    (apply #'liszt args))
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.
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)))))
125   (if (probef *ledit-infile*)
126       (let ((ifile (infile *ledit-infile*)))
127         (format t ";Reading from LEDIT:~%")
128         (ledit-load ifile)
129         (close ifile))))
131 ;;; LEDIT-LOAD
132 ;;; A generally useful form of load
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)))))
140 (setsyntax #/\x05 'macro 'ledit)                  ; make ^E = (ledit)<return>
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"))))
152 ;;; arch-tag: 2e76c01f-8d6a-4d04-b9ab-0eaabec96aee