*** empty log message ***
[bpt/emacs.git] / lisp / emulation / mlconvert.el
CommitLineData
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
5
a2535589
JA
6;; Copyright (C) 1985 Free Software Foundation, Inc.
7
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
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
e5167999
ER
24;;; Code:
25
f9f9507e 26;;;###autoload
a2535589
JA
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
0cc89026
JB
256(ml-expansion 'lines-on-screen "set-frame-height")
257(ml-expansion 'columns-on-screen "set-frame-width")
a2535589
JA
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
6594deb0 280;;; mlconvert.el ends here