├── LICENSE └── inf-janet.el /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019 Libor Čapák 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /inf-janet.el: -------------------------------------------------------------------------------- 1 | ;;; inf-janet.el --- Run an external Janet process in an Emacs buffer -*- lexical-binding: t; -*- 2 | 3 | ;; * Add the following lines to your .emacs file: 4 | ;; 5 | ;; (require 'inf-janet) 6 | 7 | ;; (setq inf-janet-program "~/janet/build/janet") 8 | ;; or 9 | ;; (setq inf-janet-program '("localhost" . 5555)) 10 | 11 | ;; (add-hook 'janet-mode-hook #'inf-janet-minor-mode) 12 | 13 | (require 'comint) 14 | (require 'janet-mode) 15 | (require 'rx) 16 | (require 's) 17 | (require 'dash) 18 | 19 | (defgroup inf-janet nil 20 | "Run an external janet process (REPL) in an Emacs buffer." 21 | :group 'janet-mode) 22 | 23 | (defvar inf-janet-syntax-table 24 | (let ((table (make-syntax-table))) 25 | 26 | ;; Comments start with a '#' and end with a newline 27 | (modify-syntax-entry ?# "<" table) 28 | (modify-syntax-entry ?\n ">" table) 29 | 30 | ;; For keywords, make the ':' part of the symbol class 31 | (modify-syntax-entry ?: "_" table) 32 | 33 | ;; Backtick is a string delimiter 34 | (modify-syntax-entry ?` "\"" table) 35 | 36 | ;; Other chars that are allowed in symbols 37 | (modify-syntax-entry ?? "_" table) 38 | (modify-syntax-entry ?! "_" table) 39 | (modify-syntax-entry ?. "_" table) 40 | (modify-syntax-entry ?@ "_" table) 41 | 42 | table)) 43 | 44 | (defcustom inf-janet-prompt-read-only t 45 | "If non-nil, the prompt will be read-only. 46 | 47 | Also see the description of `ielm-prompt-read-only'." 48 | :type 'boolean 49 | :group 'inf-janet) 50 | 51 | ;; TODO: 52 | (defcustom inf-janet-filter-regexp 53 | "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'" 54 | "What not to save on inferior janet's input history. 55 | Input matching this regexp is not saved on the input history in 56 | Inferior janet mode. Default is whitespace followed by 0 or 1 57 | single-letter colon-keyword \(as in :a, :c, etc.)" 58 | :type 'regexp 59 | :group 'inf-janet) 60 | 61 | (defvar inf-janet-mode-map 62 | (let ((map (copy-keymap comint-mode-map))) 63 | (define-key map "\C-x\C-e" #'inf-janet-eval-last-sexp) 64 | ;; (define-key map "\C-c\C-l" #'inf-janet-load-file) 65 | (define-key map "\C-c\M-o" #'inf-janet-clear-repl-buffer) 66 | map)) 67 | 68 | (defvar inf-janet-minor-mode-map 69 | (let ((map (make-sparse-keymap))) 70 | (define-key map "\M-\C-x" #'inf-janet-eval-defun) ; Gnu convention 71 | (define-key map "\C-x\C-e" #'inf-janet-eval-last-sexp) ; Gnu convention 72 | (define-key map "\C-c\C-e" #'inf-janet-eval-last-sexp) 73 | (define-key map "\C-c\C-c" #'inf-janet-eval-defun) ; SLIME/CIDER style 74 | (define-key map "\C-c\C-b" #'inf-janet-eval-buffer) 75 | (define-key map "\C-c\C-r" #'inf-janet-eval-region) 76 | (define-key map "\C-c\C-n" #'inf-janet-eval-form-and-next) 77 | (define-key map "\C-c\C-z" #'inf-janet-switch-to-repl) 78 | (define-key map "\C-c\C-l" #'inf-janet-load-file) 79 | map)) 80 | 81 | ;;;###autoload 82 | (define-minor-mode inf-janet-minor-mode 83 | "Minor mode for interacting with the inferior janet process buffer. 84 | 85 | The following commands are available: 86 | 87 | \\{inf-janet-minor-mode-map}" 88 | :lighter "" :keymap inf-janet-minor-mode-map 89 | nil) 90 | 91 | (defcustom inf-janet-program "janet -s" 92 | "The command used to start an inferior janet process in `inf-janet-mode'. 93 | 94 | Alternative you can specify a TCP connection cons pair, instead 95 | of command, consisting of a host and port 96 | number (e.g. (\"localhost\" . 5555)). That's useful if you're 97 | often connecting to a remote REPL process." 98 | :type '(choice (string) 99 | (repeat string) 100 | (cons string integer)) 101 | :group 'inf-janet) 102 | 103 | (defcustom inf-janet-load-command "(load \"%s\")\n" 104 | "Format-string for building a janet expression to load a file." 105 | :type 'string 106 | :group 'inf-janet) 107 | 108 | (defcustom inf-janet-prompt "^[^=> \n]+=> *" 109 | "Regexp to recognize prompts in the Inferior janet mode." 110 | :type 'regexp 111 | :group 'inf-janet) 112 | 113 | (defcustom inf-janet-subprompt (rx "repl:" (+ digit) ":(" (opt "`") "> ") 114 | "Regexp to recognize subprompts in the Inferior janet mode." 115 | :type 'regexp 116 | :group 'inf-janet) 117 | 118 | (defvar inf-janet-filter-subprompts nil) 119 | 120 | (defvar inf-janet-buffer nil) 121 | 122 | (defvar inf-janet-mode-hook '() 123 | "Hook for customizing Inferior janet mode.") 124 | 125 | (put 'inf-janet-mode 'mode-class 'special) 126 | 127 | (define-derived-mode inf-janet-mode comint-mode "Inferior janet" 128 | :syntax-table inf-janet-syntax-table 129 | (setq-local font-lock-defaults '(janet-highlights)) 130 | (setq comint-prompt-regexp inf-janet-prompt) 131 | (setq mode-line-process '(":%s")) 132 | ;; (scheme-mode-variables) 133 | (setq comint-get-old-input #'inf-janet-get-old-input) 134 | (setq comint-input-filter #'inf-janet-input-filter) 135 | (set (make-local-variable 'comint-prompt-read-only) inf-janet-prompt-read-only) 136 | (add-hook 'comint-preoutput-filter-functions #'inf-janet-preoutput-filter nil t)) 137 | 138 | (defun inf-janet-get-old-input () 139 | (save-excursion 140 | (let ((end (point))) 141 | (backward-sexp) 142 | (buffer-substring (point) end)))) 143 | 144 | (defun inf-janet-input-filter (str) 145 | "Return t if STR does not match `inf-janet-filter-regexp'." 146 | (not (string-match inf-janet-filter-regexp str))) 147 | 148 | (defun inf-janet-chomp (string) 149 | "Remove final newline from STRING." 150 | (if (string-match "[\n]\\'" string) 151 | (replace-match "" t t string) 152 | string)) 153 | 154 | (defun inf-janet-remove-subprompts (string) 155 | "Remove subprompts from STRING." 156 | (replace-regexp-in-string inf-janet-subprompt "" string)) 157 | 158 | (defun inf-janet-preoutput-filter (str) 159 | "Preprocess the output STR from interactive commands." 160 | ;; Capture output as a list of strings, the first item will be 161 | ;; printed output (if any) and the second the return value. Matching 162 | ;; on ANSI escape codes may not be reliable if the printed output 163 | ;; contains them. 164 | (if (or inf-janet-filter-subprompts 165 | (string-prefix-p "inf-janet-" (symbol-name (or this-command last-command)))) 166 | (inf-janet-remove-subprompts str) 167 | str)) 168 | 169 | (defvar inf-janet-project-root-files ;; TODO 170 | '("_darcs") 171 | "A list of files that can be considered project markers.") 172 | 173 | (defun inf-janet-project-root () 174 | "Retrieve the root directory of a project if available. 175 | 176 | Fallback to `default-directory.' if not within a project." 177 | (or (when (functionp 'projectile-project-root) (projectile-project-root)) 178 | (car (remove nil 179 | (mapcar (lambda 180 | (file) 181 | (locate-dominating-file default-directory file)) 182 | inf-janet-project-root-files))) 183 | default-directory)) 184 | 185 | (defun inf-janet-clear-repl-buffer () 186 | (interactive) 187 | (let ((comint-buffer-maximum-size 0)) 188 | (comint-truncate-buffer))) 189 | 190 | ;;;###autoload 191 | (defun inf-janet (cmd) 192 | (interactive (list (if current-prefix-arg 193 | ;; only a string is probably useful here 194 | (read-string "Run janet: " (if (stringp inf-janet-program) 195 | inf-janet-program 196 | (eval (car (get 'inf-janet-program 'standard-value))))) 197 | inf-janet-program))) 198 | (if (not (comint-check-proc inf-janet-buffer)) 199 | ;; run the new process in the project's root when in a project folder 200 | (let ((default-directory (inf-janet-project-root)) 201 | (cmdlist (cond ((listp cmd) cmd) 202 | ((consp cmd) (list cmd)) 203 | (t (split-string cmd))))) 204 | (with-current-buffer (apply #'make-comint 205 | "inf-janet" (car cmdlist) nil (cdr cmdlist)) 206 | (inf-janet-mode)))) 207 | (setq inf-janet-buffer "*inf-janet*") 208 | (display-buffer inf-janet-buffer)) 209 | 210 | ;;;###autoload 211 | (defalias 'run-janet 'inf-janet) 212 | 213 | ;;;###autoload 214 | (defun inf-janet-connect (host port) 215 | "Connect to janet repl over net with HOST:PORT." 216 | (interactive (list (read-string "Host: " "127.0.0.1") 217 | (read-number "Port: " 8001))) 218 | (run-janet (cons host port))) 219 | 220 | (defun inf-janet-eval-region (start end &optional and-go) 221 | (interactive "r\nP") 222 | ;; replace multiple newlines at the end of the region by a single one 223 | ;; or add one if there was no newline 224 | (comint-simple-send 225 | (inf-janet-proc) 226 | (string-trim (buffer-substring-no-properties start end))) 227 | (if and-go (inf-janet-switch-to-repl t))) 228 | 229 | (defun inf-janet-eval-string (s) 230 | "Evaluate a string and return a cons pair of the output and return value." 231 | (when-let (s ;; don't eval nil 232 | (inf-janet-filter-subprompts t) 233 | ;; start process if not running? 234 | (p (inf-janet-proc))) 235 | (with-current-buffer inf-janet-buffer 236 | (let ((start (marker-position (cdr comint-last-prompt)))) 237 | (comint-simple-send p s) 238 | (accept-process-output p) 239 | (when-let ((end (save-excursion 240 | ;; skip prompt and back one 241 | (goto-char (point-max)) 242 | (forward-line 0) 243 | (backward-char) 244 | (point))) 245 | (res (buffer-substring-no-properties start end)) 246 | ;; the last line is the result, everything else 247 | ;; is output - if there is an error it will be 248 | ;; interpreted as the result 249 | (m (string-match (rx (group (* (* nonl) "\n")) (group (* nonl)) eos) res))) 250 | (cons (match-string 1 res) 251 | (match-string 2 res))))))) 252 | 253 | (defun inf-janet-eval-output (s) 254 | (car (inf-janet-eval-string s))) 255 | 256 | (defun inf-janet-eval-return (s) 257 | (cdr (inf-janet-eval-string s))) 258 | 259 | (defun inf-janet-eval-defun (&optional and-go) 260 | (interactive "P") 261 | (save-excursion 262 | (end-of-defun) 263 | (let ((end (point)) (case-fold-search t)) 264 | (beginning-of-defun) 265 | (inf-janet-eval-region (point) end and-go)))) 266 | 267 | (defun inf-janet-eval-buffer (&optional and-go) 268 | (interactive "P") 269 | (save-excursion 270 | (widen) 271 | (let ((case-fold-search t)) 272 | (inf-janet-eval-region (point-min) (point-max) and-go)))) 273 | 274 | (defun inf-janet-eval-last-sexp (&optional and-go) 275 | (interactive "P") 276 | (inf-janet-eval-region (save-excursion (backward-sexp) (point)) (point) and-go)) 277 | 278 | (defun inf-janet-eval-form-and-next () 279 | (interactive "") 280 | (while (not (zerop (car (syntax-ppss)))) 281 | (up-list)) 282 | (inf-janet-eval-last-sexp) 283 | (forward-sexp)) 284 | 285 | (defun inf-janet-switch-to-repl (eob-p) 286 | "Switch to the inferior process buffer. 287 | With prefix argument EOB-P, positions cursor at end of buffer." 288 | (interactive "P") 289 | (if (get-buffer-process inf-janet-buffer) 290 | (let ((pop-up-frames 291 | ;; Be willing to use another frame 292 | ;; that already has the window in it. 293 | (or pop-up-frames 294 | (get-buffer-window inf-janet-buffer t)))) 295 | (pop-to-buffer inf-janet-buffer)) 296 | (run-janet inf-janet-program)) 297 | (when eob-p 298 | (push-mark) 299 | (goto-char (point-max)))) 300 | 301 | 302 | ;;; Now that inf-janet-eval-/defun/region takes an optional prefix arg, 303 | ;;; these commands are redundant. But they are kept around for the user 304 | ;;; to bind if he wishes, for backwards functionality, and because it's 305 | ;;; easier to type C-c e than C-u C-c C-e. 306 | 307 | (defun inf-janet-eval-region-and-go (start end) 308 | (interactive "r") 309 | (inf-janet-eval-region start end t)) 310 | 311 | (defun inf-janet-eval-defun-and-go () 312 | (interactive) 313 | (inf-janet-eval-defun t)) 314 | 315 | (defvar inf-janet-prev-l/c-dir/file nil 316 | "Record last directory and file used in loading or compiling. 317 | This holds a cons cell of the form `(DIRECTORY . FILE)' 318 | describing the last `inf-janet-load-file' command.") 319 | 320 | (defcustom inf-janet-source-modes '(janet-mode) 321 | "Used to determine if a buffer contains source code. 322 | If it's loaded into a buffer that is in one of these major modes, it's 323 | considered a janet source file by `inf-janet-load-file'. 324 | Used by this command to determine defaults." 325 | :type '(repeat symbol) 326 | :group 'inf-janet) 327 | 328 | ;; (defun inf-janet-load-file (file-name) 329 | ;; "Load a source file FILE-NAME into the inferior janet process." 330 | ;; (interactive (comint-get-source "Load file: " inf-janet-prev-l/c-dir/file 331 | ;; inf-janet-source-modes nil)) ; nil because LOAD 332 | ;; ; doesn't need an exact name 333 | ;; (comint-check-source file-name) ; Check to see if buffer needs saved. 334 | ;; (setq inf-janet-prev-l/c-dir/file (cons (file-name-directory file-name) 335 | ;; (file-name-nondirectory file-name))) 336 | ;; (comint-send-string (inf-janet-proc) 337 | ;; (format inf-janet-load-command file-name)) 338 | ;; (inf-janet-switch-to-repl t)) 339 | 340 | (defun inf-janet-connected-p () 341 | (not (null inf-janet-buffer))) 342 | 343 | ;;; Documentation functions 344 | 345 | ;;; Command strings 346 | ;;; =============== 347 | 348 | 349 | (defun inf-janet-proc () 350 | "Return the current inferior process. 351 | See variable `inf-janet-buffer'." 352 | (let ((proc (get-buffer-process (if (derived-mode-p 'inf-janet-mode) 353 | (current-buffer) 354 | inf-janet-buffer)))) 355 | (or proc 356 | (error "No janet subprocess; see variable `inf-janet-buffer'")))) 357 | 358 | (provide 'inf-janet) 359 | --------------------------------------------------------------------------------