Annotation of 43BSDReno/contrib/emacs-18.55/dist-1.3/fi/modes.el, revision 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.