branch: externals/a68-mode
commit 4db522fdce7b4d88e1307c94c107019a8a6c4c29
Author: Jose E. Marchesi <jose.march...@oracle.com>
Commit: Jose E. Marchesi <jose.march...@oracle.com>
Group syntax-propertize functions together
---
a68-mode.el | 119 ++++++++++++++++++++++++++++++------------------------------
1 file changed, 59 insertions(+), 60 deletions(-)
diff --git a/a68-mode.el b/a68-mode.el
index b872cd1111..2cff64086e 100644
--- a/a68-mode.el
+++ b/a68-mode.el
@@ -133,7 +133,7 @@
'upper
'supper)))
-;;;; Definitions of keywords and modes.
+;;;; Lists of keywords and modes.
(eval-and-compile
;; Those vars are used during macroexpansion (and hence compilation).
@@ -241,6 +241,64 @@
(cons "\\<\\([A-Z][A-Za-z_]*\\>\\)" ''font-lock-type-face)))
"Highlighting expressions for Algol 68 mode in SUPPER stropping.")
+;;;; Syntax-based text properties.
+
+(defun a68-syntax-propertize-function-upper (start end)
+ (let ((case-fold-search nil))
+ (goto-char start)
+ (funcall
+ (syntax-propertize-rules
+ ((rx (group "#")
+ (*? anychar)
+ (group "#"))
+ (1 (when (not (a68-within-string)) (string-to-syntax "<")))
+ (2 (when (not (a68-within-string)) (string-to-syntax ">")))
+ (0 (ignore (put-text-property (match-beginning 0) (match-end 0)
+ 'syntax-multiline t))))
+ ((rx bow (group "C") "OMMENT" eow
+ (*? anychar)
+ bow "COMMEN" (group "T") eow)
+ (1 (when (not (a68-within-string)) (string-to-syntax "< b")))
+ (2 (when (not (a68-within-string)) (string-to-syntax "> b")))
+ (0 (ignore (put-text-property (match-beginning 0) (match-end 0)
+ 'syntax-multiline t))))
+ ((rx bow (group "C") "O" eow
+ (*? anychar)
+ bow "C" (group "O") eow)
+ (1 (when (not (a68-within-string)) (string-to-syntax "< c")))
+ (2 (when (not (a68-within-string)) (string-to-syntax "> c")))
+ (0 (ignore (put-text-property (match-beginning 0) (match-end 0)
+ 'syntax-multiline t)))))
+ (point) end)))
+
+(defun a68-syntax-propertize-function-supper (start end)
+ (let ((case-fold-search nil))
+ (goto-char start)
+ (funcall
+ (syntax-propertize-rules
+ ((rx (group "#")
+ (*? anychar)
+ (group "#"))
+ (1 (when (not (a68-within-string)) (string-to-syntax "<")))
+ (2 (when (not (a68-within-string)) (string-to-syntax ">")))
+ (0 (ignore (put-text-property (match-beginning 0) (match-end 0)
+ 'syntax-multiline t))))
+ ((rx bow (group "c") "omment" eow
+ (*? anychar)
+ bow "commen" (group "t") eow)
+ (1 (when (not (a68-within-string)) (string-to-syntax "< b")))
+ (2 (when (not (a68-within-string)) (string-to-syntax "> b")))
+ (0 (ignore (put-text-property (match-beginning 0) (match-end 0)
+ 'syntax-multiline t))))
+ ((rx bow (group "c") "o" eow
+ (*? anychar)
+ bow "c" (group "o") eow)
+ (1 (when (not (a68-within-string)) (string-to-syntax "< c")))
+ (2 (when (not (a68-within-string)) (string-to-syntax "> c")))
+ (0 (ignore (put-text-property (match-beginning 0) (match-end 0)
+ 'syntax-multiline t)))))
+ (point) end)))
+
;;;; UPPER stropping
(defvar a68--smie-grammar-upper
@@ -349,37 +407,6 @@
(setq count (1- count )))
res))
-(defun a68-syntax-propertize-function-upper (start end)
- (let ((case-fold-search nil))
- (goto-char start)
- (funcall
- (syntax-propertize-rules
- ;; a comment is # ... #, but I don't want the
- ;; (eventual) shebang #! to be considered the start of
- ;; the comment.
- ((rx (group "#" (not "!"))
- (*? anychar)
- (group "#"))
- (1 (when (not (a68-within-string)) (string-to-syntax "<")))
- (2 (when (not (a68-within-string)) (string-to-syntax ">")))
- (0 (ignore (put-text-property (match-beginning 0) (match-end 0)
- 'syntax-multiline t))))
- ((rx bow (group "C") "OMMENT" eow
- (*? anychar)
- bow "COMMEN" (group "T") eow)
- (1 (when (not (a68-within-string)) (string-to-syntax "< b")))
- (2 (when (not (a68-within-string)) (string-to-syntax "> b")))
- (0 (ignore (put-text-property (match-beginning 0) (match-end 0)
- 'syntax-multiline t))))
- ((rx bow (group "C") "O" eow
- (*? anychar)
- bow "C" (group "O") eow)
- (1 (when (not (a68-within-string)) (string-to-syntax "< c")))
- (2 (when (not (a68-within-string)) (string-to-syntax "> c")))
- (0 (ignore (put-text-property (match-beginning 0) (match-end 0)
- 'syntax-multiline t)))))
- (point) end)))
-
;;;; SUPPER stropping.
(defvar a68--smie-grammar-supper
@@ -488,34 +515,6 @@
(setq count (1- count )))
res))
-(defun a68-syntax-propertize-function-supper (start end)
- (let ((case-fold-search nil))
- (goto-char start)
- (funcall
- (syntax-propertize-rules
- ((rx (group "#")
- (*? anychar)
- (group "#"))
- (1 (when (not (a68-within-string)) (string-to-syntax "<")))
- (2 (when (not (a68-within-string)) (string-to-syntax ">")))
- (0 (ignore (put-text-property (match-beginning 0) (match-end 0)
- 'syntax-multiline t))))
- ((rx bow (group "c") "omment" eow
- (*? anychar)
- bow "commen" (group "t") eow)
- (1 (when (not (a68-within-string)) (string-to-syntax "< b")))
- (2 (when (not (a68-within-string)) (string-to-syntax "> b")))
- (0 (ignore (put-text-property (match-beginning 0) (match-end 0)
- 'syntax-multiline t))))
- ((rx bow (group "c") "o" eow
- (*? anychar)
- bow "c" (group "o") eow)
- (1 (when (not (a68-within-string)) (string-to-syntax "< c")))
- (2 (when (not (a68-within-string)) (string-to-syntax "> c")))
- (0 (ignore (put-text-property (match-beginning 0) (match-end 0)
- 'syntax-multiline t)))))
- (point) end)))
-
;;;; Stropping utilities and commands.
(defun a68-supperize-buffer ()
