Mercurial > emacs
annotate lisp/emulation/mlconvert.el @ 1557:816bfa185671
* isearch.el (isearch-frames-exist): This isn't what we want -
replaced by...
(isearch-gnu-emacs-events): non-nil if should expect events in the
style generated by GNU Emacs 19. Set if set-frame-height is
fboundp; this is true on any GNU Emacs 19, whether or not it was
compiled with multiple frame support.
(isearch-mode-map): Test isearch-gnu-emacs-events instead of
isearch-frames-exist to see if we should bind switch-frame events.
(isearch-update): Test isearch-gnu-emacs-events instead of
isearch-frames-exist to see if unread-command-char's quiescent
value is nil or -1.
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Sat, 07 Nov 1992 06:17:04 +0000 |
parents | 213978acbc1e |
children | f287613dfc28 |
rev | line source |
---|---|
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
1 ;;; mlconvert.el --- convert buffer of Mocklisp code to real lisp. |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
2 |
845 | 3 ;; Copyright (C) 1985 Free Software Foundation, Inc. |
4 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
5 ;; Maintainer: FSF |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
6 ;; Keywords: extensions |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
7 |
36 | 8 ;; This file is part of GNU Emacs. |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
12 ;; the Free Software Foundation; either version 2, or (at your option) |
36 | 13 ;; any later version. |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
23 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
24 ;;; Code: |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
25 |
258 | 26 ;;;###autoload |
36 | 27 (defun convert-mocklisp-buffer () |
28 "Convert buffer of Mocklisp code to real Lisp that GNU Emacs can run." | |
29 (interactive) | |
30 (emacs-lisp-mode) | |
31 (set-syntax-table (copy-sequence (syntax-table))) | |
32 (modify-syntax-entry ?\| "w") | |
33 (message "Converting mocklisp (ugh!)...") | |
34 (goto-char (point-min)) | |
35 (fix-mlisp-syntax) | |
36 | |
37 ;; Emulation of mocklisp is accurate only within a mocklisp-function | |
38 ;; so turn any non-function into a defun and then call it. | |
39 (goto-char (point-min)) | |
40 (condition-case ignore | |
41 (while t | |
42 (let ((opt (point)) | |
43 (form (read (current-buffer)))) | |
44 (and (listp form) | |
45 (not (eq (car form) 'defun)) | |
46 (progn (insert "))\n\n(ml-foo)\n\n") | |
47 (save-excursion | |
48 (goto-char opt) | |
49 (skip-chars-forward "\n") | |
50 (insert "(defun (ml-foo \n ")))))) | |
51 (end-of-file nil)) | |
52 | |
53 (goto-char (point-min)) | |
54 (insert ";;; GNU Emacs code converted from Mocklisp\n") | |
55 (insert "(require 'mlsupport)\n\n") | |
56 (fix-mlisp-symbols) | |
57 | |
58 (goto-char (point-min)) | |
59 (message "Converting mocklisp...done")) | |
60 | |
61 (defun fix-mlisp-syntax () | |
62 (while (re-search-forward "['\"]" nil t) | |
63 (if (= (preceding-char) ?\") | |
64 (progn (forward-char -1) | |
65 (forward-sexp 1)) | |
66 (delete-char -1) | |
67 (insert "?") | |
68 (if (or (= (following-char) ?\\) (= (following-char) ?^)) | |
69 (forward-char 1) | |
70 (if (looking-at "[^a-zA-Z]") | |
71 (insert ?\\))) | |
72 (forward-char 1) | |
73 (delete-char 1)))) | |
74 | |
75 (defun fix-mlisp-symbols () | |
76 (while (progn | |
77 (skip-chars-forward " \t\n()") | |
78 (not (eobp))) | |
79 (cond ((or (= (following-char) ?\?) | |
80 (= (following-char) ?\")) | |
81 (forward-sexp 1)) | |
82 ((= (following-char) ?\;) | |
83 (forward-line 1)) | |
84 (t | |
85 (let ((start (point)) prop) | |
86 (forward-sexp 1) | |
87 (setq prop (get (intern-soft (buffer-substring start (point))) | |
88 'mocklisp)) | |
89 (cond ((null prop)) | |
90 ((stringp prop) | |
91 (delete-region start (point)) | |
92 (insert prop)) | |
93 (t | |
94 (save-excursion | |
95 (goto-char start) | |
96 (funcall prop))))))))) | |
97 | |
98 (defun ml-expansion (ml-name lisp-string) | |
99 (put ml-name 'mocklisp lisp-string)) | |
100 | |
101 (ml-expansion 'defun "ml-defun") | |
102 (ml-expansion 'if "ml-if") | |
103 (ml-expansion 'setq '(lambda () | |
104 (if (looking-at "setq[ \t\n]+buffer-modified-p") | |
105 (replace-match "set-buffer-modified-p")))) | |
106 | |
107 (ml-expansion 'while '(lambda () | |
108 (let ((end (progn (forward-sexp 2) (point-marker))) | |
109 (start (progn (forward-sexp -1) (point)))) | |
110 (let ((cond (buffer-substring start end))) | |
111 (cond ((equal cond "1") | |
112 (delete-region (point) end) | |
113 (insert "t")) | |
114 (t | |
115 (insert "(not (zerop ") | |
116 (goto-char end) | |
117 (insert "))"))) | |
118 (set-marker end nil) | |
119 (goto-char start))))) | |
120 | |
121 (ml-expansion 'arg "ml-arg") | |
122 (ml-expansion 'nargs "ml-nargs") | |
123 (ml-expansion 'interactive "ml-interactive") | |
124 (ml-expansion 'message "ml-message") | |
125 (ml-expansion 'print "ml-print") | |
126 (ml-expansion 'set "ml-set") | |
127 (ml-expansion 'set-default "ml-set-default") | |
128 (ml-expansion 'provide-prefix-argument "ml-provide-prefix-argument") | |
129 (ml-expansion 'prefix-argument-loop "ml-prefix-argument-loop") | |
130 (ml-expansion 'prefix-argument "ml-prefix-arg") | |
131 (ml-expansion 'use-local-map "ml-use-local-map") | |
132 (ml-expansion 'use-global-map "ml-use-global-map") | |
133 (ml-expansion 'modify-syntax-entry "ml-modify-syntax-entry") | |
134 (ml-expansion 'error-message "error") | |
135 | |
136 (ml-expansion 'dot "point-marker") | |
137 (ml-expansion 'mark "mark-marker") | |
138 (ml-expansion 'beginning-of-file "beginning-of-buffer") | |
139 (ml-expansion 'end-of-file "end-of-buffer") | |
140 (ml-expansion 'exchange-dot-and-mark "exchange-point-and-mark") | |
141 (ml-expansion 'set-mark "set-mark-command") | |
142 (ml-expansion 'argument-prefix "universal-arg") | |
143 | |
144 (ml-expansion 'previous-page "ml-previous-page") | |
145 (ml-expansion 'next-page "ml-next-page") | |
146 (ml-expansion 'next-window "ml-next-window") | |
147 (ml-expansion 'previous-window "ml-previous-window") | |
148 | |
149 (ml-expansion 'newline "ml-newline") | |
150 (ml-expansion 'next-line "ml-next-line") | |
151 (ml-expansion 'previous-line "ml-previous-line") | |
152 (ml-expansion 'self-insert "self-insert-command") | |
153 (ml-expansion 'meta-digit "digit-argument") | |
154 (ml-expansion 'meta-minus "negative-argument") | |
155 | |
156 (ml-expansion 'newline-and-indent "ml-newline-and-indent") | |
157 (ml-expansion 'yank-from-killbuffer "yank") | |
158 (ml-expansion 'yank-buffer "insert-buffer") | |
159 (ml-expansion 'copy-region "copy-region-as-kill") | |
160 (ml-expansion 'delete-white-space "delete-horizontal-space") | |
161 (ml-expansion 'widen-region "widen") | |
162 | |
163 (ml-expansion 'forward-word '(lambda () | |
164 (if (looking-at "forward-word[ \t\n]*)") | |
165 (replace-match "forward-word 1)")))) | |
166 (ml-expansion 'backward-word '(lambda () | |
167 (if (looking-at "backward-word[ \t\n]*)") | |
168 (replace-match "backward-word 1)")))) | |
169 | |
170 (ml-expansion 'forward-paren "forward-list") | |
171 (ml-expansion 'backward-paren "backward-list") | |
172 (ml-expansion 'search-reverse "ml-search-backward") | |
173 (ml-expansion 're-search-reverse "ml-re-search-backward") | |
174 (ml-expansion 'search-forward "ml-search-forward") | |
175 (ml-expansion 're-search-forward "ml-re-search-forward") | |
176 (ml-expansion 'quote "regexp-quote") | |
177 (ml-expansion 're-query-replace "query-replace-regexp") | |
178 (ml-expansion 're-replace-string "replace-regexp") | |
179 | |
180 ; forward-paren-bl, backward-paren-bl | |
181 | |
182 (ml-expansion 'get-tty-character "read-char") | |
183 (ml-expansion 'get-tty-input "read-input") | |
184 (ml-expansion 'get-tty-string "read-string") | |
185 (ml-expansion 'get-tty-buffer "read-buffer") | |
186 (ml-expansion 'get-tty-command "read-command") | |
187 (ml-expansion 'get-tty-variable "read-variable") | |
188 (ml-expansion 'get-tty-no-blanks-input "read-no-blanks-input") | |
189 (ml-expansion 'get-tty-key "read-key") | |
190 | |
191 (ml-expansion 'c= "char-equal") | |
192 (ml-expansion 'goto-character "goto-char") | |
193 (ml-expansion 'substr "ml-substr") | |
194 (ml-expansion 'variable-apropos "apropos") | |
195 (ml-expansion 'execute-mlisp-buffer "eval-current-buffer") | |
196 (ml-expansion 'execute-mlisp-file "load") | |
197 (ml-expansion 'visit-file "find-file") | |
198 (ml-expansion 'read-file "find-file") | |
199 (ml-expansion 'write-modified-files "save-some-buffers") | |
200 (ml-expansion 'backup-before-writing "make-backup-files") | |
201 (ml-expansion 'write-file-exit "save-buffers-kill-emacs") | |
202 (ml-expansion 'write-named-file "write-file") | |
203 (ml-expansion 'change-file-name "set-visited-file-name") | |
204 (ml-expansion 'change-buffer-name "rename-buffer") | |
205 (ml-expansion 'buffer-exists "get-buffer") | |
206 (ml-expansion 'delete-buffer "kill-buffer") | |
207 (ml-expansion 'unlink-file "delete-file") | |
208 (ml-expansion 'unlink-checkpoint-files "delete-auto-save-files") | |
209 (ml-expansion 'file-exists "file-exists-p") | |
210 (ml-expansion 'write-current-file "save-buffer") | |
211 (ml-expansion 'change-directory "cd") | |
212 (ml-expansion 'temp-use-buffer "set-buffer") | |
213 (ml-expansion 'fast-filter-region "filter-region") | |
214 | |
215 (ml-expansion 'pending-input "input-pending-p") | |
216 (ml-expansion 'execute-keyboard-macro "call-last-kbd-macro") | |
217 (ml-expansion 'start-remembering "start-kbd-macro") | |
218 (ml-expansion 'end-remembering "end-kbd-macro") | |
219 (ml-expansion 'define-keyboard-macro "name-last-kbd-macro") | |
220 (ml-expansion 'define-string-macro "ml-define-string-macro") | |
221 | |
222 (ml-expansion 'current-column "ml-current-column") | |
223 (ml-expansion 'current-indent "ml-current-indent") | |
224 (ml-expansion 'insert-character "insert") | |
225 | |
226 (ml-expansion 'users-login-name "user-login-name") | |
227 (ml-expansion 'users-full-name "user-full-name") | |
228 (ml-expansion 'current-time "current-time-string") | |
229 (ml-expansion 'current-numeric-time "current-numeric-time-you-lose") | |
230 (ml-expansion 'current-buffer-name "buffer-name") | |
231 (ml-expansion 'current-file-name "buffer-file-name") | |
232 | |
233 (ml-expansion 'local-binding-of "local-key-binding") | |
234 (ml-expansion 'global-binding-of "global-key-binding") | |
235 | |
236 ;defproc (ProcedureType, "procedure-type"); | |
237 | |
238 (ml-expansion 'remove-key-binding "global-unset-key") | |
239 (ml-expansion 'remove-binding "global-unset-key") | |
240 (ml-expansion 'remove-local-binding "local-unset-key") | |
241 (ml-expansion 'remove-all-local-bindings "use-local-map nil") | |
242 (ml-expansion 'autoload "ml-autoload") | |
243 | |
244 (ml-expansion 'checkpoint-frequency "auto-save-interval") | |
245 | |
246 (ml-expansion 'mode-string "mode-name") | |
247 (ml-expansion 'right-margin "fill-column") | |
248 (ml-expansion 'tab-size "tab-width") | |
249 (ml-expansion 'default-right-margin "default-fill-column") | |
250 (ml-expansion 'default-tab-size "default-tab-width") | |
251 (ml-expansion 'buffer-is-modified "(buffer-modified-p)") | |
252 | |
253 (ml-expansion 'file-modified-time "you-lose-on-file-modified-time") | |
254 (ml-expansion 'needs-checkpointing "you-lose-on-needs-checkpointing") | |
255 | |
779 | 256 (ml-expansion 'lines-on-screen "set-frame-height") |
257 (ml-expansion 'columns-on-screen "set-frame-width") | |
36 | 258 |
259 (ml-expansion 'dumped-emacs "t") | |
260 | |
261 (ml-expansion 'buffer-size "ml-buffer-size") | |
262 (ml-expansion 'dot-is-visible "pos-visible-in-window-p") | |
263 | |
264 (ml-expansion 'track-eol-on-^N-^P "track-eol") | |
265 (ml-expansion 'ctlchar-with-^ "ctl-arrow") | |
266 (ml-expansion 'help-on-command-completion-error "completion-auto-help") | |
267 (ml-expansion 'dump-stack-trace "backtrace") | |
268 (ml-expansion 'pause-emacs "suspend-emacs") | |
269 (ml-expansion 'compile-it "compile") | |
270 | |
271 (ml-expansion '!= "/=") | |
272 (ml-expansion '& "logand") | |
273 (ml-expansion '| "logior") | |
274 (ml-expansion '^ "logxor") | |
275 (ml-expansion '! "ml-not") | |
276 (ml-expansion '<< "lsh") | |
277 | |
278 ;Variable pause-writes-files | |
279 | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
280 ;;; mlconvert.el ends here |