157 lines
6.1 KiB
EmacsLisp
157 lines
6.1 KiB
EmacsLisp
|
;;; al-scheme.el --- Additional functionality for `scheme-mode'
|
|||
|
|
|||
|
;; Copyright © 2015–2017 Alex Kost
|
|||
|
|
|||
|
;; This program is free software; you can redistribute it and/or modify
|
|||
|
;; it under the terms of the GNU General Public License as published by
|
|||
|
;; the Free Software Foundation, either version 3 of the License, or
|
|||
|
;; (at your option) any later version.
|
|||
|
;;
|
|||
|
;; This program is distributed in the hope that it will be useful,
|
|||
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|||
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|||
|
;; GNU General Public License for more details.
|
|||
|
;;
|
|||
|
;; You should have received a copy of the GNU General Public License
|
|||
|
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
|
|
|||
|
;;; Code:
|
|||
|
|
|||
|
(defvar al/scheme-imenu-generic-expression
|
|||
|
`((nil
|
|||
|
,(rx bol "(define"
|
|||
|
(zero-or-one "*")
|
|||
|
(zero-or-one "-public")
|
|||
|
(one-or-more space)
|
|||
|
(zero-or-one "(")
|
|||
|
(group (one-or-more (or word (syntax symbol)))))
|
|||
|
1)
|
|||
|
("Methods"
|
|||
|
,(rx bol "(define-"
|
|||
|
(or "generic" "method" "accessor")
|
|||
|
(one-or-more space)
|
|||
|
(zero-or-one "(")
|
|||
|
(group (one-or-more (or word (syntax symbol)))))
|
|||
|
1)
|
|||
|
("Classes"
|
|||
|
,(rx bol "(define-class"
|
|||
|
(one-or-more space)
|
|||
|
(zero-or-one "(")
|
|||
|
(group (one-or-more (or word (syntax symbol)))))
|
|||
|
1)
|
|||
|
("Records"
|
|||
|
,(rx bol "(define-record-type"
|
|||
|
(zero-or-one "*")
|
|||
|
(one-or-more space)
|
|||
|
(group (one-or-more (or word (syntax symbol)))))
|
|||
|
1)
|
|||
|
("Conditions"
|
|||
|
,(rx bol "(define-condition-type"
|
|||
|
(one-or-more space)
|
|||
|
(group (one-or-more (or word (syntax symbol)))))
|
|||
|
1)
|
|||
|
("Modules"
|
|||
|
,(rx bol "(define-module"
|
|||
|
(one-or-more space)
|
|||
|
(group "(" (one-or-more any) ")"))
|
|||
|
1)
|
|||
|
("Macros"
|
|||
|
,(rx bol "("
|
|||
|
(or (and "defmacro"
|
|||
|
(zero-or-one "*")
|
|||
|
(zero-or-one "-public"))
|
|||
|
"define-macro" "define-syntax" "define-syntax-rule")
|
|||
|
(one-or-more space)
|
|||
|
(zero-or-one "(")
|
|||
|
(group (one-or-more (or word (syntax symbol)))))
|
|||
|
1))
|
|||
|
"Improved substitution for `scheme-imenu-generic-expression'.")
|
|||
|
|
|||
|
|
|||
|
(defvar calculate-lisp-indent-last-sexp)
|
|||
|
|
|||
|
;; The following code of `al/scheme-indent-function' originates from
|
|||
|
;; <http://www.netris.org/~mhw/scheme-indent-function.el>.
|
|||
|
|
|||
|
(defun al/scheme-indent-function (indent-point state)
|
|||
|
"Scheme mode function for the value of the variable `lisp-indent-function'.
|
|||
|
This function is the same as `scheme-indent-function' except it
|
|||
|
indents property lists properly and names starting with 'default'."
|
|||
|
(let ((normal-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 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)
|
|||
|
;; The original regexp is "\\`def" but it will
|
|||
|
;; mess indentation with such names as
|
|||
|
;; 'default-...'.
|
|||
|
(string-match "\\`define" function)))
|
|||
|
(lisp-indent-defform state indent-point))
|
|||
|
;; This next cond clause is the only change -mhw
|
|||
|
((and (null method)
|
|||
|
(> (length function) 1)
|
|||
|
;; The '#' in '#:' seems to get lost, not sure why
|
|||
|
(string-match "\\`:" function))
|
|||
|
(let ((lisp-body-indent 1))
|
|||
|
(lisp-indent-defform state indent-point)))
|
|||
|
((integerp method)
|
|||
|
(lisp-indent-specform method state
|
|||
|
indent-point normal-indent))
|
|||
|
(method
|
|||
|
(funcall method state indent-point normal-indent)))))))
|
|||
|
|
|||
|
|
|||
|
;;; Docstrings highlighting
|
|||
|
|
|||
|
;; Although `scheme-mode' has all the functionality to highlight
|
|||
|
;; docstrings properly (with `font-lock-doc-face', not with
|
|||
|
;; `font-lock-string-face'!), it doesn't do it. The only missing thing
|
|||
|
;; needed to fix it, is setting `font-lock-syntactic-face-function'.
|
|||
|
|
|||
|
;; XXX This is definitely an Emacs bug, and I should report about it! I
|
|||
|
;; think it was introduced by
|
|||
|
;; <http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=0a5cfeeecb9e1038f9df3b34b61b797e56213a7b>.
|
|||
|
|
|||
|
;; Another miss is that "scheme.el" contains "docstring rules" only for
|
|||
|
;; `define' and `lambda*', while there are other things to highlight:
|
|||
|
|
|||
|
(put 'define* 'scheme-doc-string-elt 2)
|
|||
|
(put 'lambda* 'scheme-doc-string-elt 2)
|
|||
|
(put 'case-lambda 'scheme-doc-string-elt 1)
|
|||
|
(put 'case-lambda* 'scheme-doc-string-elt 1)
|
|||
|
(put 'define-syntax-rule 'scheme-doc-string-elt 2)
|
|||
|
(put 'syntax-rules 'scheme-doc-string-elt 2)
|
|||
|
|
|||
|
(defun al/scheme-fix-docstring-font-lock ()
|
|||
|
"Fix highlighting of the Scheme docstrings.
|
|||
|
This function is intended to be added to `scheme-mode-hook'."
|
|||
|
(setq-local font-lock-syntactic-face-function
|
|||
|
'lisp-font-lock-syntactic-face-function))
|
|||
|
|
|||
|
(provide 'patch-scheme)
|
|||
|
|
|||
|
;; From: https://gitlab.com/alezost-config/emacs/blob/master/utils/al-scheme.el
|
|||
|
;;; al-scheme.el ends here
|