mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
439 lines
8.8 KiB
EmacsLisp
439 lines
8.8 KiB
EmacsLisp
;; scheme-keywords.el
|
|
;; Scheme R7RS-small syntax highlighting and keyword completion for GNU Emacs
|
|
;; Copyright (c) 2015 Frère Jérôme. Contributed to the `Chibi-Scheme' project
|
|
;; under the same BSD-style license: http://synthcode.com/license.txt
|
|
|
|
;; The *optional* keyword completion is provided by the `company' framework
|
|
;; See: https://company-mode.github.io
|
|
|
|
;; Installation:
|
|
|
|
;; If necessary, add the location of this file to your Emacs `load-path':
|
|
;; (add-to-list 'load-path "FILE LOCATION")
|
|
|
|
;; Add the following lines to your `.emacs' configuration file:
|
|
;; (when (require 'scheme-keywords nil t)
|
|
;; (add-to-list 'auto-mode-alist '("\\.sld\\'" . scheme-mode))
|
|
;; ;; CUSTOMIZATION HERE
|
|
;; )
|
|
|
|
;; Customization:
|
|
|
|
;; (scheme-add-keywords 'LIST 'FACE) ;; define additional highlights
|
|
;; (setq scheme-keywords-completions 'LIST) ;; define additional completions
|
|
|
|
(require 'company nil t)
|
|
(require 'cl)
|
|
|
|
(defconst scheme-procedures-list
|
|
'("and"
|
|
"begin"
|
|
"call\/cc"
|
|
"call-with-current-continuation"
|
|
"call-with-input-file"
|
|
"call-with-output-file"
|
|
"call-with-port"
|
|
"call-with-values"
|
|
"case"
|
|
"case-lambda"
|
|
"cond"
|
|
"cond-expand"
|
|
"cons"
|
|
"define"
|
|
"define-library"
|
|
"define-record-type"
|
|
"define-syntax"
|
|
"define-values"
|
|
"delay"
|
|
"delay-force"
|
|
"do"
|
|
"dynamic-wind"
|
|
"else"
|
|
"eof-object"
|
|
"export"
|
|
"features"
|
|
"force"
|
|
"for-each"
|
|
"if"
|
|
"import"
|
|
"include"
|
|
"include-ci"
|
|
"lambda"
|
|
"let"
|
|
"let\*"
|
|
"letrec"
|
|
"letrec\*"
|
|
"letrec-syntax"
|
|
"let-syntax"
|
|
"let-values"
|
|
"let\*-values"
|
|
"library"
|
|
"list"
|
|
"load"
|
|
"not"
|
|
"or"
|
|
"quasiquote"
|
|
"quote"
|
|
"scheme-report-environment"
|
|
"syntax-error"
|
|
"syntax-rules"
|
|
"unless"
|
|
"unquote"
|
|
"unquote-splicing"
|
|
"values"
|
|
"when"))
|
|
|
|
(defconst scheme-operators-list
|
|
'("\<"
|
|
"\<\="
|
|
"\="
|
|
"\=\>"
|
|
"\>"
|
|
"\>\="
|
|
"\_"
|
|
"\-"
|
|
"\/"
|
|
"\.\.\."
|
|
"\*"
|
|
"\+"
|
|
"caaaar"
|
|
"caaadr"
|
|
"caaar"
|
|
"caadar"
|
|
"caaddr"
|
|
"caadr"
|
|
"caar"
|
|
"cadaar"
|
|
"cadadr"
|
|
"cadar"
|
|
"caddar"
|
|
"cadddr"
|
|
"caddr"
|
|
"cadr"
|
|
"car"
|
|
"cdaaar"
|
|
"cdaadr"
|
|
"cdaar"
|
|
"cdadar"
|
|
"cdaddr"
|
|
"cdadr"
|
|
"cdar"
|
|
"cddaar"
|
|
"cddadr"
|
|
"cddar"
|
|
"cdddar"
|
|
"cddddr"
|
|
"cdddr"
|
|
"cddr"
|
|
"cdr"
|
|
"\#f"
|
|
"\#false"
|
|
"\#t"
|
|
"\#true"))
|
|
|
|
(defconst scheme-predicates-list
|
|
'("binary-port\?"
|
|
"boolean\=\?"
|
|
"boolean\?"
|
|
"bytevector"
|
|
"bytevector\?"
|
|
"char\<\=\?"
|
|
"char\<\?"
|
|
"char\=\?"
|
|
"char\>\=\?"
|
|
"char\>\?"
|
|
"char\?"
|
|
"char-alphabetic\?"
|
|
"char-ci\<\=\?"
|
|
"char-ci\<\?"
|
|
"char-ci\=\?"
|
|
"char-ci\>\=\?"
|
|
"char-ci\>\?"
|
|
"char-numeric\?"
|
|
"char-ready\?"
|
|
"char-lower-case\?"
|
|
"char-upper-case\?"
|
|
"char-whitespace\?"
|
|
"complex\?"
|
|
"eof-object\?"
|
|
"eq\?"
|
|
"equal\?"
|
|
"eqv\?"
|
|
"error-object\?"
|
|
"even\?"
|
|
"exact\?"
|
|
"exact-integer\?"
|
|
"file-error\?"
|
|
"file-exists\?"
|
|
"finite\?"
|
|
"inexact\?"
|
|
"infinite\?"
|
|
"input-port\?"
|
|
"input-port-open\?"
|
|
"integer\?"
|
|
"list\?"
|
|
"nan\?"
|
|
"negative\?"
|
|
"null\?"
|
|
"number\?"
|
|
"odd\?"
|
|
"output-port\?"
|
|
"output-port-open\?"
|
|
"pair\?"
|
|
"port\?"
|
|
"positive\?"
|
|
"procedure\?"
|
|
"promise\?"
|
|
"rational\?"
|
|
"read-error\?"
|
|
"real\?"
|
|
"string\<\=\?"
|
|
"string\<\?"
|
|
"string\=\?"
|
|
"string\>\=\?"
|
|
"string\>\?"
|
|
"string\?"
|
|
"string-ci\<\=\?"
|
|
"string-ci\<\?"
|
|
"string-ci\=\?"
|
|
"string-ci\>\=\?"
|
|
"string-ci\>\?"
|
|
"symbol\=\?"
|
|
"symbol\?"
|
|
"textual-port\?"
|
|
"u8-ready\?"
|
|
"vector\?"
|
|
"zero\?"))
|
|
|
|
(defconst scheme-mutations-list
|
|
'("bytevector-copy\!"
|
|
"bytevector-u8-set\!"
|
|
"list-set\!"
|
|
"read-bytevector\!"
|
|
"set\!"
|
|
"set-car\!"
|
|
"set-cdr\!"
|
|
"string-copy\!"
|
|
"string-fill\!"
|
|
"string-set\!"
|
|
"vector-copy\!"
|
|
"vector-fill\!"
|
|
"vector-set\!"))
|
|
|
|
(defconst scheme-exceptions-list
|
|
'("emergency-exit"
|
|
"error"
|
|
"error-object-message"
|
|
"error-object-irritants"
|
|
"exit"
|
|
"guard"
|
|
"raise"
|
|
"raise-continuable"
|
|
"with-exception-handler"))
|
|
|
|
(defconst scheme-functions-list
|
|
'("abs"
|
|
"acos"
|
|
"angle"
|
|
"append"
|
|
"apply"
|
|
"asin"
|
|
"assoc"
|
|
"assq"
|
|
"assv"
|
|
"atan"
|
|
"bytevector"
|
|
"bytevector-append"
|
|
"bytevector-copy"
|
|
"bytevector-length"
|
|
"bytevector-u8-ref"
|
|
"ceiling"
|
|
"ceiling\/"
|
|
"ceiling-quotient"
|
|
"ceiling-remainder"
|
|
"centered\/"
|
|
"centered-quotient"
|
|
"centered-remainder"
|
|
"char-downcase"
|
|
"char-foldcase"
|
|
"char-\>integer"
|
|
"char-upcase"
|
|
"close-input-port"
|
|
"close-output-port"
|
|
"close-port"
|
|
"command-line"
|
|
"cos"
|
|
"current-error-port"
|
|
"current-input-port"
|
|
"current-jiffy"
|
|
"current-output-port"
|
|
"current-second"
|
|
"delete-file"
|
|
"denominator"
|
|
"digit-value"
|
|
"display"
|
|
"environment"
|
|
"euclidean\/"
|
|
"euclidean-quotient"
|
|
"euclidean-remainder"
|
|
"exact"
|
|
"exact-\>inexact"
|
|
"exact-integer-sqrt"
|
|
"exp"
|
|
"expt"
|
|
"floor"
|
|
"floor\/"
|
|
"floor-quotient"
|
|
"floor-remainder"
|
|
"flush-output-port"
|
|
"gcd"
|
|
"get-environment-variable"
|
|
"get-environment-variables"
|
|
"get-output-bytevector"
|
|
"get-output-string"
|
|
"imag-part"
|
|
"inexact"
|
|
"inexact-\>exact"
|
|
"integer-\>char"
|
|
"interaction-environment"
|
|
"jiffies-per-second"
|
|
"lcm"
|
|
"length"
|
|
"list-copy"
|
|
"list-ref"
|
|
"list-\>string"
|
|
"list-tail"
|
|
"list-\>vector"
|
|
"log"
|
|
"magnitude"
|
|
"make-bytevector"
|
|
"make-list"
|
|
"make-parameter"
|
|
"make-polar"
|
|
"make-promise"
|
|
"make-rectangular"
|
|
"make-string"
|
|
"make-vector"
|
|
"map"
|
|
"max"
|
|
"member"
|
|
"memq"
|
|
"memv"
|
|
"min"
|
|
"modulo"
|
|
"newline"
|
|
"null-environment"
|
|
"number-\>string"
|
|
"numerator"
|
|
"open-binary-input-file"
|
|
"open-binary-output-file"
|
|
"open-input-bytevector"
|
|
"open-input-file"
|
|
"open-input-string"
|
|
"open-output-bytevector"
|
|
"open-output-file"
|
|
"open-output-string"
|
|
"parameterize"
|
|
"peek-char"
|
|
"peek-u8"
|
|
"quotient"
|
|
"rationalize"
|
|
"read"
|
|
"read-bytevector"
|
|
"read-char"
|
|
"read-line"
|
|
"read-string"
|
|
"read-u8"
|
|
"real-part"
|
|
"remainder"
|
|
"reverse"
|
|
"round"
|
|
"round\/"
|
|
"round-quotient"
|
|
"round-remainder"
|
|
"sin"
|
|
"sqrt"
|
|
"square"
|
|
"string"
|
|
"string-append"
|
|
"string-copy"
|
|
"string-downcase"
|
|
"string-foldcase"
|
|
"string-for-each"
|
|
"string-length"
|
|
"string-\>list"
|
|
"string-map"
|
|
"string-\>number"
|
|
"string-ref"
|
|
"string-\>symbol"
|
|
"string-upcase"
|
|
"string-\>utf8"
|
|
"string-\>vector"
|
|
"substring"
|
|
"symbol-\>string"
|
|
"tan"
|
|
"truncate"
|
|
"truncate\/"
|
|
"truncate-quotient"
|
|
"truncate-remainder"
|
|
"utf8-\>string"
|
|
"vector"
|
|
"vector-append"
|
|
"vector-copy"
|
|
"vector-for-each"
|
|
"vector-length"
|
|
"vector-\>list"
|
|
"vector-map"
|
|
"vector-ref"
|
|
"vector-\>string"
|
|
"with-input-from-file"
|
|
"with-output-to-file"
|
|
"write"
|
|
"write-bytevector"
|
|
"write-char"
|
|
"write-shared"
|
|
"write-simple"
|
|
"write-string"
|
|
"write-u8"))
|
|
|
|
(defvar scheme-keywords-completions '())
|
|
|
|
(defun scheme-add-keywords (keywords face)
|
|
"Add keywords to Scheme mode."
|
|
(interactive (list 'interactive))
|
|
(let ((keyword-list (concat "\\<\\(" (regexp-opt keywords) "\\)\\>")))
|
|
(font-lock-add-keywords 'scheme-mode
|
|
`((,keyword-list 1 ',face)))))
|
|
|
|
(scheme-add-keywords scheme-procedures-list
|
|
'font-lock-keyword-face)
|
|
(scheme-add-keywords scheme-operators-list
|
|
'font-lock-builtin-face)
|
|
(scheme-add-keywords scheme-predicates-list
|
|
'font-lock-type-face)
|
|
(scheme-add-keywords scheme-mutations-list
|
|
'font-lock-type-face)
|
|
(scheme-add-keywords scheme-exceptions-list
|
|
'font-lock-warning-face)
|
|
(scheme-add-keywords scheme-functions-list
|
|
'font-lock-function-name-face)
|
|
|
|
(defun scheme-keywords-hook ()
|
|
(when (featurep 'company)
|
|
(defun company-scheme-keywords
|
|
(command &optional argument &rest ignored)
|
|
(interactive (list 'interactive))
|
|
(case command
|
|
(interactive (company-begin-backend 'company-scheme-keywords))
|
|
(prefix (and (eq major-mode 'scheme-mode) (company-grab-symbol)))
|
|
(candidates (remove-if-not
|
|
(lambda (candidate)
|
|
(string-prefix-p argument candidate))
|
|
(append scheme-procedures-list scheme-operators-list
|
|
scheme-predicates-list scheme-mutations-list
|
|
scheme-exceptions-list scheme-functions-list
|
|
scheme-keywords-completions)))))
|
|
(add-to-list 'company-backends 'company-scheme-keywords)))
|
|
(add-hook 'scheme-mode-hook 'scheme-keywords-hook)
|
|
|
|
(provide 'scheme-keywords)
|