![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mlconvert.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to mlconvert.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp |
1.1 root 1: ;; Convert buffer of Mocklisp code to real lisp.
2: ;; Copyright (C) 1985 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21: (defun convert-mocklisp-buffer ()
22: "Convert buffer of Mocklisp code to real Lisp that GNU Emacs can run."
23: (interactive)
24: (emacs-lisp-mode)
25: (set-syntax-table (copy-sequence (syntax-table)))
26: (modify-syntax-entry ?\| "w")
27: (message "Converting mocklisp (ugh!)...")
28: (goto-char (point-min))
29: (fix-mlisp-syntax)
30:
31: ;; Emulation of mocklisp is accurate only within a mocklisp-function
32: ;; so turn any non-function into a defun and then call it.
33: (goto-char (point-min))
34: (condition-case ignore
35: (while t
36: (let ((opt (point))
37: (form (read (current-buffer))))
38: (and (listp form)
39: (not (eq (car form) 'defun))
40: (progn (insert "))\n\n(ml-foo)\n\n")
41: (save-excursion
42: (goto-char opt)
43: (skip-chars-forward "\n")
44: (insert "(defun (ml-foo \n "))))))
45: (end-of-file nil))
46:
47: (goto-char (point-min))
48: (insert ";;; GNU Emacs code converted from Mocklisp\n")
49: (insert "(require 'mlsupport)\n\n")
50: (fix-mlisp-symbols)
51:
52: (goto-char (point-min))
53: (message "Converting mocklisp...done"))
54:
55: (defun fix-mlisp-syntax ()
56: (while (re-search-forward "['\"]" nil t)
57: (if (= (preceding-char) ?\")
58: (progn (forward-char -1)
59: (forward-sexp 1))
60: (delete-char -1)
61: (insert "?")
62: (if (or (= (following-char) ?\\) (= (following-char) ?^))
63: (forward-char 1)
64: (if (looking-at "[^a-zA-Z]")
65: (insert ?\\)))
66: (forward-char 1)
67: (delete-char 1))))
68:
69: (defun fix-mlisp-symbols ()
70: (while (progn
71: (skip-chars-forward " \t\n()")
72: (not (eobp)))
73: (cond ((or (= (following-char) ?\?)
74: (= (following-char) ?\"))
75: (forward-sexp 1))
76: ((= (following-char) ?\;)
77: (forward-line 1))
78: (t
79: (let ((start (point)) prop)
80: (forward-sexp 1)
81: (setq prop (get (intern-soft (buffer-substring start (point)))
82: 'mocklisp))
83: (cond ((null prop))
84: ((stringp prop)
85: (delete-region start (point))
86: (insert prop))
87: (t
88: (save-excursion
89: (goto-char start)
90: (funcall prop)))))))))
91:
92: (defun ml-expansion (ml-name lisp-string)
93: (put ml-name 'mocklisp lisp-string))
94:
95: (ml-expansion 'defun "ml-defun")
96: (ml-expansion 'if "ml-if")
97: (ml-expansion 'setq '(lambda ()
98: (if (looking-at "setq[ \t\n]+buffer-modified-p")
99: (replace-match "set-buffer-modified-p"))))
100:
101: (ml-expansion 'while '(lambda ()
102: (let ((end (progn (forward-sexp 2) (point-marker)))
103: (start (progn (forward-sexp -1) (point))))
104: (let ((cond (buffer-substring start end)))
105: (cond ((equal cond "1")
106: (delete-region (point) end)
107: (insert "t"))
108: (t
109: (insert "(not (zerop ")
110: (goto-char end)
111: (insert "))")))
112: (set-marker end nil)
113: (goto-char start)))))
114:
115: (ml-expansion 'arg "ml-arg")
116: (ml-expansion 'nargs "ml-nargs")
117: (ml-expansion 'interactive "ml-interactive")
118: (ml-expansion 'message "ml-message")
119: (ml-expansion 'print "ml-print")
120: (ml-expansion 'set "ml-set")
121: (ml-expansion 'set-default "ml-set-default")
122: (ml-expansion 'provide-prefix-argument "ml-provide-prefix-argument")
123: (ml-expansion 'prefix-argument-loop "ml-prefix-argument-loop")
124: (ml-expansion 'prefix-argument "ml-prefix-arg")
125: (ml-expansion 'use-local-map "ml-use-local-map")
126: (ml-expansion 'use-global-map "ml-use-global-map")
127: (ml-expansion 'modify-syntax-entry "ml-modify-syntax-entry")
128: (ml-expansion 'error-message "error")
129:
130: (ml-expansion 'dot "point-marker")
131: (ml-expansion 'mark "mark-marker")
132: (ml-expansion 'beginning-of-file "beginning-of-buffer")
133: (ml-expansion 'end-of-file "end-of-buffer")
134: (ml-expansion 'exchange-dot-and-mark "exchange-point-and-mark")
135: (ml-expansion 'set-mark "set-mark-command")
136: (ml-expansion 'argument-prefix "universal-arg")
137:
138: (ml-expansion 'previous-page "ml-previous-page")
139: (ml-expansion 'next-page "ml-next-page")
140: (ml-expansion 'next-window "ml-next-window")
141: (ml-expansion 'previous-window "ml-previous-window")
142:
143: (ml-expansion 'newline "ml-newline")
144: (ml-expansion 'next-line "ml-next-line")
145: (ml-expansion 'previous-line "ml-previous-line")
146: (ml-expansion 'self-insert "self-insert-command")
147: (ml-expansion 'meta-digit "digit-argument")
148: (ml-expansion 'meta-minus "negative-argument")
149:
150: (ml-expansion 'newline-and-indent "ml-newline-and-indent")
151: (ml-expansion 'yank-from-killbuffer "yank")
152: (ml-expansion 'yank-buffer "insert-buffer")
153: (ml-expansion 'copy-region "copy-region-as-kill")
154: (ml-expansion 'delete-white-space "delete-horizontal-space")
155: (ml-expansion 'widen-region "widen")
156:
157: (ml-expansion 'forward-word '(lambda ()
158: (if (looking-at "forward-word[ \t\n]*)")
159: (replace-match "forward-word 1)"))))
160: (ml-expansion 'backward-word '(lambda ()
161: (if (looking-at "backward-word[ \t\n]*)")
162: (replace-match "backward-word 1)"))))
163:
164: (ml-expansion 'forward-paren "forward-list")
165: (ml-expansion 'backward-paren "backward-list")
166: (ml-expansion 'search-reverse "ml-search-backward")
167: (ml-expansion 're-search-reverse "ml-re-search-backward")
168: (ml-expansion 'search-forward "ml-search-forward")
169: (ml-expansion 're-search-forward "ml-re-search-forward")
170: (ml-expansion 'quote "regexp-quote")
171: (ml-expansion 're-query-replace "query-replace-regexp")
172: (ml-expansion 're-replace-string "replace-regexp")
173:
174: ; forward-paren-bl, backward-paren-bl
175:
176: (ml-expansion 'get-tty-character "read-char")
177: (ml-expansion 'get-tty-input "read-input")
178: (ml-expansion 'get-tty-string "read-string")
179: (ml-expansion 'get-tty-buffer "read-buffer")
180: (ml-expansion 'get-tty-command "read-command")
181: (ml-expansion 'get-tty-variable "read-variable")
182: (ml-expansion 'get-tty-no-blanks-input "read-no-blanks-input")
183: (ml-expansion 'get-tty-key "read-key")
184:
185: (ml-expansion 'c= "char-equal")
186: (ml-expansion 'goto-character "goto-char")
187: (ml-expansion 'substr "ml-substr")
188: (ml-expansion 'variable-apropos "apropos")
189: (ml-expansion 'execute-mlisp-buffer "eval-current-buffer")
190: (ml-expansion 'execute-mlisp-file "load")
191: (ml-expansion 'visit-file "find-file")
192: (ml-expansion 'read-file "find-file")
193: (ml-expansion 'write-modified-files "save-some-buffers")
194: (ml-expansion 'backup-before-writing "make-backup-files")
195: (ml-expansion 'write-file-exit "save-buffers-kill-emacs")
196: (ml-expansion 'write-named-file "write-file")
197: (ml-expansion 'change-file-name "set-visited-file-name")
198: (ml-expansion 'change-buffer-name "rename-buffer")
199: (ml-expansion 'buffer-exists "get-buffer")
200: (ml-expansion 'delete-buffer "kill-buffer")
201: (ml-expansion 'unlink-file "delete-file")
202: (ml-expansion 'unlink-checkpoint-files "delete-auto-save-files")
203: (ml-expansion 'file-exists "file-exists-p")
204: (ml-expansion 'write-current-file "save-buffer")
205: (ml-expansion 'change-directory "cd")
206: (ml-expansion 'temp-use-buffer "set-buffer")
207: (ml-expansion 'fast-filter-region "filter-region")
208:
209: (ml-expansion 'pending-input "input-pending-p")
210: (ml-expansion 'execute-keyboard-macro "call-last-kbd-macro")
211: (ml-expansion 'start-remembering "start-kbd-macro")
212: (ml-expansion 'end-remembering "end-kbd-macro")
213: (ml-expansion 'define-keyboard-macro "name-last-kbd-macro")
214: (ml-expansion 'define-string-macro "ml-define-string-macro")
215:
216: (ml-expansion 'current-column "ml-current-column")
217: (ml-expansion 'current-indent "ml-current-indent")
218: (ml-expansion 'insert-character "insert")
219:
220: (ml-expansion 'users-login-name "user-login-name")
221: (ml-expansion 'users-full-name "user-full-name")
222: (ml-expansion 'current-time "current-time-string")
223: (ml-expansion 'current-numeric-time "current-numeric-time-you-lose")
224: (ml-expansion 'current-buffer-name "buffer-name")
225: (ml-expansion 'current-file-name "buffer-file-name")
226:
227: (ml-expansion 'local-binding-of "local-key-binding")
228: (ml-expansion 'global-binding-of "global-key-binding")
229:
230: ;defproc (ProcedureType, "procedure-type");
231:
232: (ml-expansion 'remove-key-binding "global-unset-key")
233: (ml-expansion 'remove-binding "global-unset-key")
234: (ml-expansion 'remove-local-binding "local-unset-key")
235: (ml-expansion 'remove-all-local-bindings "use-local-map nil")
236: (ml-expansion 'autoload "ml-autoload")
237:
238: (ml-expansion 'checkpoint-frequency "auto-save-interval")
239:
240: (ml-expansion 'mode-string "mode-name")
241: (ml-expansion 'right-margin "fill-column")
242: (ml-expansion 'tab-size "tab-width")
243: (ml-expansion 'default-right-margin "default-fill-column")
244: (ml-expansion 'default-tab-size "default-tab-width")
245: (ml-expansion 'buffer-is-modified "(buffer-modified-p)")
246:
247: (ml-expansion 'file-modified-time "you-lose-on-file-modified-time")
248: (ml-expansion 'needs-checkpointing "you-lose-on-needs-checkpointing")
249:
250: (ml-expansion 'lines-on-screen "set-screen-height")
251: (ml-expansion 'columns-on-screen "set-screen-width")
252:
253: (ml-expansion 'dumped-emacs "t")
254:
255: (ml-expansion 'buffer-size "ml-buffer-size")
256: (ml-expansion 'dot-is-visible "pos-visible-in-window-p")
257:
258: (ml-expansion 'track-eol-on-^N-^P "track-eol")
259: (ml-expansion 'ctlchar-with-^ "ctl-arrow")
260: (ml-expansion 'help-on-command-completion-error "completion-auto-help")
261: (ml-expansion 'dump-stack-trace "backtrace")
262: (ml-expansion 'pause-emacs "suspend-emacs")
263: (ml-expansion 'compile-it "compile")
264:
265: (ml-expansion '!= "/=")
266: (ml-expansion '& "logand")
267: (ml-expansion '| "logior")
268: (ml-expansion '^ "logxor")
269: (ml-expansion '! "ml-not")
270: (ml-expansion '<< "lsh")
271:
272: ;Variable pause-writes-files
273:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.