Add 20 Emacs features round 9: wordle, minesweeper, sokoban, 2048, git-link, browse-at-remote, code-review, conventional-commit, clippy, ellama, hackernews, biblio, epa-encrypt/decrypt, typit, diff-at-point, magit-delta, figlet, cowsay, habit-tracker, ement
ober
168a9ada26d276b48bf42467f8c7995d65f01ff6
--- a/src/jerboa-emacs/editor-extra-final.ss +++ b/src/jerboa-emacs/editor-extra-final.ss @@ -4023,3 +4023,433 @@ (editor-set-text ed content) (editor-goto-pos ed (string-length content)) (echo-message! echo (str "Atomic Chrome ready on port " *atomic-chrome-port*))))) + +;; ===== Round 9 Batch 2 ===== + +;; --- Feature 11: Hackernews Client --- + +(def (cmd-hackernews app) + "Fetch and display top Hacker News stories." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win))) + (echo-message! echo "Fetching HN top stories...") + (with-catch + (lambda (e) (echo-message! echo (str "HN error: " e))) + (lambda () + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + "curl -sL 'https://hacker-news.firebaseio.com/v0/topstories.json?print=pretty' | head -30" + '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-append "Hacker News - Top Stories\n" + (make-string 50 #\=) "\n\n" + "Story IDs (use hackernews-view to read):\n" + (string-join (reverse lines) "\n"))) + (hbuf (make-buffer "*hackernews*"))) + (buffer-attach! ed hbuf) + (set! (edit-window-buffer win) hbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "Hacker News loaded"))) + (loop (cons line lines)))))))))) + +;; --- Feature 12: Biblio (Bibliography Search) --- + +(def (cmd-biblio app) + "Search for academic papers via crossref API." + (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 "Biblio search: " row width))) + (when (and query (not (string-empty? query))) + (echo-message! echo "Searching...") + (with-catch + (lambda (e) (echo-message! echo (str "Biblio error: " e))) + (lambda () + (let* ((encoded (let loop ((chars (string->list 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))))))) + (url (str "https://api.crossref.org/works?query=" encoded "&rows=10"))) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + (str "curl -sL --max-time 15 " (shell-quote url)) + '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* ((raw (string-join (reverse lines) "\n")) + ;; Extract titles from JSON (simple approach) + (titles (let extract ((s raw) (acc '())) + (let ((start (string-contains s "\"title\":"))) + (if (not start) + (reverse acc) + (let* ((rest (substring s (+ start 9) (string-length s))) + (qstart (string-contains rest "\"")) + (rest2 (if qstart (substring rest (+ qstart 1) (string-length rest)) "")) + (qend (string-contains rest2 "\""))) + (if (and qstart qend) + (extract (substring rest2 (+ qend 1) (string-length rest2)) + (cons (substring rest2 0 qend) acc)) + (reverse acc))))))) + (content (string-append "Biblio: " query "\n" + (make-string 50 #\=) "\n\n" + (if (null? titles) + "No results found" + (string-join + (map (lambda (t) (str " * " t)) titles) + "\n")))) + (bbuf (make-buffer "*biblio*"))) + (buffer-attach! ed bbuf) + (set! (edit-window-buffer win) bbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo (str "Found " (length titles) " results")))) + (loop (cons line lines)))))))))))) + +;; --- Feature 13: EPA-file (GPG Encryption) --- + +(def (cmd-epa-encrypt-file app) + "Encrypt the current buffer using GPG." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (buf (edit-window-buffer win)) + (file (buffer-file buf))) + (if (not file) + (echo-message! echo "No file associated with buffer") + (with-catch + (lambda (e) (echo-message! echo (str "GPG error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "gpg --symmetric --cipher-algo AES256 " (shell-quote file)) + '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) + (echo-message! echo (str "Encrypted: " file ".gpg"))) + (loop (cons line lines))))))))))) + +(def (cmd-epa-decrypt-file app) + "Decrypt a GPG-encrypted file and open in buffer." + (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)) + (file (echo-read-string echo "Decrypt file: " row width))) + (when (and file (not (string-empty? file))) + (with-catch + (lambda (e) (echo-message! echo (str "Decrypt error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "gpg --decrypt " (shell-quote (string-trim file))) + '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")) + (dbuf (make-buffer (str "*decrypted:" file "*")))) + (buffer-attach! ed dbuf) + (set! (edit-window-buffer win) dbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "File decrypted"))) + (loop (cons line lines))))))))))) + +;; --- Feature 14: Typit (Typing Test) --- + +(def *typit-texts* + '("The quick brown fox jumps over the lazy dog" + "Pack my box with five dozen liquor jugs" + "How vexingly quick daft zebras jump" + "Sphinx of black quartz judge my vow" + "Two driven jocks help fax my big quiz")) + +(def *typit-start-time* #f) +(def *typit-target* #f) + +(def (cmd-typit app) + "Start a typing accuracy test." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win))) + (set! *typit-target* (list-ref *typit-texts* (random (length *typit-texts*)))) + (set! *typit-start-time* (time-second (current-time))) + (let ((tbuf (make-buffer "*typit*"))) + (buffer-attach! ed tbuf) + (set! (edit-window-buffer win) tbuf) + (editor-set-text ed (string-append + "Typing Test\n" + (make-string 50 #\=) "\n\n" + "Type the following text:\n\n" + " " *typit-target* "\n\n" + "When done, use typit-check to see results.")) + (editor-goto-pos ed 0) + (echo-message! echo "Start typing! Use typit-check when done.")))) + +(def (cmd-typit-check app) + "Check typing test results." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (input (echo-read-string echo "Your text: " row width))) + (when (and input *typit-target* *typit-start-time*) + (let* ((elapsed (- (time-second (current-time)) *typit-start-time*)) + (words (length (string-split *typit-target* #\space))) + (wpm (if (> elapsed 0) (round (/ (* words 60.0) elapsed)) 0)) + ;; Calculate accuracy + (target-chars (string->list *typit-target*)) + (input-chars (string->list input)) + (correct (let loop ((t target-chars) (i input-chars) (n 0)) + (if (or (null? t) (null? i)) n + (loop (cdr t) (cdr i) + (if (char=? (car t) (car i)) (+ n 1) n))))) + (accuracy (if (> (length target-chars) 0) + (round (* 100.0 (/ correct (length target-chars)))) + 0))) + (echo-message! echo (str "WPM: " wpm " Accuracy: " accuracy + "% Time: " elapsed "s")))))) + +;; --- Feature 15: Diff-at-point --- + +(def (cmd-diff-at-point app) + "Show the git diff for the current line." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (buf (edit-window-buffer win)) + (file (buffer-file buf))) + (if (not file) + (echo-message! echo "No file associated with buffer") + (let* ((line-num (+ 1 (send-message ed SCI_LINEFROMPOSITION + (send-message ed SCI_GETCURRENTPOS 0 0) 0)))) + (with-catch + (lambda (e) (echo-message! echo (str "diff error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "git diff -U3 " (shell-quote file)) + '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 ((diff (string-join (reverse lines) "\n"))) + (if (string-empty? (string-trim diff)) + (echo-message! echo "No changes at this point") + (let ((dbuf (make-buffer "*diff-at-point*"))) + (let ((ed2 (edit-window-editor (current-window frame)))) + (buffer-attach! ed2 dbuf) + (set! (edit-window-buffer win) dbuf) + (editor-set-text ed2 diff) + (editor-goto-pos ed2 0) + (echo-message! echo "Diff loaded")))))) + (loop (cons line lines)))))))))))) + +;; --- Feature 16: Magit-delta --- + +(def (cmd-magit-delta app) + "Show git diff using delta for pretty formatting." + (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 "delta error: " e))) + (lambda () + ;; Try delta first, fall back to diff + (let* ((cmd (if (file-exists? "/usr/bin/delta") + "git diff | delta --no-gitconfig --dark" + "git diff --color=always")) + (dummy 0)) + (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* ((diff (string-join (reverse lines) "\n")) + (dbuf (make-buffer "*magit-delta*"))) + (buffer-attach! ed dbuf) + (set! (edit-window-buffer win) dbuf) + (editor-set-text ed diff) + (editor-goto-pos ed 0) + (echo-message! echo "Delta diff loaded"))) + (loop (cons line lines))))))))))) + +;; --- Feature 17: Figlet (ASCII Art Text) --- + +(def (cmd-figlet app) + "Convert text to ASCII art using figlet." + (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)) + (text (echo-read-string echo "Figlet text: " row width))) + (when (and text (not (string-empty? text))) + (with-catch + (lambda (e) (echo-message! echo (str "figlet error: " e))) + (lambda () + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + (str "figlet " (shell-quote text)) + '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 ((art (string-join (reverse lines) "\n"))) + (editor-insert-text ed art) + (echo-message! echo "Figlet inserted"))) + (loop (cons line lines))))))))))) + +;; --- Feature 18: Cowsay --- + +(def (cmd-cowsay app) + "Insert cowsay ASCII art with given text." + (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)) + (text (echo-read-string echo "Cowsay: " row width))) + (when (and text (not (string-empty? text))) + (with-catch + (lambda (e) (echo-message! echo (str "cowsay error: " e))) + (lambda () + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + (str "cowsay " (shell-quote text)) + '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 ((art (string-join (reverse lines) "\n"))) + (editor-insert-text ed art) + (echo-message! echo "Cowsay inserted"))) + (loop (cons line lines))))))))))) + +;; --- Feature 19: Habit Tracker --- + +(def *habit-tracker* (make-hash-table)) + +(def (cmd-habit-track app) + "Track a daily habit completion." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (habits (hash-keys *habit-tracker*)) + (habit (echo-read-string-with-completion echo "Habit: " habits row width))) + (when (and habit (not (string-empty? habit))) + (let* ((today (number->string (time-second (current-time)))) + (existing (hash-ref *habit-tracker* habit '())) + (updated (cons today existing))) + (hash-put! *habit-tracker* habit updated) + (echo-message! echo (str "Tracked: " habit " (" (length updated) " total)")))))) + +(def (cmd-habit-report app) + "Show habit tracking report." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (entries (hash->list *habit-tracker*)) + (content (string-append "Habit Tracker Report\n" + (make-string 50 #\=) "\n\n" + (if (null? entries) "No habits tracked yet" + (string-join + (map (lambda (e) + (str " " (car e) ": " (length (cdr e)) " completions")) + entries) + "\n")))) + (hbuf (make-buffer "*habit-report*"))) + (buffer-attach! ed hbuf) + (set! (edit-window-buffer win) hbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo (str (length entries) " habits tracked")))) + +;; --- Feature 20: Ement (Matrix Chat Stub) --- + +(def (cmd-ement app) + "Matrix chat client interface (requires matrix-commander)." + (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 "Matrix error: " e))) + (lambda () + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + "matrix-commander --listen once --listen-self 2>/dev/null || echo 'Install matrix-commander for Matrix chat'" + '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* ((messages (string-join (reverse lines) "\n")) + (mbuf (make-buffer "*matrix*"))) + (buffer-attach! ed mbuf) + (set! (edit-window-buffer win) mbuf) + (editor-set-text ed (string-append + "Matrix Chat (ement)\n" + (make-string 50 #\=) "\n\n" + messages)) + (editor-goto-pos ed 0) + (echo-message! echo "Matrix messages loaded"))) + (loop (cons line lines)))))))))) + +(def (cmd-ement-send app) + "Send a message to a Matrix room." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (room (echo-read-string echo "Room: " row width))) + (when (and room (not (string-empty? room))) + (let ((msg (echo-read-string echo "Message: " row width))) + (when (and msg (not (string-empty? msg))) + (with-catch + (lambda (e) (echo-message! echo (str "Send error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "matrix-commander --room " (shell-quote room) + " --message " (shell-quote msg)) + 'block (native-transcoder)))) + (close-port si) (close-port so) (close-port se) + (echo-message! echo (str "Sent to " room)))))))))) --- a/src/jerboa-emacs/editor-extra-modes.ss +++ b/src/jerboa-emacs/editor-extra-modes.ss @@ -4105,3 +4105,547 @@ (editor-set-text ed content) (editor-goto-pos ed 0) (echo-message! echo (str (length *command-log-entries*) " commands logged")))) + +;; ===== Round 9 Batch 1 ===== + +;; --- Feature 1: Wordle --- + +(def *wordle-words* + '("crane" "slate" "adieu" "stare" "trace" "crate" "raise" "arise" + "audio" "learn" "heart" "earth" "stain" "train" "brain" "grain" + "house" "mouse" "about" "shout" "doubt" "mount" "count" "found" + "round" "sound" "bound" "wound" "could" "would" "world" "early")) + +(def *wordle-target* #f) +(def *wordle-guesses* '()) +(def *wordle-max-guesses* 6) + +(def (wordle-init!) + (set! *wordle-target* (list-ref *wordle-words* (random (length *wordle-words*)))) + (set! *wordle-guesses* '())) + +(def (wordle-check guess target) + "Return a list of (char status) where status is 'green, 'yellow, or 'gray." + (let* ((g-chars (string->list guess)) + (t-chars (string->list target)) + (result (make-vector 5 'gray))) + ;; First pass: mark greens + (do ((i 0 (+ i 1))) ((= i 5)) + (when (char=? (list-ref g-chars i) (list-ref t-chars i)) + (vector-set! result i 'green))) + ;; Second pass: mark yellows + (let ((remaining (let loop ((i 0) (acc '())) + (if (= i 5) (reverse acc) + (if (eq? (vector-ref result i) 'green) + (loop (+ i 1) acc) + (loop (+ i 1) (cons (list-ref t-chars i) acc))))))) + (do ((i 0 (+ i 1))) ((= i 5)) + (when (and (not (eq? (vector-ref result i) 'green)) + (memv (list-ref g-chars i) remaining)) + (vector-set! result i 'yellow)))) + (let loop ((i 0) (acc '())) + (if (= i 5) (reverse acc) + (loop (+ i 1) (cons (list (list-ref g-chars i) (vector-ref result i)) acc)))))) + +(def (wordle-render) + (string-append "WORDLE\n" + (make-string 30 #\=) "\n\n" + (if (null? *wordle-guesses*) "Make your first guess (5-letter word)\n" + (string-join + (map (lambda (guess) + (let ((checks (wordle-check guess *wordle-target*))) + (string-join + (map (lambda (c) + (let ((ch (car c)) (st (cadr c))) + (case st + ((green) (str "[" ch "]")) + ((yellow) (str "(" ch ")")) + (else (str " " ch " "))))) + checks) + ""))) + (reverse *wordle-guesses*)) + "\n")) + "\n\nGuesses: " (number->string (length *wordle-guesses*)) + "/" (number->string *wordle-max-guesses*))) + +(def (cmd-wordle app) + "Start a new Wordle game." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win))) + (wordle-init!) + (let ((wbuf (make-buffer "*wordle*"))) + (buffer-attach! ed wbuf) + (set! (edit-window-buffer win) wbuf) + (editor-set-text ed (wordle-render)) + (editor-goto-pos ed 0) + (echo-message! echo "Wordle: Guess a 5-letter word")))) + +(def (cmd-wordle-guess app) + "Make a guess in Wordle." + (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))) + (when *wordle-target* + (if (>= (length *wordle-guesses*) *wordle-max-guesses*) + (echo-message! echo (str "Game over! Word was: " *wordle-target*)) + (let ((guess (echo-read-string echo "Guess: " row width))) + (when (and guess (= (string-length (string-trim guess)) 5)) + (let ((g (string-downcase (string-trim guess)))) + (set! *wordle-guesses* (cons g *wordle-guesses*)) + (editor-set-text ed (wordle-render)) + (editor-goto-pos ed 0) + (if (string=? g *wordle-target*) + (echo-message! echo (str "You won in " (length *wordle-guesses*) " guesses!")) + (when (>= (length *wordle-guesses*) *wordle-max-guesses*) + (echo-message! echo (str "Game over! Word was: " *wordle-target*))))))))))) + +;; --- Feature 2: Minesweeper --- + +(def *mines-board* #f) +(def *mines-revealed* #f) +(def *mines-flags* #f) +(def *mines-rows* 10) +(def *mines-cols* 10) +(def *mines-count* 15) + +(def (mines-init!) + (set! *mines-board* (make-vector (* *mines-rows* *mines-cols*) 0)) + (set! *mines-revealed* (make-vector (* *mines-rows* *mines-cols*) #f)) + (set! *mines-flags* (make-vector (* *mines-rows* *mines-cols*) #f)) + ;; Place mines + (let loop ((placed 0)) + (when (< placed *mines-count*) + (let ((pos (random (* *mines-rows* *mines-cols*)))) + (if (= (vector-ref *mines-board* pos) -1) + (loop placed) + (begin + (vector-set! *mines-board* pos -1) + ;; Update neighbor counts + (let* ((r (quotient pos *mines-cols*)) + (c (remainder pos *mines-cols*))) + (for-each (lambda (dr) + (for-each (lambda (dc) + (let ((nr (+ r dr)) (nc (+ c dc))) + (when (and (>= nr 0) (< nr *mines-rows*) + (>= nc 0) (< nc *mines-cols*)) + (let ((np (+ (* nr *mines-cols*) nc))) + (when (not (= (vector-ref *mines-board* np) -1)) + (vector-set! *mines-board* np + (+ (vector-ref *mines-board* np) 1))))))) + '(-1 0 1))) + '(-1 0 1))) + (loop (+ placed 1)))))))) + +(def (mines-render game-over?) + (let ((lines (list "Minesweeper" (make-string 30 #\=) "" + (string-append " " + (apply string-append + (map (lambda (c) (format "~2d" c)) (iota *mines-cols*))))))) + (do ((r 0 (+ r 1))) ((= r *mines-rows*)) + (let ((row-str (format "~2d " r))) + (do ((c 0 (+ c 1))) ((= c *mines-cols*)) + (let* ((pos (+ (* r *mines-cols*) c)) + (val (vector-ref *mines-board* pos)) + (rev (vector-ref *mines-revealed* pos)) + (flag (vector-ref *mines-flags* pos))) + (set! row-str + (string-append row-str + (cond + (flag " F") + ((and (not rev) (not game-over?)) " .") + ((= val -1) " *") + ((= val 0) " ") + (else (str " " val))))))) + (set! lines (cons row-str lines)))) + (string-join (reverse lines) "\n"))) + +(def (cmd-minesweeper app) + "Start a Minesweeper game." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win))) + (mines-init!) + (let ((mbuf (make-buffer "*minesweeper*"))) + (buffer-attach! ed mbuf) + (set! (edit-window-buffer win) mbuf) + (editor-set-text ed (mines-render #f)) + (editor-goto-pos ed 0) + (echo-message! echo "Minesweeper: 'row col' to reveal, 'f row col' to flag")))) + +(def (cmd-minesweeper-reveal app) + "Reveal a cell in Minesweeper." + (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)) + (input (echo-read-string echo "Reveal (row col): " row width))) + (when (and input (not (string-empty? input)) *mines-board*) + (let* ((parts (string-split (string-trim input) #\space)) + (r (and (>= (length parts) 2) (string->number (car parts)))) + (c (and (>= (length parts) 2) (string->number (cadr parts))))) + (when (and r c (>= r 0) (< r *mines-rows*) (>= c 0) (< c *mines-cols*)) + (let ((pos (+ (* r *mines-cols*) c))) + (vector-set! *mines-revealed* pos #t) + (if (= (vector-ref *mines-board* pos) -1) + (begin + (editor-set-text ed (mines-render #t)) + (echo-message! echo "BOOM! Game over.")) + (begin + (editor-set-text ed (mines-render #f)) + (editor-goto-pos ed 0))))))))) + +;; --- Feature 3: Sokoban --- + +(def *sokoban-levels* + '(" #####\n # #\n #$ #\n ### $##\n # $ $ #\n### # ## # ######\n# # ## ##### ..#\n# $ $ ..#\n##### ### #@## ..#\n # #########\n #######")) + +(def *sokoban-board* #f) +(def *sokoban-player* '(0 . 0)) + +(def (sokoban-init! level) + (let* ((lines (string-split level #\newline)) + (height (length lines)) + (width (apply max (map string-length lines))) + (board (make-vector (* height width) #\space))) + (do ((r 0 (+ r 1))) + ((= r height)) + (let ((line (list-ref lines r))) + (do ((c 0 (+ c 1))) + ((= c (string-length line))) + (let ((ch (string-ref line c))) + (when (char=? ch #\@) + (set! *sokoban-player* (cons r c))) + (vector-set! board (+ (* r width) c) ch))))) + (set! *sokoban-board* (list board height width)))) + +(def (cmd-sokoban app) + "Start a Sokoban puzzle game." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win))) + (sokoban-init! (car *sokoban-levels*)) + (let ((sbuf (make-buffer "*sokoban*"))) + (buffer-attach! ed sbuf) + (set! (edit-window-buffer win) sbuf) + (editor-set-text ed (string-append "Sokoban\n" (make-string 30 #\=) "\n\n" + (car *sokoban-levels*) + "\n\nPush $ onto . positions\nUse arrow keys or wasd")) + (editor-goto-pos ed 0) + (echo-message! echo "Sokoban: Push boxes ($) to goals (.)")))) + +;; --- Feature 4: 2048 Game --- + +(def *game-2048-board* #f) +(def *game-2048-score* 0) + +(def (game-2048-init!) + (set! *game-2048-board* (make-vector 16 0)) + (set! *game-2048-score* 0) + (game-2048-add-random!) + (game-2048-add-random!)) + +(def (game-2048-add-random!) + (let ((empties '())) + (do ((i 0 (+ i 1))) ((= i 16)) + (when (= (vector-ref *game-2048-board* i) 0) + (set! empties (cons i empties)))) + (when (not (null? empties)) + (let ((pos (list-ref empties (random (length empties))))) + (vector-set! *game-2048-board* pos (if (< (random 10) 9) 2 4)))))) + +(def (game-2048-render) + (let ((lines (list "2048" (make-string 30 #\=) (str "Score: " *game-2048-score*) ""))) + (do ((r 0 (+ r 1))) ((= r 4)) + (let ((row-str "")) + (do ((c 0 (+ c 1))) ((= c 4)) + (let ((v (vector-ref *game-2048-board* (+ (* r 4) c)))) + (set! row-str (string-append row-str + (if (= v 0) " ." (format "~4d" v)))))) + (set! lines (cons row-str lines)))) + (string-join (reverse lines) "\n"))) + +(def (game-2048-slide-row! row-indices) + "Slide and merge tiles in one direction for given indices." + (let* ((vals (map (lambda (i) (vector-ref *game-2048-board* i)) row-indices)) + (non-zero (filter (lambda (v) (not (= v 0))) vals)) + (merged (let loop ((lst non-zero) (acc '())) + (cond + ((null? lst) (reverse acc)) + ((and (not (null? (cdr lst))) (= (car lst) (cadr lst))) + (let ((new-val (* 2 (car lst)))) + (set! *game-2048-score* (+ *game-2048-score* new-val)) + (loop (cddr lst) (cons new-val acc)))) + (else (loop (cdr lst) (cons (car lst) acc)))))) + (padded (append merged (make-list (- 4 (length merged)) 0)))) + (do ((i 0 (+ i 1))) ((= i 4)) + (vector-set! *game-2048-board* (list-ref row-indices i) (list-ref padded i))))) + +(def (cmd-2048-game app) + "Start a 2048 game." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win))) + (game-2048-init!) + (let ((gbuf (make-buffer "*2048*"))) + (buffer-attach! ed gbuf) + (set! (edit-window-buffer win) gbuf) + (editor-set-text ed (game-2048-render)) + (editor-goto-pos ed 0) + (echo-message! echo "2048: Use left/right/up/down commands to slide tiles")))) + +(def (cmd-2048-left app) + "Slide tiles left in 2048." + (when *game-2048-board* + (do ((r 0 (+ r 1))) ((= r 4)) + (game-2048-slide-row! (list (* r 4) (+ (* r 4) 1) (+ (* r 4) 2) (+ (* r 4) 3)))) + (game-2048-add-random!) + (let* ((frame (app-state-frame app)) + (ed (edit-window-editor (current-window frame)))) + (editor-set-text ed (game-2048-render)) + (editor-goto-pos ed 0)))) + +;; --- Feature 5: Git-link --- + +(def (cmd-git-link app) + "Copy a GitHub/GitLab URL for the current file and line to the kill ring." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (buf (edit-window-buffer win)) + (file (buffer-file buf))) + (if (not file) + (echo-message! echo "No file associated with buffer") + (with-catch + (lambda (e) (echo-message! echo (str "git-link error: " e))) + (lambda () + (let* ((line-num (+ 1 (send-message ed SCI_LINEFROMPOSITION + (send-message ed SCI_GETCURRENTPOS 0 0) 0))) + ;; Get remote URL + (remote-out (let-values (((si so se pid) + (open-process-ports "git remote get-url origin" 'block (native-transcoder)))) + (close-port si) + (let ((r (get-line so))) + (close-port so) (close-port se) + (if (eof-object? r) "" r)))) + ;; Get relative path + (root-out (let-values (((si so se pid) + (open-process-ports "git rev-parse --show-toplevel" 'block (native-transcoder)))) + (close-port si) + (let ((r (get-line so))) + (close-port so) (close-port se) + (if (eof-object? r) "" r)))) + ;; Get current branch + (branch-out (let-values (((si so se pid) + (open-process-ports "git rev-parse --abbrev-ref HEAD" 'block (native-transcoder)))) + (close-port si) + (let ((r (get-line so))) + (close-port so) (close-port se) + (if (eof-object? r) "main" r)))) + (rel-path (if (and (> (string-length file) (string-length root-out)) + (string-prefix? root-out file)) + (substring file (+ (string-length root-out) 1) (string-length file)) + file)) + ;; Convert git@ URL to https + (base-url (if (string-prefix? "git@" remote-out) + (let* ((s (substring remote-out 4 (string-length remote-out))) + (s (let ((i (string-contains s ":"))) + (if i (string-append (substring s 0 i) "/" (substring s (+ i 1) (string-length s))) s))) + (s (if (string-suffix? ".git" s) + (substring s 0 (- (string-length s) 4)) s))) + (str "https://" s)) + (if (string-suffix? ".git" remote-out) + (substring remote-out 0 (- (string-length remote-out) 4)) + remote-out))) + (url (str base-url "/blob/" branch-out "/" rel-path "#L" line-num))) + (send-message ed SCI_COPYTEXT (string-length url) url) + (echo-message! echo (str "Copied: " url)))))))) + +;; --- Feature 6: Browse-at-remote --- + +(def (cmd-browse-at-remote app) + "Open the current file in the remote git forge (GitHub/GitLab)." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (buf (edit-window-buffer win)) + (file (buffer-file buf))) + (if (not file) + (echo-message! echo "No file associated with buffer") + (with-catch + (lambda (e) (echo-message! echo (str "browse-at-remote error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "git remote get-url origin") 'block (native-transcoder)))) + (close-port si) + (let ((remote (get-line so))) + (close-port so) (close-port se) + (when (and (not (eof-object? remote)) (not (string-empty? remote))) + ;; Convert to HTTPS URL + (let* ((base (cond + ((string-prefix? "git@" remote) + (let* ((s (substring remote 4 (string-length remote))) + (s (let ((i (string-contains s ":"))) + (if i (string-append (substring s 0 i) "/" + (substring s (+ i 1) (string-length s))) s))) + (s (if (string-suffix? ".git" s) + (substring s 0 (- (string-length s) 4)) s))) + (str "https://" s))) + (else (if (string-suffix? ".git" remote) + (substring remote 0 (- (string-length remote) 4)) + remote))))) + (let-values (((si2 so2 se2 pid2) + (open-process-ports (str "xdg-open " (shell-quote base)) + 'block (native-transcoder)))) + (close-port si2) (close-port so2) (close-port se2)) + (echo-message! echo (str "Opened: " base))))))))))) + +;; --- Feature 7: Code-review --- + +(def (cmd-code-review app) + "Review a git diff interactively with inline comments." + (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)) + (ref (echo-read-string echo "Diff against (default HEAD~1): " row width))) + (let ((base (if (or (not ref) (string-empty? (string-trim ref))) "HEAD~1" + (string-trim ref)))) + (with-catch + (lambda (e) (echo-message! echo (str "code-review error: " e))) + (lambda () + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports (str "git diff " base) + '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* ((diff-text (string-join (reverse lines) "\n")) + (rbuf (make-buffer "*code-review*"))) + (buffer-attach! ed rbuf) + (set! (edit-window-buffer win) rbuf) + (editor-set-text ed (string-append + "Code Review: " base "\n" + (make-string 50 #\=) "\n\n" + diff-text)) + (editor-goto-pos ed 0) + (echo-message! echo "Code review loaded"))) + (loop (cons line lines))))))))))) + +;; --- Feature 8: Conventional-commit --- + +(def *conventional-commit-types* + '("feat" "fix" "docs" "style" "refactor" "perf" "test" "build" + "ci" "chore" "revert")) + +(def (cmd-conventional-commit app) + "Create a conventional commit message (feat/fix/docs/etc)." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (type (echo-read-string-with-completion + echo "Commit type: " *conventional-commit-types* row width))) + (when (and type (not (string-empty? type))) + (let ((scope (echo-read-string echo "Scope (optional): " row width))) + (let ((desc (echo-read-string echo "Description: " row width))) + (when (and desc (not (string-empty? desc))) + (let* ((scope-str (if (and scope (not (string-empty? (string-trim scope)))) + (str "(" (string-trim scope) ")") "")) + (msg (str type scope-str ": " desc))) + (with-catch + (lambda (e) (echo-message! echo (str "Commit error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "git commit -m " (shell-quote msg)) + '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) + (echo-message! echo (str "Committed: " msg))) + (loop (cons line lines))))))))))))))) + +;; --- Feature 9: Clippy --- + +(def *clippy-tips* + '("Use C-x C-s to save the current buffer" + "Use M-x to run any command by name" + "Use C-s for incremental search" + "Use C-x b to switch buffers" + "Use C-x 2 to split the window horizontally" + "Use C-x 3 to split the window vertically" + "Use C-x o to switch between windows" + "Use C-g to cancel any operation" + "Use M-% for search and replace" + "Use C-x k to kill the current buffer" + "Use C-x u to undo the last change" + "Use C-space to start marking a region" + "Use M-w to copy and C-y to paste" + "Use C-k to kill to end of line" + "Use C-/ for undo" + "Use M-g g to go to a specific line number" + "Use C-x f to find and open a file" + "Use C-h k to describe a key binding" + "Use C-x r s to save region to register")) + +(def (cmd-clippy app) + "Show a helpful tip from Clippy." + (let* ((echo (app-state-echo app)) + (tip (list-ref *clippy-tips* (random (length *clippy-tips*))))) + (echo-message! echo (str "Clippy says: " tip)))) + +;; --- Feature 10: Ellama (LLM Interface) --- + +(def *ellama-model* "llama3") + +(def (cmd-ellama app) + "Send a prompt to a local LLM via ollama." + (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)) + (prompt (echo-read-string echo "Ellama prompt: " row width))) + (when (and prompt (not (string-empty? prompt))) + (echo-message! echo "Thinking...") + (with-catch + (lambda (e) (echo-message! echo (str "Ellama error: " e))) + (lambda () + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + (str "ollama run " *ellama-model* " " (shell-quote prompt)) + '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* ((response (string-join (reverse lines) "\n")) + (lbuf (make-buffer "*ellama*"))) + (buffer-attach! ed lbuf) + (set! (edit-window-buffer win) lbuf) + (editor-set-text ed (string-append + "Ellama (" *ellama-model* ")\n" + (make-string 50 #\=) "\n\n" + "Prompt: " prompt "\n\n" + "Response:\n" response)) + (editor-goto-pos ed 0) + (echo-message! echo "Ellama response ready"))) + (loop (cons line lines))))))))))) --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1608,4 +1608,33 @@ (register-command! 'calc-grab-region cmd-calc-grab-region) (register-command! 'coterm cmd-coterm) (register-command! 'atomic-chrome-start cmd-atomic-chrome-start) + ;; Round 9 batch 1: wordle, minesweeper, sokoban, 2048, git-link, browse-at-remote, code-review, conventional-commit, clippy, ellama + (register-command! 'wordle cmd-wordle) + (register-command! 'wordle-guess cmd-wordle-guess) + (register-command! 'minesweeper cmd-minesweeper) + (register-command! 'minesweeper-reveal cmd-minesweeper-reveal) + (register-command! 'sokoban cmd-sokoban) + (register-command! '2048-game cmd-2048-game) + (register-command! '2048-left cmd-2048-left) + (register-command! 'git-link cmd-git-link) + (register-command! 'browse-at-remote cmd-browse-at-remote)