![[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.