Re: Adding a68-mode to ELPA

[Philip Kaludercic]

Stefan Kangas <stefankangas@gmail.com> writes:

> "Jose E. Marchesi" <jemarch@gnu.org> writes:
>
>> Hello people!
>>
>> I would like to get a68-mode, a major mode for editing Algol 68
>> programs, distributed in ELPA.
>>
>>
>> The mode lives in https://git.sr.ht/~jemarch/a68-mode.
>>
>> An Algol 68 front-end for GCC is under development [1] and I use the
>> mode to write programs [2].  It works reasonably well, even though the
>> SMIE bits could be improved (yes I am too stupid for SMIE :/).
>>
>> [1] https://gcc.gnu.org/wiki/Algol68FrontEnd
>> [2] https://git.sr.ht/~jemarch/godcc
>
> Philip, Stefan, could you take a look at this please?

Just to mention it, there was a thread on this mode a while ago:
<3R4QN2M2RR03N.2G0ADM6I6F823@venera>.

Other than that, I have a few comments, suggestions and questions:

diff --git a/a68-mode.el b/a68-mode.el
index 3cbc562..c3f9d40 100644
--- a/a68-mode.el
+++ b/a68-mode.el
@@ -50,18 +50,19 @@
 
 (defcustom a68-indent-level 3
   "Indentation step for Algol 68."
-  :type 'integer
-  :safe #'integerp)
+  :type 'natnum
+  :safe #'natnump)
 
 (defcustom a68-comment-style "#"
   "Default comment style used by e.g. `comment-dwim'."
   :type '(choice (const "#")
                  (const "CO")
                  (const "COMMENT"))
-  :safe #'consp)
+  :safe #'consp)                       ;a cons isn't mentioned in :type
 
-(defvar a68-mode-hook '()
-  "Hook run when entering Algol68 mode.")
+(defcustom a68-mode-hook '()
+  "Hook run when entering `a68-mode'."
+  :type 'hook)
 
 (defvar a68-mode-map
   (let ((map (make-sparse-keymap)))
@@ -99,31 +100,27 @@
 
 (defconst a68-font-lock-keywords
   (list
-   (cons (rx word-start
-             (eval `(or ,@(mapcar (lambda (kw) kw) a68-keywords)))
-             word-end)
+   (cons (regexp-opt a68-keywords 'words)
          'font-lock-keyword-face)
-   (cons (rx word-start
-             (eval `(or ,@(mapcar (lambda (mode) mode) a68-std-modes)))
-             word-end)
+   (cons (regexp-opt a68-std-modes 'words)
          'font-lock-type-face)
-   (cons (rx word-start
-             (or "TRUE" "FALSE")
-             word-end)
+   (cons (regexp-opt '("TRUE" "FALSE") 'words)
          'font-lock-constant-face)
    ;; only valid for bold stropping
    (cons (concat "\\<[A-Z]+\\>") 'font-lock-type-face)
-   (cons "\\('\\w*'\\)"
-         'font-lock-variable-name-face))
+   (cons "\\('\\w*'\\)" 'font-lock-variable-name-face))
   "Highlighting expressions for Algol 68 mode.")
 
-(defun a68-within-string ()
+(defsubst a68-within-string ()
+  "Return non-nil if in a string."
   (nth 3 (syntax-ppss)))
 
-(defun a68-within-comment ()
+(defsubst a68-within-comment ()
+  "Return non-nil if in a comment."
   (nth 4 (syntax-ppss)))
 
-(defun a68-within-string-or-comment ()
+(defsubst a68-within-string-or-comment ()
+  "Return non-nil if in a string or comment."
   (nth 8 (syntax-ppss)))
 
 (defvar a68--keywords-regexp
@@ -227,21 +224,20 @@
 (defun a68--smie-forward-token ()
   (forward-comment (point-max))
   (cond
-   ((looking-at a68--keywords-regexp)
+   ((looking-at (rx (or (: point (+ (or word (syntax symbol))))
+                       (regexp a68--keywords-regexp))))
     (goto-char (match-end 0))
-    (match-string-no-properties 0))
-   (t (buffer-substring-no-properties (point)
-                                      (progn (skip-syntax-forward "w_")
-                                             (point))))))
+    (match-string-no-properties 0))))
 
 (defun a68--smie-backward-token ()
-  (forward-comment (- (point)))
+  (forward-comment (- (point)))                ;I am not sure if (- (point)) 
is the right thing here..,
   (cond
-   ((looking-back a68--keywords-regexp (- (point) 2) t)
+   ((and (>= (- (point) 2) (point-min))
+        (looking-back a68--keywords-regexp (- (point) 2) t))
     (goto-char (match-beginning 0))
     (match-string-no-properties 0))
    (t (buffer-substring-no-properties (point)
-                                      (progn (skip-syntax-backward "w_")
+                                      (progn (skip-syntax-backward "w_") ;is _ 
enough?
                                              (point))))))
 
 (defvar a68-mode-syntax-table
@@ -269,10 +265,12 @@
       (insert "#")
     (save-excursion
       (insert "#   #"))
-    (goto-char (+ (point) 2))))
+    (forward-char 2)))
 
 (defun a68-beginning-of-defun (&optional arg)
-  "Algol 68 specific `beginning-of-defun-function'."
+  "Algol 68 specific `beginning-of-defun-function'.
+With ARG, do it that many times.  Negative ARG means move forward to the
+ARGth following beginning of defun."   ;this this is not the case!
   (goto-char (save-excursion
                (while (and (re-search-backward (rx bow (or "PROC" "OP")) nil t)
                            (a68-within-string-or-comment)))
@@ -311,27 +309,25 @@
   (smie-setup a68--smie-grammar #'a68--smie-rules
               :forward-token #'a68--smie-forward-token
               :backward-token #'a68--smie-backward-token)
-  (add-hook 'after-change-functions 'a68--after-change-function nil t)
+  (add-hook 'after-change-functions #'a68--after-change-function nil t)
   (setq-local comment-start a68-comment-style)
   (setq-local comment-end a68-comment-style)
-  (setq-local beginning-of-defun-function 'a68-beginning-of-defun)
+  (setq-local beginning-of-defun-function #'a68-beginning-of-defun)
   (setq-local syntax-propertize-function #'a68-syntax-propertize-function))
 
 ;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.a68\\'" . a68-mode))
-
-(provide 'a68-mode)
+(add-to-list 'auto-mode-alist (cons "\\.a68\\'" #'a68-mode))
 
 ;;;; Pretty-printing of bold tags (minor mode).
 
 (defface a68-bold-tag-face '((t :inherit font-lock-keyword-face))
-  "Face for ALGOL 68 bold tags")
+  "Face for ALGOL 68 bold tags.")
 
+;; why do you need this autoload?  the autoload scraper should extract this 
declaration...
 ;;;###autoload(defvar a68-pretty-bold-tags-mode nil "Non-nil if A68 pretty 
print bold tags mode is enabled.")
 ;;;###autoload
 (define-minor-mode a68-pretty-bold-tags-mode
-  "Toggle pretty-printing of bold tags in a68-mode."
-  :group a68
+  "Toggle pretty-printing of bold tags in `a68-mode'."
   (if a68-pretty-bold-tags-mode
       (a68--pretty-print-bold-tags-on)
     (a68--pretty-print-bold-tags-off)))
@@ -340,10 +336,10 @@
   (save-excursion
     (goto-char (point-min))
     (a68--pretty-print-bold-tags (point-min) (point-max))
-    (add-hook 'after-change-functions 'a68--after-change-function nil t)))
+    (add-hook 'after-change-functions #'a68--after-change-function nil t)))
 
 (defun a68--pretty-print-bold-tags-off ()
-  (remove-hook 'after-change-functions 'a68--after-change-function t)
+  (remove-hook 'after-change-functions #'a68--after-change-function t)
   (save-excursion
     (goto-char (point-min))
     (let (match)
@@ -356,12 +352,11 @@
 (defun a68--pretty-print-bold-tag ()
   "Pretty-print an ALGOL 68 bold tag."
   (save-excursion
-    (unless (or (a68-within-comment)
-                (a68-within-string))
-      (skip-chars-forward "ABCDEFGHIJKLMNOPQRSTUVWXYZ_")
+    (unless (a68-within-string-or-comment)
+      (skip-chars-forward (concat (number-sequence ?A ?Z) [?_])) ;to avoid 
forgetting a letter
       (let* ((bold-tag-end (point))
              (bold-tag-begin (save-excursion
-                               (skip-chars-backward 
"ABCDEFGHIJKLMNOPQRSTUVWXYZ_")
+                               (skip-chars-backward (concat (number-sequence 
?A ?Z) [?_]))
                                (point))))
         (let ((replacedtext (downcase (buffer-substring bold-tag-begin 
bold-tag-end)))
               (overlay (make-overlay bold-tag-begin bold-tag-end)))
@@ -372,16 +367,14 @@
           (overlay-put overlay 'evaporate t))))))
 
 (defun a68--pretty-print-bold-tags (beginning end)
-  "Pretty-print ALGOL 68 bold tags in the given region."
-  (unless (or (a68-within-comment)
-              (a68-within-string))
+  "Pretty-print ALGOL 68 bold tags between BEGINNING and END."
+  (unless (a68-within-string-or-comment)
     (save-excursion
       (goto-char beginning)
       (while (let ((case-fold-search nil))
-               (re-search-forward (rx word-start upper (zero-or-more upper) 
word-end)
+               (re-search-forward (rx word-start (one-or-more upper) word-end)
                                   nil t))
-        (unless (or (a68-within-comment)
-                    (a68-within-string))
+        (unless (a68-within-string-or-comment)
           (let* ((bold-tag-end (match-end 0))
                  (bold-tag-begin (match-beginning 0)))
             (let ((replacedtext (downcase (buffer-substring bold-tag-begin 
bold-tag-end)))
@@ -395,8 +388,7 @@
 (defun a68--after-change-function (start stop _len)
   "Save the current buffer and point for the mode's post-command hook."
   (when a68-pretty-bold-tags-mode
-    (let* ((pos (point))
-           (in-bold-tag-already (get-char-property pos 'display)))
+    (let ((in-bold-tag-already (get-char-property (point) 'display)))
       (save-match-data
         (if (equal _len 0)
             (a68--pretty-print-bold-tag)
@@ -408,8 +400,7 @@
 ;;;###autoload(defvar a68-auto-stropping-mode nil "Non-nil if A68 auto 
stropping mode is enabled.")
 ;;;###autoload
 (define-minor-mode a68-auto-stropping-mode
-  "Toggle auto-stropping in a68-mode."
-  :group a68
+  "Toggle auto-stropping in `a68-mode'."
   (if a68-auto-stropping-mode
       (progn
         (a68--collect-modes)
@@ -426,7 +417,7 @@
 
 (defun a68--collect-modes ()
   "Collect mode-indicants of modes defined in the current buffer
-into a68--mode-indicants."
+into a68--mode-indicants."             ;<-checkdoc warning because of 
line-break!
   (save-excursion
     (goto-char (point-min))
     (let ((case-fold-search nil))
@@ -435,7 +426,8 @@ into a68--mode-indicants."
                                     (one-or-more white)
                                     (group (any "A-Z") (zero-or-more (any 
"A-Z0-9_")))
                                     (zero-or-more white)
-                                    "=") nil t)
+                                    "=")
+                               nil t)
         (setq a68--mode-indicants
               (cons (buffer-substring-no-properties (match-beginning 1)
                                                     (match-end 1))
@@ -458,4 +450,5 @@ into a68--mode-indicants."
             (delete-region beginning end)
             (insert id)))))))
 
+(provide 'a68-mode)
 ;;; a68-mode.el ends here