Got indentation mostly working. Needs cleanup.
This commit is contained in:
Tommy Olofsson
222
krl-mode.el
222
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))
|
||||
|
||||
Reference in New Issue
Block a user