;;; racket-common.el ;; Copyright (c) 2013-2016 by Greg Hendershott. ;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc. ;; Author: Greg Hendershott ;; URL: https://github.com/greghendershott/racket-mode ;; License: ;; This 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 2, or (at your option) ;; any later version. This 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. See ;; http://www.gnu.org/licenses/ for details. ;; Things used by both racket-mode and racket-repl-mode (require 'cl-lib) (require 'thingatpt) (require 'racket-custom) (require 'racket-keywords-and-builtins) (require 'racket-font-lock) (require 'racket-indent) (require 'racket-ppss) (require 'racket-util) (declare-function racket-complete-at-point "racket-complete.el" (&optional predicate)) (defvar racket-mode-abbrev-table nil) (define-abbrev-table 'racket-mode-abbrev-table ()) ;;; syntax-table and syntax-propertize-function (defvar racket-mode-syntax-table (let ((st (make-syntax-table)) (i 0)) ;; Symbol constituents (while (< i ?0) (modify-syntax-entry i "_ " st) (setq i (1+ i))) (setq i (1+ ?9)) (while (< i ?A) (modify-syntax-entry i "_ " st) (setq i (1+ i))) (setq i (1+ ?Z)) (while (< i ?a) (modify-syntax-entry i "_ " st) (setq i (1+ i))) (setq i (1+ ?z)) (while (< i 128) (modify-syntax-entry i "_ " st) (setq i (1+ i))) ;; Whitespace (except ?\n, see below in comment section) (modify-syntax-entry ?\t " " st) (modify-syntax-entry ?\f " " st) (modify-syntax-entry ?\r " " st) (modify-syntax-entry ?\s " " st) ;; These characters are delimiters but otherwise undefined. ;; Brackets and braces balance for editing convenience. (modify-syntax-entry ?\( "() " st) (modify-syntax-entry ?\) ")( " st) (modify-syntax-entry ?\[ "(] " st) (modify-syntax-entry ?\] ")[ " st) (modify-syntax-entry ?{ "(} " st) (modify-syntax-entry ?} "){ " st) ;; Other atom delimiters (modify-syntax-entry ?\" "\" " st) (modify-syntax-entry ?' "' " st) (modify-syntax-entry ?` "' " st) (modify-syntax-entry ?, "' " st) (modify-syntax-entry ?@ "' " st) (modify-syntax-entry ?\\ "\\ " st) ;; Comment related (modify-syntax-entry ?\; "< " st) ;line comments but NOT sexp #; (modify-syntax-entry ?\n "> " st) (modify-syntax-entry ?# "w 14" st) ;not necessarily prefix (modify-syntax-entry ?| "_ 23bn" st) st)) (defun racket-syntax-propertize-function (start end) (goto-char start) (racket--syntax-propertize-here-string end) (funcall (syntax-propertize-rules ;; here strings: The main responsibility here is to set the "|" ;; char syntax around the "body" so it's treated as a string for ;; indent, nav, font-lock. Think of the \n in #<" (if (or (racket--ppss-quote-p ppss) (< 1 (count-lines start eol))) ;; If we matched several lines, make sure we refontify them ;; together. Furthermore, if the \n is quoted, it means the ;; right \n is actually further down. Don't bother fixing it ;; now, but place a multiline property so that when ;; jit-lock-context-* refontifies the rest of the buffer, it ;; also refontifies the current line with it. (put-text-property start (1+ eol) 'syntax-multiline t)) (put-text-property eol (1+ eol) 'racket-here-string string) (goto-char (+ 3 start)) (string-to-syntax "|")))) (defun racket--syntax-propertize-here-string (end) "If in a here string that ends before END, add | syntax for its close." (let ((ppss (syntax-ppss))) (when (eq (racket--ppss-string-p ppss) t) ;t as opposed to ?" or ?' (let ((key (get-text-property (racket--ppss-string/comment-start ppss) 'racket-here-string))) (when (and key (re-search-forward (concat "^" (regexp-quote key) "\\(\n\\)") end t)) (let ((eol (match-beginning 1))) (put-text-property eol (1+ eol) 'syntax-table (string-to-syntax "|")))))))) ;;; (defun racket--common-variables () "Set variables common to `racket-mode' and `racket-repl-mode'." ;;; Syntax (set-syntax-table racket-mode-syntax-table) (setq-local multibyte-syntax-as-symbol t) (setq-local parse-sexp-ignore-comments t) (setq-local syntax-propertize-function #'racket-syntax-propertize-function) (syntax-propertize (point-max)) ;for e.g. paredit: see issue #222 ;; ----------------------------------------------------------------- ;; Font-lock (setq-local font-lock-defaults (list racket-font-lock-keywords ;keywords nil ;keywords-only? nil ;case-fold? nil ;syntax-alist nil ;syntax-begin ;; Additional variables: (cons 'font-lock-mark-block-function #'mark-defun) (cons 'parse-sexp-lookup-properties t) (cons 'font-lock-multiline t) (cons 'font-lock-syntactic-face-function #'racket-font-lock-syntactic-face-function) (list 'font-lock-extend-region-functions #'font-lock-extend-region-wholelines #'font-lock-extend-region-multiline))) ;; ----------------------------------------------------------------- ;; Comments. Mostly borrowed from lisp-mode and/or scheme-mode (setq-local comment-start ";") (setq-local comment-add 1) ;default to `;;' in comment-region (setq-local comment-start-skip ";+ *") (setq-local comment-column 40) (setq-local comment-multi-line t) ;for auto-fill-mode and #||# comments ;; Font lock mode uses this only when it knows a comment is starting: (setq-local font-lock-comment-start-skip ";+ *") ;; ----------------------------------------------------------------- ;; Indent (setq-local indent-line-function #'racket-indent-line) (racket--set-indentation) (setq-local indent-tabs-mode nil) ;; ----------------------------------------------------------------- ;;; Misc (setq-local local-abbrev-table racket-mode-abbrev-table) (setq-local paragraph-start (concat "$\\|" page-delimiter)) (setq-local paragraph-separate paragraph-start) (setq-local paragraph-ignore-fill-prefix t) (setq-local fill-paragraph-function #'lisp-fill-paragraph) (setq-local adaptive-fill-mode nil) (setq-local outline-regexp ";;; \\|(....") (setq-local completion-at-point-functions (list #'racket-complete-at-point)) (setq-local eldoc-documentation-function nil) (setq-local beginning-of-defun-function #'racket--beginning-of-defun-function)) ;;; Insert lambda char (like DrRacket) (defconst racket-lambda-char (make-char 'greek-iso8859-7 107) "Character inserted by `racket-insert-labmda'.") (defun racket-insert-lambda () (interactive) (insert-char racket-lambda-char 1)) (put 'racket-insert-lambda 'delete-selection t) ;;; racket--self-insert (defun racket--self-insert (event) "Simulate a `self-insert-command' of EVENT. Using this intead of `insert' allows self-insert hooks to run, which is important for things like `'electric-pair-mode'. A command using this should probably set its 'delete-selection property to t so that `delete-selection-mode' works: (put 'racket-command 'delete-selection t) If necessary the value of the property can be a function, for example `racket--electric-pair-mode-not-active'." (let ((last-command-event event)) ;set this for hooks (self-insert-command (prefix-numeric-value nil)))) (defun racket--electric-pair-mode-not-active () "A suitable value for the 'delete-selection property of commands that insert parens: Inserted text should replace the selection unless a mode like `electric-pair-mode' is enabled, in which case the selection is to be wrapped in parens." (not (and (boundp 'electric-pair-mode) electric-pair-mode))) ;;; Automatically insert matching \?) \?] or \?} (defconst racket--matching-parens '(( ?\( . ?\) ) ( ?\[ . ?\] ) ( ?\{ . ?\} ))) (defun racket-insert-closing (&optional prefix) "Insert a matching closing delimiter. With a prefix, insert the typed character as-is. This is handy if you're not yet using `paredit-mode', `smartparens-mode', or simply `electric-pair-mode' added in Emacs 24.5." (interactive "P") (let* ((do-it (not (or prefix (and (string= "#\\" (buffer-substring-no-properties (- (point) 2) (point) ))) (racket--ppss-string-p (syntax-ppss))))) (open-char (and do-it (racket--open-paren #'backward-up-list))) (close-pair (and open-char (assq open-char racket--matching-parens))) (close-char (and close-pair (cdr close-pair)))) (racket--self-insert (or close-char last-command-event)))) (put 'racket-insert-closing 'delete-selection #'racket--electric-pair-mode-not-active) ;;; Smart open bracket (defconst racket--smart-open-bracket-data (eval-when-compile `(;; cond-like (0 0 ,(rx (seq "(" (or "augment" "augment-final" "augride" "cond" "field" "inherit" "inherit-field" "inherit/super" "inherit/inner" "init" "init-field" "match-lambda" "match-lambda*" "match-lambda**" "overment" "override" "override-final" "public" "pubment" "public-final" "rename-inner" "rename-super" "super-new") (or space line-end)))) ;; case-like (2 0 ,(rx (seq "(" (or "case" "new" "match" "match*" "syntax-parse" "syntax-rules") (or space line-end)))) ;; syntax-case (3 0 ,(rx (seq "(" (or "syntax-case") (or space line-end)))) ;; syntax-case* (4 0 ,(rx (seq "(" (or "syntax-case*") (or space line-end)))) ;; let-like ;; ;; In addition to the obvious suspects with 'let' in the name, ;; handles forms like 'parameterize', 'with-handlers', 'for', ;; and 'for/fold' accumulator bindings. (0 1 ,(rx (seq (or "for" "for/list" "for/vector" "for/hash" "for/hasheq" "for/hasheqv" "for/and" "for/or" "for/lists" "for/first" "for/last" "for/fold" "for/flvector" "for/extflvector" "for/set" "for/sum" "for/product" "for*" "for*/list" "for*/vector" "for*/hash" "for*/hasheq" "for*/hasheqv" "for*/and" "for*/or" "for*/lists" "for*/first" "for*/last" "for*/fold" "for*/flvector" "for*/extflvector" "for*/set" "for*/sum" "for*/product" "fluid-let" "let" "let*" "let*-values" "let-struct" "let-syntax" "let-syntaxes" "let-values" "let/cc" "let/ec" "letrec" "letrec-syntax" "letrec-syntaxes" "letrec-syntaxes+values" "letrec-values" "match-let" "match-let*" "match-let-values" "match-let*-values" "match-letrec" "parameterize" "parameterize*" "with-handlers" "with-handlers*" "with-syntax" "with-syntax*") (or space line-end)))) ;; for/fold bindings ;; ;; Note: Previous item handles the first, accumulators subform. (0 2 ,(rx (seq (or "for/fold" "for*/fold") (or space line-end)))) ;; named-let bindings ;; (0 2 ,(rx (seq "let" (1+ whitespace) (1+ (not (in "()[]{}\",'`;#|\" ")))))))) "A list of lists. Each sub list is arguments to supply to `racket--smart-open-bracket-helper'.") (defun racket--smart-open-bracket-helper (pre-backward-sexps post-backward-sexps regexp) "Is point is a subform (of a known form REGEXP) that should open with '['. Returns '[' or nil." (and (save-excursion (ignore-errors (backward-sexp pre-backward-sexps) t)) (save-excursion (ignore-errors (let ((pt (point))) (backward-up-list) (backward-sexp post-backward-sexps) (when (looking-at-p regexp) ?\[)))))) (defun racket-smart-open-bracket () "Automatically insert a `(` or a `[` as appropriate. When `racket-smart-open-bracket-enable' is nil, this simply inserts `[`. Otherwise, this behaves like the \"Automatically adjust opening square brackets\" feature in Dr. Racket: By default, inserts a `(`. Inserts a `[` in the following cases: - `let`-like bindings -- forms with `let` in the name as well as things like `parameterize`, `with-handlers`, and `with-syntax`. - `case`, `cond`, `match`, `syntax-case`, `syntax-parse`, and `syntax-rules` clauses. - `for`-like bindings and `for/fold` accumulators. - `class` declaration syntax, such as `init` and `inherit`. When the previous s-expression in a sequence is a compound expression, uses the same kind of delimiter. To force insert `[`, use `quoted-insert': \\[quoted-insert] [. Combined with `racket-insert-closing' this means that you can press the unshifted `[` and `]` keys to get whatever delimiters follow the Racket conventions for these forms. (When `electric-pair-mode' or `paredit-mode' is active, you need not even press `]`." (interactive) (let ((ch (or (and (not racket-smart-open-bracket-enable) ?\[) (and (save-excursion (let ((pt (point))) (beginning-of-defun) (let ((state (parse-partial-sexp (point) pt))) (or (racket--ppss-string-p state) (racket--ppss-comment-p state))))) ?\[) (cl-some (lambda (xs) (apply #'racket--smart-open-bracket-helper xs)) racket--smart-open-bracket-data) (racket--open-paren #'backward-sexp) ?\())) (if (fboundp 'racket--paredit-aware-open) (racket--paredit-aware-open ch) (racket--self-insert ch)))) (put 'racket-smart-open-bracket 'delete-selection #'racket--electric-pair-mode-not-active) (eval-after-load 'paredit '(progn (defvar paredit-mode-map nil) ;byte compiler (declare-function paredit-open-round 'paredit) (declare-function paredit-open-square 'paredit) (declare-function paredit-open-curly 'paredit) (defvar racket--paredit-original-open-bracket-binding (lookup-key paredit-mode-map (kbd "[")) "The previous `paredit-mode-map' binding for [. Rather than assuming that it's `paredit-open-square', we store the actual value. This seems like the right thing to do in case someone else is doing similar hackery.") (add-hook 'paredit-mode-hook (lambda () (define-key paredit-mode-map (kbd "[") 'racket--paredit-open-square))) (defun racket--paredit-open-square () "`racket-smart-open-bracket' or original `paredit-mode-map' binding. To be compatible with `paredit-mode', `racket-smart-open-bracket' must intercept [ and decide whether to call `paredit-open-round' or `paredit-open-square'. To do so it must modify `paredit-mode-map', which affects all major modes. Therefore we check whether the current buffer's major mode is `racket-mode'. If not we call the function in the variable `racket--paredit-original-open-bracket-binding'." (interactive) (if (racket--mode-edits-racket-p) (racket-smart-open-bracket) (funcall racket--paredit-original-open-bracket-binding))) (defun racket--paredit-aware-open (ch) "A paredit-aware helper for `racket-smart-open-bracket'. When `paredit-mode' is active, use its functions (such as `paredit-open-round') Note: This function isn't defined unless paredit is loaded, so check for this function's existence using `fboundp'." (let ((paredit-active (and (boundp 'paredit-mode) paredit-mode))) (cond ((not paredit-active) (racket--self-insert ch)) ((eq ch ?\() (paredit-open-round)) ((eq ch ?\[) (paredit-open-square)) ((eq ch ?\{) (paredit-open-curly)) (t (racket--self-insert ch))))))) ;;; paredit and reader literals (defun racket--reader-literal-paredit-space-for-delimiter-predicate (endp delimiter) "`paredit-mode' shouldn't insert space beteween # and open delimiters. Examples: #() #2() #fl() #hasheq etc. This function is a suitable element for the list variable `paredit-space-for-delimiter-predicates'. " (if (and (racket--mode-edits-racket-p) (not endp)) (not (looking-back (rx ?# (* (or (syntax word) (syntax symbol)))) nil)) t)) (eval-after-load 'paredit '(add-hook 'paredit-space-for-delimiter-predicates #'racket--reader-literal-paredit-space-for-delimiter-predicate)) ;;; paredit and at-expressions (defun racket--at-expression-paredit-space-for-delimiter-predicate (endp delimiter) "`paredit-mode' shouldn't insert space before [ or { in Racket at-expressions. This function is a suitable element for the list variable `paredit-space-for-delimiter-predicates'. " (if (and (racket--mode-edits-racket-p) (not endp)) (not (or ;; @foo[ @foo{ (and (memq delimiter '(?\[ ?\{)) (looking-back (rx ?@ (* (or (syntax word) (syntax symbol)))) nil)) ;; @foo[]{ (and (eq delimiter ?\{) (looking-back (rx ?@ (* (or (syntax word) (syntax symbol))) ?\[ (* (or (syntax word) (syntax symbol))) ?\]) nil)))) t)) (eval-after-load 'paredit '(add-hook 'paredit-space-for-delimiter-predicates #'racket--at-expression-paredit-space-for-delimiter-predicate)) ;;; Cycle paren shapes (defconst racket--paren-shapes '( (?\( ?\[ ?\] ) (?\[ ?\{ ?\} ) (?\{ ?\( ?\) )) "This is not user-configurable because we expect them have to have actual ?\( and ?\) char syntax.") (defun racket-cycle-paren-shapes () "Cycle the sexpr among () [] {}." (interactive) (save-excursion (unless (eq ?\( (char-syntax (char-after))) (backward-up-list)) (pcase (assq (char-after) racket--paren-shapes) (`(,_ ,open ,close) (delete-char 1) (insert open) (backward-char 1) (forward-sexp 1) (backward-delete-char 1) (insert close)) (_ (user-error "Don't know that paren shape"))))) ;;; racket--beginning-of-defun (defun racket--beginning-of-defun-function () "Like `beginning-of-defun' but aware of Racket module forms." (let ((orig (point))) (racket--escape-string-or-comment) (pcase (racket--module-level-form-start) (`() (ignore-errors (backward-sexp 1))) (pos (goto-char pos))) (/= orig (point)))) (defun racket--module-level-form-start () "Start position of the module-level form point is within. A module-level form is the outermost form not nested in a Racket module form. If point is not within a module-level form, returns nil. If point is already exactly at the start of a module-level form, -- i.e. on the opening ?\( -- returns nil. If point is within a string or comment, returns nil. This is NOT suitable for the variable `syntax-begin-function' because it (i) doesn't move point, and (ii) doesn't know how to find the start of a string or comment." (save-excursion (ignore-errors (let ((pos nil) (parse-sexp-ignore-comments t)) (while (ignore-errors (goto-char (scan-lists (point) -1 1)) (unless (looking-at racket-module-forms) (setq pos (point))) t)) (and pos (or (racket--sexp-comment-start pos) pos)))))) (defun racket--sexp-comment-start (pos) "Start pos of sexp comment (if any) immediately before POS. Allows #; to be followed by zero or more space or newline chars." (save-excursion (goto-char pos) (while (memq (char-before) '(32 ?\n)) (goto-char (1- (point)))) (when (string= "#;" (buffer-substring-no-properties (- (point) 2) (point))) (- (point) 2)))) ;;; Misc (defun racket--escape-string-or-comment () "If point is in a string or comment, move to its start. Note that this can be expensive, as it uses `syntax-ppss' which parses from the start of the buffer. Although `syntax-ppss' uses a cache, that is invalidated after any changes to the buffer. As a result, the worst case would be to call this function after every character is inserted to a buffer." (pcase (racket--ppss-string/comment-start (syntax-ppss)) (`() nil) (pos (goto-char pos)))) (defun racket-backward-up-list () "Like `backward-up-list' but works when point is in a string or comment. Typically you should not use this command in Emacs Lisp -- especially not repeatedly. Instead, initially use `racket--escape-string-or-comment' to move to the start of a string or comment, if any, then use normal `backward-up-list' repeatedly." (interactive) (racket--escape-string-or-comment) (backward-up-list 1)) (defun racket--open-paren (back-func) "Use BACK-FUNC to find an opening ( [ or { if any. BACK-FUNC should be something like #'backward-sexp or #'backward-up-list." (save-excursion (ignore-errors (funcall back-func) (let ((ch (char-after))) (and (eq ?\( (char-syntax ch)) ch))))) (provide 'racket-common) ;; racket-common.el ends here