diff options
| author | Pavel Janík | 2001-12-22 14:13:11 +0000 |
|---|---|---|
| committer | Pavel Janík | 2001-12-22 14:13:11 +0000 |
| commit | e32abc829f0d236139942e41da64091c86a193a3 (patch) | |
| tree | d39a9fa2a7ab0fe44132af9a8c8dbc176614ec74 /lisp/emulation | |
| parent | 44eec52586a0679e8de0bcb49b4361f16041dd58 (diff) | |
| download | emacs-e32abc829f0d236139942e41da64091c86a193a3.tar.gz emacs-e32abc829f0d236139942e41da64091c86a193a3.zip | |
Files removed.
Diffstat (limited to 'lisp/emulation')
| -rw-r--r-- | lisp/emulation/mlconvert.el | 288 | ||||
| -rw-r--r-- | lisp/emulation/mlsupport.el | 435 |
2 files changed, 0 insertions, 723 deletions
diff --git a/lisp/emulation/mlconvert.el b/lisp/emulation/mlconvert.el deleted file mode 100644 index 78e3dc29cab..00000000000 --- a/lisp/emulation/mlconvert.el +++ /dev/null | |||
| @@ -1,288 +0,0 @@ | |||
| 1 | ;;; mlconvert.el --- convert buffer of Mocklisp code to real lisp | ||
| 2 | |||
| 3 | ;; Copyright (C) 1985 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Maintainer: FSF | ||
| 6 | ;; Keywords: emulations | ||
| 7 | |||
| 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 | ||
| 12 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 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 | ||
| 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. | ||
| 24 | |||
| 25 | ;;; Commentary: | ||
| 26 | |||
| 27 | ;; This package converts Mocklisp code written under a Gosling or UniPress | ||
| 28 | ;; Emacs for use with GNU Emacs. The translated code will require runtime | ||
| 29 | ;; support from the mlsupport.el equivalent. | ||
| 30 | |||
| 31 | ;;; Code: | ||
| 32 | |||
| 33 | ;;;###autoload | ||
| 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") | ||
| 110 | (ml-expansion 'setq (lambda () | ||
| 111 | (if (looking-at "setq[ \t\n]+buffer-modified-p") | ||
| 112 | (replace-match "set-buffer-modified-p")))) | ||
| 113 | |||
| 114 | ;;(ml-expansion 'while (lambda () | ||
| 115 | ;; (let ((end (progn (forward-sexp 2) (point-marker))) | ||
| 116 | ;; (start (progn (forward-sexp -1) (point)))) | ||
| 117 | ;; (let ((cond (buffer-substring start end))) | ||
| 118 | ;; (cond ((equal cond "1") | ||
| 119 | ;; (delete-region (point) end) | ||
| 120 | ;; (insert "t")) | ||
| 121 | ;; (t | ||
| 122 | ;; (insert "(not (zerop ") | ||
| 123 | ;; (goto-char end) | ||
| 124 | ;; (insert "))"))) | ||
| 125 | ;; (set-marker end nil) | ||
| 126 | ;; (goto-char start))))) | ||
| 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 | |||
| 170 | (ml-expansion 'forward-word (lambda () | ||
| 171 | (if (looking-at "forward-word[ \t\n]*)") | ||
| 172 | (replace-match "forward-word 1)")))) | ||
| 173 | (ml-expansion 'backward-word (lambda () | ||
| 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 | |||
| 198 | (ml-expansion 'concat "ml-concat") | ||
| 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 | |||
| 264 | (ml-expansion 'lines-on-screen "set-frame-height") | ||
| 265 | (ml-expansion 'columns-on-screen "set-frame-width") | ||
| 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 | |||
| 288 | ;;; mlconvert.el ends here | ||
diff --git a/lisp/emulation/mlsupport.el b/lisp/emulation/mlsupport.el deleted file mode 100644 index 25f32bcb2c0..00000000000 --- a/lisp/emulation/mlsupport.el +++ /dev/null | |||
| @@ -1,435 +0,0 @@ | |||
| 1 | ;;; mlsupport.el --- run-time support for mocklisp code | ||
| 2 | |||
| 3 | ;; Copyright (C) 1985 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Maintainer: FSF | ||
| 6 | ;; Keywords: extensions | ||
| 7 | |||
| 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 | ||
| 12 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 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 | ||
| 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. | ||
| 24 | |||
| 25 | ;;; Commentary: | ||
| 26 | |||
| 27 | ;; This package provides equivalents of certain primitives from Gosling | ||
| 28 | ;; Emacs (including the commercial UniPress versions). These have an | ||
| 29 | ;; ml- prefix to distinguish them from native GNU Emacs functions with | ||
| 30 | ;; similar names. The package mlconvert.el translates Mocklisp code | ||
| 31 | ;; to use these names. | ||
| 32 | |||
| 33 | ;;; Code: | ||
| 34 | |||
| 35 | (defmacro ml-defun (&rest defs) | ||
| 36 | (list 'ml-defun-1 (list 'quote defs))) | ||
| 37 | |||
| 38 | (defun ml-defun-1 (args) | ||
| 39 | (while args | ||
| 40 | (fset (car (car args)) (cons 'mocklisp (cdr (car args)))) | ||
| 41 | (setq args (cdr args)))) | ||
| 42 | |||
| 43 | (defmacro declare-buffer-specific (&rest vars) | ||
| 44 | (cons 'progn (mapcar (function (lambda (var) (list 'make-variable-buffer-local (list 'quote var)))) vars))) | ||
| 45 | |||
| 46 | (defun ml-set-default (varname value) | ||
| 47 | (set-default (intern varname) value)) | ||
| 48 | |||
| 49 | ; Lossage: must make various things default missing args to the prefix arg | ||
| 50 | ; Alternatively, must make provide-prefix-argument do something hairy. | ||
| 51 | |||
| 52 | (defun >> (val count) (lsh val (- count))) | ||
| 53 | (defun novalue () nil) | ||
| 54 | |||
| 55 | (defun ml-not (arg) (if (zerop arg) 1 0)) | ||
| 56 | |||
| 57 | (defun provide-prefix-arg (arg form) | ||
| 58 | (funcall (car form) arg)) | ||
| 59 | |||
| 60 | (defun define-keymap (name) | ||
| 61 | (fset (intern name) (make-keymap))) | ||
| 62 | |||
| 63 | ;; Make it work to use ml-use-...-map on "esc" and such. | ||
| 64 | (fset 'esc-map esc-map) | ||
| 65 | (fset 'ctl-x-map ctl-x-map) | ||
| 66 | |||
| 67 | (defun ml-use-local-map (name) | ||
| 68 | (use-local-map (intern (concat name "-map")))) | ||
| 69 | |||
| 70 | (defun ml-use-global-map (name) | ||
| 71 | (use-global-map (intern (concat name "-map")))) | ||
| 72 | |||
| 73 | (defun local-bind-to-key (name key) | ||
| 74 | (or (current-local-map) | ||
| 75 | (use-local-map (make-keymap))) | ||
| 76 | (define-key (current-local-map) | ||
| 77 | (if (integerp key) | ||
| 78 | (if (>= key 128) | ||
| 79 | (concat (char-to-string meta-prefix-char) | ||
| 80 | (char-to-string (- key 128))) | ||
| 81 | (char-to-string key)) | ||
| 82 | key) | ||
| 83 | (intern name))) | ||
| 84 | |||
| 85 | (defun bind-to-key (name key) | ||
| 86 | (define-key global-map (if (integerp key) (char-to-string key) key) | ||
| 87 | (intern name))) | ||
| 88 | |||
| 89 | (defun ml-autoload (name file) | ||
| 90 | (autoload (intern name) file)) | ||
| 91 | |||
| 92 | (defun ml-define-string-macro (name defn) | ||
| 93 | (fset (intern name) defn)) | ||
| 94 | |||
| 95 | (defun push-back-character (char) | ||
| 96 | (setq unread-command-events (list char))) | ||
| 97 | |||
| 98 | (defun to-col (column) | ||
| 99 | (indent-to column 0)) | ||
| 100 | |||
| 101 | (defmacro is-bound (&rest syms) | ||
| 102 | (cons 'and (mapcar (function (lambda (sym) (list 'boundp (list 'quote sym)))) syms))) | ||
| 103 | |||
| 104 | (defmacro declare-global (&rest syms) | ||
| 105 | (cons 'progn (mapcar (function (lambda (sym) (list 'defvar sym nil))) syms))) | ||
| 106 | |||
| 107 | (defmacro error-occurred (&rest body) | ||
| 108 | (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t))) | ||
| 109 | |||
| 110 | (defun return-prefix-argument (value) | ||
| 111 | (setq prefix-arg value)) | ||
| 112 | |||
| 113 | (defun ml-prefix-argument () | ||
| 114 | (if (null current-prefix-arg) 1 | ||
| 115 | (if (listp current-prefix-arg) (car current-prefix-arg) | ||
| 116 | (if (eq current-prefix-arg '-) -1 | ||
| 117 | current-prefix-arg)))) | ||
| 118 | |||
| 119 | (defun ml-print (varname) | ||
| 120 | (interactive "vPrint variable: ") | ||
| 121 | (if (boundp varname) | ||
| 122 | (message "%s => %s" (symbol-name varname) (symbol-value varname)) | ||
| 123 | (message "%s has no value" (symbol-name varname)))) | ||
| 124 | |||
| 125 | (defun ml-set (str val) (set (intern str) val)) | ||
| 126 | |||
| 127 | (defun ml-message (&rest args) (message "%s" (apply 'concat args))) | ||
| 128 | |||
| 129 | (defun kill-to-end-of-line () | ||
| 130 | (ml-prefix-argument-loop | ||
| 131 | (if (eolp) | ||
| 132 | (kill-region (point) (1+ (point))) | ||
| 133 | (kill-region (point) (if (search-forward ?\n nil t) | ||
| 134 | (1- (point)) (point-max)))))) | ||
| 135 | |||
| 136 | (defun set-auto-fill-hook (arg) | ||
| 137 | (setq auto-fill-function (intern arg))) | ||
| 138 | |||
| 139 | (defun auto-execute (function pattern) | ||
| 140 | (if (/= (aref pattern 0) ?*) | ||
| 141 | (error "Only patterns starting with * supported in auto-execute")) | ||
| 142 | (setq auto-mode-alist (cons (cons (concat "\\." (substring pattern 1) | ||
| 143 | "\\'") | ||
| 144 | function) | ||
| 145 | auto-mode-alist))) | ||
| 146 | |||
| 147 | (defun move-to-comment-column () | ||
| 148 | (indent-to comment-column)) | ||
| 149 | |||
| 150 | (defun erase-region () | ||
| 151 | (delete-region (point) (mark))) | ||
| 152 | |||
| 153 | (defun delete-region-to-buffer (bufname) | ||
| 154 | (copy-to-buffer bufname (point) (mark)) | ||
| 155 | (delete-region (point) (mark))) | ||
| 156 | |||
| 157 | (defun copy-region-to-buffer (bufname) | ||
| 158 | (copy-to-buffer bufname (point) (mark))) | ||
| 159 | |||
| 160 | (defun append-region-to-buffer (bufname) | ||
| 161 | (append-to-buffer bufname (point) (mark))) | ||
| 162 | |||
| 163 | (defun prepend-region-to-buffer (bufname) | ||
| 164 | (prepend-to-buffer bufname (point) (mark))) | ||
| 165 | |||
| 166 | (defun delete-next-character () | ||
| 167 | (delete-char (ml-prefix-argument))) | ||
| 168 | |||
| 169 | (defun delete-next-word () | ||
| 170 | (delete-region (point) (progn (forward-word (ml-prefix-argument)) (point)))) | ||
| 171 | |||
| 172 | (defun delete-previous-word () | ||
| 173 | (delete-region (point) (progn (backward-word (ml-prefix-argument)) (point)))) | ||
| 174 | |||
| 175 | (defun delete-previous-character () | ||
| 176 | (delete-backward-char (ml-prefix-argument))) | ||
| 177 | |||
| 178 | (defun forward-character () | ||
| 179 | (forward-char (ml-prefix-argument))) | ||
| 180 | |||
| 181 | (defun backward-character () | ||
| 182 | (backward-char (ml-prefix-argument))) | ||
| 183 | |||
| 184 | (defun ml-newline () | ||
| 185 | (newline (ml-prefix-argument))) | ||
| 186 | |||
| 187 | (defun ml-next-line () | ||
| 188 | (next-line (ml-prefix-argument))) | ||
| 189 | |||
| 190 | (defun ml-previous-line () | ||
| 191 | (previous-line (ml-prefix-argument))) | ||
| 192 | |||
| 193 | (defun delete-to-kill-buffer () | ||
| 194 | (kill-region (point) (mark))) | ||
| 195 | |||
| 196 | (defun narrow-region () | ||
| 197 | (narrow-to-region (point) (mark))) | ||
| 198 | |||
| 199 | (defun ml-newline-and-indent () | ||
| 200 | (let ((column (current-indentation))) | ||
| 201 | (newline (ml-prefix-argument)) | ||
| 202 | (indent-to column))) | ||
| 203 | |||
| 204 | (defun newline-and-backup () | ||
| 205 | (open-line (ml-prefix-argument))) | ||
| 206 | |||
| 207 | (defun quote-char () | ||
| 208 | (quoted-insert (ml-prefix-argument))) | ||
| 209 | |||
| 210 | (defun ml-current-column () | ||
| 211 | (1+ (current-column))) | ||
| 212 | |||
| 213 | (defun ml-current-indent () | ||
| 214 | (1+ (current-indentation))) | ||
| 215 | |||
| 216 | (defun region-around-match (&optional n) | ||
| 217 | (set-mark (match-beginning n)) | ||
| 218 | (goto-char (match-end n))) | ||
| 219 | |||
| 220 | (defun region-to-string () | ||
| 221 | (buffer-substring (min (point) (mark)) (max (point) (mark)))) | ||
| 222 | |||
| 223 | (defun use-abbrev-table (name) | ||
| 224 | (let ((symbol (intern (concat name "-abbrev-table")))) | ||
| 225 | (or (boundp symbol) | ||
| 226 | (define-abbrev-table symbol nil)) | ||
| 227 | (symbol-value symbol))) | ||
| 228 | |||
| 229 | (defun define-hooked-local-abbrev (name exp hook) | ||
| 230 | (define-abbrev local-abbrev-table name exp (intern hook))) | ||
| 231 | |||
| 232 | (defun define-hooked-global-abbrev (name exp hook) | ||
| 233 | (define-abbrev global-abbrev-table name exp (intern hook))) | ||
| 234 | |||
| 235 | (defun case-word-lower () | ||
| 236 | (ml-casify-word 'downcase-region)) | ||
| 237 | |||
| 238 | (defun case-word-upper () | ||
| 239 | (ml-casify-word 'upcase-region)) | ||
| 240 | |||
| 241 | (defun case-word-capitalize () | ||
| 242 | (ml-casify-word 'capitalize-region)) | ||
| 243 | |||
| 244 | (defun ml-casify-word (fun) | ||
| 245 | (save-excursion | ||
| 246 | (forward-char 1) | ||
| 247 | (forward-word -1) | ||
| 248 | (funcall fun (point) | ||
| 249 | (progn (forward-word (ml-prefix-argument)) | ||
| 250 | (point))))) | ||
| 251 | |||
| 252 | (defun case-region-lower () | ||
| 253 | (downcase-region (point) (mark))) | ||
| 254 | |||
| 255 | (defun case-region-upper () | ||
| 256 | (upcase-region (point) (mark))) | ||
| 257 | |||
| 258 | (defun case-region-capitalize () | ||
| 259 | (capitalize-region (point) (mark))) | ||
| 260 | |||
| 261 | (defvar saved-command-line-args nil) | ||
| 262 | |||
| 263 | (defun argc () | ||
| 264 | (or saved-command-line-args | ||
| 265 | (setq saved-command-line-args command-line-args | ||
| 266 | command-line-args ())) | ||
| 267 | (length command-line-args)) | ||
| 268 | |||
| 269 | (defun argv (i) | ||
| 270 | (or saved-command-line-args | ||
| 271 | (setq saved-command-line-args command-line-args | ||
| 272 | command-line-args ())) | ||
| 273 | (nth i saved-command-line-args)) | ||
| 274 | |||
| 275 | (defun invisible-argc () | ||
| 276 | (length (or saved-command-line-args | ||
| 277 | command-line-args))) | ||
| 278 | |||
| 279 | (defun invisible-argv (i) | ||
| 280 | (nth i (or saved-command-line-args | ||
| 281 | command-line-args))) | ||
| 282 | |||
| 283 | (defun exit-emacs () | ||
| 284 | (interactive) | ||
| 285 | (condition-case () | ||
| 286 | (exit-recursive-edit) | ||
| 287 | (error (kill-emacs)))) | ||
| 288 | |||
| 289 | ;; Lisp function buffer-size returns total including invisible; | ||
| 290 | ;; mocklisp wants just visible. | ||
| 291 | (defun ml-buffer-size () | ||
| 292 | (- (point-max) (point-min))) | ||
| 293 | |||
| 294 | (defun previous-command () | ||
| 295 | last-command) | ||
| 296 | |||
| 297 | (defun beginning-of-window () | ||
| 298 | (goto-char (window-start))) | ||
| 299 | |||
| 300 | (defun end-of-window () | ||
| 301 | (goto-char (window-start)) | ||
| 302 | (vertical-motion (- (window-height) 2))) | ||
| 303 | |||
| 304 | (defun ml-search-forward (string) | ||
| 305 | (search-forward string nil nil (ml-prefix-argument))) | ||
| 306 | |||
| 307 | (defun ml-re-search-forward (string) | ||
| 308 | (re-search-forward string nil nil (ml-prefix-argument))) | ||
| 309 | |||
| 310 | (defun ml-search-backward (string) | ||
| 311 | (search-backward string nil nil (ml-prefix-argument))) | ||
| 312 | |||
| 313 | (defun ml-re-search-backward (string) | ||
| 314 | (re-search-backward string nil nil (ml-prefix-argument))) | ||
| 315 | |||
| 316 | (defvar use-users-shell 1 | ||
| 317 | "Mocklisp compatibility variable; 1 means use shell from SHELL env var. | ||
| 318 | 0 means use /bin/sh.") | ||
| 319 | |||
| 320 | (defvar use-csh-option-f 1 | ||
| 321 | "Mocklisp compatibility variable; 1 means pass -f when calling csh.") | ||
| 322 | |||
| 323 | (defun filter-region (command) | ||
| 324 | (let ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh")) | ||
| 325 | (csh (equal (file-name-nondirectory shell) "csh"))) | ||
| 326 | (call-process-region (point) (mark) shell t t nil | ||
| 327 | (if (and csh use-csh-option-f) "-cf" "-c") | ||
| 328 | (concat "exec " command)))) | ||
| 329 | |||
| 330 | (defun execute-monitor-command (command) | ||
| 331 | (let ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh")) | ||
| 332 | (csh (equal (file-name-nondirectory shell) "csh"))) | ||
| 333 | (call-process shell nil t t | ||
| 334 | (if (and csh use-csh-option-f) "-cf" "-c") | ||
| 335 | (concat "exec " command)))) | ||
| 336 | |||
| 337 | (defun use-syntax-table (name) | ||
| 338 | (set-syntax-table (symbol-value (intern (concat name "-syntax-table"))))) | ||
| 339 | |||
| 340 | (defun line-to-top-of-window () | ||
| 341 | (recenter (1- (ml-prefix-argument)))) | ||
| 342 | |||
| 343 | (defun ml-previous-page (&optional arg) | ||
| 344 | (let ((count (or arg (ml-prefix-argument)))) | ||
| 345 | (while (> count 0) | ||
| 346 | (scroll-down nil) | ||
| 347 | (setq count (1- count))) | ||
| 348 | (while (< count 0) | ||
| 349 | (scroll-up nil) | ||
| 350 | (setq count (1+ count))))) | ||
| 351 | |||
| 352 | (defun ml-next-page () | ||
| 353 | (previous-page (- (ml-prefix-argument)))) | ||
| 354 | |||
| 355 | (defun page-next-window (&optional arg) | ||
| 356 | (let ((count (or arg (ml-prefix-argument)))) | ||
| 357 | (while (> count 0) | ||
| 358 | (scroll-other-window nil) | ||
| 359 | (setq count (1- count))) | ||
| 360 | (while (< count 0) | ||
| 361 | (scroll-other-window '-) | ||
| 362 | (setq count (1+ count))))) | ||
| 363 | |||
| 364 | (defun ml-next-window () | ||
| 365 | (select-window (next-window))) | ||
| 366 | |||
| 367 | (defun ml-previous-window () | ||
| 368 | (select-window (previous-window))) | ||
| 369 | |||
| 370 | (defun scroll-one-line-up () | ||
| 371 | (scroll-up (ml-prefix-argument))) | ||
| 372 | |||
| 373 | (defun scroll-one-line-down () | ||
| 374 | (scroll-down (ml-prefix-argument))) | ||
| 375 | |||
| 376 | (defun split-current-window () | ||
| 377 | (split-window (selected-window))) | ||
| 378 | |||
| 379 | (defun last-key-struck () last-command-char) | ||
| 380 | |||
| 381 | (defun execute-mlisp-line (string) | ||
| 382 | (eval (read string))) | ||
| 383 | |||
| 384 | (defun move-dot-to-x-y (x y) | ||
| 385 | (goto-char (window-start (selected-window))) | ||
| 386 | (vertical-motion (1- y)) | ||
| 387 | (move-to-column (1- x))) | ||
| 388 | |||
| 389 | (defun ml-modify-syntax-entry (string) | ||
| 390 | (let ((i 5) | ||
| 391 | (len (length string)) | ||
| 392 | (datastring (substring string 0 2))) | ||
| 393 | (if (= (aref string 0) ?\-) | ||
| 394 | (aset datastring 0 ?\ )) | ||
| 395 | (if (= (aref string 2) ?\{) | ||
| 396 | (if (= (aref string 4) ?\ ) | ||
| 397 | (aset datastring 0 ?\<) | ||
| 398 | (error "Two-char comment delimiter: use modify-syntax-entry directly"))) | ||
| 399 | (if (= (aref string 3) ?\}) | ||
| 400 | (if (= (aref string 4) ?\ ) | ||
| 401 | (aset datastring 0 ?\>) | ||
| 402 | (error "Two-char comment delimiter: use modify-syntax-entry directly"))) | ||
| 403 | (while (< i len) | ||
| 404 | (modify-syntax-entry (aref string i) datastring) | ||
| 405 | (setq i (1+ i)) | ||
| 406 | (if (and (< i len) | ||
| 407 | (= (aref string i) ?\-)) | ||
| 408 | (let ((c (aref string (1- i))) | ||
| 409 | (lim (aref string (1+ i)))) | ||
| 410 | (while (<= c lim) | ||
| 411 | (modify-syntax-entry c datastring) | ||
| 412 | (setq c (1+ c))) | ||
| 413 | (setq i (+ 2 i))))))) | ||
| 414 | |||
| 415 | |||
| 416 | |||
| 417 | (defun ml-substr (string from to) | ||
| 418 | (let ((length (length string))) | ||
| 419 | (if (< from 0) (setq from (+ from length))) | ||
| 420 | (if (< to 0) (setq to (+ to length))) | ||
| 421 | (substring string from (+ from to)))) | ||
| 422 | |||
| 423 | (defun ml-concat (&rest args) | ||
| 424 | (let ((newargs nil) this) | ||
| 425 | (while args | ||
| 426 | (setq this (car args)) | ||
| 427 | (if (numberp this) | ||
| 428 | (setq this (number-to-string this))) | ||
| 429 | (setq newargs (cons this newargs) | ||
| 430 | args (cdr args))) | ||
| 431 | (apply 'concat (nreverse newargs)))) | ||
| 432 | |||
| 433 | (provide 'mlsupport) | ||
| 434 | |||
| 435 | ;;; mlsupport.el ends here | ||