1 ;;; mlconvert.el --- convert buffer of Mocklisp code to real lisp.
4 ;; Last-Modified: 09 May 1991
5 ;; Keywords: extensions
7 ;; Copyright (C) 1985 Free Software Foundation, Inc.
9 ;; This file is part of GNU Emacs.
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
13 ;; the Free Software Foundation; either version 2, or (at your option)
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.
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.
28 (defun convert-mocklisp-buffer ()
29 "Convert buffer of Mocklisp code to real Lisp that GNU Emacs can run."
32 (set-syntax-table (copy-sequence (syntax-table)))
33 (modify-syntax-entry ?\|
"w")
34 (message "Converting mocklisp (ugh!)...")
35 (goto-char (point-min))
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
44 (form (read (current-buffer))))
46 (not (eq (car form
) 'defun
))
47 (progn (insert "))\n\n(ml-foo)\n\n")
50 (skip-chars-forward "\n")
51 (insert "(defun (ml-foo \n "))))))
54 (goto-char (point-min))
55 (insert ";;; GNU Emacs code converted from Mocklisp\n")
56 (insert "(require 'mlsupport)\n\n")
59 (goto-char (point-min))
60 (message "Converting mocklisp...done"))
62 (defun fix-mlisp-syntax ()
63 (while (re-search-forward "['\"]" nil t
)
64 (if (= (preceding-char) ?
\")
65 (progn (forward-char -
1)
69 (if (or (= (following-char) ?
\\) (= (following-char) ?^
))
71 (if (looking-at "[^a-zA-Z]")
76 (defun fix-mlisp-symbols ()
78 (skip-chars-forward " \t\n()")
80 (cond ((or (= (following-char) ?
\?)
81 (= (following-char) ?
\"))
83 ((= (following-char) ?\
;)
86 (let ((start (point)) prop
)
88 (setq prop
(get (intern-soft (buffer-substring start
(point)))
92 (delete-region start
(point))
97 (funcall prop
)))))))))
99 (defun ml-expansion (ml-name lisp-string
)
100 (put ml-name
'mocklisp lisp-string
))
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"))))
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
)
116 (insert "(not (zerop ")
120 (goto-char start
)))))
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")
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")
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")
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")
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")
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)"))))
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")
181 ; forward-paren-bl, backward-paren-bl
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")
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")
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")
223 (ml-expansion 'current-column
"ml-current-column")
224 (ml-expansion 'current-indent
"ml-current-indent")
225 (ml-expansion 'insert-character
"insert")
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")
234 (ml-expansion 'local-binding-of
"local-key-binding")
235 (ml-expansion 'global-binding-of
"global-key-binding")
237 ;defproc (ProcedureType, "procedure-type");
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")
245 (ml-expansion 'checkpoint-frequency
"auto-save-interval")
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)")
254 (ml-expansion 'file-modified-time
"you-lose-on-file-modified-time")
255 (ml-expansion 'needs-checkpointing
"you-lose-on-needs-checkpointing")
257 (ml-expansion 'lines-on-screen
"set-frame-height")
258 (ml-expansion 'columns-on-screen
"set-frame-width")
260 (ml-expansion 'dumped-emacs
"t")
262 (ml-expansion 'buffer-size
"ml-buffer-size")
263 (ml-expansion 'dot-is-visible
"pos-visible-in-window-p")
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")
272 (ml-expansion '!= "/=")
273 (ml-expansion '& "logand")
274 (ml-expansion '|
"logior")
275 (ml-expansion '^
"logxor")
276 (ml-expansion '! "ml-not")
277 (ml-expansion '<< "lsh")
279 ;Variable pause-writes-files
281 ;;; mlconvert.el ends here