emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/j-mode 3f852d1476 13/13: Merge pull request #30 from zelli


From: ELPA Syncer
Subject: [nongnu] elpa/j-mode 3f852d1476 13/13: Merge pull request #30 from zellio/v2.0.1
Date: Tue, 11 Jun 2024 19:00:25 -0400 (EDT)

branch: elpa/j-mode
commit 3f852d1476be5625fea51dcaaad66dd57593101a
Merge: 690c7acdfc 9a24728dec
Author: LdBeth <andpuke@foxmail.com>
Commit: GitHub <noreply@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 <ZacharyElliott1@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 <ZacharyElliott1@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 <ZacharyElliott1@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 <ZacharyElliott1@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)
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]