diff --git a/krl-mode.el b/krl-mode.el index 3a44667..9631319 100644 --- a/krl-mode.el +++ b/krl-mode.el @@ -9,29 +9,69 @@ (add-to-list 'auto-mode-alist '("\\.dat\\'" . krl-mode)) (add-to-list 'auto-mode-alist '("\\.sub\\'" . krl-mode)) -(defconst krl-keywords +(defun rstrip (str) + "Strip tailing whitespace from STR." + (replace-regexp-in-string (rx (* (any " \t\n")) eos) "" str)) + +;; Blocks allowed only at top level. +;; TODO: These should be regexes as well. (If trailing ws should be allowed...) +(defconst krl-keywords-toplevel-block-pairs + '( + ("DEF " "END\n") + ("DEFFCT " "ENDFCT\n") + )) + +(defun regexp-opt-allow-ind (str-list &optional prefix) + "Optimize regex for a list of strings, allowing for leading whitespace." + (concat "^ *" prefix (regexp-opt str-list t))) + +(defun list-nth (i pair-list) + (mapcar (lambda (x) (nth i x)) pair-list)) + +(defconst krl-indent-regex-toplevel-block-open + (regexp-opt-allow-ind (list-nth 0 krl-keywords-toplevel-block-pairs) "\\(GLOBAL +\\)?")) +(defconst krl-indent-regex-toplevel-block-close + (regexp-opt-allow-ind (list-nth 1 krl-keywords-toplevel-block-pairs))) + +;; Blocks not allowed at top level. Arb. nestable. +;; The whitespace indicates expected +(defconst krl-keywords-nested-block-pairs + '( + ;; Loops + ("FOR " "ENDFOR\n") + ("WHILE " "ENDWHILE\n") + ("REPEAT\n" "UNTIL ") + ("LOOP\n" "ENDLOOP\n") + ;; Branches + ("IF " "ENDIF\n") + ("SWITCH " "ENDSWITCH\n") + ("SPLINE" "ENDSPLINE\n") + )) + +(defconst krl-keywords-nested-block-middle + '( + ("IF " "ENDIF\n" "ELSE\n") + ("SWITCH " "ENDSWITCH\n" "CASE ") + )) + +(defconst krl-indent-regex-nested-block-middle + (regexp-opt-allow-ind (list-nth 2 krl-keywords-nested-block-middle))) + +(defconst krl-indent-regex-nested-block-open + (regexp-opt-allow-ind (append (list-nth 0 krl-keywords-nested-block-pairs)))) + +(defconst krl-indent-regex-nested-block-close + (regexp-opt-allow-ind (list-nth 1 krl-keywords-nested-block-pairs))) + +;; See SI p360. +(defconst krl-keywords-misc '( - "DEF" - "END" "DEFDAT" "ENDDAT" - "DEFFCT" - "ENDFCT" "DECL" - "RETURN" - "FOR" - "TO" - "ENDFOR" - "WHILE" - "ENDWHILE" - "IF" + "GLOBAL" + "PUBLIC" "THEN" - "ELSE" - "ENDIF" - "SWITCH" - "CASE" - "ENDSWITCH" - "LOOP" "ENUM" "NOT" "AND" @@ -44,15 +84,28 @@ "INTERRUPT" "WHEN" "DO" - ; TODO: Add more stuff. + "STEP" + "WHEN" )) +(defconst krl-keywords + (append + (mapcar (lambda (x) (rstrip (nth 0 x))) krl-keywords-toplevel-block-pairs) + (mapcar (lambda (x) (rstrip (nth 1 x))) krl-keywords-toplevel-block-pairs) + (mapcar (lambda (x) (rstrip (nth 0 x))) krl-keywords-nested-block-pairs) + (mapcar (lambda (x) (rstrip (nth 1 x))) krl-keywords-nested-block-pairs) + (mapcar (lambda (x) (rstrip (nth 2 x))) krl-keywords-nested-block-middle) + krl-keywords-misc + )) + (defconst krl-warning-keywords '( "HALT" "BRAKE" "EXIT" "WAIT" + "TRIGGER" + "!" ; Placeholder for positions. )) (defconst krl-types @@ -72,8 +125,10 @@ "FALSE" "$NULLFRAME" "$ROBROOT" + "XHOME" )) +;; TODO: Kinda flexible about what we consider builtins... (defconst krl-builtins '( ; Motion @@ -82,6 +137,10 @@ "PTP_REL" "LIN" "CIRC" + "SPL" + "SPTP" + "SLIN" + "SCIRC" ; Num functions "ABS" "SQRT" @@ -126,6 +185,130 @@ st) "Syntax table for krl-mode") +;; Get the string pair for the block we are currently on the end of. +(defun krl-get-pair () + (let ((pairs (copy-sequence krl-keywords-nested-block-pairs)) (pair nil)) + (while (and (not pair) pairs) + (when (looking-at (concat "^ *" (nth 1 (car pairs)))) + (setq pair (car pairs))) + (setq pairs (cdr pairs))) + ;; FIXME: Hack for broken ELSE, CASE. + (when (not pair) + (let ((triples (copy-sequence krl-keywords-nested-block-middle))) + (while (and (not pair) triples) + (when (looking-at (concat "^ *" (nth 2 (car triples)))) + (setq pair (car triples))) + (setq triples (cdr triples)) + ))) + pair)) + +(defun krl-indent-of-matching () + (save-excursion + (let ((balance 1) (pair (krl-get-pair))) + ;(message (nth 0 pair)) + (while (and (/= balance 0) (not (bobp))) + (progn + (forward-line -1) + (if (looking-at (concat "^ *" (nth 0 pair))) + (setq balance (1- balance))) + (if (looking-at (concat "^ *" (nth 1 pair))) + (setq balance (1+ balance))) + )) + (current-indentation) + ))) + +(defun krl-indent-of-block-opener () + (save-excursion + (let (done) + (while (and (not done) (not (bobp))) + (forward-line -1) + (when (looking-at krl-indent-regex-nested-block-open) + (setq done t)) + (when (looking-at krl-indent-regex-toplevel-block-open) + (setq done t)) + ) + (current-indentation) + ))) + +(defun krl-indent-of-block-end () + (save-excursion + (let (done) + (while (and (not done) (not (bobp))) + (forward-line -1) + (when (looking-at " *END.*") + (setq done t)) + ) + (current-indentation) + ))) + +(defun krl-find-hinted-indent () + (save-excursion + (let ((ind)) + (while (and (not ind) (not (bobp))) + (forward-line -1) + (cond + ((looking-at krl-indent-regex-toplevel-block-close) + ;(message "found tlb close") + (setq ind 0)) + ((looking-at krl-indent-regex-toplevel-block-open) + ;(message "found tlb open") + (setq ind (+ 2 (current-indentation)))) + ((looking-at krl-indent-regex-nested-block-close) + ;(message "found nb close") + (setq ind (current-indentation))) + ((looking-at krl-indent-regex-nested-block-open) + ;(message "found nb open") + (setq ind (+ 2 (current-indentation)))) + (t + ;(message "found other") + ) + )) + ind))) + +(defun krl-indent-line () + "Indent current line as KRL." + (interactive) + (save-excursion + (progn + (beginning-of-line) + (if (bobp) + (indent-line-to 0) + (let (indent-curr) + (progn + (cond ((looking-at krl-indent-regex-toplevel-block-open) + (progn + ;(message "toplevel open") + (indent-line-to 0))) + ((looking-at krl-indent-regex-toplevel-block-close) + (progn + ;(message "toplevel close") + (indent-line-to 0))) + ((looking-at "^ *&") + (progn + ;(message "&") + ;; HMI editor crud. + (indent-line-to 0))) + ((looking-at krl-indent-regex-nested-block-close) + (progn + ;(message "nested close") + (indent-line-to (krl-indent-of-matching)))) + ((looking-at krl-indent-regex-nested-block-middle) + (progn + ;(message "annoying stuff") + ;; (indent-line-to (krl-indent-of-block-opener)))) + (indent-line-to (krl-indent-of-matching)))) + (t + (progn + ;(message "other") + ;; ;(message krl-indent-regex-toplevel-block-open) + ;; (indent-line-to (krl-find-hinted-indent)))) + (let ((hinted-indent (krl-find-hinted-indent))) + (when (not hinted-indent) + (setq hinted-indent 0)) + (indent-line-to hinted-indent)))) + ))))))) + + (defun krl-mode () "Major mode for editing KRL files" (interactive) @@ -133,6 +316,7 @@ (set-syntax-table krl-mode-syntax-table) (use-local-map krl-mode-map) (set (make-local-variable 'font-lock-defaults) '(krl-font-lock-keywords)) + (set (make-local-variable 'indent-line-function) 'krl-indent-line) (setq major-mode 'krl-mode) (setq mode-name "KRL") (run-hooks 'krl-mode-hook))