;; Copyright (c) 1987-2002 Franz Inc, Berkeley, Ca.
;;
;; Permission is granted to any individual or institution to use, copy,
;; modify, and distribute this software, and to distribute modified
;; versions, provided that this complete copyright and permission notice is
;; maintained, intact, in all copies and supporting documentation.
;;
;; Franz Incorporated provides this software "as is" without
;; express or implied warranty.
;; $Id: fi-modes.el,v 3.0 2003/12/15 22:52:57 layer Exp $
;;;; Mode initializations
;;;
;; Variables
;;;
(defvar fi:inferior-common-lisp-mode-map nil
"The inferior-common-lisp major-mode keymap.")
(defvar fi:inferior-common-lisp-mode-super-key-map nil
"Used for super-key processing in inferior-common-lisp mode.")
(defvar fi:inferior-franz-lisp-mode-map nil
"The inferior-franz-lisp major-mode keymap.")
(defvar fi:inferior-franz-lisp-mode-super-key-map nil
"Used for super-key processing in inferior-franz-lisp mode.")
(defvar fi:lisp-listener-mode-map nil
"The tcp-lisp major-mode keymap.")
(defvar fi:lisp-listener-mode-super-key-map nil
"Used for super-key processing in tcp-lisp mode.")
(defvar fi:common-lisp-mode-map nil
"Major mode map used when editing Common Lisp source.")
(defvar fi:franz-lisp-mode-map nil
"Major mode map used when editing Franz Lisp source.")
(defvar fi:emacs-lisp-mode-map nil
"Major mode map used when editing GNU Emacs Lisp source.")
(defvar fi:lisp-mode-syntax-table nil
"The value of which is the syntax table for all Lisp modes, except Emacs
Lisp mode.")
(defvar fi:emacs-lisp-mode-syntax-table nil
"The value of which is the syntax table for Emacs Lisp mode.")
(defvar fi:common-lisp-file-types '(".cl" ".lisp" ".lsp")
"*A list of the file types which are automatically put in
fi:common-lisp-mode. NOTE: the value of this variable is only used at
interface load time. Setting after the interface is loaded will have no
effect.")
(defvar fi:lisp-do-indentation t
"*When non-nil, do FI-style indentation in Lisp modes.")
(defvar fi:auto-fill nil
"*When non-nil, and fi:lisp-do-indentation is non-nil, turn on auto-fill
mode in Lisp editing modes.")
(defvar fi:subprocess-mode nil
"Non-nil when buffer has a subprocess.")
(add-hook 'fi:common-lisp-mode-hook
(function
(lambda ()
(when (not (fi:member-equal "; pkg:" mode-line-process))
(setq mode-line-process
(append mode-line-process
'((fi:package ("; pkg:" fi:package))))))
(when (not (fi:member-equal "; rt:" mode-line-process))
(setq mode-line-process
(append mode-line-process
'((fi:readtable ("; rt:" fi:readtable))))))))
"*The initial value of this hook, which is run whenever a Lisp mode is
entered, causes the `package' and readtable (if any) to be displayed in the
mode line. It uses MODE-LINE-PROCESS, which has no use in non-subprocess
buffers.")
(defvar fi:in-package-regexp nil
"*If non-nil, the regular expression that describes the IN-PACKAGE form,
for purposes of tracking package changes in a subprocess Lisp buffer. The
value of this is taken from fi:default-in-package-regexp in Lisp subprocess
buffers, but is nil elsewhere.")
(make-variable-buffer-local 'fi:in-package-regexp)
(defvar fi::multiple-in-packages nil
;; non-nil if there are multiple ones in the current buffer
)
(make-variable-buffer-local 'fi::multiple-in-packages)
(defvar fi:default-in-package-regexp
"(\\(cl:\\|common-lisp:\\)?in-package\\>\\|:pa\\>\\|:pac\\>\\|:pack\\>\\|:packa\\>\\|:packag\\>\\|:package\\>"
"*The regular expression matching the Lisp expression to change the
current package. The two things this must match are the IN-PACKAGE macro
form and all the possible instances of the :package top-level command.
If nil, no automatic package tracking will be done.")
(defvar fi::menubar-initialization nil)
;;;;
;;; The Modes
;;;;
(defun fi::kill-all-local-variables ()
;; don't kill the input ring, which can be very useful
(let ((input-ring fi::input-ring)
(input-ring-yank-pointer fi::input-ring-yank-pointer)
(last-input-search-string fi::last-input-search-string)
(last-command-was-successful-search
fi::last-command-was-successful-search))
(kill-all-local-variables)
(setq fi::input-ring input-ring)
(setq fi::input-ring-yank-pointer input-ring-yank-pointer)
(setq fi::last-input-search-string last-input-search-string)
(setq fi::last-command-was-successful-search
last-command-was-successful-search)))
(defun fi:inferior-common-lisp-mode (&optional mode-hook &rest mode-hook-args)
"Major mode for interacting with Common Lisp subprocesses.
The keymap for this mode is bound to fi:inferior-common-lisp-mode-map:
\\{fi:inferior-common-lisp-mode-map}
Entry to this mode runs the following hooks:
fi:lisp-mode-hook
fi:subprocess-mode-hook
fi:inferior-common-lisp-mode-hook
in the above order.
When calling from a program, arguments are MODE-HOOK and MODE-HOOK-ARGS,
the former is applied to the latter just after killing all local variables
but before doing any other mode setup."
(interactive)
(fi::kill-all-local-variables)
(if mode-hook (apply mode-hook mode-hook-args))
(setq major-mode 'fi:inferior-common-lisp-mode)
(setq mode-name "Inferior Common Lisp")
(set-syntax-table fi:lisp-mode-syntax-table)
(fi::lisp-subprocess-mode-variables)
(fi::initialize-mode-map 'fi:inferior-common-lisp-mode-map
'fi:inferior-common-lisp-mode-super-key-map
'sub-lisp)
(use-local-map fi:inferior-common-lisp-mode-map)
(setq fi:lisp-indent-hook-property 'fi:common-lisp-indent-hook)
(run-hooks 'fi:lisp-mode-hook 'fi:subprocess-mode-hook
'fi:inferior-common-lisp-mode-hook))
(defun fi:inferior-franz-lisp-mode (&optional mode-hook &rest mode-hook-args)
"Major mode for interacting with Franz Lisp subprocesses.
The keymap for this mode is bound to fi:inferior-franz-lisp-mode-map:
\\{fi:inferior-franz-lisp-mode-map}
Entry to this mode runs the following hooks:
fi:lisp-mode-hook
fi:subprocess-mode-hook
fi:inferior-franz-lisp-mode-hook
in the above order.
When calling from a program, arguments are MODE-HOOK and MODE-HOOK-ARGS,
the former is applied to the latter just after killing all local variables
but before doing any other mode setup."
(interactive)
(fi::kill-all-local-variables)
(if mode-hook (apply mode-hook mode-hook-args))
(setq major-mode 'fi:inferior-franz-lisp-mode)
(setq mode-name "Inferior Franz Lisp")
(set-syntax-table fi:lisp-mode-syntax-table)
(fi::lisp-subprocess-mode-variables)
(fi::initialize-mode-map 'fi:inferior-franz-lisp-mode-map
'fi:inferior-franz-lisp-mode-super-key-map
'sub-lisp)
(use-local-map fi:inferior-franz-lisp-mode-map)
(setq fi:lisp-indent-hook-property 'fi:franz-lisp-indent-hook)
(run-hooks 'fi:lisp-mode-hook 'fi:subprocess-mode-hook
'fi:inferior-franz-lisp-mode-hook))
(defun fi:lisp-listener-mode (&optional mode-hook)
"Major mode for interacting with Common Lisp over a socket.
The keymap for this mode is bound to fi:lisp-listener-mode-map:
\\{fi:lisp-listener-mode-map}
Entry to this mode runs the following hooks:
fi:lisp-mode-hook
fi:subprocess-mode-hook
fi:lisp-listener-mode-hook
in the above order.
When calling from a program, argument is MODE-HOOK,
which is funcall'd just after killing all local variables but before doing
any other mode setup."
(interactive)
(fi::kill-all-local-variables)
(if mode-hook (funcall mode-hook))
(setq major-mode 'fi:lisp-listener-mode)
(setq mode-name "TCP Common Lisp")
(set-syntax-table fi:lisp-mode-syntax-table)
(fi::lisp-subprocess-mode-variables)
(fi::initialize-mode-map 'fi:lisp-listener-mode-map
'fi:lisp-listener-mode-super-key-map
'tcp-lisp)
(use-local-map fi:lisp-listener-mode-map)
(setq fi:lisp-indent-hook-property 'fi:common-lisp-indent-hook)
(run-hooks 'fi:lisp-mode-hook 'fi:subprocess-mode-hook
'fi:lisp-listener-mode-hook))
(defun fi:common-lisp-mode (&optional mode-hook)
"Major mode for editing Lisp code to run in Common Lisp.
The keymap for this mode is bound to fi:common-lisp-mode-map:
\\{fi:common-lisp-mode-map}
Entry to this mode runs the following hooks:
fi:lisp-mode-hook
fi:common-lisp-mode-hook
in the above order.
When calling from a program, argument is MODE-HOOK,
which is funcall'd just after killing all local variables but before doing
any other mode setup."
(interactive)
(kill-all-local-variables)
(if mode-hook (funcall mode-hook))
(setq major-mode 'fi:common-lisp-mode)
(setq mode-name "Common Lisp")
(set-syntax-table fi:lisp-mode-syntax-table)
(fi::lisp-edit-mode-setup)
(fi:parse-mode-line-and-package)
(fi::initialize-mode-map 'fi:common-lisp-mode-map)
(use-local-map fi:common-lisp-mode-map)
(setq fi::process-name fi::common-lisp-backdoor-main-process-name)
(setq fi:lisp-indent-hook-property 'fi:common-lisp-indent-hook)
(run-hooks 'fi:lisp-mode-hook 'fi:common-lisp-mode-hook))
(defun lisp-mode (&optional mode-hook)
"See fi:common-lisp-mode. This function is here so that set-auto-mode
will go into the FI Common Lisp mode when ``mode: lisp'' appears in
the file modeline."
(interactive)
(fi:common-lisp-mode mode-hook))
(defun common-lisp-mode (&optional mode-hook)
"See fi:common-lisp-mode. This function is here so that set-auto-mode
will go into the FI Common Lisp mode when ``mode: common-lisp'' appears in
the file modeline."
(interactive)
(fi:common-lisp-mode mode-hook))
(defun fi:franz-lisp-mode (&optional mode-hook)
"Major mode for editing Lisp code to run in Franz Lisp.
The keymap for this mode is bound to fi:franz-lisp-mode-map:
\\{fi:franz-lisp-mode-map}
Entry to this mode runs the following hooks:
fi:lisp-mode-hook
fi:franz-lisp-mode-hook
in the above order.
When calling from a program, argument is MODE-HOOK,
which is funcall'd just after killing all local variables but before doing
any other mode setup."
(interactive)
(kill-all-local-variables)
(if mode-hook (funcall mode-hook))
(setq major-mode 'fi:franz-lisp-mode)
(setq mode-name "Franz Lisp")
(set-syntax-table fi:lisp-mode-syntax-table)
(fi::lisp-edit-mode-setup)
(fi:parse-mode-line-and-package)
(fi::initialize-mode-map 'fi:franz-lisp-mode-map)
(use-local-map fi:franz-lisp-mode-map)
(setq fi::process-name fi:franz-lisp-process-name)
(setq fi:lisp-indent-hook-property 'fi:franz-lisp-indent-hook)
(run-hooks 'fi:lisp-mode-hook 'fi:franz-lisp-mode-hook))
(defun fi:emacs-lisp-mode (&optional mode-hook)
"Major mode for editing Lisp code to run in Emacs Lisp.
The keymap for this mode is bound to fi:emacs-lisp-mode-map:
\\{fi:emacs-lisp-mode-map}
Entry to this mode runs the fi:emacs-lisp-mode-hook hook.
When calling from a program, argument is MODE-HOOK,
which is funcall'd just after killing all local variables but before doing
any other mode setup."
(interactive)
(kill-all-local-variables)
(if mode-hook (funcall mode-hook))
(setq major-mode 'fi:emacs-lisp-mode)
(setq mode-name "Emacs Lisp")
(set-syntax-table fi:emacs-lisp-mode-syntax-table)
(fi::lisp-edit-mode-setup)
(fi::initialize-mode-map 'fi:emacs-lisp-mode-map)
(use-local-map fi:emacs-lisp-mode-map)
(setq fi:lisp-indent-hook-property 'fi:emacs-lisp-indent-hook)
(run-hooks 'fi:emacs-lisp-mode-hook))
(defun fi::lisp-edit-mode-setup ()
(fi::lisp-mode-setup-common))
(defun fi::lisp-subprocess-mode-variables ()
(make-local-variable 'fi:subprocess-mode)
(setq fi:subprocess-mode t)
(fi::lisp-mode-setup-common))
(defun fi::lisp-mode-setup-common ()
;; not needed for Emacs Lisp mode, but ...
(setq fi:in-package-regexp fi:default-in-package-regexp)
(setq local-abbrev-table lisp-mode-abbrev-table)
(make-local-variable 'paragraph-start)
(setq paragraph-start (concat "^$\\|" page-delimiter))
(make-local-variable 'paragraph-separate)
(setq paragraph-separate paragraph-start)
(make-local-variable 'comment-start)
(setq comment-start ";")
(make-local-variable 'comment-start-skip)
(setq comment-start-skip ";+[ \t]*")
(make-local-variable 'comment-column)
(setq comment-column 40)
(if fi:lisp-do-indentation
(progn
(make-local-variable 'fill-paragraph-function)
(setq fill-paragraph-function 'fi:fill-paragraph)
(when fi:auto-fill
(setq fill-column 75)
(auto-fill-mode 1)
(make-local-variable 'auto-fill-function)
(setq auto-fill-function 'fi::do-auto-fill))
(make-local-variable 'indent-line-function)
(setq indent-line-function 'fi:lisp-indent-line)
(make-local-variable 'comment-indent-function)
(setq comment-indent-function 'fi:lisp-comment-indent)
(make-local-variable 'parse-sexp-ignore-comments)
;; It used to be true that this variable must be `nil' when
;; comments end in newlines. However, it seems this limitation was
;; removed some time around the start of 1994, so now we'll try
;; setting it true. - smh 29jun95
(setq parse-sexp-ignore-comments t)
(setq fi::lisp-most-recent-parse-result (list 0 0 0 0 nil nil nil 0))
(setq fi::calculate-lisp-indent-state-temp (list 0 0 0 nil nil nil 0))
(setq fi::lisp-indent-state-temp (list nil nil nil nil nil nil nil)))
;; the GNU style
(lisp-mode-variables t))
(when fi::menubar-initialization (funcall fi::menubar-initialization)))
(defvar fi:default-package
"user"
"*The name of the package to use as the default package, if there is no
package specification in the mode line. See fi:parse-mode-line-and-package
for more information.")
(defvar fi::do-parse-mode-line-and-package t)
(defun fi:parse-mode-line-and-package ()
"Determine the current package in which the buffer is defined.
The buffer's IN-PACKAGE form and the -*- mode line are parsed for this
information. This function is automatically called when a Common Lisp
source file is visited, but may be executed explicitly to re-parse the
package.
When using Allegro CL 4.2 or later, the ``Readtable: '' can be used to name
the readtable used for evaluations given to Lisp from emacs."
(interactive)
(when fi::do-parse-mode-line-and-package
(setq fi:readtable (fi::parse-mode-line "readtable"))
(setq fi:package
(fi::parse-mode-line "package" fi:default-package t
'fi::parse-package-from-buffer t))))
(defun fi::parse-mode-line (key
&optional default-value messagep fail-hook
list-value-ok)
(save-excursion
(let ((case-fold-search t)
(search-string (format "%s:" key))
value found start end)
(goto-char (point-min))
(when (and (search-forward "-*-"
(save-excursion (end-of-line) (point))
t)
(progn
(skip-chars-forward " \t")
(setq start (point))
(search-forward "-*-"
(save-excursion (end-of-line) (point))
t)))
(forward-char -3)
(skip-chars-backward " \t")
(setq end (point))
(goto-char start)
(when (search-forward ":" end t)
(goto-char start)
(when (search-forward search-string end t)
(skip-chars-forward " \t")
(setq start (point))
(if (> start end) (setq end start))
(if (search-forward ";" end t)
(forward-char -1)
(goto-char end))
(skip-chars-backward " \t")
(cond
((>= start (point))
(setq value default-value))
(t
(let ((val
(if (and list-value-ok
(= (string-to-char "(")
(char-after start)))
(buffer-substring (+ 1 start)
(point))
(buffer-substring start (point)))))
(setq found t)
(setq value
(downcase
(symbol-name (car (read-from-string val)))))))))))
(when (and (not found) fail-hook)
(goto-char (point-min))
(let ((val (funcall fail-hook)))
(when val
(setq found t value val))))
(unless found (setq value default-value))
(when messagep
(if found
(message "%s specification is `%s'" key value)
(message "using default %s specification of `%s'"
key value)))
value)))
(defvar fi::*in-package-regexp*
"^(\\(cl:\\|common-lisp:\\)?in-package[\t ]*#?")
(defun fi::parse-package-from-buffer (&optional current-point
backward
post-init)
(when (not current-point) (goto-char (point-min)))
(let* ((search (if backward 're-search-backward 're-search-forward))
(pos (funcall search fi::*in-package-regexp* nil t))
value)
;; find the `in-package' form, and snarf the package
;; that way
(when pos
(let* ((start (match-end 0))
(end (progn (search-forward ")" nil t)
(match-beginning 0)))
(p-string (buffer-substring start end))
(p (car (read-from-string p-string))))
(setq value
(cond ((symbolp p)
(if (= (elt (symbol-name p) 0) ?:)
(substring (symbol-name p) 1)
(symbol-name p)))
((and (consp p)
(eq 'quote (car p))
(symbolp (car (cdr p))))
(let ((name (symbol-name (car (cdr p)))))
(if (= (elt name 0) ?:)
(substring name 1)
name)))
((stringp p) p)))))
(when (and (null post-init)
(funcall search fi::*in-package-regexp* nil t))
(setq fi::multiple-in-packages t))
value))
(defun fi::find-tag-common-lisp ()
;; This raises the intelligence of the default tag in find-tag by
;; removing explicit package qualifiers, rarely found in the target
;; source file. See find-tag-tag in lisp/progmodes/etags.el for
;; the defaulting mechanism. From smh, 8/14/2000.
(let ((default (find-tag-default)))
(when default
(let ((n (position ?: default :from-end t)))
(if n
(subseq default (1+ n))
default)))))
(dolist (m '(fi:common-lisp-mode
fi:inferior-common-lisp-mode
fi:lisp-listener-mode
fi:definition-mode))
(put m 'find-tag-default-function 'fi::find-tag-common-lisp))
;;;;
;;; Initializations
;;;;
;; the following is because the data associated with auto-mode-alist
;; is put in text space when xemacs is built, and is by default read-only.
(setq auto-mode-alist (copy-alist auto-mode-alist))
(defun fi::def-auto-mode (string mode)
(let ((xx (assoc string auto-mode-alist)))
(if xx
(rplacd xx mode)
(setq auto-mode-alist
(cons (cons string mode) auto-mode-alist)))))
(fi::def-auto-mode "\\.l$" 'fi:franz-lisp-mode)
;;
(let ((list fi:common-lisp-file-types))
(while list
(fi::def-auto-mode (concat "\\" (car list) "$")
'fi:common-lisp-mode)
(setq list (cdr list))))
(defvar fi:define-emacs-lisp-mode nil
"*If non-nil, then use the FI supplied mode for editing .el files.")
(when fi:define-emacs-lisp-mode
(fi::def-auto-mode "\\.el$" 'fi:emacs-lisp-mode)
(fi::def-auto-mode "[]>:/]\\..*emacs" 'fi:emacs-lisp-mode))
;;;; the syntax tables for Lisp and Emacs Lisp
(if (not fi:emacs-lisp-mode-syntax-table)
(let ((i 0))
(setq fi:emacs-lisp-mode-syntax-table (make-syntax-table))
(while (< i ?0)
(modify-syntax-entry i "_ " fi:emacs-lisp-mode-syntax-table)
(setq i (1+ i)))
(setq i (1+ ?9))
(while (< i ?A)
(modify-syntax-entry i "_ " fi:emacs-lisp-mode-syntax-table)
(setq i (1+ i)))
(setq i (1+ ?Z))
(while (< i ?a)
(modify-syntax-entry i "_ " fi:emacs-lisp-mode-syntax-table)
(setq i (1+ i)))
(setq i (1+ ?z))
(while (< i 128)
(modify-syntax-entry i "_ " fi:emacs-lisp-mode-syntax-table)
(setq i (1+ i)))
(modify-syntax-entry ? " " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\t " " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\n "> " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\f "> " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\; "< " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?` "' " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?' "' " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?, "' " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?. "' " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?# "' " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\" "\" " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\\ "\\ " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\( "() " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\) ")( " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\[ "(] " fi:emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\] ")[ " fi:emacs-lisp-mode-syntax-table)))
(if (not fi:lisp-mode-syntax-table)
(progn
(setq fi:lisp-mode-syntax-table
(copy-syntax-table fi:emacs-lisp-mode-syntax-table))
;;(modify-syntax-entry ?_ "w " fi:lisp-mode-syntax-table)
;;(modify-syntax-entry ?- "w " fi:lisp-mode-syntax-table)
(modify-syntax-entry ?* "w " fi:lisp-mode-syntax-table)
;; The next syntax entry doesn't work with these forms:
;; `,.foo
;; #.foo
;; but it works better with variables with .'s in them
(modify-syntax-entry ?. "w " fi:lisp-mode-syntax-table)
(modify-syntax-entry ?\| "\" " fi:lisp-mode-syntax-table)
(modify-syntax-entry ?\[ "_ " fi:lisp-mode-syntax-table)
(modify-syntax-entry ?\] "_ " fi:lisp-mode-syntax-table)))
(condition-case ()
(progn
(require 'add-log)
(pushnew 'fi:common-lisp-mode add-log-lisp-like-modes)
(pushnew 'fi:franz-lisp-mode add-log-lisp-like-modes)
(pushnew 'fi:emacs-lisp-mode add-log-lisp-like-modes))
(error () nil))