home

My NixOS systems configurations.
Log | Files | Refs | LICENSE

cue-mode.el (14574B)


      1 ;;; cue-mode.el --- CUE Lang Major Mode          -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2021  Russell Sim
      4 
      5 ;; Author: Russell Sim <russell.sim@gmail.com>
      6 ;; Keywords: languages
      7 
      8 ;; This program is free software; you can redistribute it and/or modify
      9 ;; it under the terms of the GNU General Public License as published by
     10 ;; the Free Software Foundation, either version 3 of the License, or
     11 ;; (at your option) any later version.
     12 
     13 ;; This program is distributed in the hope that it will be useful,
     14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     16 ;; GNU General Public License for more details.
     17 
     18 ;; You should have received a copy of the GNU General Public License
     19 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
     20 
     21 ;;; Commentary:
     22 
     23 ;;
     24 
     25 ;;; Code:
     26 
     27 (require 'smie)
     28 (require 'cl-extra)
     29 
     30 (defgroup cue '()
     31   "Major mode for editing Cue files."
     32   :group 'languages)
     33 
     34 (defcustom cue-eval-command
     35   '("cue" "eval")
     36   "Cue command to run in ‘cue-eval-buffer’.
     37 See also: `cue-command-options'."
     38   :type '(repeat string)
     39   :group 'cue)
     40 
     41 (defcustom cue-command-options
     42   '()
     43   "A list of options and values to pass to `cue-command'.
     44 For example:
     45   '(\"-e\" \"Nginx.Out\" \"--out=text\")"
     46   :group 'cue
     47   :type '(repeat string))
     48 
     49 (defcustom cue-fmt-command
     50   '("cue" "fmt")
     51   "Cue format command."
     52   :type '(repeat string)
     53   :group 'cue)
     54 
     55 
     56 (defcustom cue-library-search-directories
     57   nil "Sequence of Cue package search directories."
     58   :type '(repeat directory)
     59   :group 'cue)
     60 
     61 (defcustom cue-indent-level
     62   4
     63   "Number of spaces to indent with."
     64   :type '(number)
     65   :group 'cue)
     66 
     67 (defvar cue--identifier-regexp
     68   "[a-zA-Z_][a-zA-Z0-9_]*"
     69   "Regular expression matching a Cue identifier.")
     70 
     71 (defvar cue-font-lock-keywords
     72   (let ((builtin-regex (regexp-opt '("package" "import" "for" "in" "if" "let") 'words))
     73         (constant-regex (regexp-opt '("false" "null" "true") 'words))
     74         ;; All builtin functions (see https://cue.org/docs/references/spec/#builtin-functions)
     75         (standard-functions-regex (regexp-opt '("len" "close" "and" "or" "div" "mod" "quo" "rem") 'words)))
     76     (list
     77      `(,builtin-regex . font-lock-builtin-face)
     78      `(,constant-regex . font-lock-constant-face)
     79      ;; identifiers starting with a # or _ are reserved for definitions
     80      ;; and hidden fields
     81      `(,(concat "_?#" cue--identifier-regexp "+:?") . font-lock-type-face)
     82      `(,(concat cue--identifier-regexp "+:") . font-lock-keyword-face)
     83      ;; all identifiers starting with __(double underscores) as keywords
     84      `(,(concat "__" cue--identifier-regexp) . font-lock-keyword-face)
     85      `(,standard-functions-regex . font-lock-function-name-face)))
     86   "Minimal highlighting for ‘cue-mode’.")
     87 
     88 (defun cue-syntax-stringify ()
     89   "Put `syntax-table' property correctly on single/triple quotes."
     90   (let* ((ppss (save-excursion (backward-char 3) (syntax-ppss)))
     91          (string-start (and (eq t (nth 3 ppss)) (nth 8 ppss)))
     92          (quote-starting-pos (- (point) 3))
     93          (quote-ending-pos (point)))
     94     (cond ((or (nth 4 ppss)             ;Inside a comment
     95                (and string-start
     96                     ;; Inside of a string quoted with different triple quotes.
     97                     (not (eql (char-after string-start)
     98                               (char-after quote-starting-pos)))))
     99            ;; Do nothing.
    100            nil)
    101           ((nth 5 ppss)
    102            ;; The first quote is escaped, so it's not part of a triple quote!
    103            (goto-char (1+ quote-starting-pos)))
    104           ((null string-start)
    105            ;; This set of quotes delimit the start of a string.
    106            (put-text-property quote-starting-pos (1+ quote-starting-pos)
    107                               'syntax-table (string-to-syntax "|")))
    108           (t
    109            ;; This set of quotes delimit the end of a string.
    110            (put-text-property (1- quote-ending-pos) quote-ending-pos
    111                               'syntax-table (string-to-syntax "|"))))))
    112 
    113 
    114 (defvar cue-smie-verbose-p nil
    115   "Emit context information about the current syntax state.")
    116 
    117 (defmacro cue-smie-debug (message &rest format-args)
    118   `(progn
    119      (when cue-smie-verbose-p
    120        (message (format ,message ,@format-args)))
    121      nil))
    122 
    123 (defun verbose-cue-smie-rules (kind token)
    124   (let ((value (cue-smie-rules kind token)))
    125     (cue-smie-debug "%s '%s'; sibling-p:%s prev-is-OP:%s hanging:%s == %s" kind token
    126                     (ignore-errors (smie-rule-sibling-p))
    127                     (ignore-errors (smie-rule-prev-p "OP"))
    128                     (ignore-errors (smie-rule-hanging-p))
    129                     value)
    130     value))
    131 
    132 (defvar cue-smie-grammar
    133   (smie-prec2->grammar
    134    (smie-merge-prec2s
    135     (smie-bnf->prec2
    136      '((exps (exp "," exp))
    137        (exp (field)
    138             ("import" id)
    139             ("package" id)
    140             (id))
    141        (field (id ":" exp))
    142        (id))
    143      '((assoc ",") (assoc "\n") (left ":") (left ".") (left "let"))
    144      '((right "=")))
    145 
    146     (smie-precs->prec2
    147      '((right "=")
    148        (left "||" "|")
    149        (left "&&" "&")
    150        (nonassoc "=~" "!~" "!=" "==" "<=" ">=" "<" ">")
    151        (left "+" "-")
    152        (left "*" "/"))))))
    153 
    154 ;; Operators
    155 ;; +     &&    ==    <     =     (     )
    156 ;; -     ||    !=    >     :     {     }
    157 ;; *     &     =~    <=    ?     [     ]     ,
    158 ;; /     |     !~    >=    !     _|_   ...   .
    159 ;; _|_ bottom
    160 
    161 (defun cue-smie-rules (kind token)
    162   (pcase (cons kind token)
    163     (`(:elem . basic) smie-indent-basic)
    164     (`(,_ . ",") (cue-smie--indent-nested))
    165     (`(,_ . "}") (cue-smie--indent-closing))
    166     (`(,_ . "]") (smie-rule-parent (- 0 cue-indent-level)))
    167     (`(,_ . ")") (smie-rule-parent (- 0 cue-indent-level)))
    168     ))
    169 
    170 (defun cue-smie--in-object-p ()
    171   "Return t if the current block we are in is wrapped in {}."
    172   (let ((ppss (syntax-ppss)))
    173     (or (null (nth 1 ppss))
    174         (and (nth 1 ppss)
    175              (or
    176               (eq ?{ (char-after (nth 1 ppss)))
    177               (eq ?\( (char-after (nth 1 ppss))))))))
    178 
    179 
    180 (defun cue-smie-backward-token ()
    181   (let ((pos (point)))
    182     (forward-comment (- (point)))
    183     (cond
    184      ((and (not (eq (char-before) ?\,)) ;Coalesce ";" and "\n".
    185            (> pos (line-end-position))
    186            (cue-smie--in-object-p))
    187       (skip-chars-forward " \t")
    188       ;; Why bother distinguishing \n and ,?
    189       ",") ;;"\n"
    190      (t
    191       (buffer-substring-no-properties
    192        (point)
    193        (progn (if (zerop (skip-syntax-backward "."))
    194                   (skip-syntax-backward "w_'"))
    195               (point)))))))
    196 
    197 
    198 (defun cue-smie-forward-token ()
    199   (skip-chars-forward " \t")
    200   (cond
    201    ((and (looking-at "[\n]")
    202          (or (save-excursion (skip-chars-backward " \t")
    203                              ;; Only add implicit , when needed.
    204                              (or (bolp) (eq (char-before) ?\,)))
    205              (cue-smie--in-object-p)))
    206     (if (eolp) (forward-char 1) (forward-comment 1))
    207     ;; Why bother distinguishing \n and ;?
    208     ",") ;;"\n"
    209    ((progn (forward-comment (point-max)) nil))
    210    (t
    211     (buffer-substring-no-properties
    212      (point)
    213      (progn (if (zerop (skip-syntax-forward "."))
    214                 (skip-syntax-forward "w_'"))
    215             (point))))))
    216 
    217 (defun cue-smie--indent-nested ()
    218   (let ((ppss (syntax-ppss)))
    219     (if (nth 1 ppss)
    220         (let ((parent-indentation (save-excursion
    221                                     (goto-char (nth 1 ppss))
    222                                     (back-to-indentation)
    223                                     (current-column))))
    224           (cons 'column (+ parent-indentation cue-indent-level))))))
    225 
    226 (defun cue-smie--indent-closing ()
    227   (let ((ppss (syntax-ppss)))
    228     (if (nth 1 ppss)
    229         (let ((parent-indentation (save-excursion
    230                                     (goto-char (nth 1 ppss))
    231                                     (back-to-indentation)
    232                                     (current-column))))
    233           (cons 'column parent-indentation)))))
    234 
    235 (defvar cue-syntax-propertize-function
    236   (syntax-propertize-rules
    237    ((rx (or "\"\"\"" "'''"))
    238     (0 (ignore (cue-syntax-stringify))))))
    239 
    240 (defconst cue-mode-syntax-table
    241   (let ((table (make-syntax-table)))
    242     ;; Comments. Cue supports /* */ and // as comment delimiters
    243     (modify-syntax-entry ?/ ". 124" table)
    244     ;; Additionally, Cue supports # as a comment delimiter
    245     (modify-syntax-entry ?\n ">" table)
    246     ;; ", ', ,""" and ''' are quotations in Cue.
    247     ;; both """ and ''' are handled by cue--syntax-propertize-function
    248     (modify-syntax-entry ?' "\"" table)
    249     (modify-syntax-entry ?\" "\"" table)
    250     ;; Our parenthesis, braces and brackets
    251     (modify-syntax-entry ?\( "()" table)
    252     (modify-syntax-entry ?\) ")(" table)
    253     (modify-syntax-entry ?\{ "(}" table)
    254     (modify-syntax-entry ?\} "){" table)
    255     (modify-syntax-entry ?\[ "(]" table)
    256     (modify-syntax-entry ?\] ")[" table)
    257     table)
    258   "Syntax table for `cue-mode'.")
    259 
    260 
    261 ;;;###autoload
    262 (define-derived-mode cue-mode prog-mode "CUE Lang Mode"
    263   :syntax-table cue-mode-syntax-table
    264   (setq-local font-lock-defaults '(cue-font-lock-keywords ;; keywords
    265                                    nil  ;; keywords-only
    266                                    nil  ;; case-fold
    267                                    nil  ;; syntax-alist
    268                                    nil  ;; syntax-begin
    269                                    ))
    270 
    271   (setq-local syntax-propertize-function
    272               cue-syntax-propertize-function)
    273 
    274   ;; cue lang uses tabs for indent by default
    275   (setq-local indent-tabs-mode t)
    276   (setq-local tab-width cue-indent-level)
    277 
    278   (smie-setup cue-smie-grammar 'verbose-cue-smie-rules
    279               :forward-token  #'cue-smie-forward-token
    280               :backward-token #'cue-smie-backward-token)
    281   (setq-local smie-indent-basic cue-indent-level)
    282   (setq-local smie-indent-functions '(smie-indent-fixindent
    283                                       smie-indent-bob
    284                                       smie-indent-comment
    285                                       smie-indent-comment-continue
    286                                       smie-indent-comment-close
    287                                       smie-indent-comment-inside
    288                                       smie-indent-keyword
    289                                       smie-indent-after-keyword
    290                                       smie-indent-empty-line
    291                                       smie-indent-exps))
    292 
    293   (setq-local comment-start "// ")
    294   (setq-local comment-start-skip "//+[\t ]*")
    295   (setq-local comment-end "")
    296   )
    297 
    298 ;;;###autoload
    299 (add-to-list 'auto-mode-alist (cons "\\.cue\\'" 'cue-mode))
    300 
    301 ;;;###autoload
    302 (defun cue-eval-buffer ()
    303   "Run cue with the path of the current file."
    304   (interactive)
    305   (let ((file-to-eval (file-truename (buffer-file-name)))
    306         (search-dirs cue-library-search-directories)
    307         (output-buffer-name "*cue output*"))
    308     (save-some-buffers (not compilation-ask-about-save)
    309                        (let ((directories (cons (file-name-directory file-to-eval)
    310                                                 search-dirs)))
    311                          (lambda ()
    312                            (member (file-name-directory (file-truename (buffer-file-name)))
    313                                    directories))))
    314     (let ((cmd (car cue-eval-command))
    315           (args (append (cdr cue-eval-command)
    316                         cue-command-options
    317                         (cl-loop for dir in search-dirs
    318                                  collect "-I"
    319                                  collect dir)
    320                         (list file-to-eval))))
    321       (let ((outbuf (get-buffer-create output-buffer-name)))
    322         (with-current-buffer outbuf
    323           (let ((origional-point (point)))
    324             (setq buffer-read-only nil)
    325             (erase-buffer)
    326             (if (zerop (apply #'call-process cmd nil t nil args))
    327                 (progn
    328                   (cue-mode)
    329                   (view-mode))
    330               (compilation-mode nil))
    331             (goto-char origional-point)))
    332         (display-buffer outbuf '(nil (allow-no-window . t)))))))
    333 
    334 (define-key cue-mode-map (kbd "C-c C-c") 'cue-eval-buffer)
    335 
    336 
    337 ;;;###autoload
    338 (defun cue-reformat-buffer ()
    339   "Reformat entire buffer using the Cue format utility."
    340   (interactive)
    341   (let ((point (point))
    342         (file-name (buffer-file-name))
    343         (stdout-buffer (get-buffer-create "*cue fmt stdout*"))
    344         (stderr-buffer-name "*cue fmt stderr*")
    345         (stderr-file (make-temp-file "cue fmt")))
    346     (when-let ((stderr-window (get-buffer-window stderr-buffer-name t)))
    347       (quit-window nil stderr-window))
    348     (unwind-protect
    349         (let* ((only-test buffer-read-only)
    350                (exit-code (apply #'call-process-region nil nil (car cue-fmt-command)
    351                                  nil (list stdout-buffer stderr-file) nil
    352                                  (append (cdr cue-fmt-command)
    353                                          (when only-test '("--test"))
    354                                          '("-")))))
    355           (cond ((zerop exit-code)
    356                  (progn
    357                    (if (or only-test
    358                            (zerop (compare-buffer-substrings nil nil nil stdout-buffer nil nil)))
    359                        (message "No format change necessary.")
    360                      (erase-buffer)
    361                      (insert-buffer-substring stdout-buffer)
    362                      (goto-char point))
    363                    (kill-buffer stdout-buffer)))
    364                 ((and only-test (= exit-code 2))
    365                  (message "Format change is necessary, but buffer is read-only."))
    366                 (t (with-current-buffer (get-buffer-create stderr-buffer-name)
    367                      (setq buffer-read-only nil)
    368                      (insert-file-contents stderr-file t nil nil t)
    369                      (goto-char (point-min))
    370                      (when file-name
    371                        (while (search-forward "<stdin>" nil t)
    372                          (replace-match file-name)))
    373                      (set-buffer-modified-p nil)
    374                      (compilation-mode nil)
    375                      (display-buffer (current-buffer)
    376                                      '((display-buffer-reuse-window
    377                                         display-buffer-at-bottom
    378                                         display-buffer-pop-up-frame)
    379                                        .
    380                                        ((window-height . fit-window-to-buffer))))))))
    381       (delete-file stderr-file))))
    382 
    383 (define-key cue-mode-map (kbd "C-c C-r") 'cue-reformat-buffer)
    384 
    385 (provide 'cue-mode)
    386 ;;; cue-mode.el ends here