tlc.el

;;; tlc --- Major mode for editing tlc files
;;
;; Author: Eric M. Ludlam <eludlam@mathworks.com>
;; Keywords: tlc
;; X-Abstract: Major mode for editing tlc files

(defvar tlc-version "1.3"
  "The current version of TLC mode.")

;;
;; Copyright 1997-2021 Eric Ludlam
;;
;; This program is derived from free software; you can redistribute it
;; and/or modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;;; Commentary:
;;
;;  This is a major mode for editing Target Language Compiler, TLC, programs.
;;  TLC programs are an advanced template system which are used to create
;;  source code for compilers, e.g. to produce C code or C++ code.
;;
;;  TLC programs consist of :
;;     - Keywords of the form %function, %if, etc.
;;     - Built-in functions of form EXISTS().
;;     - Statement continuation using "...", e.g.
;;          %assign a = b + ...
;;              c
;;     - Single line comments are of the from: %% line
;;     - "%%{", "%%{{", "%%}", "%%}}", etc. 'indent comment shift operators' adjust indentation
;;       by 4, 8, -4, -8, etc.
;;     - "%%{N}" 'indent comment shift operators' adjust what follows to indent to column N
;;     - Block comments are of form: /% ... %/
;;     - All other content is sent to the output to create target language source code, e.g. C.
;;
;;  TLC programs therefore mix TLC semantics with target language semantics, e.g. C code:
;;
;;     %function Foo(mode) output
;;         %if mode.loop
;;             int i;
;;             for (i = 0; i < %<mode.loopLimit>; i++) {
;;                 %<Out(mode)>[i] = %<In(mode)>[i];
;;             }
;;         %else
;;             %<Out(mode)> = %<In(mode)>;
;;         %endif
;;     %endfunction
;;
;;  The mix of TLC code and C code can result in challenges for semantic indentation. In this case
;;  you can use the special "%%{", "%%}", etc. comments (called indent comment shift operators) to
;;  adjust indentation as in:
;;
;;      %if mode == "standard"
;;          if (a > 1) {
;;              if (b > 0) {
;;                  %<v> = %<v> + b;
;;      %else
;;          if (x > 0) {
;;              if (y > 0) {
;;                  %<v> = %<v> + y;
;;      %endif
;;      %%{{{                                      ;; this adjusts indentation by 12
;;                  %<w> = %<v>
;;              }
;;          }
;;      %%}                                        ;; this adjusts indentation by -4
;;
;;  Another use of the indent comment shift operators is with %openfile to write
;;  target language output comments, e.g.
;;
;;      %function GetHeader() void
;;          %openfile header
;;      %%}
;;      Unindented C
;;      comment text
;;      %%{
;;          %closefile header
;;          %return header
;;      %endfunction
;;
;;  Using %openfile/%closefile is helpful when creating messages and this often requires that the
;;  content starts at a specific column, e.g. column 1 (zero based), such that when the lines of the
;;  message are combined into a single line the words at the line boundaries are joined by spaces,
;;  e.g.
;;
;;   %function GetMessage() void
;;       %openfile message
;;   %%{1}
;;    This is a message
;;    that spans multiple lines
;;   %%{4}
;;       %closefile
;;   %endfunction
;;
;; Issues:
;;   1. Font's for continuations multiline statements are not correct, i.e.
;;        %assign a = 1 + ...
;;            2 + ...
;;            3
;;      will have the "2 + ..." and "3" line shown using tlc-font-lock-output-code.
;;      To fix, we probably need to use Multiline Font Lock constructs.

;;; History:
;;
;;  10Sep1998 by Eric M.  Ludlam <eludlam@mathworks.com>
;;    Posted First revision onto the FTP site.
;;
;;  06Oct2005 Peter S galbraith <psg@debian.org>
;;    Minor changes for:
;;    - support customization.
;;    - added autoload cookies.
;;    - CVS storage elsewhere without changing the version number.
;;
;;  Recent history is in the ChangeLog and the matlab-emacs repository.

;;; Code:
(defun tlc-version ()
  "Display the current version of TLC mode."
  (interactive)
  (message tlc-version))

(defgroup tlc nil
  "Major mode for editing tlc files."
  :group 'languages)

(defcustom tlc-mode-hook nil
  "*List of functions to call on entry to TLC mode."
  :group 'tlc
  :type 'hook)

(defvar tlc-syntax-table nil
  "Syntax table used in an TLC file.")

(unless tlc-syntax-table
  (setq tlc-syntax-table (make-syntax-table (standard-syntax-table)))
  ;; Multiline comments:   /% ... %/
  ;; Single line comments: %% ...
  (modify-syntax-entry ?/  ". 14c" tlc-syntax-table)
  (modify-syntax-entry ?%  ". 123" tlc-syntax-table)
  (modify-syntax-entry ?\n ">" tlc-syntax-table)
  ;; Strings
  (modify-syntax-entry ?\" "\"" tlc-syntax-table)
  ;; %<variable> support:
  (modify-syntax-entry ?< "(>" tlc-syntax-table)
  (modify-syntax-entry ?> ")>" tlc-syntax-table))

(defvar tlc-mode-map
  (let ((km  (make-sparse-keymap)))
    (define-key km "\C-m" 'tlc-return)
    (define-key km [return] 'tlc-return)
    (define-key km "\C-i" 'tlc-indent)
    km)
  "Keymap for `tlc-mode'.")

(defvar tlc-font-lock-output-code 'tlc-font-lock-output-code
  "Face for output code.")

(defface tlc-font-lock-output-code
  '((((class grayscale) (background light))
     (:foreground "DimGray" :underline t))
    (((class grayscale) (background dark))
     (:foreground "LightGray" :underline t))
    (((class color) (background light)) (:foreground "DarkGreen"))
    (((class color) (background dark))  (:foreground "chartreuse"))
    (t (:underline t)))
  "Font Lock mode face used to highlight tlc keywords."
  :group 'tlc)

(defcustom tlc-keywords
  '("CAST" "EXISTS" "FEVAL" "FILE_EXISTS" "FORMAT"
    "FIELDNAMES" "GETFIELD" "GENERATE"
    "GENERATE_FILENAME" "GENERATE_FORMATTED_VALUE"
    "GENERATE_FUNCTION_EXISTS" "GENERATE_TYPE"
    "GENERATE_TYPE_FUNCTION_EXISTS" "GET_COMMAND_SWITCH"
    "IDNUM" "IMAG"
    "INT8MAX" "INT8MIN"
    "INT16MAX" "INT16MIN"
    "INT32MAX" "INT32MIN"
    "ISEQUAL" "ISFIELD" "ISINF" "ISNAN" "ISFINITE"
    "NULL_FILE" "NUMTLCFILES"
    "OUTPUT_LINES" "SIZE" "STDOUT" "STRING" "STRINGOF"
    "SYSNAME" "TLCFILES" "TLC_TIME"
    "TLC_FALSE" "TLC_TRUE"
    "TLC_VERSION" "TYPE"
    "UINT8MAX" "UINT16MAX" "UINT32MAX"
    "UINTWHITE_SPACE" "WILL_ROLL")
  "Built-in function keywords to highlight in TLC."
  :type '(repeat (string :tag "keyword"))
  :group 'tlc)

(defvar tlc-font-lock-keywords
  (list
   ;; %function keyword
   '("^%function\\s-+\\(\\sw+\\)\\s-*(" 1 font-lock-function-name-face)
   '("^%function\\s-+\\(\\sw+\\)\\s-*("
     ("\\s-*\\(\\sw+\\)\\s-*[,)]" nil nil
      (1 font-lock-variable-name-face)))
   ;; Single line comments: %% text
   ;; Special "%%{", "%%}", etc. comments
   '("\\(?:%%\\)\\({+\\|{+[0-9]+}\\)\\s-*$" 1 'bold prepend)
   '("\\(?:%%\\)\\(}+\\)\\s-*$" 1 'bold prepend)
   ;; Target language output code
   '("\\(^[ \t]*\\([^ \n\t%]\\|%<\\)[^\n]*\\)$" 1 tlc-font-lock-output-code append)
   ;; Keywords, e.g., %if
   '("\\(^\\|\\s-\\)\\(%[^% \t(\n>]+\\)\\>" 2 font-lock-keyword-face)
   ;; %assign keyword
   '("%assign\\s-+:*\\([_a-zA-Z0-9.]+\\)\\s-*\\($\\|=\\)" 1 font-lock-variable-name-face)
   ;; %exit, %warning, %error, %trace keywords
   '("%\\(exit\\|warning\\|error\\|trace\\) \\([^\n]+\\)$" 2 font-lock-string-face prepend)
   ;; %<var> expansions
   '("\\(%<[^%\n>]+>\\)" 1 font-lock-constant-face prepend)
   ;; Built-in functions, e.g. EXISTS
   (list (concat "\\<\\(" (regexp-opt tlc-keywords) "\\)\\>")
	 1 'font-lock-type-face)
   '("[^.]\\(\\.\\.\\.\\)$" 1 'underline prepend)
   )
  "List of keywords for nicely coloring X defaults.")

;;;###autoload
(define-derived-mode tlc-mode prog-mode "TLC" ()
  "Major mode for editing Tlc files, or files found in tlc directories."
  (kill-all-local-variables)
  (setq major-mode 'tlc-mode)
  (setq mode-name "TLC")
  (use-local-map tlc-mode-map)
  (set-syntax-table tlc-syntax-table)
  (make-local-variable 'comment-start)
  (make-local-variable 'comment-end)
  (make-local-variable 'comment-start-skip)
  (setq comment-start "%% "
	comment-end   "")
  (setq comment-start-skip "%%\\|/%")
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'tlc-indent)
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '((tlc-font-lock-keywords)
			     nil ; do not do string/comment highlighting
			     nil ; keywords are case sensitive.
			     ;; This puts _ as a word constituent,
			     ;; simplifying our keywords significantly
			     ((?_ . "w"))))
  (tlc-version)
  (save-excursion
    (goto-char (point-min))
    (run-hooks 'tlc-mode-hook)))

(defun tlc-return ()
  "Handle carriage return in `tlc-mode'."
  (interactive)
  (delete-horizontal-space)
  (newline)
  (tlc-indent))

(defun tlc-indent ()
  "Indent the current line to the indentation of the previous line."
  (interactive)
  (let (curr-indent
        new-indent)
    (save-excursion
      (save-restriction
        (setq curr-indent (current-indentation))
        (setq new-indent (tlc--calc-indentation))))
    (if (= curr-indent new-indent)
        (when (< (current-column) curr-indent)
          (goto-char (+ (line-beginning-position) curr-indent)))
      ;; else indent
      (save-restriction
        (let ((curr-column (current-column)))
          (beginning-of-line)
          (delete-horizontal-space)
          (indent-to new-indent) ;; now current-column is new-indent
          (when (> curr-column curr-indent)
            ;; Suppose prior to tlc-indent, we had the following with cursor at column 17:
            ;;     0123456789012345678901234567890
            ;;        %assign var = MyFcn(p1)
            ;;                      ^
            ;; after indentation, we move the %assign to column 8 (because it is within another
            ;; context which requires we have indentation of 8):
            ;;     0123456789012345678901234567890
            ;;             %assign var = MyFcn(p1)
            ;;                           ^
            ;; we want the cursor to remain at 'M' and that's what the goto-char does.
            ;;
            ;; If the cursor was anywhere before the %assign, we want the cursor to be at the
            ;; '%' and that's what the indent-to function does, which is why we guard the goto-char
            ;; with (> curr-column curr-indent).
            (goto-char (+ (line-beginning-position) new-indent (- curr-column curr-indent)))))))))

(defvar tlc--indent-because-of-continuation nil)

(defun tlc--calc-indentation ()
  "Calculate the indentation of this line."
  (beginning-of-line)

  (if (and (looking-at "\\s-*%%{[0-9]+}\\s-*$")
           (not (tlc--in-multiline-comment)))
      ;; %%{N} means the place %%{N} at column 0 and the following line goes to column N
      0
    ;; Else calculate indentation based on current line PLUS the context of the prior line
    (let ((i-col (cond
	          ((and (looking-at
	                 "\\s-*\\(?:\
\\(?:\\(?:%end\\(switch\\|roll\\|with\\|for\\|foreach\\|while\\|function\\)\\)\\>\\)\
\\|}\\)")
                        (not (tlc--in-multiline-comment)))
	           -4)
                  ((and (looking-at "\\s-*\\(%case\\|%default\\)\\>")
                        (not (tlc--in-multiline-comment)))
                   -2)
                  ;; %%} means shift by -4, %%}} means shift by -8, etc.
                  ((and (looking-at "\\s-*%%\\(}+\\)\\s-*$")
                        (not (tlc--in-multiline-comment)))
                   (* -4 (- (match-end 1) (match-beginning 1))))
                  ;;
	          (t 0)))
          (is-tlc-if-part (and (looking-at "\\s-*%\\(?:else\\|elseif\\|endif\\)") ;; part of a %if?
                               (not (tlc--in-multiline-comment))))
          (percent-in-multiline-comment (and (looking-at "\\s-*%") (tlc--in-multiline-comment))))

      ;; Walk up to calculate the indent based on the construct we are within and then add it to
      ;; i-col for the current construct.
      (setq tlc--indent-because-of-continuation nil)
      (if (bobp)
          (current-indentation)
        (save-excursion
          (tlc--indent-move-up is-tlc-if-part)
	  (cond ((bobp)
                 (setq i-col (+ i-col (tlc--calc-next-indentation))))
                ;; '%' line following a "/%" line, if so add 1
	        ((and percent-in-multiline-comment (looking-at "\\s-*/%"))
                 (setq i-col (1+ (current-indentation))))
                ;; Align %elsif, %else, %endif with corresponding %if?
                (is-tlc-if-part
                 (setq i-col (current-indentation)))
	        (t
	         (setq i-col (+ (current-indentation)
			        (if (and tlc--indent-because-of-continuation
				         (or (> 0 i-col)
                                             is-tlc-if-part))
				    i-col
			          (+ i-col (tlc--calc-next-indentation)))))
	         (if (< i-col 0) (setq i-col 0))))
	  i-col)))))

(defun tlc--indent-move-up (is-tlc-if-part)
  "Move to first prior non-blank line or matching %if,  %else, %endif when IS-TLC-IF-PART is t.
Specify IS-TLC-IF-PART as t, if current line is %else, %elsif, %endif to align the %if statements."
  (let ((n-if-statements-to-skip 0)  ;; num %if statements to skip over when is-tlc-if-part is t
        done)
    (while (not done)
      ;;
      ;; Move up to first non-blank line
      ;;
      (forward-line -1)
      (beginning-of-line)
      (while (and (not (bobp))
                  (looking-at "^\\s-*$")) ;; skip blank lines
        (forward-line -1))
      ;;
      ;; Align %elseif, %else, %endif with the prior TLC statement
      ;;
      (if (and (not (bobp)) is-tlc-if-part)
          ;; If within a non-TLC statement, look up until we find the matching if "part"
          (if (looking-at "\\s-*%endif\\>")
              (setq n-if-statements-to-skip (1+ n-if-statements-to-skip))
            (if (> n-if-statements-to-skip 0)
                (if (looking-at "\\s-*%if\\>")
                    (setq n-if-statements-to-skip (1- n-if-statements-to-skip)))
              (setq  done (looking-at "\\s-*%\\(?:if\\|elseif\\|else\\)\\>"))))
        (setq done t)))))

(defun tlc--calc-next-indentation ()
  "Calculate indentation for the next line based on the current line."
  (if (and (looking-at "\\s-*%%")
           (not (tlc--in-multiline-comment)))
      (cond ((looking-at "\\s-*%%\\({+\\)\\s-*$")
             ;; %%{ means shift by 4, %%{{ means shift by 8, etc.
             (* 4 (- (match-end 1) (match-beginning 1))))
            ((looking-at "\\s-*%%{\\([0-9]+\\)}\\s-*$")
             ;; %%{N} means the place %%{N} at column 0 and the following line goes to column N
             (string-to-number (buffer-substring (match-beginning 1) (match-end 1))))
            (t 0))
    ;; Else compute indent based on language element
    (+
     ;; Include offset based on language element, e.g. %function means to indent by 4
     (cond ((save-excursion
              (and (not (tlc--assignment-continuation-p))
                   (tlc--beginning-of-statement))
              (or
               (and (looking-at "\\s-*%\\(?:switch\\|roll\\|with\\|if\\|for\\|\
foreach\\|while\\|else\\|elseif\\|function\\)\\>")
                    ;; Do not indent "tlc guards", i.e.
                    ;;    %if EXISTS(::_FILE_NAME_) == 0
                    ;;    %assign _FILE_NAME_ = 1
                    ;;    <tlc file body starts at first column, 0>
                    ;;    %endif
                    (not (looking-at "\\s-*%if\\s-+\\(?:\
EXISTS(\"?\\(?:::\\)?_[A-Z_0-9]+_\"?)\\s-*==\\s-*\\(?:0\\|TLC_FALSE\\)\\|\
!EXISTS(\"?\\(?:::\\)?_[A-Z_0-9]+_\"?)\\)"))
                    (not (tlc--in-multiline-comment)))
               (and (looking-at "\\s-*/%")
                    (tlc--in-multiline-comment))))
            4)
           ((and (save-excursion
                   (and (not (tlc--assignment-continuation-p))
                        (tlc--beginning-of-statement))
                   (looking-at "\\s-*%\\(?:case\\|default\\)\\>"))
                 (not (tlc--in-multiline-comment)))
            2)
           ;; End of multiline comment?
           ((and (looking-at "\\s-*%/")
                 (tlc--in-multiline-comment))
            (if (= (% (current-indentation) 2) 1)
                ;; When current-indentation is odd, we've shifted the "%/" by 1, so need to shift it
                ;; back
                -1
              0))
           ;; Continuation?
           ((and (tlc--assignment-continuation-p)
                 (save-excursion (forward-line -1)
                                 (not (tlc--assignment-continuation-p)))
                 (not (tlc--in-multiline-comment)))
            (setq tlc--indent-because-of-continuation t)
            4)
           ;; Open bracket target language line, e.g.  "void foo() {", "struct {\", etc.
           ((and (save-excursion
                   (end-of-line)
                   (re-search-backward "[^[:space:]]" (line-beginning-position) t)
                   (when (and (> (current-column) 0) ;; Do we have line ending in \, if so remove it
                              (looking-at "\\\\"))
                     (backward-char)
                     (when (looking-at "\\s-")
                       (re-search-backward "[^[:space:]]" (line-beginning-position) t)))
                   (looking-at "{"))
                 (not (tlc--in-multiline-comment)))
            4)
           (t 0))
     ;; Don't include continuation if not in a continuation block
     (if (and (not (tlc--line-special))
              (not (tlc--assignment-continuation-p))
              (save-excursion (forward-line -1)
                              (tlc--assignment-continuation-p))
              (not (tlc--in-multiline-comment)))
         -4
       0))))

(defun tlc--beginning-of-statement ()
  "Goto the beginning of a statement, skipping over continuation lines."
  (beginning-of-line)
  (if (not (save-excursion (forward-line -1) (tlc--assignment-continuation-p)))
      nil
    (forward-line -1)
    (while (tlc--assignment-continuation-p)
      (forward-line -1))
    (forward-line 1)
    (beginning-of-line)))

(defun tlc--line-special ()
  "Return t if the current line is a special language line."
  (save-excursion
    (save-match-data
      (beginning-of-line)
      (looking-at "\\s-*\\(?:%[^<]\\|}\\)"))))

(defun tlc--assignment-continuation-p ()
  "See if continuation lines should be indented."
  (save-excursion
    (end-of-line)
    (when (> (current-column) 2)
        (forward-char -3)
        (looking-at "\\.\\.\\."))))

(defun tlc--in-multiline-comment ()
  "Return t we are in a multiline comment."
  ;; One way to do this is to use
  ;;   (save-excursion (and (re-search-backward "/%\\|%/" nil t) (looking-at "/%")))
  ;; however this fails on something like the following where /% is in a string
  ;;    %assign foo = "dir/%<file>.h"
  ;;    %if a
  ;;    ^------- point
  ;; From
  ;; https://emacs.stackexchange.com/questions/14269/how-to-detect-if-the-point-is-within-a-comment-area
  ;; we can use syntax-ppss
  (nth 4 (syntax-ppss)))

;;; Add to mode list
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.tlc\\'" . tlc-mode))

(provide 'tlc)

;;; tlc.el ends here

;; LocalWords:  Ludlam eludlam galbraith psg debian defun defcustom setq keymap defface grayscale
;; LocalWords:  IDNUM NUMTLCFILES STRINGOF SYSNAME TLCFILES UINTWHITE repeat:nil prog calc endswitch
;; LocalWords:  bobp nexti progn alist el stackexchange ppss openfile closefile