branch: elpa/j-mode
commit 3f852d1476be5625fea51dcaaad66dd57593101a
Merge: 690c7acdfc 9a24728dec
Author: LdBeth <andp...@foxmail.com>
Commit: GitHub <nore...@github.com>
Merge pull request #30 from zellio/v2.0.1
Update to version 2.0.1
---
README.md | 5 +-
j-console.el | 34 ++++---
j-font-lock.el | 300 ++++++++++++++++++++++++++++++++++++++++++---------------
j-help.el | 97 ++++++++-----------
j-mode.el | 226 +++++++++++++++++++++++++++++++++++++------
5 files changed, 486 insertions(+), 176 deletions(-)
diff --git a/README.md b/README.md
index 6f189630de..732ee715c8 100644
--- a/README.md
+++ b/README.md
@@ -17,7 +17,8 @@ place in your load path and load / require normally.
(autoload 'j-mode "j-mode.el" "Major mode for editing J files" t)
;; Add for detection of j source files if the auto-load fails
-(add-to-list 'auto-mode-alist '("\\.ij[rstp]$" . j-mode))
+(add-to-list 'auto-mode-alist '("\\.ij[rsp]$" . j-mode))
+(add-to-list 'auto-mode-alist '("\\.ijt$" . j-lab-mode))
```
## J Font Lock
@@ -28,7 +29,7 @@ various parts of speech. Those faces are `j-verb-face`
`j-adverb-face`
standard built in faces to help meet your need.
```lisp
-(custom-set-face
+(custom-set-faces
'(j-verb-face ((t (:foreground "Red"))))
'(j-adverb-face ((t (:foreground "Green"))))
'(j-conjunction-face ((t (:foreground "Blue"))))
diff --git a/j-console.el b/j-console.el
index 82833851bb..ec67531346 100644
--- a/j-console.el
+++ b/j-console.el
@@ -1,12 +1,13 @@
-
+;; -*- lexical-binding:t -*-
;;; j-mode.el --- Major mode for editing J programs
;; Copyright (C) 2012 Zachary Elliott
+;; Copyright (C) 2023, 2024 LdBeth
;;
;; Authors: Zachary Elliott <zacharyellio...@gmail.com>
;; URL: http://github.com/zellio/j-mode
-;; Version: 1.1.1
-;; Keywords: J, Languages
+;; Version: 2.0.1
+;; Keywords: J, Langauges
;; This file is not part of GNU Emacs.
@@ -36,17 +37,13 @@
(require 'comint)
-
-;; (defconst j-console-version "1.1.1"
-;; "`j-console' version")
-
(defgroup j-console nil
"REPL integration extention for `j-mode'"
:group 'applications
:group 'j
:prefix "j-console-")
-(defcustom j-console-cmd "ijconsole"
+(defcustom j-console-cmd "jc"
"Name of the executable used for the J REPL session"
:type 'string
:group 'j-console)
@@ -86,7 +83,8 @@ Should be NIL if there is no file not the empty string"
(defun j-console-create-session ()
"Starts a comint session wrapped around the j-console-cmd"
- (setq comint-process-echoes t)
+ (setq comint-process-echoes nil
+ comint-use-prompt-regexp t)
(apply 'make-comint j-console-cmd-buffer-name
j-console-cmd j-console-cmd-init-file j-console-cmd-args)
(mapc
@@ -110,7 +108,8 @@ Should be NIL if there is no file not the empty string"
(get-process j-console-cmd-buffer-name))))
(define-derived-mode inferior-j-mode comint-mode "Inferior J"
- "Major mode for J inferior process.")
+ "Major mode for J inferior process."
+ (setq comint-prompt-regexp "\s+"))
;;;###autoload
(defun j-console ()
@@ -129,19 +128,30 @@ the containing buffer"
(session (j-console-ensure-session)))
(pop-to-buffer (process-buffer session))
(goto-char (point-max))
- (insert (format "\n%s\n" region))
+ (insert (format "%s" region))
(comint-send-input)))
(defun j-console-execute-line ()
"Sends current line to the j-console-cmd session and exectues it"
(interactive)
- (j-console-execute-region (point-at-bol) (point-at-eol)))
+ (j-console-execute-region (pos-bol) (pos-eol)))
(defun j-console-execute-buffer ()
"Sends current buffer to the j-console-cmd session and exectues it"
(interactive)
(j-console-execute-region (point-min) (point-max)))
+;;XXX should maybe check that we are indeed in an explicit def, unlike
+;;elisp counterpart
+(defun j-console-execute-definition ()
+ "Send the current explicit definition to a running J session."
+ (interactive)
+ (save-excursion
+ (mark-defun)
+ (let ((start (point))
+ (end (mark)))
+ (j-console-execute-region start end))))
+
(provide 'j-console)
;;; j-console.el ends here
diff --git a/j-font-lock.el b/j-font-lock.el
index 46511069f2..909cc5cf6a 100644
--- a/j-font-lock.el
+++ b/j-font-lock.el
@@ -1,12 +1,13 @@
-
+;; -*- lexical-binding:t -*-
;;; j-font-lock.el --- font-lock extension for j-mode
;; Copyright (C) 2012 Zachary Elliott
+;; Copyright (C) 2023, 2024 LdBeth
;;
;; Authors: Zachary Elliott <zacharyellio...@gmail.com>
;; URL: http://github.com/zellio/j-mode
-;; Version: 1.1.1
-;; Keywords: J, Languages
+;; Version: 2.0.1
+;; Keywords: J, Langauges
;; This file is not part of GNU Emacs.
@@ -41,10 +42,7 @@
;; USA.
;;; Code:
-
-
-;; (defconst j-font-lock-version "1.1.1"
-;; "`j-font-lock' version")
+(eval-when-compile (require 'rx))
(defgroup j-font-lock nil
"font-lock extension for j-mode"
@@ -57,137 +55,289 @@
:group 'j
:group 'j-font-lock)
-(defvar j-verb-face
- (defface j-verb-face
- `((t (:foreground "Red")))
+(defface j-verb-face
+ `((t (:foreground "Red")))
"Font Lock mode face used to higlight vrebs"
- :group 'j-faces))
+ :group 'j-faces)
-(defvar j-adverb-face
- (defface j-adverb-face
- `((t (:foreground "Green")))
+(defface j-adverb-face
+ `((t (:foreground "Green")))
"Font Lock mode face used to higlight adverbs"
- :group 'j-faces))
+ :group 'j-faces)
-(defvar j-conjunction-face
- (defface j-conjunction-face
- `((t (:foreground "Blue")))
+(defface j-conjunction-face
+ `((t (:foreground "Blue")))
"Font Lock mode face used to higlight conjunctions"
- :group 'j-faces))
+ :group 'j-faces)
-(defvar j-other-face
- (defface j-other-face
- `((t (:foreground "Black")))
+(defface j-other-face
+ `((t (:foreground "Black")))
"Font Lock mode face used to higlight others"
- :group 'j-faces))
+ :group 'j-faces)
(defvar j-font-lock-syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?\{ "." table)
(modify-syntax-entry ?\} "." table)
- (modify-syntax-entry ?\[ "." table)
- (modify-syntax-entry ?\] "." table)
- (modify-syntax-entry ?\" "." table)
+ (modify-syntax-entry '(?! . ?&) "." table)
+ (modify-syntax-entry '(?* . ?/) "." table)
+ (modify-syntax-entry '(?: . ?@) "." table)
+ (modify-syntax-entry '(?\[ . ?^) "." table)
(modify-syntax-entry ?\\ "." table)
- (modify-syntax-entry ?\. "w" table)
- (modify-syntax-entry ?\: "w" table)
+ ;; (modify-syntax-entry ?\. "_" table)
+ ;; (modify-syntax-entry ?\: "_" table)
(modify-syntax-entry ?\( "()" table)
(modify-syntax-entry ?\) ")(" table)
- (modify-syntax-entry ?\' "\"" table)
- (modify-syntax-entry ?N "w 1" table)
- (modify-syntax-entry ?\B "w 2" table)
- (modify-syntax-entry ?\n ">" table)
- (modify-syntax-entry ?\r ">" table)
+ (modify-syntax-entry ?\' "." table)
+ ;; (modify-syntax-entry ?N "w 1" table)
+ ;; (modify-syntax-entry ?B "w 2" table)
+ ;; (modify-syntax-entry ?\n ">" table)
+ ;; (modify-syntax-entry ?\r ">" table)
table)
"Syntax table for j-mode")
-(defvar j-font-lock-constants '())
+(defalias 'j-mode-syntax-propertize
+ (syntax-propertize-rules
+ ("\\(N\\)\\(B\\)\\..*$" (1 "w 1") (2 "w 2")
+ (0 (j-font-lock-nota-bene)))
+ ("\\(?:0\\|noun\\)\s+\\(?::\s*0\\|define\\)"
+ (0 (j-font-lock-multiline-string ?:)))
+ ("^\\()\\)$" (1 (j-font-lock-multiline-string ?\))))
+ ("{{)n" (0 (j-font-lock-multiline-string ?\{)))
+ ("}}" (0 (j-font-lock-multiline-string ?\})))
+ ("{{\\()\\)" (1 "."))
+ ("\\('\\)`?[0-9A-Z_a-z ]*\\('\\)\s*=[.:]" (1 ".") (2 "."))
+ ("\\('\\)\\(?:[^'\n]\\|''\\)*\\('\\)" (1 "\"") (2 "\""))))
+
+(defalias 'j-lab-mode-syntax-propertize
+ (syntax-propertize-rules
+ ("\\(N\\)\\(?:B\\.\s*\\(?:===\\|---\\)\\|ote\s*''\\)"
+ (1 (j-font-lock-multiline-string ?N)))
+ ("\\(N\\)\\(B\\)\\..*$" (1 "w 1") (2 "w 2")
+ (0 (j-font-lock-nota-bene)))
+ ("\\(?:0\\|noun\\)\s+\\(?::\s*0\\|define\\)"
+ (0 (j-font-lock-multiline-string ?:)))
+ ("^\\()\\)$" (1 (j-font-lock-multiline-string ?\))))
+ ("{{)n" (0 (j-font-lock-multiline-string ?\{)))
+ ("}}" (0 (j-font-lock-multiline-string ?\})))
+ ("{{\\()\\)" (1 "."))
+ ("\\('\\)`?[0-9A-Z_a-z ]*\\('\\)\s*=[.:]" (1 ".") (2 "."))
+ ("\\('\\)\\(?:[^'\n]\\|''\\)*\\('\\)" (1 "\"") (2 "\""))))
+
+(defun j-font-lock-nota-bene ()
+ (let ((eol (pos-eol)))
+ (put-text-property (1- eol) eol
+ 'syntax-table (string-to-syntax ">"))))
+(defun j-font-lock-multiline-string (arg)
+ (pcase arg
+ (?: (let* ((ppss (syntax-ppss))
+ (string-start (and (eq t (nth 3 ppss)) (nth 8 ppss)))
+ (eol (pos-eol)))
+ (unless (or (or string-start (> (1+ eol) (point-max)))
+ (save-excursion
+ (goto-char (1+ eol))
+ (looking-at "^)$")))
+ (put-text-property eol (1+ eol)
+ 'syntax-table (string-to-syntax "|")))
+ nil))
+ (?N (let ((ppss (save-excursion (syntax-ppss (match-beginning 1)))))
+ (unless (and (eq t (nth 3 ppss)) (nth 8 ppss)) ; inside string
+ (string-to-syntax "|"))))
+ (?\{ (let* ((ppss (save-excursion (backward-char 4) (syntax-ppss)))
+ (string-start (and (eq t (nth 3 ppss)) (nth 8 ppss)))
+ (quote-starting-pos (- (point) 4)))
+ (unless string-start
+ (put-text-property quote-starting-pos (1+ quote-starting-pos)
+ 'syntax-table (string-to-syntax "|"))
+ (put-text-property (+ 2 quote-starting-pos) (+ 3
quote-starting-pos)
+ 'syntax-table (string-to-syntax ".")))
+ nil))
+ (?\) (let* ((ppss (save-excursion (backward-char 2) (syntax-ppss)))
+ (string-start (and (eq t (nth 3 ppss)) (nth 8 ppss)))
+ (quote-starting-pos (- (point) 1)))
+ (if (and string-start (or
+ (eql (char-after string-start) ?\n)
+ (eql (char-after string-start) ?N)))
+ (put-text-property (1- quote-starting-pos) quote-starting-pos
+ 'syntax-table (string-to-syntax "|")))
+ (string-to-syntax ".")))
+ (?\} (let* ((ppss (save-excursion (backward-char 2) (syntax-ppss)))
+ (string-start (and (eq t (nth 3 ppss)) (nth 8 ppss)))
+ (quote-end-pos (point)))
+ (if (and string-start (eql (char-after string-start)
+ ?\{))
+ (put-text-property (1- quote-end-pos) quote-end-pos
+ 'syntax-table (string-to-syntax "|")))
+ nil))))
+
+
+(defvar j-font-lock-constants
+ '(
+ ;; char codes
+ "CR" "CRLF" "LF" "TAB" "EMPTY"
+ ;; grammar codes
+ ;;0 1 2 3 3 4
+ "noun" "adverb" "conjunction" "verb" "monad" "dyad"
+ ))
+
+(defvar j-font-lock-builtins
+ `(;; modules
+ "require" "load" "loadd" "script" "scriptd"
+ "jpath" "jcwdpath" "jhostpath" "jsystemdefs"
+ ;; OO
+ "coclass" "cocreate" "cocurrent" "codestroy" "coerase"
+ "coextend" "cofullname" "coinsert" "coname" "conames" "conew"
+ "conl" "copath" "coreset"
+ ;; environment
+ "type" "names" "nameclass" "nc" "namelist" "nl" "erase"
+ ;; dll
+ "cd" "memr" "memw" "mema" "memf" "memu" "cdf"
+ ;; system
+ "assert"
+ "getenv" "setenv" "exit" "stdin" "stdout" "stderr"
+ ;; : :0
+ "def" "define" ))
(defvar j-font-lock-control-structures
'("assert." "break." "continue." "while." "whilst." "for." "do."
"end."
"if." "else." "elseif." "return." "select." "case." "fcase."
"throw."
- "try." "catch." "catchd." "catcht." "end."
- ;; "for_[a-zA-Z]+\\." "goto_[a-zA-Z]+\\." "label_[a-zA-Z]+\\."
- ))
+ "try." "catch." "catchd." "catcht." "end."))
+
+(defvar j-font-lock-direct-definition
+ '("{{" "}}"))
(defvar j-font-lock-foreign-conjunctions
- '("0!:" "1!:" "2!:" "3!:" "4!:" "5!:" "6!:" "7!:" "8!:" "9!:" "11!:" "13!:"
+ '("0!:" "1!:" "2!:" "3!:" "4!:" "5!:" "6!:" "7!:" "8!:" "9!:" "13!:"
"15!:" "18!:" "128!:" ))
(defvar j-font-lock-len-3-verbs
- '("_9:" "p.." "{::"))
+ '("p.." "{::"))
(defvar j-font-lock-len-2-verbs
- '("x:" "u:" "s:" "r." "q:" "p:" "p." "o." "L." "j." "I." "i:" "i." "E." "e."
- "C." "A." "?." "\":" "\"." "}:" "}." "{:" "{." "[:" "/:" "\\:" "#:" "#."
";:" ",:"
+ '("u:" "u." "v." "s:" "r." "q:" "p:" "p." "o." "L." "j." "I."
+ "i:" "i." "E." "e." "x:" "Z:"
+ "C." "c." "A." "T." "?." "\":" "\"." "}:" "}." "{:" "{." "[:" "/:" "\\:"
"#:" "#." ";:" ",:"
",." "|:" "|." "~:" "~." "$:" "$." "^." "%:" "%." "-:" "-." "*:" "*." "+:"
- "+." "_:" ">:" ">." "<:" "<."))
+ "+." ">:" ">." "<:" "<."))
(defvar j-font-lock-len-1-verbs
- '("?" "{" "]" "[" ":" "!" "#" ";" "," "|" "$" "^" "%" "-" "*" "+" ">" "<"
"="))
+ '("?" "{" "]" "[" "!" "#" ";" "," "|" "$" "^" "%" "-" "*" "+" ">" "<" "="))
(defvar j-font-lock-verbs
(append j-font-lock-len-3-verbs j-font-lock-len-2-verbs
j-font-lock-len-1-verbs))
+(defvar j-font-lock-len-3-adverbs
+ '("/.."))
(defvar j-font-lock-len-2-adverbs
- '("t:" "t." "M." "f." "b." "/."))
+ '("]:" "M." "f." "b." "/." "\\."))
(defvar j-font-lock-len-1-adverbs
- '("}" "." "\\" "/" "~"))
+ '("}" "\\" "/" "~"))
(defvar j-font-lock-adverbs
- (append j-font-lock-len-2-adverbs j-font-lock-len-1-adverbs))
+ (append j-font-lock-len-3-adverbs j-font-lock-len-2-adverbs
j-font-lock-len-1-adverbs))
(defvar j-font-lock-len-3-others
'("NB."))
(defvar j-font-lock-len-2-others
- '("=." "=:" "_." "a." "a:"))
+ '("=." "=:" "a." "a:" ;; "__" "_."
+ ))
(defvar j-font-lock-len-1-others
'("_" ))
(defvar j-font-lock-others
(append j-font-lock-len-3-others j-font-lock-len-2-others
j-font-lock-len-1-others))
(defvar j-font-lock-len-3-conjunctions
- '("&.:"))
+ '("&.:" "F.." "F.:" "F:." "F::"))
(defvar j-font-lock-len-2-conjunctions
- '("T." "S:" "L:" "H." "D:" "D." "d." "&:" "&." "@:" "@." "`:" "!:" "!." ";."
- "::" ":." ".:" ".." "^:"))
+ '("t." "S:" "L:" "H." "D:" "D." "d." "F." "F:" "m."
+ "&:" "&." "@:" "@." "`:" "!:" "!." ";." "[." "]."
+ "^:"))
(defvar j-font-lock-len-1-conjunctions
- '("&" "@" "`" "\"" ":" "."))
+ '("&" "@" "`" "\""))
(defvar j-font-lock-conjunctions
(append j-font-lock-len-3-conjunctions
j-font-lock-len-2-conjunctions
j-font-lock-len-1-conjunctions))
+(defconst j-font-lock-multiassign-regexp
+ (rx (group "'") (? "`") (* (any "_a-zA-Z0-9 ")) (group "'")
+ (* "\s") "=" (or "." ":")))
+
+(defun j-font-lock-prematch-variable ()
+ (goto-char (match-end 1))
+ (match-beginning 2))
(defvar j-font-lock-keywords
`(
- ("\\([_a-zA-Z0-9]+\\)\s*\\(=[.:]\\)"
- (1 font-lock-variable-name-face) (2 j-other-face))
-
+ (,(rx (group (+ (any "_a-zA-Z0-9")))
+ (* "\s") "=" (or "." ":"))
+ (1 font-lock-variable-name-face))
+ (,j-font-lock-multiassign-regexp
+ (1 font-lock-keyword-face)
+ (2 font-lock-keyword-face)
+ ("[_a-zA-Z0-9]+"
+ (j-font-lock-prematch-variable) nil
+ (0 font-lock-variable-name-face)))
+ (,(rx bow (any "a-zA-Z")
+ (* (any "_a-zA-Z0-9"))
+ "_:") ;; Self-Effacing References
+ . font-lock-warning-face)
(,(regexp-opt j-font-lock-foreign-conjunctions) . font-lock-warning-face)
- (,(concat (regexp-opt j-font-lock-control-structures)
- "\\|\\(?:\\(?:for\\|goto\\|label\\)_[a-zA-Z]+\\.\\)")
+ (,(rx symbol-start
+ (or (regexp (regexp-opt j-font-lock-control-structures))
+ (seq (or "for" "goto" "label")
+ "_" (+ (any "a-zA-Z")) ".")))
. font-lock-keyword-face)
- (,(regexp-opt j-font-lock-constants) . font-lock-constant-face)
- (,(regexp-opt j-font-lock-len-3-verbs) . j-verb-face)
- (,(regexp-opt j-font-lock-len-3-conjunctions) . j-conjunction-face)
+ (,(rx symbol-start (regexp (regexp-opt j-font-lock-builtins)) eow)
+ . font-lock-builtin-face)
+ (,(rx symbol-start
+ (regexp
+ (regexp-opt j-font-lock-constants))
+ eow)
+ . font-lock-constant-face)
+ (,(regexp-opt j-font-lock-len-3-verbs)
+ . 'j-verb-face)
+ (,(regexp-opt j-font-lock-len-3-adverbs) . 'j-adverb-face)
+ (,(regexp-opt j-font-lock-len-3-conjunctions) . 'j-conjunction-face)
;;(,(regexp-opt j-font-lock-len-3-others) . )
- (,(regexp-opt j-font-lock-len-2-verbs) . j-verb-face)
- (,(regexp-opt j-font-lock-len-2-adverbs) . j-adverb-face)
- (,(regexp-opt j-font-lock-len-2-conjunctions) . j-conjunction-face)
- ;;(,(regexp-opt j-font-lock-len-2-others) . )
- (,(regexp-opt j-font-lock-len-1-verbs) . j-verb-face)
- (,(regexp-opt j-font-lock-len-1-adverbs) . j-adverb-face)
- (,(regexp-opt j-font-lock-len-1-conjunctions) . j-conjunction-face)
- ;;(,(regexp-opt j-font-lock-len-1-other) . )
- ) "J Mode font lock keys words")
+ (,(rx (or (regexp (regexp-opt j-font-lock-len-2-verbs))
+ (seq symbol-start (opt "_") (regexp "[0-9_]") ":")))
+ . 'j-verb-face)
+ (,(regexp-opt j-font-lock-len-2-adverbs) . 'j-adverb-face)
+ (,(regexp-opt j-font-lock-len-2-conjunctions) . 'j-conjunction-face)
+ (,(regexp-opt j-font-lock-len-2-others) . 'j-other-face)
+ (,(regexp-opt j-font-lock-direct-definition) . 'font-lock-keyword-face)
+ (,(regexp-opt j-font-lock-len-1-verbs) . 'j-verb-face)
+ (,(regexp-opt j-font-lock-len-1-adverbs) . 'j-adverb-face)
+ (,(regexp-opt j-font-lock-len-1-conjunctions) . 'j-conjunction-face)
+ (,(rx (or bol (+ "\s")) (group (or ":" "." ":." "::")))
+ (1 'j-conjunction-face))
+ ;;(,(regexp-opt j-font-lock-len-1-others) . 'j-other-face)
+ )
+ "J Mode font lock keys words")
+
+(defun j-font-lock-docstring-p (state)
+ "Detect if multi-line string should be docstring."
+ (save-excursion
+ (goto-char (nth 8 state))
+ (beginning-of-line)
+ (not (looking-at-p "[_'`a-zA-Z0-9\s]+=[.:]"))))
(defun j-font-lock-syntactic-face-function (state)
- "Function for detection of string vs. Comment Note: J comments
+ "Function for detection of string vs. Comment. Note: J comments
are three chars longs, there is no easy / evident way to handle
this in emacs and it poses problems"
- (if (nth 3 state) font-lock-string-face
- (let* ((start-pos (nth 8 state)))
- (and (<= (+ start-pos 3) (point-max))
- (eq (char-after start-pos) ?N)
+ (let ((start-pos (nth 8 state)))
+ (cond
+ ((nth 3 state)
+ (if (or (and ; A free standing multiline string
+ (eql (char-after start-pos) ?\n)
+ (j-font-lock-docstring-p state))
+ ;; J Lab command
+ (eql (char-after start-pos) ?N))
+ font-lock-doc-face
+ font-lock-string-face))
+ ((and (<= (+ start-pos 3) (point-max))
+ (eql (char-after start-pos) ?N)
(string= (buffer-substring-no-properties
- start-pos (+ start-pos 3)) "NB.")
- font-lock-comment-face))))
+ start-pos (+ start-pos 3))
+ "NB."))
+ font-lock-comment-face))))
(provide 'j-font-lock)
diff --git a/j-help.el b/j-help.el
index c912b9ea82..05d2aba0cb 100644
--- a/j-help.el
+++ b/j-help.el
@@ -1,10 +1,12 @@
-;;; j-help.el --- Documentation extention for j-mode -*- lexical-binding: t;
-*-
+;; -*- lexical-binding:t -*-
+;;; j-help.el --- Documentation extention for j-mode
;; Copyright (C) 2012 Zachary Elliott
+;; Copyright (C) 2023, 2024 LdBeth
;;
;; Authors: Zachary Elliott <zacharyellio...@gmail.com>
;; URL: http://github.com/zellio/j-mode
-;; Version: 1.1.1
+;; Version: 2.0.1
;; Keywords: J, Languages
;; This file is not part of GNU Emacs.
@@ -41,31 +43,21 @@
;;; Code:
-(defun group-by* ( list fn prev coll agr )
- "Helper method for the group-by function. Should not be called directly."
- (if list
- (let* ((head (car list))
- (tail (cdr list)))
- (if (eq (funcall fn head) (funcall fn prev))
- (group-by* tail fn head (cons head coll) agr)
- (group-by* tail fn head '() (cons coll agr))))
- (cons coll agr)))
-
-(defun group-by ( list fn )
- "Group-by is a FUNCTION across LIST, returning a sequence
-It groups the objects in LIST according to the predicate FN"
- (let ((sl (sort list (lambda (x y) (< (funcall fn x) (funcall fn y))))))
- (group-by* sl fn '() '() '())))
-
-(unless (fboundp 'some)
- (defun some ( fn list )
- (when list
- (let ((val (funcall fn (car list))))
- (if val val (some fn (cdr list)))))))
-
-(unless (fboundp 'caddr)
- (defun caddr ( list )
- (car (cdr (cdr list)))))
+(defun j-help--process-voc-list (alist)
+ (let ((table (make-hash-table))
+ res)
+ (dolist (x alist)
+ (let ((len (length (car x))))
+ (puthash len
+ (cons x (gethash len table))
+ table)))
+ (maphash (lambda (key l) (push
+ (list key
+ (regexp-opt (mapcar #'car l))
+ l)
+ res))
+ table)
+ res))
(defgroup j-help nil
"Documentation extention for j-mode"
@@ -120,11 +112,7 @@ It groups the objects in LIST according to the predicate
FN"
"(string * string) alist")
(defconst j-help-dictionary-data-block
- (mapcar
- (lambda (l) (list (length (caar l))
- (regexp-opt (mapcar 'car l))
- l))
- (delq nil (group-by j-help-voc-alist (lambda (x) (length (car x))))))
+ (j-help--process-voc-list j-help-voc-alist)
"(int * string * (string * string) alist) list")
(defun j-help-valid-dictionary ()
@@ -137,11 +125,10 @@ It groups the objects in LIST according to the predicate
FN"
j-help-remote-dictionary-url))))
(defun j-help-symbol-pair-to-doc-url ( alist-data )
- ""
(let ((dic (j-help-valid-dictionary)))
(if (or (not alist-data) (string= dic ""))
(error "%s" "No dictionary found. Please specify a dictionary.")
- (let ((name (car alist-data))
+ (let ((_name (car alist-data))
(doc-name (cdr alist-data)))
(format "%s/%s.%s" dic doc-name "htm")))))
@@ -149,36 +136,37 @@ It groups the objects in LIST according to the predicate
FN"
"Convert J-SYMBOL into localtion URL"
(j-help-symbol-pair-to-doc-url (assoc j-symbol j-help-voc-alist)))
-(defun j-help-determine-symbol ( s point )
+(defun j-help--determine-symbol ( s point )
"Internal function to determine j symbols. Should not be called directly
-
string * int -> (string * string) list"
(unless (or (< point 0) (< (length s) point))
- (some
- (lambda (x)
- (let* ((check-size (car x)))
- (if (and
- (<= (+ check-size point) (length s))
- (string-match (cadr x) (substring s point (+ point check-size))))
- (let* ((m (match-data))
- (ss (substring s (+ point (car m)) (+ point (cadr m)))))
- (assoc ss (caddr x))))))
- j-help-dictionary-data-block)))
+ (let ((list j-help-dictionary-data-block)
+ val)
+ (while (and list (not val))
+ (setq val (let* ((x (car list))
+ (check-size (car x)))
+ (and
+ (<= (+ check-size point) (length s))
+ (string-match (cadr x) (substring s point (+ point
check-size)))
+ (let* ((m (match-data))
+ (ss (substring s (+ point (car m)) (+ point (cadr
m)))))
+ (assoc ss (caddr x)))))
+ list (cdr list)))
+ val)))
(defun j-help-determine-symbol-at-point ( point )
"int -> (string * string) list"
(save-excursion
(goto-char point)
- (let* ((bol (point-at-bol))
- (eol (point-at-eol))
+ (let* ((bol (pos-bol))
+ (eol (pos-eol))
(s (buffer-substring-no-properties bol eol)))
- (j-help-determine-symbol s (- point bol)))))
+ (j-help--determine-symbol s (- point bol)))))
(defun j-help-branch-determine-symbol-at-point*
( string current-index target-index resolved-symbol )
- ""
(if (> current-index target-index) resolved-symbol
- (let ((next-symbol (j-help-determine-symbol string current-index)))
+ (let ((next-symbol (j-help--determine-symbol string current-index)))
(j-help-branch-determine-symbol-at-point*
string
(+ current-index (length (or (car next-symbol) " ")))
@@ -186,13 +174,12 @@ string * int -> (string * string) list"
next-symbol))))
(defun j-help-branch-determine-symbol-at-point ( point )
- ""
(save-excursion
(goto-char point)
(j-help-branch-determine-symbol-at-point*
- (buffer-substring-no-properties (point-at-bol) (point-at-eol))
- (- (max (- point j-help-symbol-search-branch-limit) (point-at-bol))
(point-at-bol))
- (- point (point-at-bol))
+ (buffer-substring-no-properties (pos-bol) (pos-eol))
+ (- (max (- point j-help-symbol-search-branch-limit) (pos-bol)) (pos-bol))
+ (- point (pos-bol))
nil)))
;;;###autoload
diff --git a/j-mode.el b/j-mode.el
index 5cadb58213..fd0640a457 100644
--- a/j-mode.el
+++ b/j-mode.el
@@ -1,12 +1,13 @@
-
+;; -*- lexical-binding:t -*-
;;; j-mode.el --- Major mode for editing J programs
;; Copyright (C) 2012 Zachary Elliott
+;; Copyright (C) 2023, 2024 LdBeth
;;
;; Authors: Zachary Elliott <zacharyellio...@gmail.com>
;; URL: http://github.com/zellio/j-mode
-;; Version: 1.1.1
-;; Keywords: J, Languages
+;; Version: 2.0.1
+;; Keywords: J, Langauges
;; This file is not part of GNU Emacs.
@@ -47,17 +48,13 @@
;;; Code:
;; Required eval depth for older systems
-(setq max-lisp-eval-depth (max 500 max-lisp-eval-depth))
-
+;; (setq max-lisp-eval-depth (max 500 max-lisp-eval-depth))
(require 'j-font-lock)
(require 'j-console)
(require 'j-help)
+(eval-when-compile (require 'rx))
-
-(defconst j-mode-version "1.1.1"
- "`j-mode' version")
-
-(defgroup j-mode nil
+(defgroup j nil
"A mode for J"
:group 'languages
:prefix "j-")
@@ -67,12 +64,165 @@
:type 'hook
:group 'j)
+(defcustom j-indent-offset 2
+ "Amount of offset per level of indentation."
+ :type 'natnum
+ :group 'j)
+
+(defconst j-indenting-keywords-regexp
+ (rx (or (seq bow
+ (or (regexp
+ (regexp-opt
+ '(;;"do\\."
+ "if." "else." "elseif."
+ "select." "case." "fcase."
+ "throw."
+ "try." "except." "catch." "catcht." "catchd."
+ "while." "whilst."
+ "for.")))
+ (seq (or "for" "label") "_"
+ (+ (any "a-zA-Z"))
+ ".")))
+ (seq bol ":" eol)
+ (seq (+ (any "_a-zA-Z0-9")) (? "'")
+ (* "\s") "=" (or "." ":") (* "\s")
+ (or "{{"
+ (seq (regexp
+ (regexp-opt
+ '("dyad" "monad" "adverb" "verb" "conjunction"
+ "1" "2" "3" "4")))
+ (+ "\s")
+ (or (seq ":" (* "\s") "0")
+ "define")))))))
+
+(defconst j-dedenting-keywords-regexp
+ (rx (or "}}"
+ (seq ")" eol)
+ (seq bow
+ (regexp (regexp-opt '("end."
+ "else." "elseif."
+ "case." "fcase."
+ "catch." "catcht." "catchd."
+ "except."
+ "label")))))))
+
+(defun j-thing-outside-string (thing-regexp)
+ "Look for REGEXP from `point' til `point-at-eol' outside strings and
+comments. Match-data is set for THING-REGEXP. Returns nil if no match was
+found, else beginning and end of the match."
+ (save-excursion
+ (if (not (search-forward-regexp thing-regexp (pos-eol) t))
+ nil
+ (let* ((thing-begin (match-beginning 0))
+ (thing-end (match-end 0))
+ (eol (pos-eol))
+ (parse (save-excursion
+ (parse-partial-sexp eol
+ (max eol thing-end)))))
+ (if (or (nth 3 parse) (nth 4 parse))
+ nil
+ (list thing-begin thing-end))))))
+
+(defun j-compute-indentation ()
+ "Return what indentation should be in effect, disregarding
+contents of current line."
+ (let ((indent 0))
+ (save-excursion
+ ;; skip empty/comment lines, if that leaves us in the first line, return 0
+ (while (and (= (forward-line -1) 0)
+ (if (looking-at "^[ \t]*\\(?:NB\\..*\\)?$")
+ t
+ (setq indent (save-match-data
+ (back-to-indentation)
+ (if (and (looking-at
j-indenting-keywords-regexp)
+ (progn
+ (goto-char (match-end 0))
+ (not (j-thing-outside-string
+ (rx (or (seq word-start
"end.")
+ "}}"
+ (seq bol ")"
eol)))))))
+ (+ (current-indentation)
j-indent-offset)
+ (current-indentation))))
+ nil))))
+ indent))
+
+(defun j-indent-line ()
+ "Indent current line correctly."
+ (interactive)
+ (let ((old-point (point)))
+ (save-match-data
+ (back-to-indentation)
+ (let* ((tentative-indent (j-compute-indentation))
+ ;;FIXME doesn't handle comments correctly
+ (indent (cond
+ ((looking-at j-dedenting-keywords-regexp)
+ (max 0 (- tentative-indent j-indent-offset)))
+ ((looking-at ":") 0)
+ (t tentative-indent)))
+ (delta (- indent (current-indentation))))
+;; (message "###DEBUGi:%d t:%d" indent tentative-indent)
+ (indent-line-to indent)
+ (back-to-indentation)
+ (goto-char (max (point) (+ old-point delta)))))))
+
+(defun j-which-explict-definition ()
+ "Return nil, `:one-liner' or `:multi-liner' depending on what
+ kind of explicit definition we are `looking-at'. Modifies `match-data'!"
+ ;; XXX we could dump the check for NB. if we prepending '^' to the others
+ (cond ((j-thing-outside-string (rx (or (seq bow "define")
+ (seq ":" (* "\s") "0"))))
+ :multi-liner)
+ ((j-thing-outside-string (rx (or (seq bow "def")
+ " :")
+ (+ "\s")))
+ (pcase (char-after (match-end 0))
+ ('nil (error "XXX Illegal definition?"))
+ (?\' :one-liner)
+ (_ :multi-liner)))
+ ((j-thing-outside-string "{{") :direct)
+ (t nil)))
+
+(defun j-end-of-explicit-definition ()
+ "Goto the end of the next explicit definition below point."
+ (interactive)
+ (if (not (= (point) (pos-eol)))
+ (beginning-of-line)
+ (forward-line 1))
+ (beginning-of-line)
+ (save-match-data
+ (pcase (j-which-explict-definition)
+ ('nil (forward-line 1))
+ (:one-liner (beginning-of-line 2) t)
+ (:multi-liner (search-forward-regexp "^)") t)
+ (:direct (search-forward-regexp
+ (rx bol "}}" (? (not (any ".:")) (* nonl)) eol))
+ t))))
+
+(defun j-beginning-of-explicit-definition ()
+ "Got the start of the next explicit definition above point."
+ (interactive)
+ (let ((cur (point)) beg end)
+ (save-excursion
+ (if (not (= (point) (pos-bol)))
+ (beginning-of-line)
+ (forward-line -1))
+ (save-match-data
+ (while (not (or (j-which-explict-definition)
+ (= (pos-bol) (point-min))))
+ (forward-line -1)))
+ (setq beg (point))
+ (j-end-of-explicit-definition)
+ (setq end (point)))
+ (if (> end cur) (goto-char beg)
+ (beginning-of-line))))
+
(defvar j-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c !") 'j-console)
(define-key map (kbd "C-c C-c") 'j-console-execute-buffer)
(define-key map (kbd "C-c C-r") 'j-console-execute-region)
(define-key map (kbd "C-c C-l") 'j-console-execute-line)
+ (define-key map (kbd "C-M-x") 'j-console-execute-definition)
(define-key map (kbd "C-c h") 'j-help-lookup-symbol)
(define-key map (kbd "C-c C-h") 'j-help-lookup-symbol-at-point)
map)
@@ -85,37 +235,49 @@
["Execute Buffer" j-console-execute-buffer t]
["Execute Region" j-console-execute-region t]
["Execute Line" j-console-execute-line t]
+ ["Execute Definition" j-console-execute-definition t]
"---"
["J Symbol Look-up" j-help-lookup-symbol t]
["J Symbol Dynamic Look-up" j-help-lookup-symbol-at-point t]
["Help on J-mode" describe-mode t]))
;;;###autoload
-(defun j-mode ()
- "Major mode for editing J"
- (interactive)
- (kill-all-local-variables)
- (use-local-map j-mode-map)
- (setq mode-name "J"
- major-mode 'j-mode)
- (set-syntax-table j-font-lock-syntax-table)
- (set (make-local-variable 'comment-start)
- "NB. ")
- (set (make-local-variable 'comment-start-skip)
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)NB. *")
- (set (make-local-variable 'font-lock-comment-start-skip)
- "NB. *")
- (set (make-local-variable 'font-lock-defaults)
- '(j-font-lock-keywords
- nil nil nil nil
- ;;(font-lock-mark-block-function . mark-defun)
- (font-lock-syntactic-face-function
- . j-font-lock-syntactic-face-function)))
- (run-mode-hooks 'j-mode-hook))
+(define-derived-mode j-mode prog-mode "J"
+ "Major mode for editing J."
+ :group 'j
+ :syntax-table j-font-lock-syntax-table
+ (setq-local comment-start
+ "NB. "
+ comment-start-skip
+ (rx (group (group (or bol (not (any "\\" "\n" ))))
+ (* (group "\\\\")))
+ "NB."
+ (* "\s"))
+ comment-column 40
+ syntax-propertize-function #'j-mode-syntax-propertize
+ indent-tabs-mode nil
+ indent-line-function #'j-indent-line
+ beginning-of-defun-function #'j-beginning-of-explicit-definition
+ end-of-defun-function #'j-end-of-explicit-definition
+ font-lock-comment-start-skip
+ "NB\\. *"
+ font-lock-defaults
+ '(j-font-lock-keywords
+ nil nil nil nil
+ ;;(font-lock-mark-block-function . mark-defun)
+ (font-lock-syntactic-face-function
+ . j-font-lock-syntactic-face-function))))
+;;;###autoload
+(define-derived-mode j-lab-mode j-mode "J Lab"
+ "Mojor mode for J Labs."
+ :group 'j
+ (setq-local syntax-propertize-function #'j-lab-mode-syntax-propertize))
;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.ij[rstp]$" . j-mode))
+(progn
+ (add-to-list 'auto-mode-alist '("\\.ij[rsp]$" . j-mode))
+ (add-to-list 'auto-mode-alist '("\\.ijt$" . j-lab-mode)))
(provide 'j-mode)
