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