portal.el (19299B)
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 ;; Customizations 3 4 (defgroup portal nil 5 "Portal group." 6 :group 'convenience) 7 8 (defcustom portal-outputs-directory 9 "~/.portals/" 10 "Directory where to create output artifacts." 11 :type 'string :group 'portal) 12 13 (defcustom portal-default-stdout-buffer-len 14 4096 15 "Default buffer length for the stdout preview." 16 :group 'portal :type 'number) 17 18 (defcustom portal-default-stderr-buffer-len 19 4096 20 "Default buffer length for the stderr preview." 21 :group 'portal :type 'number) 22 23 (defface portal-face 24 '((((class color) (background dark)) 25 (:foreground "#fff" :bold t)) 26 (((class color) (background light)) 27 (:foreground "#000" :bold t))) 28 "Portal face." 29 :group 'portal) 30 31 (defface portal-exited-stdout-face 32 '((t :foreground "#acac9e")) 33 "Portal exited stdout face." 34 :group 'portal) 35 36 (defface portal-exited-stderr-face 37 '((t :foreground "#aa7070")) 38 "Portal exited stderr face." 39 :group 'portal) 40 41 (defface portal-exit-success-face 42 '((t :foreground "#89b664")) 43 "Portal exit successful face." 44 :group 'portal) 45 46 (defface portal-exit-failure-face 47 '((t :foreground "#ae6161")) 48 "Portal exit failure face." 49 :group 'portal) 50 51 (defface portal-meta-face 52 '((t :foreground "#89b664")) 53 "Portal meta face." 54 :group 'portal) 55 56 (defface portal-stdout-face 57 '((t :inherit 'default)) 58 "Portal stdout face." 59 :group 'portal) 60 61 (defface portal-stderr-face 62 '((t :foreground "#ae6161")) 63 "Portal stderr face." 64 :group 'portal) 65 66 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 67 ;; Interactive commands 68 69 (defun portal-insert-shell-command (command) 70 "Launch an asynchronous shell of COMMAND, make a portal associated 71 with the current buffer and insert the portal into the current 72 buffer." 73 (interactive "sCommand: ") 74 (portal-insert-command 75 (list shell-file-name shell-command-switch command))) 76 77 (defun portal-open-stdout () 78 "Open the stdout of the file at point." 79 (interactive) 80 (find-file (portal-file-name (portal-at-point) "stdout"))) 81 82 (defun portal-open-stderr () 83 "Open the stderr of the file at point." 84 (interactive) 85 (find-file (portal-file-name (portal-at-point) "stderr"))) 86 87 (defun portal-interrupt () 88 "Interrupt the process at point." 89 (interactive) 90 (let ((proc (get-process (portal-process-name (portal-at-point))))) 91 (when (process-live-p proc) 92 (interrupt-process proc)))) 93 94 (defun portal-rerun () 95 "Re-run portal at point." 96 (interactive) 97 (portal-jump-to-portal) 98 (let* ((portal (portal-at-point)) 99 (command (portal-read-json-file portal "command")) 100 (env (portal-read-json-file portal "env")) 101 (default-directory (portal-read-json-file portal "directory"))) 102 (portal-interrupt) 103 (delete-region (line-beginning-position) (line-end-position)) 104 (portal-wipe-summary) 105 (portal-insert-command (append command nil)) 106 (portal-refresh-soon))) 107 108 (defun portal-edit () 109 "Edit and re-run portal at point." 110 (interactive) 111 (portal-jump-to-portal) 112 (portal-interrupt) 113 (let* ((portal (portal-at-point)) 114 (command 115 (vector 116 shell-file-name 117 shell-command-switch 118 (read-from-minibuffer 119 "Command: " 120 (portal-as-shell-command (portal-read-json-file portal "command"))))) 121 (env (portal-read-json-file portal "env")) 122 (default-directory (portal-read-json-file portal "directory"))) 123 (delete-region (line-beginning-position) (line-end-position)) 124 (portal-wipe-summary) 125 (portal-insert-command (append command nil)) 126 (portal-refresh-soon))) 127 128 (defun portal-clone () 129 "Clone the portal at point." 130 (interactive) 131 (portal-jump-to-portal) 132 (let* ((portal (portal-at-point)) 133 (command (portal-read-json-file portal "command")) 134 (env (portal-read-json-file portal "env")) 135 (default-directory (portal-read-json-file portal "directory"))) 136 (save-excursion (insert "\n")) 137 (portal-insert-command (append command nil)) 138 (portal-refresh-soon))) 139 140 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 141 ;; Launching processes 142 143 (defun portal-start (buffer portal stdout-path stderr-path program program-args) 144 "Run PROGRAM-PATH with ARGS, connect it to portal PORTAL in buffer 145 BUFFER, and write the stdout to STDOUT-PATH and stderr to 146 STDERR-PATH." 147 (let* ((stderr-pipe 148 (make-pipe-process 149 :name (portal-stderr-process-name portal) 150 :buffer buffer 151 :noquery t 152 :filter 'portal-process-filter 153 :sentinel 'portal-stderr-pipe-sentinel)) 154 (main-process 155 (make-process 156 :name (portal-process-name portal) 157 :buffer buffer 158 :command (cons program program-args) 159 :noquery nil 160 :connection-type 'pipe 161 :sentinel 'portal-main-process-sentinel 162 :filter 'portal-process-filter 163 :stderr stderr-pipe))) 164 165 (process-put stderr-pipe :portal portal) 166 (process-put stderr-pipe :output-path stderr-path) 167 (process-put stderr-pipe :buffer "") 168 (process-put stderr-pipe :buffer-len portal-default-stderr-buffer-len) 169 170 (process-put main-process :portal portal) 171 (process-put main-process :output-path stdout-path) 172 (process-put main-process :buffer "") 173 (process-put main-process :buffer-len portal-default-stdout-buffer-len) 174 175 ;; Connect the two processes. 176 (process-put main-process :stderr-process stderr-pipe) 177 178 (portal-write-json-file portal "command" (apply #'vector (cons program program-args))) 179 (portal-write-json-file portal "env" (apply #'vector process-environment)) 180 (portal-write-json-file portal "directory" default-directory) 181 (portal-write-json-file portal "status" (format "%S" (process-status main-process))))) 182 183 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 184 ;; Process filtering 185 186 (defun portal-process-filter (process output) 187 (let ((filepath (process-get process :output-path))) 188 (when debug-on-error 189 (message "portal-process-filter: Writing to %s" filepath)) 190 (portal-accumulate-buffer process output) 191 (with-temp-buffer 192 (insert output) 193 (write-region (point-min) (point-max) filepath :append :no-messages)))) 194 195 (defun portal-accumulate-buffer (process output) 196 "Accumulate some OUTPUT into PROCESS's preview buffer." 197 (process-put 198 process 199 :buffer (portal-shrink-preview 200 (process-get process :buffer-len) 201 (concat (process-get process :buffer) output)))) 202 203 (defun portal-shrink-preview (len string) 204 "Shrink a preview buffer STRING to the right length." 205 (if (> (length string) len) 206 (substring string (- len)) 207 string)) 208 209 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 210 ;; Sentinels 211 212 (defun portal-main-process-sentinel (process event) 213 "Handles the main process's status updates." 214 (when debug-on-error 215 (message "main-process-sentinel: %S: %S" process event)) 216 (portal-write-json-file 217 (process-get process :portal) 218 "status" (format "%S" (process-exit-status process)))) 219 220 (defun portal-stderr-pipe-sentinel (process event) 221 "Handles the stderr pipe's status updates." 222 (when debug-on-error 223 (message "stderr-pipe-sentinel: %S: %S" process event))) 224 225 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 226 ;; File/directory operations 227 228 (defun portal-ensure-directory (portal) 229 "Create the stdout/stderr files for PORTAL in an appropriate 230 location." 231 (let ((directory (concat (file-name-as-directory portal-outputs-directory) portal))) 232 (make-directory directory :including-parents) 233 directory)) 234 235 (defun portal-directory-exists-p (portal) 236 "Check PORTAL has a directory that exists." 237 (let ((directory (concat (file-name-as-directory portal-outputs-directory) portal))) 238 (file-exists-p directory))) 239 240 (defun portal-file-exists-p (portal name) 241 "Check PORTAL has a file NAME that exists." 242 (let ((directory (concat (file-name-as-directory portal-outputs-directory) portal))) 243 (file-exists-p (concat (file-name-as-directory directory) name)))) 244 245 (defun portal-persist-file (portal name content) 246 "Persist CONTENT to disk with filename NAME." 247 (with-temp-buffer 248 (insert content) 249 (write-region 250 (point-min) (point-max) 251 (portal-file-name portal name) 252 nil ; no-append 253 :no-messages)) 254 content) 255 256 (defun portal-write-json-file (portal name expr) 257 "Print EXPR to disk with filename NAME." 258 (with-temp-buffer 259 (insert (json-serialize expr)) 260 (write-region 261 (point-min) (point-max) 262 (portal-file-name portal name) 263 nil ; no-append 264 :no-messages)) 265 expr) 266 267 (defun portal-read-json-file (portal name) 268 "Read JSON content from file NAME for the given PORTAL." 269 (with-temp-buffer 270 (insert-file-contents (portal-file-name portal name)) 271 (json-parse-string (buffer-string)))) 272 273 (defun portal-read-file (portal name) 274 "Read content from file NAME for the given PORTAL." 275 (with-temp-buffer 276 (let ((file (portal-file-name portal name))) 277 (when (file-exists-p file) 278 (insert-file-contents file))) 279 (buffer-string))) 280 281 (defun portal-tail-file (portal n name) 282 "Tail last N lines of file NAME for the given PORTAL." 283 (with-temp-buffer 284 (let ((file (portal-file-name portal name))) 285 (if (file-exists-p file) 286 (portal-tail-n-lines n file) 287 "")))) 288 289 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 290 ;; Nano-IDs 291 292 (defun portal-generate-nanoid () 293 "Generate a Nano ID of the form `portal_NGMyMDVkZjZiYTVlZTVhM' using SHA-1." 294 (let* ((random-string (format "%s%s%S" (emacs-pid) (current-time-string) (random))) 295 (sha1-hash (secure-hash 'sha1 random-string)) 296 (base64-encoded (base64-encode-string sha1-hash)) 297 (nanoid (string-trim-right (substring base64-encoded 0 21)))) 298 (concat "portal_" nanoid))) 299 300 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 301 ;; A small minor mode that just sets up a timer that runs a thing in a 302 ;; given buffer every N seconds 303 304 (defvar-local portal-alpha-timer 305 nil) 306 307 (define-minor-mode portal-alpha-minor-mode 308 "TODO" 309 :init-value nil 310 :lighter "@" 311 (when portal-alpha-timer (cancel-timer portal-alpha-timer)) 312 (when portal-alpha-minor-mode 313 (setq portal-alpha-timer 314 (run-with-timer 1 2 'portal-beta-refresh (current-buffer))))) 315 316 (defun portal-refresh-soon () 317 "Trigger a refresh within the blink of an eye, but no sooner, or 318 later." 319 (run-with-timer 0.100 nil 'portal-beta-refresh (current-buffer))) 320 321 (defun portal-beta-refresh (buffer) 322 "Refresh portal displays." 323 (when (buffer-live-p buffer) 324 (let ((window (get-buffer-window buffer))) 325 (when window 326 (with-current-buffer buffer 327 (let ((point (point))) 328 (save-excursion 329 (goto-char (point-min)) 330 (while (and (re-search-forward portal-regexp nil t nil) 331 (<= (point) (window-end window))) 332 (when (<= (window-start window) (point) (window-end window)) 333 (let* ((portal (match-string 0)) 334 (process (get-process (portal-process-name portal))) 335 (summary (if (portal-directory-exists-p portal) 336 (portal-summary portal process) 337 "# Invalid portal.")) 338 (match-end (match-end 0)) 339 (old-summary (get-text-property (line-beginning-position) 'portal-summary))) 340 (unless (and old-summary (string= summary old-summary)) 341 (put-text-property (line-beginning-position) (point) 342 'portal-summary 343 summary) 344 (put-text-property (line-beginning-position) (point) 345 'portal 346 portal) 347 (portal-wipe-summary) 348 (insert "\n" summary)))))) 349 (goto-char point))))))) 350 351 (defun portal-wipe-summary () 352 "Wipe the '# summary' lines that follow the portal." 353 (save-excursion 354 (when (looking-at "\n#") 355 (forward-line 1) 356 (let ((point (point))) 357 (or (search-forward-regexp "^[^#]" nil t 1) 358 (goto-char (point-max))) 359 (delete-matching-lines "^#" point (point)))))) 360 361 (defun portal-summary (portal process) 362 "Generate a summary of the portal." 363 (let* ((command (portal-read-json-file portal "command")) 364 (directory (portal-read-json-file portal "directory")) 365 (status (portal-read-json-file portal "status")) 366 (stdout (if process 367 (portal-last-n-lines 368 5 369 (process-get process :buffer)) 370 (portal-tail-file portal 5 "stdout"))) 371 (stderr (if process 372 (portal-last-n-lines 373 5 374 (process-get (process-get process :stderr-process) :buffer)) 375 (portal-tail-file portal 5 "stderr")))) 376 (with-temp-buffer 377 (insert (propertize 378 (concat "# (" (if (string= status "run") "🌀" status) ") " (portal-as-shell-command command)) 379 'face 380 (if (string= status "run") 381 'portal-meta-face 382 (if (string= status "0") 383 'portal-exit-success-face 384 'portal-exit-failure-face)))) 385 ;; Only show if it's different to the current directory, 386 ;; otherwise it's noise. 387 (unless (string= default-directory directory) (insert "\n# " directory)) 388 (unless (= 0 (length (string-trim stdout))) 389 (insert "\n" 390 (propertize (portal-clean-output stdout) 391 'face (if (string= status "run") 392 'portal-stdout-face 393 'portal-exited-stdout-face)))) 394 (unless (= 0 (length (string-trim stderr))) 395 (insert "\n" 396 (propertize (portal-clean-output stderr) 397 'face 398 (if (string= status "run") 399 'portal-stderr-face 400 'portal-exited-stderr-face)))) 401 (propertize (buffer-string) 402 'portal portal)))) 403 404 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 405 ;; String generation 406 407 (defun portal-as-shell-command (command) 408 "If the vector COMMAND is a shell run, strip the prefix, else return the whole thing joined." 409 (if (and (= 3 (length command)) 410 (string= (elt command 0) shell-file-name) 411 (string= (elt command 1) shell-command-switch)) 412 (elt command 2) 413 (mapconcat 'shell-quote-argument command " "))) 414 415 (defun portal-clean-output (output) 416 "Clean output for previewing, prefixed with #." 417 (portal-limit-lines-to-80-columns 418 (concat "# " (replace-regexp-in-string 419 "\n" "\n# " 420 (portal-no-empty-lines output))))) 421 422 (defun portal-limit-lines-to-80-columns (string) 423 "Limit all lines in STRING to 80 columns." 424 (with-temp-buffer 425 (insert string) 426 (goto-char (point-min)) 427 (while (not (eobp)) 428 (move-to-column 80 t) 429 (delete-region (point) (line-end-position)) 430 (forward-line)) 431 (buffer-string))) 432 433 (defun portal-process-name (portal) 434 (concat portal "-main-process")) 435 436 (defun portal-stderr-process-name (portal) 437 (concat portal "-stderr-pipe")) 438 439 (defun portal-file-name (portal name) 440 (concat (file-name-as-directory (portal-ensure-directory portal)) name)) 441 442 (defun portal-no-empty-lines (string) 443 "Drop empty lines from a string." 444 (replace-regexp-in-string "\n$" "" string)) 445 446 (defun portal-last-n-lines (n string) 447 "Take last N lines from STRING." 448 (mapconcat #'identity (reverse (seq-take (reverse (split-string string "[\r\n]+" t)) n)) "\n")) 449 450 (defun portal-tail-n-lines (n file-path) 451 "Tail the last N lines from FILE-PATH using tail, if possible. If 452 not possible (due to lack of such tool), return nil." 453 (let ((this-buffer (current-buffer))) 454 (with-temp-buffer 455 (let ((out-buffer (current-buffer))) 456 (with-current-buffer this-buffer 457 (cl-case (call-process "tail" nil out-buffer nil "-n" (format "%d" n) 458 (expand-file-name file-path)) 459 (0 (with-current-buffer out-buffer (buffer-string))) 460 (t ""))))))) 461 462 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 463 ;; Finding portals and gathering information for them 464 465 (defconst portal-regexp "\\<portal_[A-Za-z0-9]\\{21\\}\\>" 466 "Match on a portal's unique ID.") 467 468 (defun portal-at-point () 469 "Return the portal at point." 470 (or (save-excursion 471 (goto-char (line-beginning-position)) 472 (when (looking-at portal-regexp) 473 (buffer-substring (match-beginning 0) (match-end 0)))) 474 (get-text-property (point) 'portal) 475 (error "Not at a portal."))) 476 477 (defun portal-jump-to-portal () 478 "If there's a portal at point or a summary of a portal at point, 479 jump to the portal at the beginning of the line upwards within 480 the same paragraph." 481 (let ((portal (portal-at-point))) 482 (goto-char 483 (save-excursion 484 (goto-char (line-end-position)) 485 (re-search-backward 486 (concat "^" (regexp-quote portal)) 487 (save-excursion (forward-paragraph -1)) 488 nil 489 1))))) 490 491 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 492 ;; Notes 493 494 ;; Use this on a portals buffer to stop it constantly being saved: 495 ; 496 ;; (setq buffer-save-without-query t) 497 498 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 499 ;; Major mode 500 501 (defvar-keymap portal-mode-map 502 "M-!" 'portal-shell-command 503 "C-c C-c" 'portal-interrupt 504 "RET" 'portal-jump-to-thing-at-point 505 ) 506 507 (define-derived-mode portal-mode 508 fundamental-mode "Portals" 509 "Major mode for portals." 510 (portal-alpha-minor-mode)) 511 512 (defun portal-insert-command (command) 513 "Launch an asynchronous proc of COMMAND, make a portal associated 514 with the current buffer and insert the portal into the current 515 buffer." 516 (let* ((portal (portal-generate-nanoid))) 517 (portal-start 518 (current-buffer) 519 portal 520 (portal-file-name portal "stdout") 521 (portal-file-name portal "stderr") 522 (car command) 523 (cdr command)) 524 (insert portal))) 525 526 (defun portal-shell-command (command) 527 "Run a shell command and insert it at point." 528 (interactive "sCommand: ") 529 (portal-insert-command 530 (list shell-file-name shell-command-switch command))) 531 532 (defun portal-jump-to-thing-at-point () 533 "Jump to the thing at point, i.e. an stdout/stderr output jumps to 534 the file." 535 (interactive) 536 (let ((face (get-text-property (point) 'face))) 537 (cond 538 ((eq face 'portal-stderr-face) 539 (portal-open-stderr)) 540 ((eq face 'portal-exited-stderr-face) 541 (portal-open-stderr)) 542 ((eq face 'portal-stdout-face) 543 (portal-open-stdout)) 544 ((eq face 'portal-exited-stdout-face) 545 (portal-open-stdout)) 546 (t (call-interactively 'newline)))))