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