Commit 1367ff3a authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

Add DSSSL mode and share code with newly required

lisp-mode as much as possible.
(scheme-mode-variables): Copy filling stuff from lisp-mode.
Add an outline-regexp.
(scheme-mode-map): Inherit shared-lisp-mode-map and provide a menu.
(dsssl-sgml-declaration): New variable.
(dsssl-mode): New command.
(dsssl-font-lock-keywords): New variable.
(scheme-indent-function): Near copy of lisp-indent-function.
(scheme-comment-indent, scheme-indent-offset,
scheme-indent-function, scheme-indent-line,
calculate-scheme-indent, scheme-indent-specform,
scheme-indent-defform, scheme-indent-sexp): Removed; use lisp-mode
equivalents.
(scheme-imenu-generic-expression): New variable.
(dsssl-imenu-generic-expression): New variable.
(scheme-let-indent): Use lisp-indent-specform.
parent 76773443
;;; scheme.el --- Scheme mode, and its idiosyncratic commands.
;;; scheme.el --- Scheme (and DSSSL) editing mode.
;; Copyright (C) 1986, 1987, 1988 Free Software Foundation, Inc.
;; Copyright (C) 1986, 87, 88, 1997 Free Software Foundation, Inc.
;; Author: Bill Rozas <jinz@prep.ai.mit.edu>
;; Keywords: languages, lisp
......@@ -22,15 +22,29 @@
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;; Originally adapted from Lisp mode by Bill Rozas, jinx@prep with a
;; comment that the code should be merged back. Merging done by
;; d.love@dl.ac.uk when DSSSL features added.
;;; Commentary:
;; Adapted from Lisp mode by Bill Rozas, jinx@prep.
;; Initially a query replace of Lisp mode, except for the indentation
;; of special forms. Probably the code should be merged at some point
;; so that there is sharing between both libraries.
;; The major mode for editing Scheme-type Lisp code, very similar to
;; the Lisp mode documented in the Emacs manual. `dsssl-mode' is a
;; variant of scheme-mode for editing DSSSL specifications for SGML
;; documents. [As of Apr 1997, some pointers for DSSSL may be found,
;; for instance, at <URL:http://www.sil.org/sgml/related.html#dsssl>.]
;; All these Lisp-ish modes vary basically in details of the language
;; syntax they highlight/indent/index, but dsssl-mode uses "^;;;" as
;; the page-delimiter since ^L isn't normally a legal SGML character.
;;
;; For interacting with a Scheme interpreter See also `run-scheme' in
;; the `cmuscheme' package and also the implementation-specific
;; `xscheme' package.
;;; Code:
(require 'lisp-mode)
(defvar scheme-mode-syntax-table nil "")
(if (not scheme-mode-syntax-table)
(let ((i 0))
......@@ -65,8 +79,8 @@
;; These characters are delimiters but otherwise undefined.
;; Brackets and braces balance for editing convenience.
(modify-syntax-entry ?[ "(] ")
(modify-syntax-entry ?] ")[ ")
(modify-syntax-entry ?\[ "(] ")
(modify-syntax-entry ?\] ")[ ")
(modify-syntax-entry ?{ "(} ")
(modify-syntax-entry ?} "){ ")
(modify-syntax-entry ?\| " 23")
......@@ -88,6 +102,15 @@
(defvar scheme-mode-abbrev-table nil "")
(define-abbrev-table 'scheme-mode-abbrev-table ())
(defvar scheme-imenu-generic-expression
'((nil
"^(define\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)*\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)" 4)
(" Types"
"^(define-class\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)" 1)
(" Macros"
"^(\\(defmacro\\|define-macro\\|define-syntax\\)\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)" 2))
"Imenu generic expression for Scheme mode. See `imenu-generic-expression'.")
(defun scheme-mode-variables ()
(set-syntax-table scheme-mode-syntax-table)
(setq local-abbrev-table scheme-mode-abbrev-table)
......@@ -97,10 +120,19 @@
(setq paragraph-separate paragraph-start)
(make-local-variable 'paragraph-ignore-fill-prefix)
(setq paragraph-ignore-fill-prefix t)
(make-local-variable 'fill-paragraph-function)
(setq fill-paragraph-function 'lisp-fill-paragraph)
;; Adaptive fill mode gets in the way of auto-fill,
;; and should make no difference for explicit fill
;; because lisp-fill-paragraph should do the job.
(make-local-variable 'adaptive-fill-mode)
(setq adaptive-fill-mode nil)
(make-local-variable 'indent-line-function)
(setq indent-line-function 'scheme-indent-line)
(setq indent-line-function 'lisp-indent-line)
(make-local-variable 'parse-sexp-ignore-comments)
(setq parse-sexp-ignore-comments t)
(make-local-variable 'outline-regexp)
(setq outline-regexp ";;; \\|(....")
(make-local-variable 'comment-start)
(setq comment-start ";")
(make-local-variable 'comment-start-skip)
......@@ -110,23 +142,42 @@
(make-local-variable 'comment-column)
(setq comment-column 40)
(make-local-variable 'comment-indent-function)
(setq comment-indent-function 'scheme-comment-indent)
(setq comment-indent-function 'lisp-comment-indent)
(make-local-variable 'parse-sexp-ignore-comments)
(setq parse-sexp-ignore-comments t)
(setq mode-line-process '("" scheme-mode-line-process)))
(make-local-variable 'lisp-indent-function)
(set lisp-indent-function 'scheme-indent-function)
(setq mode-line-process '("" scheme-mode-line-process))
(make-local-variable 'imenu-generic-expression)
(setq imenu-generic-expression scheme-imenu-generic-expression))
(defvar scheme-mode-line-process "")
(defvar scheme-mode-map nil
"Keymap for Scheme mode.
All commands in `shared-lisp-mode-map' are inherited by this map.")
(if scheme-mode-map
()
(let ((map (make-sparse-keymap "Scheme")))
(setq scheme-mode-map
(nconc (make-sparse-keymap) shared-lisp-mode-map))
(define-key scheme-mode-map "\e\t" 'lisp-complete-symbol)
(define-key scheme-mode-map [menu-bar] (make-sparse-keymap))
(define-key scheme-mode-map [menu-bar scheme]
(cons "Scheme" map))
(define-key map [run-scheme] '("Run Inferior Scheme" . run-scheme))
(define-key map [comment-region] '("Comment Out Region" . comment-region))
(define-key map [indent-region] '("Indent Region" . indent-region))
(define-key map [indent-line] '("Indent Line" . lisp-indent-line))
(put 'comment-region 'menu-enable 'mark-active)
(put 'indent-region 'menu-enable 'mark-active)))
;; Used by cmuscheme
(defun scheme-mode-commands (map)
(define-key map "\t" 'scheme-indent-line)
(define-key map "\177" 'backward-delete-char-untabify)
(define-key map "\e\C-q" 'scheme-indent-sexp))
(defvar scheme-mode-map nil)
(if (not scheme-mode-map)
(progn
(setq scheme-mode-map (make-sparse-keymap))
(scheme-mode-commands scheme-mode-map)))
;;;###autoload
(defun scheme-mode ()
......@@ -160,212 +211,128 @@ if that value is non-nil."
(defvar scheme-mit-dialect t
"If non-nil, scheme mode is specialized for MIT Scheme.
Set this to nil if you normally use another dialect.")
(defvar dsssl-sgml-declaration
"<!DOCTYPE style-sheet PUBLIC \"-//James Clark//DTD DSSSL Style Sheet//EN\">
"
"*An SGML declaration (typically using James Clark's style-sheet
doctype, as required for Jade) which will be inserted into an empty
buffer in dsssl-mode.")
(defvar dsssl-imenu-generic-expression
;; Perhaps this should also look for the style-sheet DTD tags. I'm
;; not sure it's the best way to organize it; perhaps one type
;; should be at the first level, though you don't see this anyhow if
;; it gets split up.
'((" Defines"
"^(define\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)" 1)
(" Modes"
"^\\s-*(mode\\s-+\\(\\(\\sw\\|\\s-\\|\\s_\\)+\\)" 1)
(" Elements"
;; (element foo ...) or (element (foo bar ...) ...)
"^\\s-*(element\\s-+(?\\(\\(\\sw\\|\\s-\\|\\s_\\)+\\))?" 1)
(" Declarations"
"^(declare\\(-\\sw+\\)+\\>\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" 2))
"Imenu generic expression for DSSSL mode. See `imenu-generic-expression'.")
;;;###autoload
(defun dsssl-mode ()
"Major mode for editing DSSSL code.
Editing commands are similar to those of lisp-mode.
Commands:
Delete converts tabs to spaces as it moves back.
Blank lines separate paragraphs. Semicolons start comments.
\\{scheme-mode-map}
Entry to this mode calls the value of dsssl-mode-hook
if that value is non-nil."
(interactive)
(kill-all-local-variables)
(use-local-map scheme-mode-map)
(scheme-mode-initialize)
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(dsssl-font-lock-keywords
nil t (("+-*/.<>=!?$%_&~^:" . "w"))
beginning-of-defun
(font-lock-comment-start-regexp . ";")
(font-lock-mark-block-function . mark-defun)))
(make-local-variable 'page-delimiter)
(setq page-delimiter "^;;;" ; ^L not valid SGML char
major-mode 'dsssl-mode
mode-name "DSSSL")
;; Insert a suitable SGML declaration into an empty buffer.
(and (zerop (buffer-size))
dsssl-sgml-declaration
(not buffer-read-only)
(insert dsssl-sgml-declaration))
(run-hooks 'scheme-mode-hook)
(run-hooks 'dsssl-mode-hook)
(scheme-mode-variables)
(setq imenu-generic-expression dsssl-imenu-generic-expression))
;; Extra syntax for DSSSL. This isn't separated from Scheme, but
;; shouldn't cause much trouble in scheme-mode.
(put 'element 'scheme-indent-function 1)
(put 'mode 'scheme-indent-function 1)
(put 'with-mode 'scheme-indent-function 1)
(defvar dsssl-font-lock-keywords
'(("(\\(define\\(-\\w+\\)?\\)\\>[ ]*\\\((?\\)\\(\\sw+\\)\\>"
(1 font-lock-keyword-face)
(4 font-lock-function-name-face))
("(\\(case\\|cond\\|else\\|if\\|lambda\\|let\\*?\\|letrec\\|and\\|or\\|map\\|with-mode\\)\\>" . 1)
("(\\(element\\|mode\\|declare-\\w+\\)\\>[ ]*\\(\\sw+\\)"
(1 font-lock-keyword-face)
(2 font-lock-type-face))
("(\\(element\\)\\>[ ]*(\\(\\S)+\\))"
(1 font-lock-keyword-face)
(2 font-lock-type-face))
("\\<\\sw+:\\>" . font-lock-reference-face)
("<\\([!?][-a-z0-9]+\\)" 1 font-lock-keyword-face)
("<\\(/?[-a-z0-9]+\\)" 1 font-lock-function-name-face))
"Default expressions to highlight in DSSSL mode.")
(defun scheme-comment-indent (&optional pos)
(save-excursion
(if pos (goto-char pos))
(cond ((looking-at ";;;") (current-column))
((looking-at ";;")
(let ((tem (calculate-scheme-indent)))
(if (listp tem) (car tem) tem)))
(t
(skip-chars-backward " \t")
(max (if (bolp) 0 (1+ (current-column)))
comment-column)))))
(defvar scheme-indent-offset nil "")
(defvar scheme-indent-function 'scheme-indent-function "")
(defun scheme-indent-line (&optional whole-exp)
"Indent current line as Scheme code.
With argument, indent any additional lines of the same expression
rigidly along with this one."
(interactive "P")
(let ((indent (calculate-scheme-indent)) shift-amt beg end
(pos (- (point-max) (point))))
(beginning-of-line)
(setq beg (point))
(skip-chars-forward " \t")
(if (looking-at "[ \t]*;;;")
;; Don't alter indentation of a ;;; comment line.
nil
(if (listp indent) (setq indent (car indent)))
(setq shift-amt (- indent (current-column)))
(if (zerop shift-amt)
nil
(delete-region beg (point))
(indent-to indent))
;; If initial point was within line's indentation,
;; position after the indentation. Else stay at same point in text.
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))
;; If desired, shift remaining lines of expression the same amount.
(and whole-exp (not (zerop shift-amt))
(save-excursion
(goto-char beg)
(forward-sexp 1)
(setq end (point))
(goto-char beg)
(forward-line 1)
(setq beg (point))
(> end beg))
(indent-code-rigidly beg end shift-amt)))))
(defun calculate-scheme-indent (&optional parse-start)
"Return appropriate indentation for current line as scheme code.
In usual case returns an integer: the column to indent to.
Can instead return a list, whose car is the column to indent to.
This means that following lines at the same level of indentation
should not necessarily be indented the same way.
The second element of the list is the buffer position
of the start of the containing expression."
(save-excursion
(beginning-of-line)
(let ((indent-point (point)) state paren-depth desired-indent (retry t)
last-sexp containing-sexp first-sexp-list-p)
(if parse-start
(goto-char parse-start)
(beginning-of-defun))
;; Find outermost containing sexp
(while (< (point) indent-point)
(setq state (parse-partial-sexp (point) indent-point 0)))
;; Find innermost containing sexp
(while (and retry (setq paren-depth (car state)) (> paren-depth 0))
(setq retry nil)
(setq last-sexp (nth 2 state))
(setq containing-sexp (car (cdr state)))
;; Position following last unclosed open.
(goto-char (1+ containing-sexp))
;; Is there a complete sexp since then?
(if (and last-sexp (> last-sexp (point)))
;; Yes, but is there a containing sexp after that?
(let ((peek (parse-partial-sexp last-sexp indent-point 0)))
(if (setq retry (car (cdr peek))) (setq state peek))))
(if (not retry)
;; Innermost containing sexp found
(progn
(goto-char (1+ containing-sexp))
(if (not last-sexp)
;; indent-point immediately follows open paren.
;; Don't call hook.
(setq desired-indent (current-column))
;; Move to first sexp after containing open paren
(parse-partial-sexp (point) last-sexp 0 t)
(setq first-sexp-list-p (looking-at "\\s("))
(cond
((> (save-excursion (forward-line 1) (point))
last-sexp)
;; Last sexp is on same line as containing sexp.
;; It's almost certainly a function call.
(parse-partial-sexp (point) last-sexp 0 t)
(if (/= (point) last-sexp)
;; Indent beneath first argument or, if only one sexp
;; on line, indent beneath that.
(progn (forward-sexp 1)
(parse-partial-sexp (point) last-sexp 0 t)))
(backward-prefix-chars))
(t
;; Indent beneath first sexp on same line as last-sexp.
;; Again, it's almost certainly a function call.
(goto-char last-sexp)
(beginning-of-line)
(parse-partial-sexp (point) last-sexp 0 t)
(backward-prefix-chars)))))))
;; If looking at a list, don't call hook.
(if first-sexp-list-p
(setq desired-indent (current-column)))
;; Point is at the point to indent under unless we are inside a string.
;; Call indentation hook except when overridden by scheme-indent-offset
;; or if the desired indentation has already been computed.
(cond ((car (nthcdr 3 state))
;; Inside a string, don't change indentation.
(goto-char indent-point)
(skip-chars-forward " \t")
(setq desired-indent (current-column)))
((and (integerp scheme-indent-offset) containing-sexp)
;; Indent by constant offset
(goto-char containing-sexp)
(setq desired-indent (+ scheme-indent-offset (current-column))))
((not (or desired-indent
(and (boundp 'scheme-indent-function)
scheme-indent-function
(not retry)
(setq desired-indent
(funcall scheme-indent-function
indent-point state)))))
;; Use default indentation if not computed yet
(setq desired-indent (current-column))))
desired-indent)))
(defvar calculate-lisp-indent-last-sexp)
;; Copied from lisp-indent-function, but with gets of
;; scheme-indent-{function,hook}.
(defun scheme-indent-function (indent-point state)
(let ((normal-indent (current-column)))
(save-excursion
(goto-char (1+ (car (cdr state))))
(re-search-forward "\\sw\\|\\s_")
(if (/= (point) (car (cdr state)))
(let ((function (buffer-substring (progn (forward-char -1) (point))
(progn (forward-sexp 1) (point))))
method)
;; Who cares about this, really?
;(if (not (string-match "\\\\\\||" function)))
(setq function (downcase function))
(setq method (get (intern-soft function) 'scheme-indent-function))
(cond ((integerp method)
(scheme-indent-specform method state indent-point))
(method
(funcall method state indent-point))
((and (> (length function) 3)
(string-equal (substring function 0 3) "def"))
(scheme-indent-defform state indent-point))))))))
(defvar scheme-body-indent 2 "")
(defun scheme-indent-specform (count state indent-point)
(let ((containing-form-start (car (cdr state))) (i count)
body-indent containing-form-column)
;; Move to the start of containing form, calculate indentation
;; to use for non-distinguished forms (> count), and move past the
;; function symbol. scheme-indent-function guarantees that there is at
;; least one word or symbol character following open paren of containing
;; form.
(goto-char containing-form-start)
(setq containing-form-column (current-column))
(setq body-indent (+ scheme-body-indent containing-form-column))
(forward-char 1)
(forward-sexp 1)
;; Now find the start of the last form.
(parse-partial-sexp (point) indent-point 1 t)
(while (and (< (point) indent-point)
(condition-case nil
(progn
(setq count (1- count))
(forward-sexp 1)
(parse-partial-sexp (point) indent-point 1 t))
(error nil))))
;; Point is sitting on first character of last (or count) sexp.
(cond ((> count 0)
;; A distinguished form. Use double scheme-body-indent.
(list (+ containing-form-column (* 2 scheme-body-indent))
containing-form-start))
;; A non-distinguished form. Use body-indent if there are no
;; distinguished forms and this is the first undistinguished
;; form, or if this is the first undistinguished form and
;; the preceding distinguished form has indentation at least
;; as great as body-indent.
((and (= count 0)
(or (= i 0)
(<= body-indent normal-indent)))
body-indent)
(t
normal-indent))))
(defun scheme-indent-defform (state indent-point)
(goto-char (car (cdr state)))
(forward-line 1)
(if (> (point) (car (cdr (cdr state))))
(progn
(goto-char (car (cdr state)))
(+ scheme-body-indent (current-column)))))
(goto-char (1+ (elt state 1)))
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
(if (and (elt state 2)
(not (looking-at "\\sw\\|\\s_")))
;; car of form doesn't seem to be a a symbol
(progn
(if (not (> (save-excursion (forward-line 1) (point))
calculate-lisp-indent-last-sexp))
(progn (goto-char calculate-lisp-indent-last-sexp)
(beginning-of-line)
(parse-partial-sexp (point)
calculate-lisp-indent-last-sexp 0 t)))
;; Indent under the list or under the first sexp on the same
;; line as calculate-lisp-indent-last-sexp. Note that first
;; thing on that line has to be complete sexp since we are
;; inside the innermost containing sexp.
(backward-prefix-chars)
(current-column))
(let ((function (buffer-substring (point)
(progn (forward-sexp 1) (point))))
method)
(setq method (or (get (intern-soft function) 'scheme-indent-function)
(get (intern-soft function) 'scheme-indent-hook)))
(cond ((or (eq method 'defun)
(and (null method)
(> (length function) 3)
(string-match "\\`def" function)))
(lisp-indent-defform state indent-point))
((integerp method)
(lisp-indent-specform method state
indent-point normal-indent))
(method
(funcall method state indent-point)))))))
;;; Let is different in Scheme
......@@ -389,8 +356,8 @@ of the start of the containing expression."
(defun scheme-let-indent (state indent-point)
(skip-chars-forward " \t")
(if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
(scheme-indent-specform 2 state indent-point)
(scheme-indent-specform 1 state indent-point)))
(lisp-indent-specform 2 state indent-point (current-column))
(lisp-indent-specform 1 state indent-point (current-column))))
;; (put 'begin 'scheme-indent-function 0), say, causes begin to be indented
;; like defun if the first form is placed on the next line, otherwise
......@@ -456,59 +423,6 @@ of the start of the containing expression."
(put 'unassigned\?-components 'scheme-indent-function 1)
(put 'unbound\?-components 'scheme-indent-function 1)
(put 'variable-components 'scheme-indent-function 1)))
(defun scheme-indent-sexp ()
"Indent each line of the list starting just after point."
(interactive)
(let ((indent-stack (list nil)) (next-depth 0) bol
outer-loop-done inner-loop-done state this-indent)
(save-excursion (forward-sexp 1))
(save-excursion
(setq outer-loop-done nil)
(while (not outer-loop-done)
(setq last-depth next-depth
innerloop-done nil)
(while (and (not innerloop-done)
(not (setq outer-loop-done (eobp))))
(setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
nil nil state))
(setq next-depth (car state))
(if (car (nthcdr 4 state))
(progn (indent-for-comment)
(end-of-line)
(setcar (nthcdr 4 state) nil)))
(if (car (nthcdr 3 state))
(progn
(forward-line 1)
(setcar (nthcdr 5 state) nil))
(setq innerloop-done t)))
(if (setq outer-loop-done (<= next-depth 0))
nil
(while (> last-depth next-depth)
(setq indent-stack (cdr indent-stack)
last-depth (1- last-depth)))
(while (< last-depth next-depth)
(setq indent-stack (cons nil indent-stack)
last-depth (1+ last-depth)))
(forward-line 1)
(setq bol (point))
(skip-chars-forward " \t")
(if (or (eobp) (looking-at "[;\n]"))
nil
(if (and (car indent-stack)
(>= (car indent-stack) 0))
(setq this-indent (car indent-stack))
(let ((val (calculate-scheme-indent
(if (car indent-stack) (- (car indent-stack))))))
(if (integerp val)
(setcar indent-stack
(setq this-indent val))
(if (cdr val)
(setcar indent-stack (- (car (cdr val)))))
(setq this-indent (car val)))))
(if (/= (current-column) this-indent)
(progn (delete-region bol (point))
(indent-to this-indent)))))))))
(provide 'scheme)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment