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