Mercurial > emacs
annotate lisp/emulation/mlconvert.el @ 37747:e5c590c9fe66
(Fsingle_key_description): Replace a build_string with
a make_multibyte_string. From Kenichi Handa <handa@etl.go.jp>.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Wed, 16 May 2001 10:49:21 +0000 |
parents | 9ae7afa3d8d1 |
children | 253f761ad37b |
rev | line source |
---|---|
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
1 ;;; mlconvert.el --- convert buffer of Mocklisp code to real lisp. |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
2 |
845 | 3 ;; Copyright (C) 1985 Free Software Foundation, Inc. |
4 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
5 ;; Maintainer: FSF |
2308
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
6 ;; Keywords: emulations |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
7 |
36 | 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 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
12 ;; the Free Software Foundation; either version 2, or (at your option) |
36 | 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 | |
14169 | 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. | |
36 | 24 |
2308
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
25 ;;; Commentary: |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
26 |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
2308
diff
changeset
|
27 ;; This package converts Mocklisp code written under a Gosling or UniPress |
2308
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
28 ;; Emacs for use with GNU Emacs. The translated code will require runtime |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
29 ;; support from the mlsupport.el equivalent. |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
30 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
31 ;;; Code: |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
32 |
258 | 33 ;;;###autoload |
36 | 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") | |
29582
9ae7afa3d8d1
(backward-word, forward-word, setq): Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
14169
diff
changeset
|
110 (ml-expansion 'setq (lambda () |
36 | 111 (if (looking-at "setq[ \t\n]+buffer-modified-p") |
112 (replace-match "set-buffer-modified-p")))) | |
113 | |
29582
9ae7afa3d8d1
(backward-word, forward-word, setq): Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
14169
diff
changeset
|
114 ;;(ml-expansion 'while (lambda () |
4166
90003380b443
(while): Comment out converter.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
115 ;; (let ((end (progn (forward-sexp 2) (point-marker))) |
90003380b443
(while): Comment out converter.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
116 ;; (start (progn (forward-sexp -1) (point)))) |
90003380b443
(while): Comment out converter.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
117 ;; (let ((cond (buffer-substring start end))) |
90003380b443
(while): Comment out converter.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
118 ;; (cond ((equal cond "1") |
90003380b443
(while): Comment out converter.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
119 ;; (delete-region (point) end) |
90003380b443
(while): Comment out converter.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
120 ;; (insert "t")) |
90003380b443
(while): Comment out converter.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
121 ;; (t |
90003380b443
(while): Comment out converter.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
122 ;; (insert "(not (zerop ") |
90003380b443
(while): Comment out converter.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
123 ;; (goto-char end) |
90003380b443
(while): Comment out converter.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
124 ;; (insert "))"))) |
90003380b443
(while): Comment out converter.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
125 ;; (set-marker end nil) |
90003380b443
(while): Comment out converter.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
126 ;; (goto-char start))))) |
36 | 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 | |
29582
9ae7afa3d8d1
(backward-word, forward-word, setq): Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
14169
diff
changeset
|
170 (ml-expansion 'forward-word (lambda () |
36 | 171 (if (looking-at "forward-word[ \t\n]*)") |
172 (replace-match "forward-word 1)")))) | |
29582
9ae7afa3d8d1
(backward-word, forward-word, setq): Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
14169
diff
changeset
|
173 (ml-expansion 'backward-word (lambda () |
36 | 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 | |
11092 | 198 (ml-expansion 'concat "ml-concat") |
36 | 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 | |
779 | 264 (ml-expansion 'lines-on-screen "set-frame-height") |
265 (ml-expansion 'columns-on-screen "set-frame-width") | |
36 | 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 | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
288 ;;; mlconvert.el ends here |