Annotation of 43BSDReno/contrib/emacs-18.55/dist-1.3/fi/modes.el, revision 1.1.1.1

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

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.