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