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