[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/d-mode 809586a 266/346: Reorganize code
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/d-mode 809586a 266/346: Reorganize code |
|
Date: |
Sun, 29 Aug 2021 11:00:43 -0400 (EDT) |
branch: elpa/d-mode
commit 809586a7ad4a77c9a56451d7e9ca4b7216c442d6
Author: Vladimir Panteleev <git@thecybershadow.net>
Commit: Vladimir Panteleev <git@thecybershadow.net>
Reorganize code
- Group code by purpose into logical sections
- Add bigger comment headers which clearly delimit section bounds
- Ensure compile-time definitions (e.g. defsubst) occur before they
are used
---
d-mode.el | 2229 +++++++++++++++++++++++++++++++------------------------------
1 file changed, 1135 insertions(+), 1094 deletions(-)
diff --git a/d-mode.el b/d-mode.el
index a16f8ed..fb8f534 100644
--- a/d-mode.el
+++ b/d-mode.el
@@ -7,7 +7,7 @@
;; Maintainer: Russel Winder <russel@winder.org.uk>
;; Vladimir Panteleev <vladimir@thecybershadow.net>
;; Created: March 2007
-;; Version: 201909121818
+;; Version: 201909121829
;; Keywords: D programming language emacs cc-mode
;; Package-Requires: ((emacs "25.1"))
@@ -72,9 +72,14 @@
;; History is tracked in the Git repository rather than in this file.
;; See
https://github.com/Emacs-D-Mode-Maintainers/Emacs-D-Mode/commits/master
-;;----------------------------------------------------------------------------
;;; Code:
+;; ----------------------------------------------------------------------------
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Required packages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ----------------------------------------------------------------------------
+
(require 'cc-mode)
(require 'cc-langs)
@@ -102,6 +107,13 @@
(eval-when-compile
(require 'cc-fonts))
+
+;; ----------------------------------------------------------------------------
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; cc-mode configuration ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ----------------------------------------------------------------------------
+
(eval-and-compile
;; Make our mode known to the language constant system. Use Java
;; mode as the fallback for the constants we don't change here.
@@ -189,47 +201,6 @@ operators."
(c-lang-defconst c-post-protection-token
d ":")
-;;; Patterns to recognize the compiler generated messages
-
-(defun d-mode-add-dmd-message-pattern (expr level symbol)
- "Register DMD `compile' pattern for an error level.
-
-EXPR is the `rx' message sub-expression indicating the error level LEVEL.
-The expression is added to `compilation-error-regexp-alist' and
-`compilation-error-regexp-alist-alist' as SYMBOL."
- (add-to-list
- 'compilation-error-regexp-alist-alist
- `(,symbol
- ,(rx-to-string
- `(and
- line-start
- (group-n 1 (one-or-more any)) ; File name
- "("
- (group-n 2 (one-or-more digit)) ; Line number
- (zero-or-one
- ","
- (group-n 3 (one-or-more digit))) ; Column number
- "): "
- ,expr
- (group-n 4 (one-or-more nonl)) ; Message
- line-end))
- 1 2 3 ,level 4))
- (add-to-list 'compilation-error-regexp-alist symbol))
-
-(d-mode-add-dmd-message-pattern "Error: " 2 'dmd-error )
-(d-mode-add-dmd-message-pattern "Warning: " 1 'dmd-warning )
-(d-mode-add-dmd-message-pattern "Deprecation: " 1 'dmd-deprecation )
-(d-mode-add-dmd-message-pattern '(one-or-more " ") 0 'dmd-continuation)
-
-;; The following regexp recognizes messages generated by the D runtime for
-;; unhandled exceptions (e.g. assert failures).
-
-(add-to-list 'compilation-error-regexp-alist-alist
- '(d-exceptions
- "^[a-zA-Z0-9.]*?@\\(.*?\\)(\\([0-9]+\\)):"
- 1 2 nil 2))
-(add-to-list 'compilation-error-regexp-alist 'd-exceptions)
-
;;----------------------------------------------------------------------------
;; Built-in basic types
@@ -440,1176 +411,1246 @@ The expression is added to
`compilation-error-regexp-alist' and
(c-lang-defconst c-recognize-<>-arglists
d nil)
-(defcustom d-font-lock-extra-types nil
- "*List of extra types (aside from the type keywords) to recognize in D mode.
+;; ----------------------------------------------------------------------------
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; cc-mode patches ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ----------------------------------------------------------------------------
-Each list item should be a regexp matching a single identifier."
- :type '(repeat regexp)
- :group 'd-mode)
+;;----------------------------------------------------------------------------
+;;; Workaround for special case of 'else static if' not being handled properly
+(defun d-special-case-looking-at (orig-fun &rest args)
+ ;; checkdoc-params: (orig-fun args)
+ "Advice function for fixing cc-mode indentation in certain D constructs."
+ (let ((rxp (car args)))
+ (if (and (stringp rxp) (string= rxp "if\\>[^_]"))
+ (or (apply orig-fun '("static\\>\\s-+if\\>[^_]"))
+ (apply orig-fun '("version\\>[^_]"))
+ (apply orig-fun '("debug\\>[^_]"))
+ (apply orig-fun args))
+ (apply orig-fun args))))
-(c-lang-defconst c-basic-matchers-after
- d (append
- ;; D module and import statements
- (list (c-make-font-lock-BO-decl-search-function
- (c-make-keywords-re t (c-lang-const c-ref-list-kwds))
- '((c-fontify-types-and-refs ()
- (d-forward-module-clause)
- (if (> (point) limit) (goto-char limit))))))
- ;; cc-mode defaults
- (c-lang-const c-basic-matchers-after)))
+(defun d-around--c-add-stmt-syntax (orig-fun &rest args)
+ ;; checkdoc-params: (orig-fun args)
+ "Advice function for fixing cc-mode indentation in certain D constructs."
+ (if (not (c-major-mode-is 'd-mode))
+ (apply orig-fun args)
+ (add-function :around (symbol-function 'looking-at)
+ #'d-special-case-looking-at)
+ (unwind-protect
+ (apply orig-fun args)
+ (remove-function (symbol-function 'looking-at)
+ #'d-special-case-looking-at))))
-(defconst d-font-lock-keywords-1 (c-lang-const c-matchers-1 d)
- "Minimal highlighting for D mode.")
+(advice-add 'c-add-stmt-syntax :around #'d-around--c-add-stmt-syntax)
-(defconst d-font-lock-keywords-2 (c-lang-const c-matchers-2 d)
- "Fast normal highlighting for D mode.")
+;;----------------------------------------------------------------------------
+;;; Implements handling of D constructors
+;;; Fixes e.g. indentation of contracts on constructors.
-(defconst d-font-lock-keywords-3 (c-lang-const c-matchers-3 d)
- "Accurate normal highlighting for D mode.")
+;; Make it so that inside c-forward-decl-or-cast-1,
+;; "this" looks like a function identifier but not a type identifier.
-(defvar d-font-lock-keywords d-font-lock-keywords-3
- "Default expressions to highlight in D mode.")
+(defun d-special-case-c-forward-name (orig-fun &rest args)
+ ;; checkdoc-params: (orig-fun args)
+ "Advice function for fixing cc-mode handling of D constructors."
+ (if (not (looking-at (c-make-keywords-re t '("this" "~this"))))
+ (apply orig-fun args)
+ (goto-char (match-end 1))
+ t))
-(defun d-font-lock-keywords-2 ()
- "Function to get fast normal highlighting for D mode."
- (c-compose-keywords-list d-font-lock-keywords-2))
-(defun d-font-lock-keywords-3 ()
- "Function to get accurate normal highlighting for D mode."
- (c-compose-keywords-list d-font-lock-keywords-3))
-(defun d-font-lock-keywords ()
- "Function to get default expressions to highlight in D mode."
- (c-compose-keywords-list d-font-lock-keywords))
+(defsubst d-forward-name () "Shorthand." (d-special-case-c-forward-name
#'c-forward-name))
-(defvar d-mode-syntax-table nil
- "Syntax table used in d-mode buffers.")
-(or d-mode-syntax-table
- (setq d-mode-syntax-table
- (let ((table (funcall (c-lang-const c-make-mode-syntax-table d))))
- ;; Make it recognize D `backquote strings`
- (modify-syntax-entry ?` "\"" table)
+(defun d-around--c-forward-decl-or-cast-1 (orig-fun &rest args)
+ ;; checkdoc-params: (orig-fun args)
+ "Advice function for fixing cc-mode handling of D constructors."
+ (cond
+ ((not (c-major-mode-is 'd-mode))
+ (apply orig-fun args))
- ;; Make it recognize D's nested /+ +/ comments
- (modify-syntax-entry ?+ ". 23n" table)
- table)))
+ ;; D: The logic in cc-mode's `c-forward-decl-or-cast-1' will
+ ;; recognize "someIdentifier in" as a variable declaration,
+ ;; fontifying someIdentifier as a type. Prevent this here.
+ ((save-excursion
+ (and
+ (looking-at c-identifier-start)
+ (progn
+ (c-forward-token-2)
+ (looking-at (c-make-keywords-re t '("in"))))))
+ nil)
-(defvar d-mode-abbrev-table nil
- "Abbreviation table used in d-mode buffers.")
-(c-define-abbrev-table 'd-mode-abbrev-table
- ;; Use the abbrevs table to trigger indentation actions
- ;; on keywords that, if they occur first on a line, might alter the
- ;; syntactic context.
- ;; Syntax for abbrevs is:
- ;; ( pattern replacement command initial-count)
- '(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0)
- ("catch" "catch" c-electric-continued-statement 0)
- ("finally" "finally" c-electric-continued-statement 0)))
+ ;; D: cc-mode gets confused due to "scope" being a keyword that can
+ ;; both be part of declarations (as a storage class), and a
+ ;; statement (e.g. "scope(exit)"). Disambiguate them here.
+ ((save-excursion
+ (and
+ (looking-at (c-make-keywords-re t '("scope")))
+ (progn
+ (c-forward-token-2)
+ (looking-at "("))))
+ nil)
-(defvar d-mode-map ()
- "Keymap used in d-mode buffers.")
-(if d-mode-map
- nil
- (setq d-mode-map (c-make-inherited-keymap))
- ;; Add bindings which are only useful for D
- ;; (define-key d-mode-map "\C-c\C-e" 'd-cool-function)
- )
+ ;; D: The "else" following a "version" or "static if" can start a
+ ;; declaration even without a { } block. For this reason, "else" is
+ ;; in `c-decl-start-kwds'.
+ ;; However, cc-mode invokes `c-forward-decl-or-cast-1' with point
+ ;; at the "else" keyword, which, when followed by a function call,
+ ;; is mis-parsed as a function declaration.
+ ;; Fix this by moving point forward, past the "else" keyword, to
+ ;; put cc-mode on the right track.
+ ((looking-at (c-make-keywords-re t '("else")))
+ (goto-char (match-end 1))
+ (c-forward-syntactic-ws)
+ (apply orig-fun args))
-(c-lang-defconst c-mode-menu
- ;; The definition for the mode menu. The menu title is prepended to
- ;; this before it's fed to `easy-menu-define'.
- d `(["Comment Out Region" comment-region
- (c-fn-region-is-active-p)]
- ["Uncomment Region" (comment-region (region-beginning)
- (region-end) '(4))
- (c-fn-region-is-active-p)]
- ["Indent Expression" c-indent-exp
- (memq (char-after) '(?\( ?\[ ?\{))]
- ["Indent Line or Region" c-indent-line-or-region t]
- ["Fill Comment Paragraph" c-fill-paragraph t]
- "----"
- ["Backward Statement" c-beginning-of-statement t]
- ["Forward Statement" c-end-of-statement t]
- "----"
- ("Toggle..."
- ["Syntactic indentation" c-toggle-syntactic-indentation
- :style toggle :selected c-syntactic-indentation]
- ["Electric mode" c-toggle-electric-state
- :style toggle :selected c-electric-flag]
- ["Auto newline" c-toggle-auto-newline
- :style toggle :selected c-auto-newline]
- ["Hungry delete" c-toggle-hungry-state
- :style toggle :selected c-hungry-delete-key]
- ["Subword mode" c-subword-mode
- :style toggle :selected (and (boundp 'c-subword-mode)
- c-subword-mode)])))
+ (t
+ ;; Work around a cc-mode bug(?) in which the c-forward-annotation
+ ;; calls in c-forward-decl-or-cast-1 do not advance the start
+ ;; position, causing the annotation to be fontified as the
+ ;; function name.
+ (while (c-forward-annotation)
+ (c-forward-syntactic-ws))
-(easy-menu-define d-menu d-mode-map "D Mode Commands"
- (cons "D" (c-lang-const c-mode-menu d)))
+ (add-function :around (symbol-function 'c-forward-name)
+ #'d-special-case-c-forward-name)
+ (unwind-protect
+ (apply orig-fun args)
+ (remove-function (symbol-function 'c-forward-name)
+ #'d-special-case-c-forward-name)))))
+
+(advice-add 'c-forward-decl-or-cast-1 :around
#'d-around--c-forward-decl-or-cast-1)
;;----------------------------------------------------------------------------
-;; Old imenu implementation - regular expressions:
+(defun d-around--c-get-fontification-context (orig-fun match-pos &rest args)
+ ;; checkdoc-params: (orig-fun match-pos args)
+ "Advice function for fixing cc-mode handling of D lambda parameter lists."
+ (let ((res (apply orig-fun match-pos args)))
+ (when (and
+ (c-major-mode-is 'd-mode)
+ (eq (car res) nil)
+ (save-excursion
+ (goto-char match-pos )
+ (c-backward-syntactic-ws)
+ (eq (char-before) ?\()))
+ (setq res (cons 'arglist t)))
+ res))
+(advice-add 'c-get-fontification-context :around
#'d-around--c-get-fontification-context)
-(eval-when-compile
- (defconst d--imenu-rx-def-start
- '(seq
- ;; Conditionals
- (zero-or-one
- "else"
- (zero-or-more space))
- (zero-or-one
- "version"
- (zero-or-more space)
- "("
- (zero-or-more space)
- (one-or-more (any "a-zA-Z0-9_"))
- (zero-or-more space)
- ")"
- (zero-or-more space))
+;;----------------------------------------------------------------------------
+;;; Fixes fontification of constructor parameter lists in D code.
- (zero-or-more
- (or
- word-start
- (or
- ;; StorageClass
- "deprecated"
- "static"
- "extern"
- "abstract"
- "final"
- "override"
- "synchronized"
- "scope"
- "nothrow"
- "pure"
- "ref"
- (seq
- (or
- "extern"
- "deprecated"
- "package"
- )
- (zero-or-more space)
- "("
- (zero-or-more space)
- (one-or-more (not (any "()")))
- (zero-or-more space)
- ")")
+(defun d-special-case-looking-at-2 (orig-fun regexp)
+ ;; checkdoc-params: (orig-fun regexp)
+ "Advice function for fixing cc-mode handling of D constructors."
+ (if (and
+ (eq regexp c-not-decl-init-keywords)
+ (apply orig-fun (c-make-keywords-re t '("this")) nil)) ; looking-at
"this"
+ nil
+ (apply orig-fun regexp nil)))
- ;; VisibilityAttribute
- "private"
- "package"
- "protected"
- "public"
- "export"
- )
+(defun d-around--c-font-lock-declarations (orig-fun &rest args)
+ ;; checkdoc-params: (orig-fun args)
+ "Advice function for fixing cc-mode handling of D constructors."
+ (if (not (c-major-mode-is 'd-mode))
+ (apply orig-fun args)
+ (add-function :around (symbol-function 'looking-at)
+ #'d-special-case-looking-at-2)
+ (unwind-protect
+ (apply orig-fun args)
+ (remove-function (symbol-function 'looking-at)
+ #'d-special-case-looking-at-2))))
- ;; AtAttribute
- (seq
- "@"
- (one-or-more (any "a-zA-Z0-9_"))
- (zero-or-one
- (zero-or-more space)
- "("
- (zero-or-more space)
- (one-or-more (not (any "()")))
- (zero-or-more space)
- ")")))
- (zero-or-more space))
+(advice-add 'c-font-lock-declarations :around
#'d-around--c-font-lock-declarations)
- )))
+;;----------------------------------------------------------------------------
+;; Borrowed from
https://github.com/josteink/csharp-mode/blob/master/csharp-mode.el
+(defun d--syntax-propertize-function (beg end)
+ "Apply syntax table properties to special constructs in region BEG to END.
+Currently handles `-delimited string literals."
+ (save-excursion
+ (goto-char beg)
+ (while (search-forward "`" end t)
+ (let ((in-comment-or-string-p (save-excursion
+ (goto-char (match-beginning 0))
+ (or (nth 3 (syntax-ppss))
+ (nth 4 (syntax-ppss))))))
+ (when (not in-comment-or-string-p)
+ (let (done)
+ (while (and (not done) (< (point) end))
+ (skip-chars-forward "^`\\\\" end)
+ (cond
+ ((= (following-char) ?\\)
+ (put-text-property (point) (1+ (point))
+ 'syntax-table (string-to-syntax "."))
+ (forward-char 1))
+ ((= (following-char) ?\`)
+ (forward-char 1)
+ (setq done t))))))))))
-(defconst d-imenu-method-name-pattern
- (rx
- ;; Whitespace
- bol
- (zero-or-more space)
+;;----------------------------------------------------------------------------
- (eval d--imenu-rx-def-start)
+(defun d--on-func-identifier ()
+ "Version of `c-on-identifier', but also match D constructors."
- ;; Type
- (group
- (one-or-more (any "a-zA-Z0-9_.*![]()")))
- (one-or-more space)
+ (save-excursion
+ (skip-syntax-backward "w_")
- ;; Function name
- (group
- (one-or-more (any "a-zA-Z0-9_")))
- (zero-or-more space)
+ (or
+ ;; Check for a normal (non-keyword) identifier.
+ (and (looking-at c-symbol-start)
+ (or
+ (looking-at (c-make-keywords-re t '("this" "~this")))
+ (not (looking-at c-keywords-regexp)))
+ (point)))))
- ;; Type arguments
- (zero-or-one
- "(" (zero-or-more (not (any ")"))) ")"
- (zero-or-more (any " \t\n")))
+(defun d-in-knr-argdecl (&optional lim)
+ "Modified version of `c-in-knr-argdecl' for d-mode." ;; checkdoc-params: lim
+ (save-excursion
+ ;; If we're in a macro, our search range is restricted to it. Narrow to
+ ;; the searchable range.
+ (let* ((start (point))
+ before-lparen
+ after-rparen
+ (pp-count-out 20) ; Max number of paren/brace constructs before
+ ; we give up.
+ knr-start
+ c-last-identifier-range)
- ;; Arguments
- "("
- (zero-or-more (not (any "()")))
- (zero-or-more
- "("
- (zero-or-more (not (any "()")))
- ")"
- (zero-or-more (not (any "()"))))
- ")"
- (zero-or-more (any " \t\n"))
+ (catch 'knr
+ (while (> pp-count-out 0) ; go back one paren/bracket pair each time.
+ (setq pp-count-out (1- pp-count-out))
+ (c-syntactic-skip-backward "^)]}=;")
+ (cond ((eq (char-before) ?\))
+ (setq after-rparen (point)))
+ ((eq (char-before) ?\])
+ (setq after-rparen nil))
+ (t ; either } (hit previous defun) or = or no more
+ ; parens/brackets.
+ (throw 'knr nil)))
- ;; Pure/const etc.
- (zero-or-more
- (one-or-more (any "a-z@"))
- symbol-end
- (zero-or-more (any " \t\n")))
+ (if after-rparen
+ ;; We're inside a paren. Could it be our argument list....?
+ (if
+ (and
+ (progn
+ (goto-char after-rparen)
+ (unless (c-go-list-backward) (throw 'knr nil)) ;
+ ;; FIXME!!! What about macros between the parens?
2007/01/20
+ (setq before-lparen (point)))
- (zero-or-more
- "//"
- (zero-or-more not-newline)
- (zero-or-more space))
+ ;; It can't be the arg list if next token is ; or {
+ (progn (goto-char after-rparen)
+ (c-forward-syntactic-ws)
+ (not (memq (char-after) '(?\; ?\{ ?\=))))
- ;; ';' or 'if' or '{'
- (or
- ";"
- (and
- (zero-or-more (any " \t\n"))
- (or "if" "{")))
- ))
+ ;; Is the thing preceding the list an identifier (the
+ ;; function name), or a macro expansion?
+ (progn
+ (goto-char before-lparen)
+ (eq (c-backward-token-2) 0)
+ (or (eq (d--on-func-identifier) (point))
+ (and (eq (char-after) ?\))
+ (c-go-up-list-backward)
+ (eq (c-backward-token-2) 0)
+ (eq (d--on-func-identifier) (point)))))
-(defun d-imenu-method-index-function ()
- "Find D function declarations for imenu."
- (and
- (let ((pt))
- (setq pt (re-search-backward d-imenu-method-name-pattern nil t))
- ;; The method name regexp will match lines like
- ;; "return foo(x);" or "static if(x) {"
- ;; so we exclude type name 'static' or 'return' here
- (while (let ((type (match-string 1))
- (name (match-string 2)))
- (and pt name
- (save-match-data
- (or
- (string-match (c-lang-const d-non-func-type-kwds-re) type)
- (string-match (c-lang-const d-non-func-name-kwds-re)
name)))))
- (setq pt (re-search-backward d-imenu-method-name-pattern nil t)))
- pt)
- ;; Do not count invisible definitions.
- (let ((invis (invisible-p (point))))
- (or (not invis)
- (progn
- (while (and invis
- (not (bobp)))
- (setq invis (not (re-search-backward
- d-imenu-method-name-pattern nil 'move))))
- (not invis))))))
+ ;; Check that we're outside of the template arg list
(D-specific).
+ (progn
+ (setq knr-start
+ (progn (goto-char after-rparen)
+ (c-forward-syntactic-ws)
+ (when (eq (char-after) ?\()
+ (c-go-list-forward)
+ (c-forward-syntactic-ws))
+ (point)))
+ (<= knr-start start))
-(defvar d-imenu-generic-expression
- `(("*Classes*"
- ,(rx
- bol
- (zero-or-more space)
- (eval d--imenu-rx-def-start)
- word-start
- "class"
- (one-or-more (syntax whitespace))
- (submatch
- (one-or-more
- (any ?_
- (?0 . ?9)
- (?A . ?Z)
- (?a . ?z)))))
- 1)
- ("*Interfaces*"
- ,(rx
- bol
- (zero-or-more space)
- (eval d--imenu-rx-def-start)
- word-start
- "interface"
- (one-or-more (syntax whitespace))
- (submatch
- (one-or-more
- (any ?_
- (?0 . ?9)
- (?A . ?Z)
- (?a . ?z)))))
- 1)
- ("*Structs*"
- ,(rx
- bol
- (zero-or-more space)
- (eval d--imenu-rx-def-start)
- word-start
- "struct"
- (one-or-more (syntax whitespace))
- (submatch
- (one-or-more
- (any ?_
- (?0 . ?9)
- (?A . ?Z)
- (?a . ?z)))))
- 1)
- ("*Templates*"
- ,(rx
- bol
- (zero-or-more space)
- (eval d--imenu-rx-def-start)
- (zero-or-one
- "mixin"
- (one-or-more (syntax whitespace)))
- word-start
- "template"
- (one-or-more (syntax whitespace))
- (submatch
- (one-or-more
- (any ?_
- (?0 . ?9)
- (?A . ?Z)
- (?a . ?z)))))
- 1)
- ("*Enums*"
- ,(rx
- bol
- (zero-or-more space)
- (eval d--imenu-rx-def-start)
- word-start
- "enum"
- (one-or-more (syntax whitespace))
- (submatch
- (one-or-more
- (any ?_
- (?0 . ?9)
- (?A . ?Z)
- (?a . ?z))))
- (zero-or-more (any " \t\n"))
- (or ":" "{"))
- 1)
- ;; NB: We can't easily distinguish aliases declared outside
- ;; functions from local ones, so just search for those that are
- ;; declared at the beginning of lines.
- ("*Aliases*"
- ,(rx
- bol
- (eval d--imenu-rx-def-start)
- "alias"
- (one-or-more (syntax whitespace))
- (submatch
- (one-or-more
- (any ?_
- (?0 . ?9)
- (?A . ?Z)
- (?a . ?z))))
- (zero-or-more (syntax whitespace))
- (zero-or-one
- "("
- (zero-or-more (not (any "()")))
- ")"
- (zero-or-more (syntax whitespace)))
- "=")
- 1)
- ("*Aliases*"
- ,(rx
- bol
- (eval d--imenu-rx-def-start)
- "alias"
- (one-or-more (syntax whitespace))
- (one-or-more
- (not (any ";")))
- (one-or-more (syntax whitespace))
- (submatch
- (one-or-more
- (any ?_
- (?0 . ?9)
- (?A . ?Z)
- (?a . ?z))))
- (zero-or-more (syntax whitespace))
- ";"
- (zero-or-more (syntax whitespace))
- (or
- eol
- "//"
- "/*")
- )
- 1)
- (nil d-imenu-method-index-function 2)))
-
-;; New imenu implementation - use cc-mode machinery:
-
-(defun d-imenu-create-index-function ()
- "Create imenu entries for D-mode."
- (goto-char (point-min))
- (c-save-buffer-state
- (d-spots last-spot (d-blocks (make-hash-table)))
- (c-find-decl-spots
- (point-max)
- c-decl-start-re
- (eval c-maybe-decl-faces)
- (lambda (match-pos inside-macro toplev)
- (when toplev
- (let* ((got-context
- (c-get-fontification-context
- match-pos nil toplev))
- (context (car got-context))
- (decl-or-cast
- (when (eq context 'top)
- (c-forward-decl-or-cast-1
- match-pos
- context
- nil ; last-cast-end
- ))))
- (when (and decl-or-cast (not (eq (car decl-or-cast) last-spot)))
- (let* ((decl-end (point))
- (id-start (progn
- (goto-char (car decl-or-cast))
- (when (eq (char-after) ?=)
- (c-backward-syntactic-ws)
- (c-simple-skip-symbol-backward))
- (point)))
- (id-end (progn
- (goto-char id-start)
- (when (d-forward-name)
- (c-backward-syntactic-ws)
- (point))))
- (name (when id-end
- (buffer-substring-no-properties id-start id-end)))
- (id-prev-token (progn
- (goto-char id-start)
- (c-backward-syntactic-ws)
- (let ((end (point)))
- (when (c-simple-skip-symbol-backward)
- (buffer-substring-no-properties
(point) end)))))
- (type-start (cadddr decl-or-cast))
- (type-prev-token (when type-start
- (goto-char type-start)
- (c-backward-syntactic-ws)
- (let ((end (point)))
- (when (c-simple-skip-symbol-backward)
- (buffer-substring-no-properties
(point) end)))))
- (next-char (when id-end
- (goto-char id-end)
- (c-forward-syntactic-ws)
- (char-after)))
- (res (cond
- ((null name)
- nil)
- ((equal id-prev-token "else")
- nil) ; false positive after else
- ((equal name "{")
- nil) ; false positive with decl-start keyword and
{...} group
- ((equal id-prev-token "enum")
- '("Enums" t))
- ((equal id-prev-token "class")
- '("Classes" t))
- ((equal id-prev-token "struct")
- '("Structs" t))
- ((equal id-prev-token "template")
- '("Templates" t))
- ((equal id-prev-token "alias")
- '("Aliases" nil))
- ((equal type-prev-token "alias")
- '("Aliases" nil)) ; old-style alias
- ((memq next-char '(?\; ?= ?,))
- nil) ; '("variable" nil))
- ((member name '("import" "if"))
- nil) ; static import/if
- ((memq next-char '(?\())
- '(nil t)) ; function
- (t ; unknown
- (list id-prev-token nil))))
- (kind (car res))
- (have-block (cadr res))
- (paren-state (when res (c-parse-state)))
- (outer-brace match-pos)
- d-context
- d-fqname)
-
- (when res
- (when paren-state
- ;; Find brace with known context
- (while (and outer-brace
- (not d-context))
- (setq outer-brace (c-most-enclosing-brace paren-state
outer-brace))
- (setq d-context (gethash outer-brace d-blocks))))
+ ;; (... original c-in-knr-argdecl logic omitted here ...)
+ t)
+ ;; ...Yes. We've identified the function's argument list.
+ (throw 'knr knr-start)
+ ;; ...No. The current parens aren't the function's arg list.
+ (goto-char before-lparen))
- (setq d-fqname (if d-context (concat d-context "." name) name))
+ (or (c-go-list-backward) ; backwards over [ .... ]
+ (throw 'knr nil))))))))
- (when have-block
- (goto-char decl-end)
- (when (and (c-syntactic-re-search-forward "[{};]" nil t)
- (eq (char-before) ?{))
- (puthash (1- (point)) d-fqname d-blocks)))
+(defun d-around--c-in-knr-argdecl (orig-fun &rest args)
+ ;; checkdoc-params: (orig-fun args)
+ "Advice function for fixing cc-mode indentation in certain D constructs."
+ (apply
+ (if (c-major-mode-is 'd-mode)
+ #'d-in-knr-argdecl
+ orig-fun)
+ args))
- (setq last-spot (car decl-or-cast)
- d-spots
- (cons
- (if kind
- (cons kind (list (cons d-fqname id-start)))
- (cons d-fqname id-start))
- d-spots)))))))))
- (nreverse d-spots)))
+(advice-add 'c-in-knr-argdecl :around #'d-around--c-in-knr-argdecl)
;;----------------------------------------------------------------------------
-;;; Workaround for special case of 'else static if' not being handled properly
-(defun d-special-case-looking-at (orig-fun &rest args)
- ;; checkdoc-params: (orig-fun args)
- "Advice function for fixing cc-mode indentation in certain D constructs."
- (let ((rxp (car args)))
- (if (and (stringp rxp) (string= rxp "if\\>[^_]"))
- (or (apply orig-fun '("static\\>\\s-+if\\>[^_]"))
- (apply orig-fun '("version\\>[^_]"))
- (apply orig-fun '("debug\\>[^_]"))
- (apply orig-fun args))
- (apply orig-fun args))))
+;; We can't include "enum" in `c-typedef-decl-kwds', as that will not
+;; work well with D manifest constants (enum [TYPE] NAME = VALUE).
+;; Instead, omit it from `c-typedef-decl-kwds' (which allows manifest
+;; constants to be fontified properly), and handle actual enumerations
+;; manually by adding fontification of the enum name as a type name to
+;; our version of `c-font-lock-enum-body' below:
-(defun d-around--c-add-stmt-syntax (orig-fun &rest args)
+(defun d-font-lock-enum-body (limit)
+ "Modified version of `c-font-lock-enum-body' for d-mode." ;;
checkdoc-params: limit
+ (while (search-forward-regexp c-enum-clause-introduction-re limit t)
+ (when (save-excursion
+ (backward-char)
+ (when (c-backward-over-enum-header)
+ ;; Fontify type name here
+ (c-forward-token-2) ; Over "enum"
+ (c-forward-syntactic-ws)
+ (c-fontify-types-and-refs ((id-start (point)))
+ (when (c-forward-type)
+ (c-backward-syntactic-ws)
+ (c-put-font-lock-face id-start
+ (point)
+ 'font-lock-type-face)))
+ t))
+ ;; As in the original `c-font-lock-enum-body', fontify the body
+ ;; (enum members).
+ (c-forward-syntactic-ws)
+ (c-font-lock-declarators limit t nil t)))
+ nil)
+
+(defun d-around--c-font-lock-enum-body (orig-fun &rest args)
;; checkdoc-params: (orig-fun args)
- "Advice function for fixing cc-mode indentation in certain D constructs."
- (if (not (c-major-mode-is 'd-mode))
- (apply orig-fun args)
- (add-function :around (symbol-function 'looking-at)
- #'d-special-case-looking-at)
- (unwind-protect
- (apply orig-fun args)
- (remove-function (symbol-function 'looking-at)
- #'d-special-case-looking-at))))
+ "Advice function for fixing fontification for D enums."
+ (apply
+ (if (c-major-mode-is 'd-mode)
+ #'d-font-lock-enum-body
+ orig-fun)
+ args))
-(advice-add 'c-add-stmt-syntax :around #'d-around--c-add-stmt-syntax)
+(advice-add 'c-font-lock-enum-body :around #'d-around--c-font-lock-enum-body)
;;----------------------------------------------------------------------------
-;;; Implements handling of D constructors
-;;; Fixes e.g. indentation of contracts on constructors.
-;; Make it so that inside c-forward-decl-or-cast-1,
-;; "this" looks like a function identifier but not a type identifier.
+(defun d-forward-type (&optional brace-block-too)
+ "Modified version of `c-forward-type' for d-mode." ;; checkdoc-params:
brace-block-too
+ (let ((start (point)) pos res name-res id-start id-end id-range
saw-storage-class)
-(defun d-special-case-c-forward-name (orig-fun &rest args)
- ;; checkdoc-params: (orig-fun args)
- "Advice function for fixing cc-mode handling of D constructors."
- (if (not (looking-at (c-make-keywords-re t '("this" "~this"))))
- (apply orig-fun args)
- (goto-char (match-end 1))
- t))
+ ;; D: Parse storage classes and similar keywords.
+ ;; Technically these are not part of the type, but we parse them here
+ ;; because they can substitute the type declaration (for type inference).
+ (while (and
+ (looking-at (c-lang-const d-storage-class-key))
-(defsubst d-forward-name () "Shorthand." (d-special-case-c-forward-name
#'c-forward-name))
+ (save-excursion
+ (goto-char (match-end 1))
+ (c-forward-syntactic-ws)
+ (setq pos (point))
+ (looking-at c-identifier-start))) ; Variable name or
+ ; continuation, but NOT (
+ (goto-char pos)
+ (setq saw-storage-class t))
-(defun d-around--c-forward-decl-or-cast-1 (orig-fun &rest args)
- ;; checkdoc-params: (orig-fun args)
- "Advice function for fixing cc-mode handling of D constructors."
- (cond
- ((not (c-major-mode-is 'd-mode))
- (apply orig-fun args))
+ (cond
+ ;; D: "this" is not a type, even though it appears at the
+ ;; beginning of a "function" (constructor) declaration.
+ ((looking-at (c-make-keywords-re t '("this")))
+ nil)
- ;; D: The logic in cc-mode's `c-forward-decl-or-cast-1' will
- ;; recognize "someIdentifier in" as a variable declaration,
- ;; fontifying someIdentifier as a type. Prevent this here.
- ((save-excursion
- (and
- (looking-at c-identifier-start)
- (progn
- (c-forward-token-2)
- (looking-at (c-make-keywords-re t '("in"))))))
- nil)
+ ;; D: Storage class substituting the type (e.g. auto)
+ ((and
+ saw-storage-class
+ (not (looking-at (c-lang-const d-type-modifier-key)))
+ (save-excursion
+ (c-forward-token-2) ; maybe variable/function name
+ (looking-at "[(;=]")))
+ (setq res t))
+
+ ;; D: const/immutable/...(...)
+ ((looking-at (c-lang-const d-type-modifier-key))
+ (when
+ (and
+ ;; Followed by a ( ?
+ (progn
+ (goto-char (match-end 1))
+ (c-forward-syntactic-ws)
+ (looking-at "("))
+ ;; Followed by a type in the parens?
+ (progn
+ (forward-char)
+ (c-forward-syntactic-ws)
+ (c-forward-type))
+ ;; Followed by a closing ) ?
+ (progn
+ (c-forward-syntactic-ws)
+ (looking-at ")")))
+ (forward-char)
+ (c-forward-syntactic-ws)
+ (setq res 'prefix)))
+
+ ;; Identifier
+ ((progn
+ (setq pos nil)
+ (if (looking-at c-identifier-start)
+ (save-excursion
+ (setq id-start (point)
+ name-res (c-forward-name))
+ (when name-res
+ (setq id-end (point)
+ id-range c-last-identifier-range))))
+ (and (cond ((looking-at c-primitive-type-key)
+ (setq res t))
+ ((c-with-syntax-table c-identifier-syntax-table
+ (looking-at c-known-type-key))
+ (setq res 'known)))
+ (or (not id-end)
+ (>= (save-excursion
+ (save-match-data
+ (goto-char (match-end 1))
+ (c-forward-syntactic-ws)
+ (setq pos (point))))
+ id-end)
+ (setq res nil))))
+ ;; Looking at a primitive or known type identifier. We've
+ ;; checked for a name first so that we don't go here if the
+ ;; known type match only is a prefix of another name.
- ;; D: cc-mode gets confused due to "scope" being a keyword that can
- ;; both be part of declarations (as a storage class), and a
- ;; statement (e.g. "scope(exit)"). Disambiguate them here.
- ((save-excursion
- (and
- (looking-at (c-make-keywords-re t '("scope")))
- (progn
- (c-forward-token-2)
- (looking-at "("))))
- nil)
+ (setq id-end (match-end 1))
- ;; D: The "else" following a "version" or "static if" can start a
- ;; declaration even without a { } block. For this reason, "else" is
- ;; in `c-decl-start-kwds'.
- ;; However, cc-mode invokes `c-forward-decl-or-cast-1' with point
- ;; at the "else" keyword, which, when followed by a function call,
- ;; is mis-parsed as a function declaration.
- ;; Fix this by moving point forward, past the "else" keyword, to
- ;; put cc-mode on the right track.
- ((looking-at (c-make-keywords-re t '("else")))
- (goto-char (match-end 1))
- (c-forward-syntactic-ws)
- (apply orig-fun args))
+ (when (and c-record-type-identifiers
+ (or c-promote-possible-types (eq res t)))
+ (c-record-type-id (cons (match-beginning 1) (match-end 1))))
- (t
- ;; Work around a cc-mode bug(?) in which the c-forward-annotation
- ;; calls in c-forward-decl-or-cast-1 do not advance the start
- ;; position, causing the annotation to be fontified as the
- ;; function name.
- (while (c-forward-annotation)
- (c-forward-syntactic-ws))
+ (unless (save-match-data (c-forward-keyword-clause 1))
+ (if pos
+ (goto-char pos)
+ (goto-char (match-end 1))
+ (c-forward-syntactic-ws))))
- (add-function :around (symbol-function 'c-forward-name)
- #'d-special-case-c-forward-name)
- (unwind-protect
- (apply orig-fun args)
- (remove-function (symbol-function 'c-forward-name)
- #'d-special-case-c-forward-name)))))
+ (name-res
+ (cond ((eq name-res t)
+ ;; A normal identifier.
+ (goto-char id-end)
+ (if (or res c-promote-possible-types)
+ (progn
+ (c-add-type id-start id-end)
+ (when (and c-record-type-identifiers id-range)
+ (c-record-type-id id-range))
+ (unless res
+ (setq res 'found)))
+ (setq res (if (c-check-type id-start id-end)
+ ;; It's an identifier that has been used as
+ ;; a type somewhere else.
+ 'found
+ ;; It's an identifier that might be a type.
+ 'maybe))))
+ (t
+ ;; Otherwise it's an operator identifier, which is not a type.
+ (goto-char start)
+ (setq res nil)))))
-(advice-add 'c-forward-decl-or-cast-1 :around
#'d-around--c-forward-decl-or-cast-1)
+ (when res
+ ;; D: Skip over template parameters, if any
+ (when (looking-at "!")
+ (forward-char)
+ (c-forward-syntactic-ws)
+ (c-forward-sexp)
+ (c-forward-syntactic-ws))
-;;----------------------------------------------------------------------------
+ ;; D: Descend into scope names
+ (when (looking-at "[.]")
+ (forward-char)
+ (c-forward-syntactic-ws)
+ (unless (d-forward-type)
+ (setq res nil)))
-(defun d-around--c-get-fontification-context (orig-fun match-pos &rest args)
- ;; checkdoc-params: (orig-fun match-pos args)
- "Advice function for fixing cc-mode handling of D lambda parameter lists."
- (let ((res (apply orig-fun match-pos args)))
- (when (and
- (c-major-mode-is 'd-mode)
- (eq (car res) nil)
- (save-excursion
- (goto-char match-pos )
- (c-backward-syntactic-ws)
- (eq (char-before) ?\()))
- (setq res (cons 'arglist t)))
- res))
-(advice-add 'c-get-fontification-context :around
#'d-around--c-get-fontification-context)
+ ;; Step over any type suffix operator. Do not let the existence
+ ;; of these alter the classification of the found type, since
+ ;; these operators typically are allowed in normal expressions
+ ;; too.
+ (when c-opt-type-suffix-key ; e.g. "..."
+ (while (looking-at c-opt-type-suffix-key)
+ (goto-char (match-end 1))
+ (c-forward-syntactic-ws)))
-;;----------------------------------------------------------------------------
-;;; Fixes fontification of constructor parameter lists in D code.
+ (when (and c-record-found-types (memq res '(known found)) id-range)
+ (setq c-record-found-types
+ (cons id-range c-record-found-types))))
-(defun d-special-case-looking-at-2 (orig-fun regexp)
- ;; checkdoc-params: (orig-fun regexp)
- "Advice function for fixing cc-mode handling of D constructors."
- (if (and
- (eq regexp c-not-decl-init-keywords)
- (apply orig-fun (c-make-keywords-re t '("this")) nil)) ; looking-at
"this"
- nil
- (apply orig-fun regexp nil)))
+ ;;(message "c-forward-type %s -> %s: %s" start (point) res)
-(defun d-around--c-font-lock-declarations (orig-fun &rest args)
+ (unless res
+ (when saw-storage-class
+ (goto-char start)))
+
+ res))
+
+(defun d-around--c-forward-type (orig-fun &rest args)
;; checkdoc-params: (orig-fun args)
- "Advice function for fixing cc-mode handling of D constructors."
- (if (not (c-major-mode-is 'd-mode))
- (apply orig-fun args)
- (add-function :around (symbol-function 'looking-at)
- #'d-special-case-looking-at-2)
- (unwind-protect
- (apply orig-fun args)
- (remove-function (symbol-function 'looking-at)
- #'d-special-case-looking-at-2))))
+ "Advice function for fixing fontification for D enums."
+ (apply
+ (if (c-major-mode-is 'd-mode)
+ #'d-forward-type
+ orig-fun)
+ args))
-(advice-add 'c-font-lock-declarations :around
#'d-around--c-font-lock-declarations)
+(advice-add 'c-forward-type :around #'d-around--c-forward-type)
;;----------------------------------------------------------------------------
-;; Borrowed from
https://github.com/josteink/csharp-mode/blob/master/csharp-mode.el
-(defun d--syntax-propertize-function (beg end)
- "Apply syntax table properties to special constructs in region BEG to END.
-Currently handles `-delimited string literals."
- (save-excursion
- (goto-char beg)
- (while (search-forward "`" end t)
- (let ((in-comment-or-string-p (save-excursion
- (goto-char (match-beginning 0))
- (or (nth 3 (syntax-ppss))
- (nth 4 (syntax-ppss))))))
- (when (not in-comment-or-string-p)
- (let (done)
- (while (and (not done) (< (point) end))
- (skip-chars-forward "^`\\\\" end)
- (cond
- ((= (following-char) ?\\)
- (put-text-property (point) (1+ (point))
- 'syntax-table (string-to-syntax "."))
- (forward-char 1))
- ((= (following-char) ?\`)
- (forward-char 1)
- (setq done t))))))))))
+
+(c-lang-defconst d-flat-decl-maybe-block-kwds
+ ;; Keywords which don't introduce a scope, and may or may not be
+ ;; followed by a {...} block.
+ d (append (c-lang-const c-modifier-kwds)
+ (list "else" ; for version / static if
+ "if" ; static if
+ "version")))
+(c-lang-defconst d-flat-decl-maybe-block-re
+ d (c-make-keywords-re t (c-lang-const d-flat-decl-maybe-block-kwds)))
+
+(defun d-update-brace-stack (stack from to)
+ "Modified version of `c-update-brace-stack' for d-mode." ;; checkdoc-params:
(stack from to)
+ ;; Given a brace-stack which has the value STACK at position FROM, update it
+ ;; to its value at position TO, where TO is after (or equal to) FROM.
+ ;; Return a cons of either TO (if it is outside a literal) and this new
+ ;; value, or of the next position after TO outside a literal and the new
+ ;; value.
+ (let (match kwd-sym (prev-match-pos 1)
+ (s (cdr stack))
+ (bound-<> (car stack)))
+ (save-excursion
+ (cond
+ ((and bound-<> (<= to bound-<>))
+ (goto-char to)) ; Nothing to do.
+ (bound-<>
+ (goto-char bound-<>)
+ (setq bound-<> nil))
+ (t (goto-char from)))
+ (while (and (< (point) to)
+ (c-syntactic-re-search-forward
+ (if (<= (car s) 0)
+ c-brace-stack-thing-key
+ c-brace-stack-no-semi-key)
+ to 'after-literal)
+ (> (point) prev-match-pos)) ; prevent infinite loop.
+ (setq prev-match-pos (point))
+ (setq match (match-string-no-properties 1)
+ kwd-sym (c-keyword-sym match))
+ (cond
+ ((and (equal match "{")
+ (progn (backward-char)
+ (prog1 (looking-at "\\s(")
+ (forward-char))))
+ (setq s (if s
+ ;; D: Constructs such as "version", "static if", or
+ ;; "extern(...)" may or may not enclose their declarations
+ ;; in a {...} block. For this reason, we can't blindly
+ ;; update the cc-mode brace stack when we see these
keywords
+ ;; (otherwise, if they are not immediately succeeded by a
+ ;; {...} block, then the brace stack change will apply to
+ ;; the next encountered {...} block such as that of a
+ ;; function's).
+ (if (save-excursion
+ (backward-char)
+ (c-backward-syntactic-ws)
+ (when (eq (char-before) ?\))
+ (c-backward-sexp)
+ (c-backward-syntactic-ws))
+ (c-backward-token-2)
+ (looking-at (c-lang-const
d-flat-decl-maybe-block-re)))
+ ;; D: Keep the brace stack state from the parent
+ ;; context. I.e., the contents of a "static if" at the
+ ;; top level should remain top-level, but in a
function,
+ ;; it should remain non-top-level.
+ s
+ (cons (if (<= (car s) 0)
+ 1
+ (1+ (car s)))
+ (cdr s)))
+ (list 1))))
+ ((and (equal match "}")
+ (progn (backward-char)
+ (prog1 (looking-at "\\s)")
+ (forward-char))))
+ (setq s
+ (cond
+ ((and s (> (car s) 1))
+ (cons (1- (car s)) (cdr s)))
+ ((and (cdr s) (eq (car s) 1))
+ (cdr s))
+ (t s))))
+ ((and (equal match ":")
+ s
+ (eq (car s) 0))
+ (setq s (cons -1 (cdr s))))
+ ((and (equal match ",")
+ (eq (car s) -1))) ; at "," in "class foo : bar, ..."
+ ((member match '(";" "," ")"))
+ (when (and s (cdr s) (<= (car s) 0))
+ (setq s (cdr s))))
+ ((c-keyword-member kwd-sym 'c-flat-decl-block-kwds)
+ (push 0 s))))
+ ;; The failing `c-syntactic-re-search-forward' may have left us in the
+ ;; middle of a token, which might be a significant token. Fix this!
+ (c-beginning-of-current-token)
+ (cons (point)
+ (cons bound-<> s)))))
+
+(defun d-around--c-update-brace-stack (orig-fun &rest args)
+ ;; checkdoc-params: (orig-fun args)
+ "Advice function for fixing cc-mode handling of certain D constructs."
+ (apply
+ (if (c-major-mode-is 'd-mode)
+ #'d-update-brace-stack
+ orig-fun)
+ args))
+
+(advice-add 'c-update-brace-stack :around #'d-around--c-update-brace-stack)
;;----------------------------------------------------------------------------
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.d[i]?\\'" . d-mode))
+;; Support for fontifying module name(s) after a module or import keyword.
-;; Custom variables
-;;;###autoload
-(defcustom d-mode-hook nil
- "*Hook called by `d-mode'."
- :type 'hook
- :group 'c)
+(defun d-forward-module-clause ()
+ "Fontify the module name(s) after a module or import keyword."
+ (let (safe-pos pos)
+ (goto-char (match-end 1))
+ (while
+ (progn
+ (c-forward-syntactic-ws)
+ (setq safe-pos (point))
+ (cond
+ ((looking-at c-identifier-start)
+ ;; identifier
+ (setq c-last-identifier-range nil)
+ (forward-char)
+ (c-end-of-current-token)
+ (when c-record-type-identifiers
+ (c-record-ref-id (cons safe-pos (point))))
+ t)
+ ;; . or , or = (keep fontifying)
+ ((memq (char-after) '(?. ?, ?=))
+ (forward-char)
+ t)
+ ;; ; or : or anything else weird
+ (t
+ nil))))
+ (goto-char safe-pos)
+ t))
-;;;###autoload
-(define-derived-mode d-mode prog-mode "D"
- "Major mode for editing code written in the D Programming Language.
+;; ----------------------------------------------------------------------------
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;; compilation-mode support ;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ----------------------------------------------------------------------------
-See http://dlang.org for more information about the D language.
+;;; Patterns to recognize the compiler generated messages
-The hook `c-mode-common-hook' is run with no args at mode
-initialization, then `d-mode-hook'.
+(defun d-mode-add-dmd-message-pattern (expr level symbol)
+ "Register DMD `compile' pattern for an error level.
-Key bindings:
-\\{d-mode-map}"
- (c-initialize-cc-mode t)
- (setq local-abbrev-table d-mode-abbrev-table
- abbrev-mode t)
- (use-local-map d-mode-map)
- (c-init-language-vars d-mode)
- (when (fboundp 'c-make-noise-macro-regexps)
- (c-make-noise-macro-regexps))
+EXPR is the `rx' message sub-expression indicating the error level LEVEL.
+The expression is added to `compilation-error-regexp-alist' and
+`compilation-error-regexp-alist-alist' as SYMBOL."
+ (add-to-list
+ 'compilation-error-regexp-alist-alist
+ `(,symbol
+ ,(rx-to-string
+ `(and
+ line-start
+ (group-n 1 (one-or-more any)) ; File name
+ "("
+ (group-n 2 (one-or-more digit)) ; Line number
+ (zero-or-one
+ ","
+ (group-n 3 (one-or-more digit))) ; Column number
+ "): "
+ ,expr
+ (group-n 4 (one-or-more nonl)) ; Message
+ line-end))
+ 1 2 3 ,level 4))
+ (add-to-list 'compilation-error-regexp-alist symbol))
- ;; Generate a function that applies D-specific syntax properties.
- ;; Concretely, inside back-quoted string literals the backslash
- ;; character '\' is treated as a punctuation symbol. See help for
- ;; syntax-propertize-rules function for more information.
- (setq-local
- syntax-propertize-function
- #'d--syntax-propertize-function)
+(d-mode-add-dmd-message-pattern "Error: " 2 'dmd-error )
+(d-mode-add-dmd-message-pattern "Warning: " 1 'dmd-warning )
+(d-mode-add-dmd-message-pattern "Deprecation: " 1 'dmd-deprecation )
+(d-mode-add-dmd-message-pattern '(one-or-more " ") 0 'dmd-continuation)
- (c-common-init 'd-mode)
- (easy-menu-add d-menu)
- (c-run-mode-hooks 'c-mode-common-hook 'd-mode-hook)
- (c-update-modeline)
- (if (fboundp 'c-get-fontification-context)
- (cc-imenu-init nil #'d-imenu-create-index-function)
- (cc-imenu-init d-imenu-generic-expression)))
+;; The following regexp recognizes messages generated by the D runtime for
+;; unhandled exceptions (e.g. assert failures).
-;;----------------------------------------------------------------------------
+(add-to-list 'compilation-error-regexp-alist-alist
+ '(d-exceptions
+ "^[a-zA-Z0-9.]*?@\\(.*?\\)(\\([0-9]+\\)):"
+ 1 2 nil 2))
+(add-to-list 'compilation-error-regexp-alist 'd-exceptions)
-(defun d--on-func-identifier ()
- "Version of `c-on-identifier', but also match D constructors."
- (save-excursion
- (skip-syntax-backward "w_")
+;; ----------------------------------------------------------------------------
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; imenu support ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ----------------------------------------------------------------------------
- (or
- ;; Check for a normal (non-keyword) identifier.
- (and (looking-at c-symbol-start)
- (or
- (looking-at (c-make-keywords-re t '("this" "~this")))
- (not (looking-at c-keywords-regexp)))
- (point)))))
+;; Old imenu implementation - regular expressions:
-(defun d-in-knr-argdecl (&optional lim)
- "Modified version of `c-in-knr-argdecl' for d-mode." ;; checkdoc-params: lim
- (save-excursion
- ;; If we're in a macro, our search range is restricted to it. Narrow to
- ;; the searchable range.
- (let* ((start (point))
- before-lparen
- after-rparen
- (pp-count-out 20) ; Max number of paren/brace constructs before
- ; we give up.
- knr-start
- c-last-identifier-range)
+(eval-when-compile
+ (defconst d--imenu-rx-def-start
+ '(seq
+ ;; Conditionals
+ (zero-or-one
+ "else"
+ (zero-or-more space))
+ (zero-or-one
+ "version"
+ (zero-or-more space)
+ "("
+ (zero-or-more space)
+ (one-or-more (any "a-zA-Z0-9_"))
+ (zero-or-more space)
+ ")"
+ (zero-or-more space))
- (catch 'knr
- (while (> pp-count-out 0) ; go back one paren/bracket pair each time.
- (setq pp-count-out (1- pp-count-out))
- (c-syntactic-skip-backward "^)]}=;")
- (cond ((eq (char-before) ?\))
- (setq after-rparen (point)))
- ((eq (char-before) ?\])
- (setq after-rparen nil))
- (t ; either } (hit previous defun) or = or no more
- ; parens/brackets.
- (throw 'knr nil)))
+ (zero-or-more
+ (or
+ word-start
+ (or
+ ;; StorageClass
+ "deprecated"
+ "static"
+ "extern"
+ "abstract"
+ "final"
+ "override"
+ "synchronized"
+ "scope"
+ "nothrow"
+ "pure"
+ "ref"
+ (seq
+ (or
+ "extern"
+ "deprecated"
+ "package"
+ )
+ (zero-or-more space)
+ "("
+ (zero-or-more space)
+ (one-or-more (not (any "()")))
+ (zero-or-more space)
+ ")")
- (if after-rparen
- ;; We're inside a paren. Could it be our argument list....?
- (if
- (and
- (progn
- (goto-char after-rparen)
- (unless (c-go-list-backward) (throw 'knr nil)) ;
- ;; FIXME!!! What about macros between the parens?
2007/01/20
- (setq before-lparen (point)))
+ ;; VisibilityAttribute
+ "private"
+ "package"
+ "protected"
+ "public"
+ "export"
+ )
- ;; It can't be the arg list if next token is ; or {
- (progn (goto-char after-rparen)
- (c-forward-syntactic-ws)
- (not (memq (char-after) '(?\; ?\{ ?\=))))
+ ;; AtAttribute
+ (seq
+ "@"
+ (one-or-more (any "a-zA-Z0-9_"))
+ (zero-or-one
+ (zero-or-more space)
+ "("
+ (zero-or-more space)
+ (one-or-more (not (any "()")))
+ (zero-or-more space)
+ ")")))
+ (zero-or-more space))
- ;; Is the thing preceding the list an identifier (the
- ;; function name), or a macro expansion?
- (progn
- (goto-char before-lparen)
- (eq (c-backward-token-2) 0)
- (or (eq (d--on-func-identifier) (point))
- (and (eq (char-after) ?\))
- (c-go-up-list-backward)
- (eq (c-backward-token-2) 0)
- (eq (d--on-func-identifier) (point)))))
+ )))
- ;; Check that we're outside of the template arg list
(D-specific).
- (progn
- (setq knr-start
- (progn (goto-char after-rparen)
- (c-forward-syntactic-ws)
- (when (eq (char-after) ?\()
- (c-go-list-forward)
- (c-forward-syntactic-ws))
- (point)))
- (<= knr-start start))
+(defconst d-imenu-method-name-pattern
+ (rx
+ ;; Whitespace
+ bol
+ (zero-or-more space)
+
+ (eval d--imenu-rx-def-start)
- ;; (... original c-in-knr-argdecl logic omitted here ...)
- t)
- ;; ...Yes. We've identified the function's argument list.
- (throw 'knr knr-start)
- ;; ...No. The current parens aren't the function's arg list.
- (goto-char before-lparen))
+ ;; Type
+ (group
+ (one-or-more (any "a-zA-Z0-9_.*![]()")))
+ (one-or-more space)
- (or (c-go-list-backward) ; backwards over [ .... ]
- (throw 'knr nil))))))))
+ ;; Function name
+ (group
+ (one-or-more (any "a-zA-Z0-9_")))
+ (zero-or-more space)
-(defun d-around--c-in-knr-argdecl (orig-fun &rest args)
- ;; checkdoc-params: (orig-fun args)
- "Advice function for fixing cc-mode indentation in certain D constructs."
- (apply
- (if (c-major-mode-is 'd-mode)
- #'d-in-knr-argdecl
- orig-fun)
- args))
+ ;; Type arguments
+ (zero-or-one
+ "(" (zero-or-more (not (any ")"))) ")"
+ (zero-or-more (any " \t\n")))
-(advice-add 'c-in-knr-argdecl :around #'d-around--c-in-knr-argdecl)
+ ;; Arguments
+ "("
+ (zero-or-more (not (any "()")))
+ (zero-or-more
+ "("
+ (zero-or-more (not (any "()")))
+ ")"
+ (zero-or-more (not (any "()"))))
+ ")"
+ (zero-or-more (any " \t\n"))
-;;----------------------------------------------------------------------------
-;; We can't include "enum" in `c-typedef-decl-kwds', as that will not
-;; work well with D manifest constants (enum [TYPE] NAME = VALUE).
-;; Instead, omit it from `c-typedef-decl-kwds' (which allows manifest
-;; constants to be fontified properly), and handle actual enumerations
-;; manually by adding fontification of the enum name as a type name to
-;; our version of `c-font-lock-enum-body' below:
+ ;; Pure/const etc.
+ (zero-or-more
+ (one-or-more (any "a-z@"))
+ symbol-end
+ (zero-or-more (any " \t\n")))
-(defun d-font-lock-enum-body (limit)
- "Modified version of `c-font-lock-enum-body' for d-mode." ;;
checkdoc-params: limit
- (while (search-forward-regexp c-enum-clause-introduction-re limit t)
- (when (save-excursion
- (backward-char)
- (when (c-backward-over-enum-header)
- ;; Fontify type name here
- (c-forward-token-2) ; Over "enum"
- (c-forward-syntactic-ws)
- (c-fontify-types-and-refs ((id-start (point)))
- (when (c-forward-type)
- (c-backward-syntactic-ws)
- (c-put-font-lock-face id-start
- (point)
- 'font-lock-type-face)))
- t))
- ;; As in the original `c-font-lock-enum-body', fontify the body
- ;; (enum members).
- (c-forward-syntactic-ws)
- (c-font-lock-declarators limit t nil t)))
- nil)
+ (zero-or-more
+ "//"
+ (zero-or-more not-newline)
+ (zero-or-more space))
-(defun d-around--c-font-lock-enum-body (orig-fun &rest args)
- ;; checkdoc-params: (orig-fun args)
- "Advice function for fixing fontification for D enums."
- (apply
- (if (c-major-mode-is 'd-mode)
- #'d-font-lock-enum-body
- orig-fun)
- args))
+ ;; ';' or 'if' or '{'
+ (or
+ ";"
+ (and
+ (zero-or-more (any " \t\n"))
+ (or "if" "{")))
+ ))
-(advice-add 'c-font-lock-enum-body :around #'d-around--c-font-lock-enum-body)
+(defun d-imenu-method-index-function ()
+ "Find D function declarations for imenu."
+ (and
+ (let ((pt))
+ (setq pt (re-search-backward d-imenu-method-name-pattern nil t))
+ ;; The method name regexp will match lines like
+ ;; "return foo(x);" or "static if(x) {"
+ ;; so we exclude type name 'static' or 'return' here
+ (while (let ((type (match-string 1))
+ (name (match-string 2)))
+ (and pt name
+ (save-match-data
+ (or
+ (string-match (c-lang-const d-non-func-type-kwds-re) type)
+ (string-match (c-lang-const d-non-func-name-kwds-re)
name)))))
+ (setq pt (re-search-backward d-imenu-method-name-pattern nil t)))
+ pt)
+ ;; Do not count invisible definitions.
+ (let ((invis (invisible-p (point))))
+ (or (not invis)
+ (progn
+ (while (and invis
+ (not (bobp)))
+ (setq invis (not (re-search-backward
+ d-imenu-method-name-pattern nil 'move))))
+ (not invis))))))
+
+(defvar d-imenu-generic-expression
+ `(("*Classes*"
+ ,(rx
+ bol
+ (zero-or-more space)
+ (eval d--imenu-rx-def-start)
+ word-start
+ "class"
+ (one-or-more (syntax whitespace))
+ (submatch
+ (one-or-more
+ (any ?_
+ (?0 . ?9)
+ (?A . ?Z)
+ (?a . ?z)))))
+ 1)
+ ("*Interfaces*"
+ ,(rx
+ bol
+ (zero-or-more space)
+ (eval d--imenu-rx-def-start)
+ word-start
+ "interface"
+ (one-or-more (syntax whitespace))
+ (submatch
+ (one-or-more
+ (any ?_
+ (?0 . ?9)
+ (?A . ?Z)
+ (?a . ?z)))))
+ 1)
+ ("*Structs*"
+ ,(rx
+ bol
+ (zero-or-more space)
+ (eval d--imenu-rx-def-start)
+ word-start
+ "struct"
+ (one-or-more (syntax whitespace))
+ (submatch
+ (one-or-more
+ (any ?_
+ (?0 . ?9)
+ (?A . ?Z)
+ (?a . ?z)))))
+ 1)
+ ("*Templates*"
+ ,(rx
+ bol
+ (zero-or-more space)
+ (eval d--imenu-rx-def-start)
+ (zero-or-one
+ "mixin"
+ (one-or-more (syntax whitespace)))
+ word-start
+ "template"
+ (one-or-more (syntax whitespace))
+ (submatch
+ (one-or-more
+ (any ?_
+ (?0 . ?9)
+ (?A . ?Z)
+ (?a . ?z)))))
+ 1)
+ ("*Enums*"
+ ,(rx
+ bol
+ (zero-or-more space)
+ (eval d--imenu-rx-def-start)
+ word-start
+ "enum"
+ (one-or-more (syntax whitespace))
+ (submatch
+ (one-or-more
+ (any ?_
+ (?0 . ?9)
+ (?A . ?Z)
+ (?a . ?z))))
+ (zero-or-more (any " \t\n"))
+ (or ":" "{"))
+ 1)
+ ;; NB: We can't easily distinguish aliases declared outside
+ ;; functions from local ones, so just search for those that are
+ ;; declared at the beginning of lines.
+ ("*Aliases*"
+ ,(rx
+ bol
+ (eval d--imenu-rx-def-start)
+ "alias"
+ (one-or-more (syntax whitespace))
+ (submatch
+ (one-or-more
+ (any ?_
+ (?0 . ?9)
+ (?A . ?Z)
+ (?a . ?z))))
+ (zero-or-more (syntax whitespace))
+ (zero-or-one
+ "("
+ (zero-or-more (not (any "()")))
+ ")"
+ (zero-or-more (syntax whitespace)))
+ "=")
+ 1)
+ ("*Aliases*"
+ ,(rx
+ bol
+ (eval d--imenu-rx-def-start)
+ "alias"
+ (one-or-more (syntax whitespace))
+ (one-or-more
+ (not (any ";")))
+ (one-or-more (syntax whitespace))
+ (submatch
+ (one-or-more
+ (any ?_
+ (?0 . ?9)
+ (?A . ?Z)
+ (?a . ?z))))
+ (zero-or-more (syntax whitespace))
+ ";"
+ (zero-or-more (syntax whitespace))
+ (or
+ eol
+ "//"
+ "/*")
+ )
+ 1)
+ (nil d-imenu-method-index-function 2)))
;;----------------------------------------------------------------------------
+;; New imenu implementation - use cc-mode machinery:
-(defun d-forward-type (&optional brace-block-too)
- "Modified version of `c-forward-type' for d-mode." ;; checkdoc-params:
brace-block-too
- (let ((start (point)) pos res name-res id-start id-end id-range
saw-storage-class)
+(defun d-imenu-create-index-function ()
+ "Create imenu entries for D-mode."
+ (goto-char (point-min))
+ (c-save-buffer-state
+ (d-spots last-spot (d-blocks (make-hash-table)))
+ (c-find-decl-spots
+ (point-max)
+ c-decl-start-re
+ (eval c-maybe-decl-faces)
+ (lambda (match-pos inside-macro toplev)
+ (when toplev
+ (let* ((got-context
+ (c-get-fontification-context
+ match-pos nil toplev))
+ (context (car got-context))
+ (decl-or-cast
+ (when (eq context 'top)
+ (c-forward-decl-or-cast-1
+ match-pos
+ context
+ nil ; last-cast-end
+ ))))
+ (when (and decl-or-cast (not (eq (car decl-or-cast) last-spot)))
+ (let* ((decl-end (point))
+ (id-start (progn
+ (goto-char (car decl-or-cast))
+ (when (eq (char-after) ?=)
+ (c-backward-syntactic-ws)
+ (c-simple-skip-symbol-backward))
+ (point)))
+ (id-end (progn
+ (goto-char id-start)
+ (when (d-forward-name)
+ (c-backward-syntactic-ws)
+ (point))))
+ (name (when id-end
+ (buffer-substring-no-properties id-start id-end)))
+ (id-prev-token (progn
+ (goto-char id-start)
+ (c-backward-syntactic-ws)
+ (let ((end (point)))
+ (when (c-simple-skip-symbol-backward)
+ (buffer-substring-no-properties
(point) end)))))
+ (type-start (cadddr decl-or-cast))
+ (type-prev-token (when type-start
+ (goto-char type-start)
+ (c-backward-syntactic-ws)
+ (let ((end (point)))
+ (when (c-simple-skip-symbol-backward)
+ (buffer-substring-no-properties
(point) end)))))
+ (next-char (when id-end
+ (goto-char id-end)
+ (c-forward-syntactic-ws)
+ (char-after)))
+ (res (cond
+ ((null name)
+ nil)
+ ((equal id-prev-token "else")
+ nil) ; false positive after else
+ ((equal name "{")
+ nil) ; false positive with decl-start keyword and
{...} group
+ ((equal id-prev-token "enum")
+ '("Enums" t))
+ ((equal id-prev-token "class")
+ '("Classes" t))
+ ((equal id-prev-token "struct")
+ '("Structs" t))
+ ((equal id-prev-token "template")
+ '("Templates" t))
+ ((equal id-prev-token "alias")
+ '("Aliases" nil))
+ ((equal type-prev-token "alias")
+ '("Aliases" nil)) ; old-style alias
+ ((memq next-char '(?\; ?= ?,))
+ nil) ; '("variable" nil))
+ ((member name '("import" "if"))
+ nil) ; static import/if
+ ((memq next-char '(?\())
+ '(nil t)) ; function
+ (t ; unknown
+ (list id-prev-token nil))))
+ (kind (car res))
+ (have-block (cadr res))
+ (paren-state (when res (c-parse-state)))
+ (outer-brace match-pos)
+ d-context
+ d-fqname)
- ;; D: Parse storage classes and similar keywords.
- ;; Technically these are not part of the type, but we parse them here
- ;; because they can substitute the type declaration (for type inference).
- (while (and
- (looking-at (c-lang-const d-storage-class-key))
+ (when res
+ (when paren-state
+ ;; Find brace with known context
+ (while (and outer-brace
+ (not d-context))
+ (setq outer-brace (c-most-enclosing-brace paren-state
outer-brace))
+ (setq d-context (gethash outer-brace d-blocks))))
- (save-excursion
- (goto-char (match-end 1))
- (c-forward-syntactic-ws)
- (setq pos (point))
- (looking-at c-identifier-start))) ; Variable name or
- ; continuation, but NOT (
- (goto-char pos)
- (setq saw-storage-class t))
+ (setq d-fqname (if d-context (concat d-context "." name) name))
- (cond
- ;; D: "this" is not a type, even though it appears at the
- ;; beginning of a "function" (constructor) declaration.
- ((looking-at (c-make-keywords-re t '("this")))
- nil)
+ (when have-block
+ (goto-char decl-end)
+ (when (and (c-syntactic-re-search-forward "[{};]" nil t)
+ (eq (char-before) ?{))
+ (puthash (1- (point)) d-fqname d-blocks)))
- ;; D: Storage class substituting the type (e.g. auto)
- ((and
- saw-storage-class
- (not (looking-at (c-lang-const d-type-modifier-key)))
- (save-excursion
- (c-forward-token-2) ; maybe variable/function name
- (looking-at "[(;=]")))
- (setq res t))
+ (setq last-spot (car decl-or-cast)
+ d-spots
+ (cons
+ (if kind
+ (cons kind (list (cons d-fqname id-start)))
+ (cons d-fqname id-start))
+ d-spots)))))))))
+ (nreverse d-spots)))
- ;; D: const/immutable/...(...)
- ((looking-at (c-lang-const d-type-modifier-key))
- (when
- (and
- ;; Followed by a ( ?
- (progn
- (goto-char (match-end 1))
- (c-forward-syntactic-ws)
- (looking-at "("))
- ;; Followed by a type in the parens?
- (progn
- (forward-char)
- (c-forward-syntactic-ws)
- (c-forward-type))
- ;; Followed by a closing ) ?
- (progn
- (c-forward-syntactic-ws)
- (looking-at ")")))
- (forward-char)
- (c-forward-syntactic-ws)
- (setq res 'prefix)))
+;; ----------------------------------------------------------------------------
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; Major mode definition ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ----------------------------------------------------------------------------
- ;; Identifier
- ((progn
- (setq pos nil)
- (if (looking-at c-identifier-start)
- (save-excursion
- (setq id-start (point)
- name-res (c-forward-name))
- (when name-res
- (setq id-end (point)
- id-range c-last-identifier-range))))
- (and (cond ((looking-at c-primitive-type-key)
- (setq res t))
- ((c-with-syntax-table c-identifier-syntax-table
- (looking-at c-known-type-key))
- (setq res 'known)))
- (or (not id-end)
- (>= (save-excursion
- (save-match-data
- (goto-char (match-end 1))
- (c-forward-syntactic-ws)
- (setq pos (point))))
- id-end)
- (setq res nil))))
- ;; Looking at a primitive or known type identifier. We've
- ;; checked for a name first so that we don't go here if the
- ;; known type match only is a prefix of another name.
+(defcustom d-font-lock-extra-types nil
+ "*List of extra types (aside from the type keywords) to recognize in D mode.
- (setq id-end (match-end 1))
+Each list item should be a regexp matching a single identifier."
+ :type '(repeat regexp)
+ :group 'd-mode)
- (when (and c-record-type-identifiers
- (or c-promote-possible-types (eq res t)))
- (c-record-type-id (cons (match-beginning 1) (match-end 1))))
+(c-lang-defconst c-basic-matchers-after
+ d (append
+ ;; D module and import statements
+ (list (c-make-font-lock-BO-decl-search-function
+ (c-make-keywords-re t (c-lang-const c-ref-list-kwds))
+ '((c-fontify-types-and-refs ()
+ (d-forward-module-clause)
+ (if (> (point) limit) (goto-char limit))))))
+ ;; cc-mode defaults
+ (c-lang-const c-basic-matchers-after)))
- (unless (save-match-data (c-forward-keyword-clause 1))
- (if pos
- (goto-char pos)
- (goto-char (match-end 1))
- (c-forward-syntactic-ws))))
+(defconst d-font-lock-keywords-1 (c-lang-const c-matchers-1 d)
+ "Minimal highlighting for D mode.")
- (name-res
- (cond ((eq name-res t)
- ;; A normal identifier.
- (goto-char id-end)
- (if (or res c-promote-possible-types)
- (progn
- (c-add-type id-start id-end)
- (when (and c-record-type-identifiers id-range)
- (c-record-type-id id-range))
- (unless res
- (setq res 'found)))
- (setq res (if (c-check-type id-start id-end)
- ;; It's an identifier that has been used as
- ;; a type somewhere else.
- 'found
- ;; It's an identifier that might be a type.
- 'maybe))))
- (t
- ;; Otherwise it's an operator identifier, which is not a type.
- (goto-char start)
- (setq res nil)))))
+(defconst d-font-lock-keywords-2 (c-lang-const c-matchers-2 d)
+ "Fast normal highlighting for D mode.")
- (when res
- ;; D: Skip over template parameters, if any
- (when (looking-at "!")
- (forward-char)
- (c-forward-syntactic-ws)
- (c-forward-sexp)
- (c-forward-syntactic-ws))
+(defconst d-font-lock-keywords-3 (c-lang-const c-matchers-3 d)
+ "Accurate normal highlighting for D mode.")
- ;; D: Descend into scope names
- (when (looking-at "[.]")
- (forward-char)
- (c-forward-syntactic-ws)
- (unless (d-forward-type)
- (setq res nil)))
+(defvar d-font-lock-keywords d-font-lock-keywords-3
+ "Default expressions to highlight in D mode.")
- ;; Step over any type suffix operator. Do not let the existence
- ;; of these alter the classification of the found type, since
- ;; these operators typically are allowed in normal expressions
- ;; too.
- (when c-opt-type-suffix-key ; e.g. "..."
- (while (looking-at c-opt-type-suffix-key)
- (goto-char (match-end 1))
- (c-forward-syntactic-ws)))
+(defun d-font-lock-keywords-2 ()
+ "Function to get fast normal highlighting for D mode."
+ (c-compose-keywords-list d-font-lock-keywords-2))
+(defun d-font-lock-keywords-3 ()
+ "Function to get accurate normal highlighting for D mode."
+ (c-compose-keywords-list d-font-lock-keywords-3))
+(defun d-font-lock-keywords ()
+ "Function to get default expressions to highlight in D mode."
+ (c-compose-keywords-list d-font-lock-keywords))
- (when (and c-record-found-types (memq res '(known found)) id-range)
- (setq c-record-found-types
- (cons id-range c-record-found-types))))
+(defvar d-mode-syntax-table nil
+ "Syntax table used in d-mode buffers.")
+(or d-mode-syntax-table
+ (setq d-mode-syntax-table
+ (let ((table (funcall (c-lang-const c-make-mode-syntax-table d))))
+ ;; Make it recognize D `backquote strings`
+ (modify-syntax-entry ?` "\"" table)
- ;;(message "c-forward-type %s -> %s: %s" start (point) res)
+ ;; Make it recognize D's nested /+ +/ comments
+ (modify-syntax-entry ?+ ". 23n" table)
+ table)))
- (unless res
- (when saw-storage-class
- (goto-char start)))
+(defvar d-mode-abbrev-table nil
+ "Abbreviation table used in d-mode buffers.")
+(c-define-abbrev-table 'd-mode-abbrev-table
+ ;; Use the abbrevs table to trigger indentation actions
+ ;; on keywords that, if they occur first on a line, might alter the
+ ;; syntactic context.
+ ;; Syntax for abbrevs is:
+ ;; ( pattern replacement command initial-count)
+ '(("else" "else" c-electric-continued-statement 0)
+ ("while" "while" c-electric-continued-statement 0)
+ ("catch" "catch" c-electric-continued-statement 0)
+ ("finally" "finally" c-electric-continued-statement 0)))
- res))
+(defvar d-mode-map ()
+ "Keymap used in d-mode buffers.")
+(if d-mode-map
+ nil
+ (setq d-mode-map (c-make-inherited-keymap))
+ ;; Add bindings which are only useful for D
+ ;; (define-key d-mode-map "\C-c\C-e" 'd-cool-function)
+ )
-(defun d-around--c-forward-type (orig-fun &rest args)
- ;; checkdoc-params: (orig-fun args)
- "Advice function for fixing fontification for D enums."
- (apply
- (if (c-major-mode-is 'd-mode)
- #'d-forward-type
- orig-fun)
- args))
+(c-lang-defconst c-mode-menu
+ ;; The definition for the mode menu. The menu title is prepended to
+ ;; this before it's fed to `easy-menu-define'.
+ d `(["Comment Out Region" comment-region
+ (c-fn-region-is-active-p)]
+ ["Uncomment Region" (comment-region (region-beginning)
+ (region-end) '(4))
+ (c-fn-region-is-active-p)]
+ ["Indent Expression" c-indent-exp
+ (memq (char-after) '(?\( ?\[ ?\{))]
+ ["Indent Line or Region" c-indent-line-or-region t]
+ ["Fill Comment Paragraph" c-fill-paragraph t]
+ "----"
+ ["Backward Statement" c-beginning-of-statement t]
+ ["Forward Statement" c-end-of-statement t]
+ "----"
+ ("Toggle..."
+ ["Syntactic indentation" c-toggle-syntactic-indentation
+ :style toggle :selected c-syntactic-indentation]
+ ["Electric mode" c-toggle-electric-state
+ :style toggle :selected c-electric-flag]
+ ["Auto newline" c-toggle-auto-newline
+ :style toggle :selected c-auto-newline]
+ ["Hungry delete" c-toggle-hungry-state
+ :style toggle :selected c-hungry-delete-key]
+ ["Subword mode" c-subword-mode
+ :style toggle :selected (and (boundp 'c-subword-mode)
+ c-subword-mode)])))
-(advice-add 'c-forward-type :around #'d-around--c-forward-type)
+(easy-menu-define d-menu d-mode-map "D Mode Commands"
+ (cons "D" (c-lang-const c-mode-menu d)))
;;----------------------------------------------------------------------------
-(c-lang-defconst d-flat-decl-maybe-block-kwds
- ;; Keywords which don't introduce a scope, and may or may not be
- ;; followed by a {...} block.
- d (append (c-lang-const c-modifier-kwds)
- (list "else" ; for version / static if
- "if" ; static if
- "version")))
-(c-lang-defconst d-flat-decl-maybe-block-re
- d (c-make-keywords-re t (c-lang-const d-flat-decl-maybe-block-kwds)))
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.d[i]?\\'" . d-mode))
-(defun d-update-brace-stack (stack from to)
- "Modified version of `c-update-brace-stack' for d-mode." ;; checkdoc-params:
(stack from to)
- ;; Given a brace-stack which has the value STACK at position FROM, update it
- ;; to its value at position TO, where TO is after (or equal to) FROM.
- ;; Return a cons of either TO (if it is outside a literal) and this new
- ;; value, or of the next position after TO outside a literal and the new
- ;; value.
- (let (match kwd-sym (prev-match-pos 1)
- (s (cdr stack))
- (bound-<> (car stack)))
- (save-excursion
- (cond
- ((and bound-<> (<= to bound-<>))
- (goto-char to)) ; Nothing to do.
- (bound-<>
- (goto-char bound-<>)
- (setq bound-<> nil))
- (t (goto-char from)))
- (while (and (< (point) to)
- (c-syntactic-re-search-forward
- (if (<= (car s) 0)
- c-brace-stack-thing-key
- c-brace-stack-no-semi-key)
- to 'after-literal)
- (> (point) prev-match-pos)) ; prevent infinite loop.
- (setq prev-match-pos (point))
- (setq match (match-string-no-properties 1)
- kwd-sym (c-keyword-sym match))
- (cond
- ((and (equal match "{")
- (progn (backward-char)
- (prog1 (looking-at "\\s(")
- (forward-char))))
- (setq s (if s
- ;; D: Constructs such as "version", "static if", or
- ;; "extern(...)" may or may not enclose their declarations
- ;; in a {...} block. For this reason, we can't blindly
- ;; update the cc-mode brace stack when we see these
keywords
- ;; (otherwise, if they are not immediately succeeded by a
- ;; {...} block, then the brace stack change will apply to
- ;; the next encountered {...} block such as that of a
- ;; function's).
- (if (save-excursion
- (backward-char)
- (c-backward-syntactic-ws)
- (when (eq (char-before) ?\))
- (c-backward-sexp)
- (c-backward-syntactic-ws))
- (c-backward-token-2)
- (looking-at (c-lang-const
d-flat-decl-maybe-block-re)))
- ;; D: Keep the brace stack state from the parent
- ;; context. I.e., the contents of a "static if" at the
- ;; top level should remain top-level, but in a
function,
- ;; it should remain non-top-level.
- s
- (cons (if (<= (car s) 0)
- 1
- (1+ (car s)))
- (cdr s)))
- (list 1))))
- ((and (equal match "}")
- (progn (backward-char)
- (prog1 (looking-at "\\s)")
- (forward-char))))
- (setq s
- (cond
- ((and s (> (car s) 1))
- (cons (1- (car s)) (cdr s)))
- ((and (cdr s) (eq (car s) 1))
- (cdr s))
- (t s))))
- ((and (equal match ":")
- s
- (eq (car s) 0))
- (setq s (cons -1 (cdr s))))
- ((and (equal match ",")
- (eq (car s) -1))) ; at "," in "class foo : bar, ..."
- ((member match '(";" "," ")"))
- (when (and s (cdr s) (<= (car s) 0))
- (setq s (cdr s))))
- ((c-keyword-member kwd-sym 'c-flat-decl-block-kwds)
- (push 0 s))))
- ;; The failing `c-syntactic-re-search-forward' may have left us in the
- ;; middle of a token, which might be a significant token. Fix this!
- (c-beginning-of-current-token)
- (cons (point)
- (cons bound-<> s)))))
+;; Custom variables
+;;;###autoload
+(defcustom d-mode-hook nil
+ "*Hook called by `d-mode'."
+ :type 'hook
+ :group 'c)
-(defun d-around--c-update-brace-stack (orig-fun &rest args)
- ;; checkdoc-params: (orig-fun args)
- "Advice function for fixing cc-mode handling of certain D constructs."
- (apply
- (if (c-major-mode-is 'd-mode)
- #'d-update-brace-stack
- orig-fun)
- args))
+;;;###autoload
+(define-derived-mode d-mode prog-mode "D"
+ "Major mode for editing code written in the D Programming Language.
-(advice-add 'c-update-brace-stack :around #'d-around--c-update-brace-stack)
+See http://dlang.org for more information about the D language.
-;;----------------------------------------------------------------------------
-;; Support for fontifying module name(s) after a module or import keyword.
+The hook `c-mode-common-hook' is run with no args at mode
+initialization, then `d-mode-hook'.
-(defun d-forward-module-clause ()
- "Fontify the module name(s) after a module or import keyword."
- (let (safe-pos pos)
- (goto-char (match-end 1))
- (while
- (progn
- (c-forward-syntactic-ws)
- (setq safe-pos (point))
- (cond
- ((looking-at c-identifier-start)
- ;; identifier
- (setq c-last-identifier-range nil)
- (forward-char)
- (c-end-of-current-token)
- (when c-record-type-identifiers
- (c-record-ref-id (cons safe-pos (point))))
- t)
- ;; . or , or = (keep fontifying)
- ((memq (char-after) '(?. ?, ?=))
- (forward-char)
- t)
- ;; ; or : or anything else weird
- (t
- nil))))
- (goto-char safe-pos)
- t))
+Key bindings:
+\\{d-mode-map}"
+ (c-initialize-cc-mode t)
+ (setq local-abbrev-table d-mode-abbrev-table
+ abbrev-mode t)
+ (use-local-map d-mode-map)
+ (c-init-language-vars d-mode)
+ (when (fboundp 'c-make-noise-macro-regexps)
+ (c-make-noise-macro-regexps))
+
+ ;; Generate a function that applies D-specific syntax properties.
+ ;; Concretely, inside back-quoted string literals the backslash
+ ;; character '\' is treated as a punctuation symbol. See help for
+ ;; syntax-propertize-rules function for more information.
+ (setq-local
+ syntax-propertize-function
+ #'d--syntax-propertize-function)
+
+ (c-common-init 'd-mode)
+ (easy-menu-add d-menu)
+ (c-run-mode-hooks 'c-mode-common-hook 'd-mode-hook)
+ (c-update-modeline)
+ (if (fboundp 'c-get-fontification-context)
+ (cc-imenu-init nil #'d-imenu-create-index-function)
+ (cc-imenu-init d-imenu-generic-expression)))
+
+;; ----------------------------------------------------------------------------
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Optional features ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ----------------------------------------------------------------------------
-;;----------------------------------------------------------------------------
-;;
;; Support for "Adjusting Alignment Rules for UCFS-Chains in D",
;; cf.
https://stackoverflow.com/questions/25797945/adjusting-alignment-rules-for-ucfs-chains-in-d
;;
- [nongnu] elpa/d-mode b40a7ab 328/346: Unbundle undercover.el, (continued)
- [nongnu] elpa/d-mode b40a7ab 328/346: Unbundle undercover.el, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode a9c05fd 331/346: tests/I0102: Remove #min-version, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode 32446a7 338/346: Merge pull request #107 from CyberShadow/github-actions, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode c3be102 344/346: Cask: Fetch undercover.el directly from git, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode 7fdd7b2 343/346: .github/workflows/test.yml: Add final step to call the Coveralls webhook, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode 505022e 341/346: tests: New testcase, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode 199743d 346/346: tests/I0021: Update condition, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode 66796d0 247/346: Rename gplv2.txt -> COPYING, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode 51dcd68 251/346: Improve comprehension of D constructors and destructors, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode f4b3d8a 267/346: Precompute regular expressions for inline keyword lists, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode 809586a 266/346: Reorganize code,
ELPA Syncer <=
- [nongnu] elpa/d-mode 4851fc2 270/346: Fix fontification of "enum" in string literals, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode 49cb5a8 275/346: Consolidate c-forward-decl-or-cast-1 annotation patch, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode 45c60e0 286/346: Fix fontification of variable declarations with top-level types, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode e9a034e 283/346: Tighten decl/arglist recognition, obsoleting another patch, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode 05fc5f1 284/346: Consolidate c-forward-decl-or-cast-1 "scope" patch, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode 44cf02b 287/346: tests: New testcase, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode 73f4bdc 292/346: Emacs 25 compatibility, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode 8e77187 293/346: Fix fontification of return statements, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode cb97457 297/346: Remove another obsolete hack, ELPA Syncer, 2021/08/29
- [nongnu] elpa/d-mode bc725ef 296/346: Use a conditional compilation macro for version checks, ELPA Syncer, 2021/08/29