Add 20 Emacs features round 10: journalctl, bluetooth, volume, ascii-table, unicode-search, emoji-insert, kaomoji, xkcd, cheat-sh, tldr, httpstat, jwt-decode, xml-format, csv-sort, markdown-toc, focus-mode, typewriter-mode, rain, wifi, screenshot
ober
4ad7b55dad6bb98886d816a9bdf0e1f00f646e33
--- a/src/jerboa-emacs/editor-extra-final.ss +++ b/src/jerboa-emacs/editor-extra-final.ss @@ -4453,3 +4453,322 @@ 'block (native-transcoder)))) (close-port si) (close-port so) (close-port se) (echo-message! echo (str "Sent to " room)))))))))) + +;; ===== Round 10 Batch 2 ===== + +;; --- Feature 11: HTTP Stat --- + +(def (cmd-httpstat app) + "Show HTTP request timing statistics for a URL." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (row (tui-rows)) (width (tui-cols)) + (url (echo-read-string echo "URL: " row width))) + (when (and url (not (string-empty? url))) + (with-catch + (lambda (e) (echo-message! echo (str "httpstat error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "curl -sL -o /dev/null -w '" + "DNS: %{time_namelookup}s\\n" + "Connect: %{time_connect}s\\n" + "TLS: %{time_appconnect}s\\n" + "TTFB: %{time_starttransfer}s\\n" + "Total: %{time_total}s\\n" + "Status: %{http_code}\\n" + "Size: %{size_download} bytes\\n" + "' " (shell-quote (string-trim url))) + 'block (native-transcoder)))) + (close-port si) + (let loop ((lines '())) + (let ((line (get-line so))) + (if (eof-object? line) + (begin + (close-port so) (close-port se) + (let* ((content (string-append "HTTP Stats: " (string-trim url) "\n" + (make-string 50 #\=) "\n\n" + (string-join (reverse lines) "\n"))) + (hbuf (make-buffer "*httpstat*"))) + (buffer-attach! ed hbuf) + (set! (edit-window-buffer win) hbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "HTTP stats loaded"))) + (loop (cons line lines))))))))))) + +;; --- Feature 12: JWT Decode --- + +(def (cmd-jwt-decode app) + "Decode a JWT token and display its payload." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (row (tui-rows)) (width (tui-cols)) + (token (echo-read-string echo "JWT token: " row width))) + (when (and token (not (string-empty? token))) + (let* ((parts (string-split (string-trim token) #\.))) + (if (< (length parts) 2) + (echo-message! echo "Invalid JWT: expected 3 parts separated by .") + (with-catch + (lambda (e) (echo-message! echo (str "JWT decode error: " e))) + (lambda () + ;; Decode base64 header and payload + (let* ((decode-part (lambda (part) + (let-values (((si so se pid) + (open-process-ports + (str "echo " (shell-quote part) " | base64 -d 2>/dev/null") + 'block (native-transcoder)))) + (close-port si) + (let loop ((lines '())) + (let ((line (get-line so))) + (if (eof-object? line) + (begin (close-port so) (close-port se) + (string-join (reverse lines) "\n")) + (loop (cons line lines)))))))) + (header (decode-part (car parts))) + (payload (decode-part (cadr parts))) + (content (string-append "JWT Decode\n" + (make-string 50 #\=) "\n\n" + "Header:\n" header "\n\n" + "Payload:\n" payload "\n")) + (jbuf (make-buffer "*jwt*"))) + (buffer-attach! ed jbuf) + (set! (edit-window-buffer win) jbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "JWT decoded"))))))))) + +;; --- Feature 13: XML Format --- + +(def (cmd-xml-format app) + "Format/pretty-print XML in the current buffer." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (len (send-message ed SCI_GETLENGTH 0 0)) + (text (editor-get-text ed len))) + (when (and text (> (string-length text) 0)) + (with-catch + (lambda (e) (echo-message! echo (str "XML format error: " e))) + (lambda () + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + "xmllint --format - 2>/dev/null || python3 -c 'import sys,xml.dom.minidom;print(xml.dom.minidom.parseString(sys.stdin.read()).toprettyxml())'" + 'block (native-transcoder)))) + (display text p-stdin) + (close-port p-stdin) + (let loop ((lines '())) + (let ((line (get-line p-stdout))) + (if (eof-object? line) + (begin + (close-port p-stdout) (close-port p-stderr) + (let ((formatted (string-join (reverse lines) "\n"))) + (when (> (string-length formatted) 0) + (editor-set-text ed formatted) + (editor-goto-pos ed 0) + (echo-message! echo "XML formatted")))) + (loop (cons line lines))))))))))) + +;; --- Feature 14: CSV Sort --- + +(def (cmd-csv-sort app) + "Sort CSV data by a specified column." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (row (tui-rows)) (width (tui-cols)) + (col-str (echo-read-string echo "Sort by column (1-based): " row width))) + (when (and col-str (not (string-empty? col-str))) + (let ((col (string->number (string-trim col-str)))) + (when (and col (> col 0)) + (let* ((len (send-message ed SCI_GETLENGTH 0 0)) + (text (editor-get-text ed len)) + (lines (string-split text #\newline)) + (header (car lines)) + (data (cdr lines)) + (get-col (lambda (line) + (let ((fields (string-split line #\,))) + (if (>= (length fields) col) + (list-ref fields (- col 1)) + "")))) + (sorted (sort (lambda (a b) (string<? (get-col a) (get-col b))) data)) + (result (string-join (cons header sorted) "\n"))) + (editor-set-text ed result) + (editor-goto-pos ed 0) + (echo-message! echo (str "Sorted by column " col)))))))) + +;; --- Feature 15: Markdown TOC --- + +(def (cmd-markdown-toc app) + "Generate a table of contents from markdown headings." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (len (send-message ed SCI_GETLENGTH 0 0)) + (text (editor-get-text ed len)) + (lines (string-split text #\newline)) + (headings (filter (lambda (l) (and (> (string-length l) 0) + (char=? (string-ref l 0) #\#))) + lines)) + (toc-entries + (map (lambda (h) + (let* ((level (let loop ((i 0)) + (if (and (< i (string-length h)) (char=? (string-ref h i) #\#)) + (loop (+ i 1)) i))) + (title (string-trim (substring h level (string-length h)))) + (anchor (string-downcase + (let loop ((chars (string->list title)) (acc '())) + (cond + ((null? chars) (list->string (reverse acc))) + ((char-alphabetic? (car chars)) + (loop (cdr chars) (cons (char-downcase (car chars)) acc))) + ((char-numeric? (car chars)) + (loop (cdr chars) (cons (car chars) acc))) + ((char=? (car chars) #\space) + (loop (cdr chars) (cons #\- acc))) + (else (loop (cdr chars) acc)))))) + (indent (make-string (* (- level 1) 2) #\space))) + (str indent "- [" title "](#" anchor ")"))) + headings)) + (toc (string-append "## Table of Contents\n\n" + (string-join toc-entries "\n") "\n"))) + ;; Insert at beginning + (send-message ed SCI_GOTOPOS 0 0) + (editor-insert-text ed (str toc "\n")) + (echo-message! echo (str "TOC generated with " (length headings) " headings")))) + +;; --- Feature 16: Focus Mode --- + +(def *focus-mode-enabled* #f) + +(def (cmd-focus-mode app) + "Toggle focus/zen mode — minimize distractions." + (set! *focus-mode-enabled* (not *focus-mode-enabled*)) + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win))) + (if *focus-mode-enabled* + (begin + ;; Hide margins, disable wrapping distractions + (send-message ed SCI_SETMARGINWIDTHN 0 0) ;; hide line numbers + (send-message ed SCI_SETMARGINWIDTHN 1 0) + (send-message ed SCI_SETMARGINWIDTHN 2 0) + (echo-message! echo "Focus mode: on (minimal UI)")) + (begin + ;; Restore margins + (send-message ed SCI_SETMARGINWIDTHN 0 50) ;; restore line numbers + (echo-message! echo "Focus mode: off"))))) + +;; --- Feature 17: Typewriter Mode --- + +(def *typewriter-mode* #f) + +(def (cmd-typewriter-mode app) + "Toggle typewriter mode — keep cursor centered vertically." + (set! *typewriter-mode* (not *typewriter-mode*)) + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win))) + (when *typewriter-mode* + ;; Center current line + (let* ((pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (line (send-message ed SCI_LINEFROMPOSITION pos 0)) + (first-visible (send-message ed SCI_GETFIRSTVISIBLELINE 0 0)) + (lines-on-screen (send-message ed SCI_LINESONSCREEN 0 0)) + (target (max 0 (- line (quotient lines-on-screen 2))))) + (send-message ed SCI_SETFIRSTVISIBLELINE target 0))) + (echo-message! echo (if *typewriter-mode* "Typewriter mode: on" "Typewriter mode: off")))) + +;; --- Feature 18: Matrix Rain --- + +(def (cmd-rain app) + "Display Matrix-style digital rain animation in buffer." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (width 60) (height 20) + (chars "abcdefghijklmnopqrstuvwxyz0123456789@#$%&") + (char-len (string-length chars)) + (lines '())) + (do ((r 0 (+ r 1))) ((= r height)) + (let ((row-str "")) + (do ((c 0 (+ c 1))) ((= c width)) + (set! row-str + (string-append row-str + (if (< (random 10) 3) + (str (string-ref chars (random char-len))) + " ")))) + (set! lines (cons row-str lines)))) + (let* ((content (string-append "The Matrix\n" + (make-string width #\=) "\n\n" + (string-join (reverse lines) "\n"))) + (rbuf (make-buffer "*matrix-rain*"))) + (buffer-attach! ed rbuf) + (set! (edit-window-buffer win) rbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "Matrix rain")))) + +;; --- Feature 19: WiFi Status --- + +(def (cmd-wifi app) + "Show WiFi connection status and available networks." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win))) + (with-catch + (lambda (e) (echo-message! echo (str "wifi error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + "nmcli dev wifi list 2>/dev/null || iwconfig 2>/dev/null || echo 'WiFi tools not found'" + 'block (native-transcoder)))) + (close-port si) + (let loop ((lines '())) + (let ((line (get-line so))) + (if (eof-object? line) + (begin + (close-port so) (close-port se) + (let* ((content (string-append "WiFi Networks\n" + (make-string 50 #\=) "\n\n" + (string-join (reverse lines) "\n"))) + (wbuf (make-buffer "*wifi*"))) + (buffer-attach! ed wbuf) + (set! (edit-window-buffer win) wbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "WiFi networks listed"))) + (loop (cons line lines)))))))))) + +;; --- Feature 20: Screenshot --- + +(def (cmd-screenshot app) + "Take a screenshot and save it to a file." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (file (echo-read-string echo "Save screenshot to: " row width))) + (when (and file (not (string-empty? file))) + (let ((path (string-trim file))) + (with-catch + (lambda (e) (echo-message! echo (str "Screenshot error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "import " (shell-quote path) " 2>/dev/null || " + "scrot " (shell-quote path) " 2>/dev/null || " + "gnome-screenshot -f " (shell-quote path) " 2>/dev/null || " + "echo 'No screenshot tool found'") + 'block (native-transcoder)))) + (close-port si) (close-port so) (close-port se) + (echo-message! echo (str "Screenshot saved to " path))))))))) --- a/src/jerboa-emacs/editor-extra-modes.ss +++ b/src/jerboa-emacs/editor-extra-modes.ss @@ -4649,3 +4649,348 @@ (editor-goto-pos ed 0) (echo-message! echo "Ellama response ready"))) (loop (cons line lines))))))))))) + +;; ===== Round 10 Batch 1 ===== + +;; --- Feature 1: Journalctl Viewer --- + +(def (cmd-journalctl app) + "View recent systemd journal entries." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (row (tui-rows)) (width (tui-cols)) + (unit (echo-read-string echo "Unit (empty for all): " row width)) + (cmd (if (or (not unit) (string-empty? (string-trim unit))) + "journalctl --no-pager -n 100" + (str "journalctl --no-pager -n 100 -u " (shell-quote (string-trim unit)))))) + (with-catch + (lambda (e) (echo-message! echo (str "journalctl error: " e))) + (lambda () + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports cmd 'block (native-transcoder)))) + (close-port p-stdin) + (let loop ((lines '())) + (let ((line (get-line p-stdout))) + (if (eof-object? line) + (begin + (close-port p-stdout) (close-port p-stderr) + (let* ((content (string-join (reverse lines) "\n")) + (jbuf (make-buffer "*journalctl*"))) + (buffer-attach! ed jbuf) + (set! (edit-window-buffer win) jbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo (str (length lines) " journal entries")))) + (loop (cons line lines)))))))))) + +;; --- Feature 2: Bluetooth Control --- + +(def (cmd-bluetooth app) + "Show bluetooth device status and manage connections." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win))) + (with-catch + (lambda (e) (echo-message! echo (str "bluetooth error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports "bluetoothctl devices 2>/dev/null || echo 'bluetoothctl not available'" + 'block (native-transcoder)))) + (close-port si) + (let loop ((lines '())) + (let ((line (get-line so))) + (if (eof-object? line) + (begin + (close-port so) (close-port se) + (let* ((content (string-append "Bluetooth Devices\n" + (make-string 50 #\=) "\n\n" + (string-join (reverse lines) "\n"))) + (bbuf (make-buffer "*bluetooth*"))) + (buffer-attach! ed bbuf) + (set! (edit-window-buffer win) bbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "Bluetooth devices listed"))) + (loop (cons line lines)))))))))) + +;; --- Feature 3: Volume Control --- + +(def (cmd-volume app) + "Show and adjust system volume." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols))) + (with-catch + (lambda (e) (echo-message! echo (str "volume error: " e))) + (lambda () + ;; Get current volume + (let-values (((si so se pid) + (open-process-ports "pactl get-sink-volume @DEFAULT_SINK@ 2>/dev/null || amixer get Master 2>/dev/null | grep -o '[0-9]*%' | head -1" + 'block (native-transcoder)))) + (close-port si) + (let ((current (get-line so))) + (close-port so) (close-port se) + (let ((vol-str (if (eof-object? current) "unknown" current))) + (let ((input (echo-read-string echo + (str "Volume [" vol-str "] (0-100 or +/-): ") row width))) + (when (and input (not (string-empty? input))) + (let ((v (string-trim input))) + (with-catch + (lambda (e) (echo-message! echo (str "Set error: " e))) + (lambda () + (let-values (((si2 so2 se2 pid2) + (open-process-ports + (str "pactl set-sink-volume @DEFAULT_SINK@ " v "% 2>/dev/null || amixer set Master " v "% 2>/dev/null") + 'block (native-transcoder)))) + (close-port si2) (close-port so2) (close-port se2) + (echo-message! echo (str "Volume set to " v "%"))))))))))))))) + +;; --- Feature 4: ASCII Table --- + +(def (cmd-ascii-table app) + "Display an ASCII character table." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (lines (list "ASCII Table" (make-string 60 #\=) "" + "Dec Hex Oct Char | Dec Hex Oct Char" + (make-string 60 #\-)))) + (do ((i 32 (+ i 1))) ((= i 127)) + (let ((ch (if (= i 127) "DEL" (str (integer->char i))))) + (set! lines (cons (format "~3d ~2,'0x ~3,'0o ~4a" i i i ch) + lines)))) + (let* ((content (string-join (reverse lines) "\n")) + (abuf (make-buffer "*ascii-table*"))) + (buffer-attach! ed abuf) + (set! (edit-window-buffer win) abuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "ASCII table displayed")))) + +;; --- Feature 5: Unicode Search --- + +(def *unicode-common* + '(("arrow right" . "→") ("arrow left" . "←") ("arrow up" . "↑") ("arrow down" . "↓") + ("check mark" . "✓") ("cross mark" . "✗") ("bullet" . "•") ("degree" . "°") + ("copyright" . "©") ("registered" . "®") ("trademark" . "™") ("section" . "§") + ("paragraph" . "¶") ("micro" . "µ") ("plus minus" . "±") ("multiply" . "×") + ("divide" . "÷") ("not equal" . "≠") ("less equal" . "≤") ("greater equal" . "≥") + ("infinity" . "∞") ("square root" . "√") ("sum" . "∑") ("integral" . "∫") + ("alpha" . "α") ("beta" . "β") ("gamma" . "γ") ("delta" . "δ") + ("epsilon" . "ε") ("pi" . "π") ("sigma" . "σ") ("omega" . "ω") + ("lambda" . "λ") ("theta" . "θ") ("phi" . "φ") ("psi" . "ψ") + ("heart" . "♥") ("star" . "★") ("diamond" . "◆") ("spade" . "♠") + ("club" . "♣") ("music note" . "♪") ("sun" . "☀") ("snowflake" . "❄") + ("skull" . "☠") ("peace" . "☮") ("yin yang" . "☯") ("smile" . "☺") + ("ellipsis" . "…") ("en dash" . "–") ("em dash" . "—") ("left quote" . "\x201C;") + ("right quote" . "\x201D;") ("euro" . "€") ("pound" . "£") ("yen" . "¥"))) + +(def (cmd-unicode-search app) + "Search and insert a Unicode character by name." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (row (tui-rows)) (width (tui-cols)) + (names (map car *unicode-common*)) + (query (echo-read-string-with-completion echo "Unicode: " names row width))) + (when (and query (not (string-empty? query))) + (let ((match (assoc query *unicode-common*))) + (if match + (begin + (editor-insert-text ed (cdr match)) + (echo-message! echo (str "Inserted: " (cdr match) " (" (car match) ")"))) + ;; Try substring match + (let ((matches (filter (lambda (e) (string-contains (car e) (string-downcase query))) + *unicode-common*))) + (if (null? matches) + (echo-message! echo "No matching character found") + (begin + (editor-insert-text ed (cdar matches)) + (echo-message! echo (str "Inserted: " (cdar matches) + " (" (caar matches) ")")))))))))) + +;; --- Feature 6: Emoji Insert --- + +(def *emoji-list* + '(("smile" . "😊") ("laugh" . "😂") ("heart" . "❤️") ("thumbs up" . "👍") + ("fire" . "🔥") ("rocket" . "🚀") ("star" . "⭐") ("check" . "✅") + ("warning" . "⚠️") ("bug" . "🐛") ("bulb" . "💡") ("wrench" . "🔧") + ("book" . "📖") ("memo" . "📝") ("pin" . "📌") ("link" . "🔗") + ("clock" . "🕐") ("coffee" . "☕") ("pizza" . "🍕") ("beer" . "🍺") + ("tada" . "🎉") ("sparkles" . "✨") ("muscle" . "💪") ("brain" . "🧠") + ("eyes" . "👀") ("wave" . "👋") ("clap" . "👏") ("pray" . "🙏") + ("thinking" . "🤔") ("shrug" . "🤷") ("facepalm" . "🤦") ("100" . "💯") + ("poop" . "💩") ("ghost" . "👻") ("skull" . "💀") ("robot" . "🤖") + ("cat" . "🐱") ("dog" . "🐶") ("tree" . "🌲") ("sun" . "☀️") + ("moon" . "🌙") ("cloud" . "☁️") ("rain" . "🌧️") ("snow" . "❄️"))) + +(def (cmd-emoji-insert app) + "Insert an emoji by name." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (row (tui-rows)) (width (tui-cols)) + (names (map car *emoji-list*)) + (choice (echo-read-string-with-completion echo "Emoji: " names row width))) + (when (and choice (not (string-empty? choice))) + (let ((match (assoc choice *emoji-list*))) + (if match + (begin + (editor-insert-text ed (cdr match)) + (echo-message! echo (str "Inserted " (cdr match)))) + (echo-message! echo "Unknown emoji")))))) + +;; --- Feature 7: Kaomoji --- + +(def *kaomoji-list* + '(("happy" . "(╹◡╹)") ("sad" . "(╥﹏╥)") ("angry" . "(╬ ಠ益ಠ)") + ("shrug" . "¯\\_(ツ)_/¯") ("flip" . "(╯°□°)╯︵ ┻━┻") + ("unflip" . "┬─┬ノ( º _ ºノ)") ("bear" . "ʕ•ᴥ•ʔ") + ("sparkle" . "(ﾉ◕ヮ◕)ﾉ*:･ﾟ✧") ("love" . "(♥ω♥*)") + ("cool" . "(⌐■_■)") ("dance" . "♪┏(・o・)┛♪") + ("cat" . "(=^・ω・^=)") ("dog" . "∪・ω・∪") + ("cry" . "(;´༎ຶД༎ຶ`)") ("wink" . "(^_~)") + ("surprise" . "Σ(°△°|||)") ("sleep" . "(−_−) zzZ") + ("fight" . "(ง •̀_•́)ง") ("run" . "ε=ε=ε=┌(;*´Д`)ノ"))) + +(def (cmd-kaomoji app) + "Insert a kaomoji (Japanese emoticon)." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (row (tui-rows)) (width (tui-cols)) + (names (map car *kaomoji-list*)) + (choice (echo-read-string-with-completion echo "Kaomoji: " names row width))) + (when (and choice (not (string-empty? choice))) + (let ((match (assoc choice *kaomoji-list*))) + (if match + (begin + (editor-insert-text ed (cdr match)) + (echo-message! echo (str "Inserted: " (cdr match)))) + (echo-message! echo "Unknown kaomoji")))))) + +;; --- Feature 8: XKCD --- + +(def (cmd-xkcd app) + "Fetch and display the latest XKCD comic info." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win))) + (with-catch + (lambda (e) (echo-message! echo (str "XKCD error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports "curl -sL https://xkcd.com/info.0.json" + 'block (native-transcoder)))) + (close-port si) + (let loop ((lines '())) + (let ((line (get-line so))) + (if (eof-object? line) + (begin + (close-port so) (close-port se) + (let* ((json (string-join (reverse lines) "")) + ;; Extract title and alt from JSON + (get-field (lambda (field) + (let ((start (string-contains json (str "\"" field "\":")))) + (if (not start) "?" + (let* ((rest (substring json (+ start (string-length field) 3) (string-length json))) + (qstart (string-contains rest "\"")) + (rest2 (if qstart (substring rest (+ qstart 1) (string-length rest)) "")) + (qend (string-contains rest2 "\""))) + (if (and qstart qend) + (substring rest2 0 qend) "?")))))) + (title (get-field "safe_title")) + (alt (get-field "alt")) + (num (get-field "num")) + (content (string-append "XKCD #" num "\n" + (make-string 50 #\=) "\n\n" + "Title: " title "\n\n" + "Alt: " alt "\n")) + (xbuf (make-buffer "*xkcd*"))) + (buffer-attach! ed xbuf) + (set! (edit-window-buffer win) xbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo (str "XKCD #" num ": " title)))) + (loop (cons line lines)))))))))) + +;; --- Feature 9: Cheat.sh --- + +(def (cmd-cheat-sh app) + "Look up a cheat sheet from cheat.sh." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (row (tui-rows)) (width (tui-cols)) + (query (echo-read-string echo "cheat.sh query: " row width))) + (when (and query (not (string-empty? query))) + (with-catch + (lambda (e) (echo-message! echo (str "cheat.sh error: " e))) + (lambda () + (let* ((encoded (let loop ((chars (string->list (string-trim query))) (acc '())) + (if (null? chars) (list->string (reverse acc)) + (let ((c (car chars))) + (if (char=? c #\space) + (loop (cdr chars) (cons #\+ acc)) + (loop (cdr chars) (cons c acc)))))))) + (let-values (((si so se pid) + (open-process-ports + (str "curl -sL 'https://cheat.sh/" encoded "?T'") + 'block (native-transcoder)))) + (close-port si) + (let loop ((lines '())) + (let ((line (get-line so))) + (if (eof-object? line) + (begin + (close-port so) (close-port se) + (let* ((content (string-join (reverse lines) "\n")) + (cbuf (make-buffer "*cheat.sh*"))) + (buffer-attach! ed cbuf) + (set! (edit-window-buffer win) cbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo (str "cheat.sh: " query)))) + (loop (cons line lines)))))))))))) + +;; --- Feature 10: TLDR --- + +(def (cmd-tldr app) + "Look up TLDR page for a command." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (row (tui-rows)) (width (tui-cols)) + (cmd (echo-read-string echo "TLDR command: " row width))) + (when (and cmd (not (string-empty? cmd))) + (with-catch + (lambda (e) (echo-message! echo (str "tldr error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "tldr " (shell-quote (string-trim cmd)) " 2>/dev/null || " + "curl -sL 'https://raw.githubusercontent.com/tldr-pages/tldr/main/pages/common/" + (string-trim cmd) ".md' 2>/dev/null || echo 'Page not found'") + 'block (native-transcoder)))) + (close-port si) + (let loop ((lines '())) + (let ((line (get-line so))) + (if (eof-object? line) + (begin + (close-port so) (close-port se) + (let* ((content (string-join (reverse lines) "\n")) + (tbuf (make-buffer "*tldr*"))) + (buffer-attach! ed tbuf) + (set! (edit-window-buffer win) tbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo (str "TLDR: " cmd)))) + (loop (cons line lines))))))))))) --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1637,4 +1637,26 @@ (register-command! 'habit-report cmd-habit-report) (register-command! 'ement cmd-ement) (register-command! 'ement-send cmd-ement-send) + ;; Round 10 batch 1: journalctl, bluetooth, volume, ascii-table, unicode-search, emoji-insert, kaomoji, xkcd, cheat-sh, tldr + (register-command! 'journalctl cmd-journalctl) + (register-command! 'bluetooth cmd-bluetooth) + (register-command! 'volume cmd-volume) + (register-command! 'ascii-table cmd-ascii-table) + (register-command! 'unicode-search cmd-unicode-search) + (register-command! 'emoji-insert cmd-emoji-insert) + (register-command! 'kaomoji cmd-kaomoji) + (register-command! 'xkcd cmd-xkcd) + (register-command! 'cheat-sh cmd-cheat-sh) + (register-command! 'tldr cmd-tldr) + ;; Round 10 batch 2: httpstat, jwt-decode, xml-format, csv-sort, markdown-toc, focus-mode, typewriter-mode, rain, wifi, screenshot + (register-command! 'httpstat cmd-httpstat) + (register-command! 'jwt-decode cmd-jwt-decode) + (register-command! 'xml-format cmd-xml-format) + (register-command! 'csv-sort cmd-csv-sort) + (register-command! 'markdown-toc cmd-markdown-toc) + (register-command! 'focus-mode cmd-focus-mode) + (register-command! 'typewriter-mode cmd-typewriter-mode) + (register-command! 'rain cmd-rain) + (register-command! 'wifi cmd-wifi) + (register-command! 'screenshot cmd-screenshot) )