Blob


1 ;;; a68-mode.el --- Major mode for editing Algol 68 code -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2011 Jose E. Marchesi
4 ;; Copyright (C) 2021 Omar Polo <op@omarpolo.com>
6 ;; Author: Jose E. Marchesi
7 ;; Omar Polo <op@omarpolo.com>
8 ;; Maintainer: Omar Polo
9 ;; URL: https://git.omarpolo.com/a68-mode
10 ;; Keywords: languages
11 ;; Version: 0
12 ;; Package-Requires: ((emacs "24.3"))
14 ;; This file is NOT part of GNU Emacs.
16 ;; This program is free software; you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation; either version 3, or (at your option)
19 ;; any later version.
21 ;; This program is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with this program; see the file COPYING. If not, write to the
28 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
29 ;; Boston, MA 02110-1301, USA.
31 ;;; Commentary:
33 ;; A major mode for editing Algol 68 code.
34 ;;
35 ;; This is an improved and modernized version of the a68-mode written
36 ;; by Jose E. Marchesi. The original code was taken from
37 ;;
38 ;; https://github.com/lachrymology/me/blob/master/.emacs.d/extras/algol-mode.el
39 ;;
40 ;; TODO: support quote and dot stropping.
42 ;;; Code:
44 (require 'font-lock)
45 (require 'smie)
46 (require 'syntax)
48 (eval-when-compile
49 (require 'rx))
51 (defgroup a68 nil
52 "Major mode for editing Algol68 code."
53 :prefix "a68-"
54 :group 'languages)
56 (defcustom a68-indent-level 3
57 "Indentation step for Algol 68."
58 :type 'integer
59 :safe #'integerp)
61 (defcustom a68-comment-style "#"
62 "Default comment style used by e.g. `comment-dwim'."
63 :type '(choice (const "#")
64 (const "CO")
65 (const "COMMENT"))
66 :safe #'consp)
68 (defvar a68-mode-hook '()
69 "Hook run when entering Algol68 mode.")
71 (defvar a68-mode-map
72 (let ((map (make-sparse-keymap)))
73 (define-key map (kbd "C-j") #'newline-and-indent)
74 ;; (define-key map (kbd "RET") #'a68-electric-terminate-line)
75 map)
76 "Keymap for Algol 68 major mode.")
78 (defconst a68-font-lock-keywords
79 (list
80 (cons (rx word-start
81 (or "DECS" "PROGRAM" "CONTEXT" "USE" "FINISH" "KEEP"
82 "ALIEN"
83 "MODE" "OP" "PRIO" "PROC"
84 "OF" "AT" "IS" "ISNT" "EMPTY" "SKIP"
85 "PR" "PRAGMAT"
86 "CASE" "IN" "OUSE" "OUT" "ESAC"
87 "FOR" "FORALL" "FROM" "TO" "BY" "WHILE" "DO" "OD"
88 "IF" "THEN" "ELIF" "THEN" "ELSE" "FI"
89 "PAR" "BEGIN" "END" "GOTO" "EXIT"
90 "LWB" "UPB" "NOT" "ABS" "BIN" "REPR" "LENG"
91 "SHORTEN" "ODD" "SIGN" "ROUND" "ENTIER" "AND" "OR"
92 "DIV" "OVER" "MOD" "ELEM" "SHL" "SHR" "OVERAB" "DIVAB" "MODAB"
93 "REF")
94 word-end)
95 'font-lock-keyword-face)
96 (cons (rx word-start
97 (or "TRUE" "FALSE")
98 word-end)
99 'font-lock-constant-face)
100 ;; only valid for bold stropping
101 (cons (concat "\\<[A-Z]+\\>") 'font-lock-type-face)
102 (cons "\\('\\w*'\\)"
103 'font-lock-variable-name-face))
104 "Highlighting expressions for Algol 68 mode.")
106 (defvar a68--keywords-regexp
107 (regexp-opt '("+" "*" ";" ">" "<" ":=" "=" "," ":")))
109 (defvar a68--smie-grammar
110 (smie-prec2->grammar
111 (smie-bnf->prec2 '((id)
112 (ids (id "-anchor-" id))
113 (fields (fields "," fields)
114 (ids))
115 (args ("(" fargs ")"))
116 (fargs (fargs "," fargs)
117 (exp))
118 (exp (ids)
119 (exp "OF" exp)
120 (exp "[" exp "]")
121 ("(" exp ")")
122 ("BEGIN" exp "END"))
123 (type-decl ("MODE" type-decl*))
124 (type-decl* (type-decl* "," type-decl*)
125 (id "=" type-decl**))
126 (type-decl** ("STRUCT" args)
127 ("UNION" args)
128 ("PROC" args "-archor-" ids))
129 (op-decl (op-decl "," op-decl)
130 ("OP" ids "=" args ids ":" exp))
131 (proc-decl (proc-decl "," proc-decl)
132 ("OP" ids "=" args ids ":" exp)
133 ("PROC" ids "=" ids ":" exp))
134 ;; TODO: this don't cover all the loop
135 ;; possibilities.
136 (loop ("FOR" exp "FROM" exp "TO" exp "BY" exp
137 "DO" exp "OD")
138 ("FOR" exp "FROM" exp "TO" exp
139 "DO" exp "OD")
140 ("FOR" exp "BY" exp "TO" exp
141 "DO" exp "OD")
142 ("-to-" "TO" exp "DO" exp "OD")
143 ("WHILE" exp "DO" exp "OD"))
144 (insts (insts ";" insts)
145 (id ":=" exp)
146 ("IF" exp "THEN" insts "FI")
147 ("IF" exp "THEN" insts "ELSE" insts "FI")
148 ("IF" exp "THEN" insts
149 "ELSIF" exp "THEN" insts "ELSE" insts "FI")
150 ("IF" exp "THEN" insts
151 "ELSIF" exp "THEN" insts
152 "ELSIF" exp "THEN" insts "ELSE" insts "FI")
153 ;; TODO OUSE for both case and conformity case
154 ("CASE" exp "IN" fargs "ESAC")
155 ("CASE" exp "IN" conformity-cases "ESAC")
156 ("CASE" exp "IN" fargs "OUT" exp "ESAC")
157 (op-decl)
158 (type-decl)
159 (proc-decl)
160 (loop)))
161 '((assoc "OF" "[")
162 (assoc ";")
163 (assoc "|" "|:")
164 (assoc ","))
165 '((assoc "=" "/" ":=" ":=:" ":/=:"
166 "+" "-" "*" "/")))))
168 (defun a68--smie-rules (kind token)
169 (pcase (cons kind token)
170 (`(:elem . basic) a68-indent-level)
171 ;; (`(,_ . ",") (smie-rule-separator kind))
172 (`(,_ . ",") (smie-rule-separator kind))
173 (`(,_ . ";") (when (smie-rule-parent-p)
174 (smie-rule-parent)))
175 (`(:after . ":=") a68-indent-level)
176 (`(:after . "=") a68-indent-level)
177 (`(:before . ,(or `"BEGIN" '"(")) (when (smie-rule-hanging-p)
178 (smie-rule-parent)))
179 (`(:before . "IF")
180 (and (not (smie-rule-bolp))
181 (smie-rule-prev-p "ELSE")
182 (smie-rule-parent)))))
184 (defun a68--smie-forward-token ()
185 (forward-comment (point-max))
186 (cond
187 ((looking-at a68--keywords-regexp)
188 (goto-char (match-end 0))
189 (match-string-no-properties 0))
190 (t (buffer-substring-no-properties (point)
191 (progn (skip-syntax-forward "w_")
192 (point))))))
194 (defun a68--smie-backward-token ()
195 (forward-comment (- (point)))
196 (cond
197 ((looking-back a68--keywords-regexp (- (point) 2) t)
198 (goto-char (match-beginning 0))
199 (match-string-no-properties 0))
200 (t (buffer-substring-no-properties (point)
201 (progn (skip-syntax-backward "w_")
202 (point))))))
204 (defvar a68-mode-syntax-table
205 (let ((st (make-syntax-table)))
206 (modify-syntax-entry ?# "<" st)
207 (modify-syntax-entry ?# ">" st)
208 (modify-syntax-entry ?\\ "." st)
209 (modify-syntax-entry ?, "." st)
210 (modify-syntax-entry ?: "." st)
211 ;; define parentheses to match
212 (modify-syntax-entry ?\( "()" st)
213 (modify-syntax-entry ?\) ")(" st)
214 st))
216 (defvar a68-mode-abbrev-table nil
217 "Abbreviation table used in `a68-mode' buffers.")
219 (define-abbrev-table 'a68-mode-abbrev-table
220 '())
222 ;;;###autoload
223 (define-derived-mode a68-mode prog-mode "Algol68"
224 "Major mode for editing Alogl68 files."
225 :abbrev-table a68-mode-abbrev-table
226 (setq-local font-lock-defaults '(a68-font-lock-keywords))
227 (smie-setup a68--smie-grammar #'a68--smie-rules
228 :forward-token #'a68--smie-forward-token
229 :backward-token #'a68--smie-backward-token)
230 (setq-local comment-start a68-comment-style)
231 (setq-local comment-end a68-comment-style)
232 (setq-local syntax-propertize-function
233 (syntax-propertize-rules
234 ((rx (group bow "COMMENT" eow)
235 (group (*? anychar))
236 (group bow "COMMENT" eow))
237 (1 "<")
238 (3 ">"))
239 ((rx (group bow "CO" eow)
240 (group (*? anychar))
241 (group bow "CO" eow))
242 (1 "<")
243 (3 ">"))
244 ;; a comment is # ... #, but I don't want the
245 ;; (eventual) shebang #! to be considered the start of
246 ;; the comment.
247 ((rx (group "#" (not "!"))
248 (group (*? anychar))
249 (group "#"))
250 (1 "<")
251 (3 ">")))))
253 ;;;###autoload
254 (add-to-list 'auto-mode-alist '("\\.a68\\'" . a68-mode))
256 (provide 'a68-mode)
257 ;;; a68-mode.el ends here