|
|
1.1 ! root 1: ;; ! 2: ;; copyright (C) 1987, 1988 Franz Inc, Berkeley, Ca. ! 3: ;; ! 4: ;; The software, data and information contained herein are the property ! 5: ;; of Franz, Inc. ! 6: ;; ! 7: ;; This file (or any derivation of it) may be distributed without ! 8: ;; further permission from Franz Inc. as long as: ! 9: ;; ! 10: ;; * it is not part of a product for sale, ! 11: ;; * no charge is made for the distribution, other than a tape ! 12: ;; fee, and ! 13: ;; * all copyright notices and this notice are preserved. ! 14: ;; ! 15: ;; If you have any comments or questions on this interface, please feel ! 16: ;; free to contact Franz Inc. at ! 17: ;; Franz Inc. ! 18: ;; Attn: Kevin Layer ! 19: ;; 1995 University Ave ! 20: ;; Suite 275 ! 21: ;; Berkeley, CA 94704 ! 22: ;; (415) 548-3600 ! 23: ;; or ! 24: ;; emacs-info%[email protected] ! 25: ;; ucbvax!franz!emacs-info ! 26: ! 27: ;; $Header: modes.el,v 1.28 88/11/21 21:14:40 layer Exp $ ! 28: ! 29: ;;;; Mode initializations ! 30: ! 31: ;;; ! 32: ;; Variables ! 33: ;;; ! 34: ! 35: (defvar fi:inferior-common-lisp-mode-map nil ! 36: "The inferior-common-lisp major-mode keymap.") ! 37: (defvar fi:inferior-common-lisp-mode-super-key-map nil ! 38: "Used for super-key processing in inferior-common-lisp mode.") ! 39: ! 40: (defvar fi:inferior-franz-lisp-mode-map nil ! 41: "The inferior-franz-lisp major-mode keymap.") ! 42: (defvar fi:inferior-franz-lisp-mode-super-key-map nil ! 43: "Used for super-key processing in inferior-franz-lisp mode.") ! 44: ! 45: (defvar fi:tcp-common-lisp-mode-map nil ! 46: "The tcp-lisp major-mode keymap.") ! 47: (defvar fi:tcp-common-lisp-mode-super-key-map nil ! 48: "Used for super-key processing in tcp-lisp mode.") ! 49: ! 50: (defvar fi:common-lisp-mode-map nil ! 51: "Major mode map used when editing Common Lisp source.") ! 52: (defvar fi:franz-lisp-mode-map nil ! 53: "Major mode map used when editing Franz Lisp source.") ! 54: ! 55: (defvar fi:indent-setup-hook nil ! 56: "Hook called to setup local indentation in Inferior Lisp and Lisp ! 57: modes.") ! 58: ! 59: (defvar fi:common-lisp-file-types '(".cl" ".lisp" ".lsp") ! 60: "A list of the files which are automatically put in fi:common-lisp-mode. ! 61: This variable should be set before this package is loaded.") ! 62: ! 63: ;;;; ! 64: ;;; The Modes ! 65: ;;;; ! 66: ! 67: (defun fi:inferior-common-lisp-mode () ! 68: "Major mode for interacting with an inferior Common Lisp subprocess." ! 69: (interactive) ! 70: (kill-all-local-variables) ! 71: (setq major-mode 'fi:inferior-common-lisp-mode) ! 72: (setq mode-name "Inferior Common Lisp") ! 73: (set-syntax-table lisp-mode-syntax-table) ! 74: (setq local-abbrev-table lisp-mode-abbrev-table) ! 75: (fi::lisp-subprocess-mode-variables) ! 76: (if (null fi:inferior-common-lisp-mode-super-key-map) ! 77: (progn ! 78: (setq fi:inferior-common-lisp-mode-super-key-map ! 79: (make-sparse-keymap)) ! 80: (fi::subprocess-mode-super-keys ! 81: fi:inferior-common-lisp-mode-super-key-map 'sub-lisp))) ! 82: (if (null fi:inferior-common-lisp-mode-map) ! 83: (setq fi:inferior-common-lisp-mode-map ! 84: (fi::inferior-lisp-mode-commands ! 85: (make-sparse-keymap) fi:inferior-common-lisp-mode-super-key-map))) ! 86: (use-local-map fi:inferior-common-lisp-mode-map) ! 87: (setq fi:subprocess-super-key-map fi:inferior-common-lisp-mode-super-key-map) ! 88: (run-hooks 'fi:indent-setup-hook 'fi:lisp-mode-hook ! 89: 'fi:subprocess-mode-hook 'fi:inferior-common-lisp-mode-hook)) ! 90: ! 91: (defun fi:inferior-franz-lisp-mode () ! 92: "Major mode for interacting with an inferior Franz Lisp subprocess." ! 93: (interactive) ! 94: (kill-all-local-variables) ! 95: (setq major-mode 'fi:inferior-franz-lisp-mode) ! 96: (setq mode-name "Inferior Franz Lisp") ! 97: (set-syntax-table lisp-mode-syntax-table) ! 98: (setq local-abbrev-table lisp-mode-abbrev-table) ! 99: (fi::lisp-subprocess-mode-variables) ! 100: (if (null fi:inferior-franz-lisp-mode-super-key-map) ! 101: (progn ! 102: (setq fi:inferior-franz-lisp-mode-super-key-map ! 103: (make-sparse-keymap)) ! 104: (fi::subprocess-mode-super-keys ! 105: fi:inferior-franz-lisp-mode-super-key-map 'sub-lisp))) ! 106: (if (null fi:inferior-franz-lisp-mode-map) ! 107: (setq fi:inferior-franz-lisp-mode-map ! 108: (fi::inferior-lisp-mode-commands ! 109: (make-sparse-keymap) fi:inferior-franz-lisp-mode-super-key-map))) ! 110: (use-local-map fi:inferior-franz-lisp-mode-map) ! 111: (setq fi:subprocess-super-key-map fi:inferior-franz-lisp-mode-super-key-map) ! 112: ! 113: (run-hooks 'fi:indent-setup-hook 'fi:lisp-mode-hook ! 114: 'fi:subprocess-mode-hook 'fi:inferior-franz-lisp-mode-hook)) ! 115: ! 116: (defun fi:tcp-common-lisp-mode () ! 117: "Major mode for interacting with a Common Lisp over a TCP/IP socket." ! 118: (interactive) ! 119: (kill-all-local-variables) ! 120: (setq major-mode 'fi:tcp-common-lisp-mode) ! 121: (setq mode-name "TCP Common Lisp") ! 122: (set-syntax-table lisp-mode-syntax-table) ! 123: (setq local-abbrev-table lisp-mode-abbrev-table) ! 124: (fi::lisp-subprocess-mode-variables) ! 125: (if (null fi:tcp-common-lisp-mode-super-key-map) ! 126: (progn ! 127: (setq fi:tcp-common-lisp-mode-super-key-map (make-sparse-keymap)) ! 128: (fi::subprocess-mode-super-keys ! 129: fi:tcp-common-lisp-mode-super-key-map 'tcp-lisp))) ! 130: (if (null fi:tcp-common-lisp-mode-map) ! 131: (setq fi:tcp-common-lisp-mode-map ! 132: (fi::tcp-common-lisp-mode-commands ! 133: (make-sparse-keymap) fi:tcp-common-lisp-mode-super-key-map))) ! 134: (use-local-map fi:tcp-common-lisp-mode-map) ! 135: (setq fi:subprocess-super-key-map fi:tcp-common-lisp-mode-super-key-map) ! 136: ! 137: (run-hooks 'fi:indent-setup-hook 'fi:lisp-mode-hook ! 138: 'fi:subprocess-mode-hook 'fi:tcp-common-lisp-mode-hook)) ! 139: ! 140: (defun fi:common-lisp-mode () ! 141: "Major mode for editing Lisp code to run in Common Lisp. ! 142: The bindings are taken from the variable `fi:common-lisp-mode-map'. ! 143: Entry to this mode calls the value of `fi:common-lisp-mode-hook'." ! 144: (interactive) ! 145: (kill-all-local-variables) ! 146: (setq major-mode 'fi:common-lisp-mode) ! 147: (setq mode-name "Common Lisp") ! 148: (fi::lisp-edit-mode-setup) ! 149: (fi::check-for-package-info) ! 150: (if (null fi:common-lisp-mode-map) ! 151: (progn ! 152: (setq fi:common-lisp-mode-map (make-sparse-keymap)) ! 153: (fi::lisp-mode-commands fi:common-lisp-mode-map nil nil))) ! 154: (use-local-map fi:common-lisp-mode-map) ! 155: (make-local-variable 'fi::sublisp-name) ! 156: (setq fi::sublisp-name fi::freshest-common-sublisp-name) ! 157: (run-hooks 'fi:indent-setup-hook 'fi:lisp-mode-hook ! 158: 'fi:common-lisp-mode-hook)) ! 159: ! 160: (defun fi:franz-lisp-mode () ! 161: "Major mode for editing Lisp code to run in Franz Lisp. ! 162: The bindings are taken from the variable `fi:franz-lisp-mode-map'. ! 163: Entry to this mode calls the value of `fi:lisp-mode-hook' and ! 164: `fi:franz-lisp-mode-hook', in this order, if their value is non-nil." ! 165: (interactive) ! 166: (kill-all-local-variables) ! 167: (setq major-mode 'fi:franz-lisp-mode) ! 168: (setq mode-name "Franz Lisp") ! 169: (fi::lisp-edit-mode-setup) ! 170: (fi::check-for-package-info) ! 171: (if (null fi:franz-lisp-mode-map) ! 172: (progn ! 173: (setq fi:franz-lisp-mode-map (make-sparse-keymap)) ! 174: (fi::lisp-mode-commands fi:franz-lisp-mode-map nil nil))) ! 175: (use-local-map fi:franz-lisp-mode-map) ! 176: (make-local-variable 'fi::sublisp-name) ! 177: (setq fi::sublisp-name fi::freshest-franz-sublisp-name) ! 178: (run-hooks 'fi:indent-setup-hook 'fi:lisp-mode-hook ! 179: 'fi:franz-lisp-mode-hook)) ! 180: ! 181: (defun fi::lisp-edit-mode-setup () ! 182: (set-syntax-table lisp-mode-syntax-table) ! 183: (setq local-abbrev-table lisp-mode-abbrev-table) ! 184: (make-local-variable 'fi::emacs-to-lisp-transaction-file) ! 185: (make-local-variable 'fi::emacs-to-lisp-transaction-buf) ! 186: (make-local-variable 'fi::emacs-to-lisp-package) ! 187: (fi::lisp-subprocess-mode-variables)) ! 188: ! 189: (defun fi::lisp-subprocess-mode-variables () ! 190: (setq fi::cl-package-regexp fi:common-lisp-package-regexp) ! 191: (make-local-variable 'paragraph-start) ! 192: (setq paragraph-start (concat "^$\\|" page-delimiter)) ! 193: (make-local-variable 'paragraph-separate) ! 194: (setq paragraph-separate paragraph-start)) ! 195: ! 196: (defun fi::check-for-package-info () ! 197: (save-excursion ! 198: ;; look for -*- ... package: xxx; .... -*- ! 199: (let (beg end) ! 200: (goto-char (point-min)) ! 201: (skip-chars-forward " \t\n") ! 202: (if (and (search-forward "-*-" (save-excursion (end-of-line) (point)) t) ! 203: (progn ! 204: (skip-chars-forward " \t") ! 205: (setq beg (point)) ! 206: (search-forward "-*-" ! 207: (save-excursion (end-of-line) (point)) t)) ! 208: (progn ! 209: (forward-char -3) ! 210: (skip-chars-backward " \t") ! 211: (setq end (point)) ! 212: (goto-char beg) ! 213: (if (search-forward ":" end t) ! 214: (progn ! 215: (goto-char beg) ! 216: (if (let ((case-fold-search t)) ! 217: (search-forward "package:" end t)) ! 218: (progn ! 219: (skip-chars-forward " \t") ! 220: (setq beg (point)) ! 221: (if (search-forward ";" end t) ! 222: (forward-char -1) ! 223: (goto-char end)) ! 224: (skip-chars-backward " \t") ! 225: (setq fi:package ! 226: (car (read-from-string ! 227: (buffer-substring beg (point))))) ! 228: (setq fi:package ! 229: (downcase ! 230: (format "%s" (if (consp fi:package) ! 231: (car fi:package) ! 232: fi:package)))))))) ! 233: fi:package)) ! 234: fi:package ! 235: (let* ((case-fold-search t) ! 236: (pos (re-search-forward "^(in-package[\t ]*" nil t))) ! 237: ;; find the `in-package' form, and snarf the package ! 238: ;; that way ! 239: (if pos ! 240: (let* ((start (match-end 0)) ! 241: (end (progn (search-forward ")" nil t) ! 242: (match-beginning 0))) ! 243: (p-string (buffer-substring start end)) ! 244: (p (car (read-from-string p-string)))) ! 245: (setq fi:package ! 246: (cond ((symbolp p) ! 247: (if (= (elt (symbol-name p) 0) ?:) ! 248: (substring (symbol-name p) 1) ! 249: (symbol-name p))) ! 250: ((and (consp p) ! 251: (eq 'quote (car p)) ! 252: (symbolp (car (cdr p)))) ! 253: (let ((name (symbol-name (car (cdr p))))) ! 254: (if (= (elt name 0) ?:) ! 255: (substring name 1) ! 256: name))) ! 257: ((stringp p) p))))))))) ! 258: (if (or (not (boundp 'fi:package)) ! 259: (null fi:package)) ! 260: (progn ! 261: (setq fi:package "user") ! 262: (message "using default package specification of `%s'" fi:package)) ! 263: (message "package specification is `%s'" fi:package))) ! 264: ! 265: (defun set-auto-mode () ! 266: "Select major mode appropriate for current buffer. ! 267: May base decision on visited file name (See variable auto-mode-list) ! 268: or on buffer contents (-*- line or local variables spec), but does not look ! 269: for the \"mode:\" local variable. For that, use hack-local-variables." ! 270: ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- ! 271: (let (beg end mode) ! 272: (save-excursion ! 273: (goto-char (point-min)) ! 274: (skip-chars-forward " \t\n") ! 275: (if (and (search-forward "-*-" (save-excursion (end-of-line) (point)) t) ! 276: (progn ! 277: (skip-chars-forward " \t") ! 278: (setq beg (point)) ! 279: (search-forward "-*-" (save-excursion (end-of-line) (point)) t)) ! 280: (progn ! 281: (forward-char -3) ! 282: (skip-chars-backward " \t") ! 283: (setq end (point)) ! 284: (goto-char beg) ! 285: (if (search-forward ":" end t) ! 286: (progn ! 287: (goto-char beg) ! 288: (if (let ((case-fold-search t)) ! 289: (search-forward "mode:" end t)) ! 290: (progn ! 291: (skip-chars-forward " \t") ! 292: (setq beg (point)) ! 293: (if (search-forward ";" end t) ! 294: (forward-char -1) ! 295: (goto-char end)) ! 296: (skip-chars-backward " \t") ! 297: (setq mode (buffer-substring beg (point)))))) ! 298: (setq mode (buffer-substring beg end))))) ! 299: (progn ! 300: (setq mode (downcase mode)) ! 301: (if (or (equal mode "lisp") (equal mode "common-lisp")) ! 302: (setq mode "fi:common-lisp")) ! 303: (funcall (intern (concat mode "-mode")))) ! 304: (let ((alist auto-mode-alist) ! 305: (name buffer-file-name)) ! 306: (let ((case-fold-search (eq system-type 'vax-vms))) ! 307: ;; Remove backup-suffixes from file name. ! 308: (setq name (file-name-sans-versions name)) ! 309: ;; Find first matching alist entry. ! 310: (while (and (not mode) alist) ! 311: (if (string-match (car (car alist)) name) ! 312: (setq mode (cdr (car alist)))) ! 313: (setq alist (cdr alist)))) ! 314: (if mode (funcall mode))))))) ! 315: ! 316: ;;;; ! 317: ;;; Initializations ! 318: ;;;; ! 319: ! 320: ;; the following is because the data associated with auto-mode-alist ! 321: ;; is put in text space when xemacs is built, and is by default read-only. ! 322: (setq auto-mode-alist (copy-alist auto-mode-alist)) ! 323: ! 324: (defun fi::def-auto-mode (string mode) ! 325: (let ((xx (assoc string auto-mode-alist))) ! 326: (if xx ! 327: (rplacd xx mode) ! 328: (setq auto-mode-alist ! 329: (cons (cons string mode) auto-mode-alist))))) ! 330: ! 331: (fi::def-auto-mode "\\.l$" 'fi:franz-lisp-mode) ! 332: ;; ! 333: (let ((list fi:common-lisp-file-types)) ! 334: (while list ! 335: (fi::def-auto-mode (concat "\\" (car list) "$") ! 336: 'fi:common-lisp-mode) ! 337: (setq list (cdr list)))) ! 338: ! 339: (setq fi:indent-setup-hook 'fi::indent-setup-hook) ! 340: ! 341: (defun fi::indent-setup-hook () ! 342: (make-local-variable 'indent-line-function) ! 343: (setq indent-line-function 'lisp-indent-line) ! 344: (make-local-variable 'comment-start) ! 345: (setq comment-start ";") ! 346: (make-local-variable 'comment-start-skip) ! 347: (setq comment-start-skip ";+ *") ! 348: (make-local-variable 'comment-column) ! 349: (setq comment-column 40) ! 350: (make-local-variable 'comment-indent-hook) ! 351: (setq comment-indent-hook 'lisp-comment-indent))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.