Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
556 lines (498 sloc) 21.3 KB
;;; scribble-mode.el --- Major mode for Scribble typesetting language. -*- lexical-binding: t -*-
;; Copyright (C) 2019 Alex Harsanyi
;; Author: Alex Harsanyi <AlexHarsanyi@gmail.com>
;; Keywords: tools
;; 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 <https://www.gnu.org/licenses/>.
(require 'racket-mode)
(require 'cl-lib)
(defgroup scribble-mode nil
"Major mode for editing text files in Scribble format."
:prefix "scribble-"
:group 'text)
(defvar scribble-syntax-table
(let ((table (make-syntax-table)))
;; Make @, - and / word constituents -- they seem more useful as
;; such, especially in regexps
(modify-syntax-entry ?@ "w 1" table)
(modify-syntax-entry ?- "w" table)
(modify-syntax-entry ?/ "w" table)
(modify-syntax-entry ?* "w" table)
(modify-syntax-entry ?\; ". 2" table)
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?\( "(" table)
(modify-syntax-entry ?\) ")" table)
(modify-syntax-entry ?\[ "(" table)
(modify-syntax-entry ?\] ")" table)
(modify-syntax-entry ?\{ "(" table)
(modify-syntax-entry ?\} ")" table)
table)
"Syntax table used in `scribble-mode'.")
;;................................................................ faces ....
(defface scribble-section-face
'((t (:inherit font-lock-function-name-face :weight bold)))
"Face for section (and sub-section) text."
:group 'scribble-mode)
(defvar scribble-section-face 'scribble-section-face)
(defface scribble-italic-face
'((t (:inherit italic)))
"Face for italic text."
:group 'scribble-mode)
(defvar scribble-italic-face 'scribble-italic-face)
(defface scribble-bold-face
'((t (:inherit bold)))
"Face for bold text."
:group 'scribble-mode)
(defvar scribble-bold-face 'scribble-bold-face)
(defface scribble-racket-face
'((t (:inherit font-lock-doc-face)))
"Face for @racket sections."
:group 'scribble-mode)
(defvar scribble-racket-face 'scribble-racket-face)
(defface scribble-code-face
'((t (:inherit fixed-pitch)))
"Face for @tt sections"
:group 'scribble-mode)
(defvar scribble-code-face 'scribble-code-face)
;; NOTE: this does not seem to work -- the @;{...} comment is
;; highlighted briefly, than font-lock removes the comment highlight
;; from the region. @; comments seem to work fine.
(defun scribble-font-lock-sexp-comments (limit)
"Find the region for Scribble comments @;... and @;{...}.
This function marks the beginning and end of such a block comment
in the match data, using `set-match-data' and it is indented to
be used in font-lock-keywords."
(ignore-errors
(when (re-search-forward "@;" limit 'noerror)
(let ((md (match-data)))
(goto-char (match-end 0))
(if (looking-at "{")
(forward-sexp 1)
(end-of-line))
;; set (match-end 0) to the end of the comment
(setf (elt md 1) (point-marker))
(set-match-data md)
t))))
(defun scribble-font-lock-text-style (text-style limit &optional skip-datum)
(when (re-search-forward text-style limit 'noerror)
;; note `set-match-data' must receive a modified list produced by
;; `match-data'
(let ((result (list (make-marker) (make-marker)
(make-marker) (make-marker)
(make-marker) (make-marker))))
(set-marker (nth 0 result) (match-beginning 0))
(set-marker (nth 2 result) (match-beginning 0))
(set-marker (nth 3 result) (match-end 0))
(goto-char (match-end 0))
(when (and skip-datum (looking-at "\\["))
(forward-sexp 1))
(when (looking-at "{\\|\\[")
(progn
(set-marker (nth 4 result) (1+ (point)))
(forward-sexp 1)
;; set (match-end 0) to the end of the comment
(set-marker (nth 5 result) (1- (point)))
(set-marker (nth 1 result) (point))))
(set-match-data result)
t)))
(defun scribble-font-lock-at-exp (limit)
(when (re-search-forward "@(" limit 'noerror)
(let ((result (list (make-marker) (make-marker)
(make-marker) (make-marker)
(make-marker) (make-marker))))
(set-marker (nth 0 result) (match-beginning 0))
(set-marker (nth 2 result) (match-beginning 0))
(set-marker (nth 3 result) (1- (match-end 0)))
(goto-char (match-end 0))
(set-marker (nth 4 result) (point))
(forward-char -1)
(forward-sexp 1)
(set-marker (nth 1 result) (point))
(goto-char (nth 4 result))
(forward-sexp 1)
(set-marker (nth 5 result) (point))
(set-match-data result)
t)))
(defun scribble-font-lock-italic (limit)
(scribble-font-lock-text-style "@\\(italic\\|emph\\)\\_>" limit))
(defun scribble-font-lock-bold (limit)
(scribble-font-lock-text-style "@bold\\_>" limit))
(defun scribble-font-lock-tt (limit)
(scribble-font-lock-text-style "@tt\\_>" limit))
(defun scribble-font-lock-racket (limit)
(scribble-font-lock-text-style "@racket\\_>" limit))
(defun scribble-font-lock-sections (limit)
(scribble-font-lock-text-style "@\\(author\\|title\\|\\(\\(sub\\)*\\*?section\\)\\)\\_>" limit 'skip-datum))
(defvar scribble-font-lock-keywords
`(("@def\\sw+" (0 font-lock-keyword-face))
(scribble-font-lock-at-exp
. ((1 font-lock-keyword-face)
(2 font-lock-function-name-face)))
;; Comments
(,#'scribble-font-lock-sexp-comments
(0 font-lock-comment-face append))
;; Keywords and symbols
("#:\\sw+" (0 font-lock-constant-face))
("\\B\\('\\sw+\\)" (1 font-lock-constant-face))
;; Document structure
("@include-section\\_>" . font-lock-keyword-face)
(scribble-font-lock-sections . ((1 font-lock-keyword-face)
(2 scribble-section-face)))
;; Blocks
("@\\(para\\|nested\\|centered\\|margin-note\\*?\\|itemlist\\|item\\|tabular\\|verbatim\\)\\_>"
. (0 font-lock-constant-face))
;; Text style and Content
("@\\(elem\\|subscript\\|superscript\\|smaller\\|larger\\|literal\\)\\_>"
. (0 font-lock-builtin-face))
(scribble-font-lock-italic . ((1 font-lock-builtin-face)
(2 scribble-italic-face t)))
(scribble-font-lock-bold .((1 font-lock-builtin-face)
(2 scribble-bold-face)))
(scribble-font-lock-tt . ((1 font-lock-builtin-face)
(2 scribble-code-face)))
;; Other
("@\\(image\\|linebreak\\|nonbreaking\\|hspace\\|hyperlink\\|url\\|[Ss]ecref\\|seclink\\|other-doc\\|elemtag\\|elemref\\|\\(as-\\|section-\\)?index\\*?\\|index-section\\|\\(local-\\)?table-of-contents\\)\\_>"
. (0 font-lock-type-face))
(scribble-font-lock-racket .((1 font-lock-function-name-face)
(2 scribble-racket-face)))
;; Warning-Highlight space between the datum [], and body {} --
;; Scribble likes next to each other -- note that we highlight the
;; closing and opening brackets too, as highlighting just the
;; space is not very visible.
("\\]\\([ \t\n\r\f]+\\){"
(0 font-lock-warning-face prepend))
;; Warning-Highlight space between the @command and the datum[] --
;; Scribble likes them next to each other -- note that we
;; highlight the entire command, since highlight just the space is
;; not very visible.
("@\\sw*\\([ \t\n\r\f]+\\)\\((\\|\\[\\|{\\)"
(0 font-lock-warning-face prepend)))
"Font lock definitions for `scribble-mode'.")
;;...................................................... syntax analysis ....
(cl-defstruct scribble-context
kind ; 'comment, 'string 'at-expression 'at-command
name ; name of the 'at-command
start ; start position for the entire context
section ; 'datum for inside [], 'body for inside {}
place ; 'open, 'continuation, 'close
anchor ; position of section start
ppss ; result of syntax-ppss
)
(defun scribble-context-of-line (&optional no-back-to-indentation)
"Determine the syntax context of the current line of code.
Returns a list of `scribble-context' instances, inner-most
first."
(save-excursion
(unless no-back-to-indentation
(back-to-indentation))
(let ((start (point))
(ppss (syntax-ppss (point)))
(context '())
(place nil))
(cond
((nth 4 ppss) ; inside a comment
(push (make-scribble-context
:ppss ppss
:kind 'comment
:start (nth 8 ppss)
:anchor (nth 8 ppss))
context))
((nth 3 ppss) ; inside a string
(push (make-scribble-context
:ppss ppss
:kind 'comment
:start (nth 8 ppss)
:anchor (nth 8 ppss))
context))
((looking-at "\\(\\]\\|}\\)")
;; Whatever context we are in, this is the closing line
(setq place 'close)))
(goto-char start)
(dolist (pos (reverse (nth 9 ppss)))
(goto-char pos)
(cond
((looking-at "(")
(forward-char -1)
(when (looking-at "@")
(let ((canchor (point)))
(goto-char start)
(skip-chars-backward " \t\n\r\f\v")
(if (eq (point) pos)
(setq place 'open) ; override it
(unless place
(setq place 'continuation)))
(push (make-scribble-context
:ppss ppss
:kind 'at-expression
:start canchor
:place place
:anchor pos)
context))))
((looking-at "\\[")
(skip-chars-backward " \t\n\r\f\v")
(skip-syntax-backward "w")
(when (looking-at "\\(@\\w+\\)\\s-*\\[")
(let ((cname (match-string-no-properties 1))
(canchor (point)))
(goto-char start)
(skip-chars-backward " \t\n\r\f\v")
(forward-char -1)
(if (eq (point) pos)
(setq place 'open) ; override it
(unless place
(setq place 'continuation)))
(push (make-scribble-context
:ppss ppss
:kind 'at-command
:name cname
:start canchor
:section 'datum
:place place
:anchor pos)
context))))
((looking-at "{")
(forward-char -1)
(skip-chars-backward " \t\n\r\f\v")
(when (looking-at "\\]") ; skip over [...]
(forward-char 1)
(forward-sexp -1))
(skip-chars-backward " \t\n\r\f\v")
(skip-syntax-backward "w")
(when (looking-at "\\(@\\w+\\)\\s-*\\(\\[\\|{\\)")
(let ((cname (match-string-no-properties 1))
(canchor (point)))
(goto-char start)
(skip-chars-backward " \t\n\r\f\v")
(forward-char -1)
(if (eq (point) pos)
(setq place 'open) ; override it
(unless place
(setq place 'continuation)))
(push (make-scribble-context
:ppss ppss
:kind 'at-command
:name cname
:start canchor
:section 'body
:place place
:anchor pos)
context))))))
(reverse context))))
(defun scribble-current-atcommand-body-region ()
"Find the region of the inner-most @command body at `point'.
Returns a (cons START END) of buffer positions, or nil if there
is no @command surrounding `point'"
(let ((context (scribble-context-of-line 'no-back-to-indentation)))
(when context
(let ((item (car context)))
(when (and (eq (scribble-context-kind item) 'at-command)
(eq (scribble-context-section item) 'body))
(save-excursion
(goto-char (scribble-context-anchor item))
(condition-case _err
(progn
(forward-sexp 1)
(cons (scribble-context-anchor item) (point)))
(scan-error
(cons (scribble-context-anchor item) (point-max))))))))))
(defun scribble-fill-paragaph (&optional justify region)
"Fill the text in a Scribble paragraph.
This is intended to be used as `fill-paragraph-function' and will
limit the region to be filled to the @command body, so filling
works nicely inside {...} constructs. The actual filling is done
by `fill-region' if point is inside an @command body, or
delegated back to `fill-paragraph' if outside."
(let ((body-region (scribble-current-atcommand-body-region)))
(if body-region
(let* ((here (point))
(pstart (max (1+ (car body-region))
(progn (forward-paragraph -1) (point))))
(pend (min (1- (cdr body-region))
(progn (goto-char here) (forward-paragraph 1) (point)))))
(goto-char here)
(fill-region pstart pend justify))
(let ((fill-paragraph-function nil)
(fill-paragraph-handle-comment t))
(fill-paragraph justify region)))))
(defun scribble-beginning-of-defun (&optional arg)
"Move point to the beginning of the current @command."
;; NOTE: the implementation of this function needs to be somewhat
;; complex, as it needs to handle negative ARG values, and move to
;; the end of defun in such a case. The "end-of-defun" movement is
;; done as a combination of calling this function with a negative
;; ARG followed by calling `end-of-defun-function'. Thus
;; `end-of-defun-function' is called in a special context and only
;; needs to move over some sexps
;;
;; (message "scribble-beginning-of-defun: arg = %s" arg)
(if (and (numberp arg) (< arg 0))
(skip-chars-forward " \t\n\r\f\v")
(progn
(unless (equal (skip-chars-backward " \t\n\r\f\v") 0)
(forward-char -1))
(skip-syntax-backward "w")))
(if (looking-at "\\(@\\w+\\)\\s-*\\(\\[\\|{\\)") ; already at start of defun
(forward-sexp 1)
(let ((context (scribble-context-of-line 'no-back-to-indentation)))
(catch 'done
(dolist (item context)
(when (eq (scribble-context-kind item) 'at-command)
;; We are supposed to move point to the opening bracket,
;; not to the actual beginning of the defun.
;; `beginning-of-defun' will do the rest.
(goto-char (scribble-context-anchor item)))
(throw 'done t)))))
;; Negative arg indicates that we need to move to the end of defun
;; instead.
(when (and (numberp arg) (< arg 0))
(condition-case _err
(forward-sexp 1)
(scan-error
(goto-char (point-max)))))
(if (and (numberp arg) (/= arg -1) (/= arg 1) (/= arg 0))
(scribble-beginning-of-defun (if (> arg 0) (1- arg) (1+ arg)))
(point)))
(defun scribble-end-of-defun (&optional _arg)
"Move point to the end of the current @command"
;; This implementation is very simple because `beginning-of-defun'
;; does most of the work, as it is called even when we need to move
;; to the end of defun.
(when (looking-at "@")
(forward-word 1))
(when (looking-at ";")
(forward-char 1))
(when (looking-at "\\[")
(forward-sexp 1))
(when (looking-at "{")
(forward-sexp 1)))
;;................................................................. rest ....
(defvar scribble-basic-offset 2)
(defun scribble-use-previous-line-indentation (context-item)
"Return the indentation of the previous line.
If the start of the previous line is before the anchor of SYNTAX,
use the column of the anchor + 1."
(let ((limit (scribble-context-anchor context-item))
(ppss (scribble-context-ppss context-item)))
(catch 'done
(save-excursion
(while t
(if (< (point) limit)
;; We went beyond our anchor point, so take anchor + 1
;; as the indentation column.
(progn
(goto-char limit)
(throw 'done (1+ (current-column))))
(if (= (forward-line -1) 0)
(progn
(back-to-indentation)
(let ((ppss1 (syntax-ppss (point))))
;; Only consider previous line if it is not empty
;; and at the same PPSS context
(when (and (not (looking-at "\\s-*$"))
(eq (nth 3 ppss) (nth 3 ppss1))
(eq (nth 4 ppss) (nth 4 ppss1))
(eq (nth 0 ppss) (nth 0 ppss1)))
(throw 'done (current-column)))))
;; Forward-line didn't move, we must be at the start of
;; buffer
(throw 'done (current-column)))))))))
(defun scribble-use-anchor-indentation (context-item)
(save-excursion
(goto-char (scribble-context-anchor context-item))
(back-to-indentation)
(current-column)))
(defun scribble-use-start-indentation (context-item)
(save-excursion
(goto-char (scribble-context-start context-item))
(back-to-indentation)
(current-column)))
(defun scribble-context-item-region (context-item)
"Find the region of the CONTEXT-ITEM"
(when (memq (scribble-context-section context-item) '(datum body))
(save-excursion
(goto-char (scribble-context-anchor context-item))
(condition-case _err
(progn
(forward-sexp 1)
(cons (scribble-context-anchor context-item) (point)))
(scan-error
(cons (scribble-context-anchor context-item) (point-max)))))))
(defun scribble-use-racket-indentation (context-item &optional base-indentation)
(let ((region (scribble-context-item-region context-item))
(cline (current-line)))
(if region
(save-excursion
(let ((indent (save-restriction
(widen)
(narrow-to-region (1+ (car region)) (1- (cdr region)))
(racket--calculate-indent))))
(if indent
(progn
(goto-char (1+ (car region)))
(+ indent (if (or (= indent 0) (< (- cline (current-line)) 2))
(current-column)
0)))
base-indentation)))
base-indentation)))
(defun scribble-calculate-indentation (context &optional base-indentation)
(if context
(let ((context-item (car context)))
(cond
((and (eq (scribble-context-kind context-item) 'at-command)
(eq (scribble-context-section context-item) 'datum)
(member (scribble-context-name context-item)
'("@interaction" "@defproc" "@defmethod" "@examples")))
(scribble-use-racket-indentation context-item))
((memq (scribble-context-section context-item) '(datum body))
(case (scribble-context-place context-item)
((open)
(+ (scribble-use-start-indentation context-item)
scribble-basic-offset))
((continuation)
(scribble-use-previous-line-indentation context-item))
((close)
(scribble-use-start-indentation context-item))))
(t base-indentation)))
base-indentation))
(defun scribble-indent-line ()
"Indent a Scribble line of code"
(let* ((context (scribble-context-of-line))
(base-column (current-column))
(indent-column (scribble-calculate-indentation context)))
(when indent-column
(back-to-indentation)
(let ((offset (- base-column (current-column))))
;; avoid modifying the buffer when the indentation does not
;; have to change
(unless (eq (current-column) indent-column)
(indent-line-to indent-column))
(when (> offset 0)
(forward-char offset))))))
;;;###autoload
(define-derived-mode scribble-mode prog-mode
"Scribble"
"Major mode for editing Scribble documents"
(set-syntax-table scribble-syntax-table)
(set (make-local-variable 'comment-start) "@;")
(set (make-local-variable 'comment-start-skip) "@;\\s-*")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'indent-line-function) #'scribble-indent-line)
(set (make-local-variable 'beginning-of-defun-function) #'scribble-beginning-of-defun)
(set (make-local-variable 'end-of-defun-function) #'scribble-end-of-defun)
(set (make-local-variable 'font-lock-defaults)
'((scribble-font-lock-keywords)
nil nil nil nil
(font-lock-multiline . t)
(font-lock-mark-block-function . mark-defun)))
(set (make-local-variable 'fill-paragraph-function) #'scribble-fill-paragaph))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.scrbl\\'" . scribble-mode))
(provide 'scribble-mode)
You can’t perform that action at this time.