Add 20 Emacs features round 6: speed-type, tetris, disk-usage, darkroom, super-save, beginend, battery, memory-report, color-picker, insert-timestamp, count-words, yank-indent, whole-line-or-region, weather, smex, ace-jump-buffer, bug-reference, list-packages, link-hint, sys-info
ober
2123b3f93baa3a128cc08a9437637634e9394109
--- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1520,4 +1520,31 @@ (register-command! 'plantuml-mode cmd-plantuml-mode) (register-command! 'plantuml-preview cmd-plantuml-preview) (register-command! 'auto-compile-mode cmd-auto-compile-mode) + ;; Round 6 batch 1: speed-type, tetris, disk-usage, darkroom, super-save, beginend, battery, memory, color-picker, timestamp + (register-command! 'speed-type cmd-speed-type) + (register-command! 'speed-type-results cmd-speed-type-results) + (register-command! 'tetris cmd-tetris) + (register-command! 'disk-usage cmd-disk-usage) + (register-command! 'darkroom-mode cmd-darkroom-mode) + (register-command! 'super-save-mode cmd-super-save-mode) + (register-command! 'beginend-beginning cmd-beginend-beginning) + (register-command! 'beginend-end cmd-beginend-end) + (register-command! 'fancy-battery cmd-fancy-battery) + (register-command! 'memory-report cmd-memory-report) + (register-command! 'color-picker cmd-color-picker) + (register-command! 'insert-timestamp cmd-insert-timestamp) + (register-command! 'insert-date cmd-insert-date) + ;; Round 6 batch 2: count-words, yank-indent, whole-line, weather, smex, ace-jump-buffer, bug-reference, list-packages, link-hint, sys-info + (register-command! 'count-words cmd-count-words) + (register-command! 'yank-indent-mode cmd-yank-indent-mode) + (register-command! 'whole-line-or-region-kill cmd-whole-line-or-region-kill) + (register-command! 'whole-line-or-region-copy cmd-whole-line-or-region-copy) + (register-command! 'weather cmd-weather) + (register-command! 'weather-full cmd-weather-full) + (register-command! 'smex cmd-smex) + (register-command! 'ace-jump-buffer cmd-ace-jump-buffer) + (register-command! 'bug-reference-mode cmd-bug-reference-mode) + (register-command! 'list-packages cmd-list-packages) + (register-command! 'link-hint-open cmd-link-hint-open) + (register-command! 'sys-info cmd-sys-info) ) --- a/src/jerboa-emacs/editor-extra-tools2.ss +++ b/src/jerboa-emacs/editor-extra-tools2.ss @@ -2974,3 +2974,322 @@ (when (and nick (not (string-empty? nick))) (set! *erc-nick* nick) (echo-message! echo (string-append "Nick set to: " nick))))) + +;;;============================================================================ +;;; Round 6 batch 2: Features 11-20 +;;;============================================================================ + +;; --- Feature 11: Count Words --- + +(def (cmd-count-words app) + "Count words, characters, and lines in buffer or region." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (sel-start (send-message ed SCI_GETSELECTIONSTART 0 0)) + (sel-end (send-message ed SCI_GETSELECTIONEND 0 0)) + (has-region (not (= sel-start sel-end))) + (text (editor-get-text ed)) + (target (if has-region (substring text sel-start sel-end) text)) + (chars (string-length target)) + (lines (length (string-split target #\newline))) + (words (length (filter (lambda (w) (not (string-empty? w))) + (string-split target #\space))))) + (echo-message! echo + (string-append (if has-region "Region" "Buffer") ": " + (number->string words) " words, " + (number->string chars) " chars, " + (number->string lines) " lines")))) + +;; --- Feature 12: Yank Indent (auto-indent on yank) --- + +(def *yank-indent-enabled* #f) + +(def (cmd-yank-indent-mode app) + "Toggle yank-indent — auto-indent pasted text." + (set! *yank-indent-enabled* (not *yank-indent-enabled*)) + (echo-message! (app-state-echo app) + (if *yank-indent-enabled* + "Yank-indent mode: on" + "Yank-indent mode: off"))) + +;; --- Feature 13: Whole Line or Region --- + +(def (cmd-whole-line-or-region-kill app) + "Kill region if active, otherwise kill entire current line." + (let* ((ed (edit-window-editor (current-window (app-state-frame app)))) + (sel-start (send-message ed SCI_GETSELECTIONSTART 0 0)) + (sel-end (send-message ed SCI_GETSELECTIONEND 0 0))) + (if (not (= sel-start sel-end)) + ;; Has region — cut it + (begin + (let ((text (editor-get-text ed))) + (set! (app-state-kill-ring app) + (cons (substring text sel-start sel-end) (app-state-kill-ring app)))) + (send-message ed SCI_CUT 0 0)) + ;; No region — kill whole line + (let* ((line (send-message ed SCI_LINEFROMPOSITION sel-start 0)) + (line-start (send-message ed SCI_POSITIONFROMLINE line 0)) + (next-line-start (send-message ed SCI_POSITIONFROMLINE (+ line 1) 0)) + (text (editor-get-text ed)) + (line-text (substring text line-start + (min next-line-start (string-length text))))) + (set! (app-state-kill-ring app) (cons line-text (app-state-kill-ring app))) + (send-message ed SCI_SETTARGETSTART line-start 0) + (send-message ed SCI_SETTARGETEND next-line-start 0) + (send-message ed SCI_REPLACETARGET 0 (string->alien/nul "")))))) + +(def (cmd-whole-line-or-region-copy app) + "Copy region if active, otherwise copy entire current line." + (let* ((ed (edit-window-editor (current-window (app-state-frame app)))) + (sel-start (send-message ed SCI_GETSELECTIONSTART 0 0)) + (sel-end (send-message ed SCI_GETSELECTIONEND 0 0)) + (text (editor-get-text ed))) + (if (not (= sel-start sel-end)) + (let ((region (substring text sel-start sel-end))) + (set! (app-state-kill-ring app) (cons region (app-state-kill-ring app))) + (echo-message! (app-state-echo app) "Region copied")) + (let* ((line (send-message ed SCI_LINEFROMPOSITION sel-start 0)) + (line-start (send-message ed SCI_POSITIONFROMLINE line 0)) + (next-line-start (send-message ed SCI_POSITIONFROMLINE (+ line 1) 0)) + (line-text (substring text line-start + (min next-line-start (string-length text))))) + (set! (app-state-kill-ring app) (cons line-text (app-state-kill-ring app))) + (echo-message! (app-state-echo app) "Line copied"))))) + +;; --- Feature 14: Weather (wttr.in) --- + +(def (cmd-weather app) + "Show weather via wttr.in." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (location (echo-read-string echo "Weather location (city or empty for auto): " row width)) + (loc (if (or (not location) (string-empty? location)) "" location)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win))) + (echo-message! echo "Fetching weather...") + (let ((cmd (string-append "curl -s 'wttr.in/" loc "?format=3' 2>&1"))) + (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 ((result (string-join (reverse lines) "\n"))) + (echo-message! echo (if (string-empty? result) "Weather unavailable" result)))) + (loop (cons line lines))))))))) + +(def (cmd-weather-full app) + "Show full weather report via wttr.in." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (location (echo-read-string echo "Weather location: " row width)) + (loc (if (or (not location) (string-empty? location)) "" location)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win))) + (echo-message! echo "Fetching weather...") + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + (string-append "curl -s 'wttr.in/" loc "' 2>&1") + '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")) + (buf (make-buffer "*weather*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "Weather displayed"))) + (loop (cons line lines)))))))) + +;; --- Feature 15: Smex (enhanced M-x with frecency) --- + +(def *smex-frequency* (make-hash-table)) + +(def (smex-record! cmd-name) + "Record command usage for frecency sorting." + (let ((count (hash-ref *smex-frequency* cmd-name 0))) + (hash-put! *smex-frequency* cmd-name (+ count 1)))) + +(def (cmd-smex app) + "Enhanced M-x with frecency-sorted command completion." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + ;; Get all registered commands and sort by frequency + (all-cmds (map (lambda (p) (symbol->string (car p))) (command-alist))) + (sorted (sort (lambda (a b) + (> (hash-ref *smex-frequency* (string->symbol a) 0) + (hash-ref *smex-frequency* (string->symbol b) 0))) + all-cmds)) + (choice (echo-read-string-with-completion echo "M-x (smex): " sorted row width))) + (when (and choice (not (string-empty? choice))) + (let ((sym (string->symbol choice))) + (smex-record! sym) + (execute-command! app sym))))) + +;; --- Feature 16: Ace Jump Buffer --- + +(def (cmd-ace-jump-buffer app) + "Quick-switch between buffers with single-key selection." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (bufs (buffer-list)) + (keys "asdfjklghqwertyuiopzxcvbnm") + (entries + (let loop ((bs bufs) (i 0) (acc '())) + (if (or (null? bs) (>= i (string-length keys))) + (reverse acc) + (let* ((buf (car bs)) + (name (buffer-name buf)) + (key (string (string-ref keys i)))) + (loop (cdr bs) (+ i 1) + (cons (string-append "[" key "] " name) acc)))))) + (choice (echo-read-string-with-completion echo "Jump to buffer: " entries row width))) + (when (and choice (not (string-empty? choice))) + ;; Extract buffer name from "[x] name" + (let ((name (if (and (> (string-length choice) 4) + (char=? (string-ref choice 0) #\[)) + (substring choice 4 (string-length choice)) + choice))) + (let ((buf (buffer-by-name name))) + (when buf + (let* ((fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (echo-message! echo name)))))))) + +;; --- Feature 17: Bug Reference Mode --- + +(def *bug-reference-pattern* "#[0-9]+") +(def *bug-reference-url* "https://github.com/issues/") + +(def (cmd-bug-reference-mode app) + "Toggle bug-reference — highlight issue numbers like #123." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (on (toggle-mode! 'bug-reference))) + (if on + (begin + ;; Use indicator 15 for bug references + (send-message ed SCI_INDICSETSTYLE 15 4) ;; INDIC_DASH + (send-message ed SCI_INDICSETFORE 15 #x6060FF) + (send-message ed SCI_SETINDICATORCURRENT 15 0) + ;; Scan for #NNN patterns + (let* ((text (editor-get-text ed)) + (len (string-length text)) + (count 0)) + (let loop ((i 0)) + (when (< i (- len 1)) + (when (and (char=? (string-ref text i) #\#) + (< (+ i 1) len) + (char-numeric? (string-ref text (+ i 1)))) + ;; Found #N — find extent + (let num-loop ((j (+ i 1))) + (if (or (>= j len) (not (char-numeric? (string-ref text j)))) + (begin + (send-message ed SCI_INDICATORFILLRANGE i (- j i)) + (set! count (+ count 1))) + (num-loop (+ j 1))))) + (loop (+ i 1)))) + (echo-message! echo + (string-append "Bug references: " (number->string count) " found")))) + (begin + (send-message ed SCI_SETINDICATORCURRENT 15 0) + (send-message ed SCI_INDICATORCLEARRANGE 0 + (send-message ed SCI_GETLENGTH 0 0)) + (echo-message! echo "Bug reference mode: off"))))) + +;; --- Feature 18: List Packages (list available features) --- + +(def (cmd-list-packages app) + "List all available commands/features." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (cmds (sort (lambda (a b) (string<? (symbol->string (car a)) (symbol->string (car b)))) + (command-alist))) + (lines (map (lambda (c) (string-append " " (symbol->string (car c)))) cmds)) + (content (string-append "Available Commands (" (number->string (length cmds)) " total)\n" + (make-string 50 #\=) "\n" + (string-join lines "\n") "\n")) + (buf (make-buffer "*packages*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo (string-append (number->string (length cmds)) " commands available")))) + +;; --- Feature 19: Link Hint (jump to URLs) --- + +(def (cmd-link-hint-open app) + "Find and open URL under cursor or nearest URL." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (text (editor-get-text ed)) + (len (string-length text))) + ;; Search backward and forward for http + (let* ((search-start (max 0 (- pos 200))) + (search-end (min len (+ pos 200))) + (region (substring text search-start search-end))) + (let loop ((i 0) (best #f) (best-dist 999999)) + (if (>= i (- (string-length region) 7)) + (if best + (echo-message! echo (string-append "URL: " best)) + (echo-message! echo "No URL found near cursor")) + (if (or (string-prefix? "http://" (substring region i (min (string-length region) (+ i 7)))) + (string-prefix? "https://" (substring region i (min (string-length region) (+ i 8))))) + ;; Found URL — extract it + (let url-end ((j i)) + (if (or (>= j (string-length region)) + (memv (string-ref region j) '(#\space #\newline #\tab #\) #\] #\> #\"))) + (let* ((url (substring region i j)) + (dist (abs (- (+ search-start i) pos)))) + (if (< dist best-dist) + (loop (+ j 1) url dist) + (loop (+ j 1) best best-dist))) + (url-end (+ j 1)))) + (loop (+ i 1) best best-dist))))))) + +;; --- Feature 20: System Info --- + +(def (cmd-sys-info app) + "Display system information." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win))) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + "echo 'Hostname:'; hostname; echo ''; echo 'Kernel:'; uname -a; echo ''; echo 'Uptime:'; uptime; echo ''; echo 'CPU:'; lscpu | head -15; echo ''; echo 'Memory:'; free -h" + '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 "System Information\n" + (make-string 60 #\=) "\n" + (string-join (reverse lines) "\n"))) + (buf (make-buffer "*sys-info*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "System info displayed"))) + (loop (cons line lines)))))))) --- a/src/jerboa-emacs/editor-extra-vcs.ss +++ b/src/jerboa-emacs/editor-extra-vcs.ss @@ -2359,3 +2359,317 @@ (string->alien/nul choice)) (echo-message! echo (string-append "Corrected: " word " → " choice))))))) (loop (cons line lines))))))))))) + +;;;============================================================================ +;;; Round 6 batch 1: Features 1-10 +;;;============================================================================ + +;; --- Feature 1: Speed Type (typing speed test) --- + +(def *speed-type-text* + "The quick brown fox jumps over the lazy dog. Pack my box with five dozen liquor jugs. How vexingly quick daft zebras jump. The five boxing wizards jump quickly.") + +(def (cmd-speed-type app) + "Start a typing speed test." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (buf (make-buffer "*speed-type*")) + (content (string-append "=== Speed Typing Test ===\n\n" + "Type the following text as fast as you can:\n\n" + *speed-type-text* "\n\n" + (make-string 50 #\-) "\n" + "Start typing below this line:\n\n"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed (string-length content)) + (echo-message! echo "Speed type: start typing! Use speed-type-results when done"))) + +(def (cmd-speed-type-results app) + "Calculate and display speed typing results." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (text (editor-get-text ed)) + (lines (string-split text #\newline)) + ;; Find typed text (after the separator line) + (typed (let loop ((ls lines) (found #f) (acc '())) + (cond ((null? ls) (string-join (reverse acc) " ")) + ((string-prefix? "Start typing" (string-trim (car ls))) + (loop (cdr ls) #t acc)) + (found (loop (cdr ls) #t (cons (string-trim (car ls)) acc))) + (else (loop (cdr ls) #f acc))))) + (words (length (filter (lambda (w) (not (string-empty? w))) + (string-split typed #\space)))) + ;; Compare with original + (orig-words (filter (lambda (w) (not (string-empty? w))) + (string-split *speed-type-text* #\space))) + (correct (let loop ((tw (string-split typed #\space)) + (ow orig-words) (n 0)) + (cond ((or (null? tw) (null? ow)) n) + ((string=? (string-trim (car tw)) (car ow)) + (loop (cdr tw) (cdr ow) (+ n 1))) + (else (loop (cdr tw) (cdr ow) n))))) + (accuracy (if (> (length orig-words) 0) + (quotient (* correct 100) (length orig-words)) + 0))) + (echo-message! echo + (string-append "Words typed: " (number->string words) + " | Correct: " (number->string correct) + " | Accuracy: " (number->string accuracy) "%")))) + +;; --- Feature 2: Tetris (simple text-based game) --- + +(def *tetris-board* #f) +(def *tetris-score* 0) +(def *tetris-width* 10) +(def *tetris-height* 20) + +(def (cmd-tetris app) + "Start a text-based Tetris game display." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (buf (make-buffer "*tetris*")) + ;; Generate empty board + (board (let loop ((row 0) (lines '())) + (if (>= row *tetris-height*) + (reverse lines) + (loop (+ row 1) + (cons (string-append "|" (make-string *tetris-width* #\space) "|") lines))))) + (content (string-append + "=== TETRIS ===\n" + "Score: 0\n\n" + (string-join board "\n") "\n" + "+" (make-string *tetris-width* #\-) "+\n\n" + "Controls: tetris-left, tetris-right, tetris-rotate, tetris-drop\n" + "(This is a display-mode placeholder for a future interactive game)"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (set! *tetris-score* 0) + (echo-message! echo "Tetris started (display mode)"))) + +;; --- Feature 3: Disk Usage --- + +(def (cmd-disk-usage app) + "Show disk usage information." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win))) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports "df -h 2>&1" '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 "Disk Usage\n" + (make-string 60 #\=) "\n" + (string-join (reverse lines) "\n"))) + (buf (make-buffer "*disk-usage*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "Disk usage displayed"))) + (loop (cons line lines)))))))) + +;; --- Feature 4: Darkroom Mode (distraction-free writing) --- + +(def *darkroom-enabled* #f) +(def *darkroom-saved-margin* 0) + +(def (cmd-darkroom-mode app) + "Toggle darkroom mode — distraction-free writing environment." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app))))) + (set! *darkroom-enabled* (not *darkroom-enabled*)) + (if *darkroom-enabled* + (begin + ;; Save current margins and set wide margins for centered text + (set! *darkroom-saved-margin* (send-message ed SCI_GETMARGINLEFT 0 0)) + (let ((width (tui-cols))) + (let ((margin (max 0 (quotient (- width 80) 2)))) + (send-message ed SCI_SETMARGINLEFT 0 (* margin 8)) + (send-message ed SCI_SETMARGINRIGHT 0 (* margin 8)))) + ;; Hide line numbers + (send-message ed SCI_SETMARGINWIDTHN 0 0) + ;; Extra line spacing + (send-message ed SCI_SETEXTRAASCENT 4 0) + (send-message ed SCI_SETEXTRADESCENT 2 0) + (echo-message! echo "Darkroom mode: on (distraction-free)")) + (begin + (send-message ed SCI_SETMARGINLEFT 0 *darkroom-saved-margin*) + (send-message ed SCI_SETMARGINRIGHT 0 0) + (send-message ed SCI_SETMARGINWIDTHN 0 40) ;; restore line numbers + (send-message ed SCI_SETEXTRAASCENT 0 0) + (send-message ed SCI_SETEXTRADESCENT 0 0) + (echo-message! echo "Darkroom mode: off"))))) + +;; --- Feature 5: Super Save (auto-save on focus change) --- + +(def *super-save-enabled* #f) + +(def (cmd-super-save-mode app) + "Toggle super-save — auto-save buffer on idle/focus change." + (set! *super-save-enabled* (not *super-save-enabled*)) + (echo-message! (app-state-echo app) + (if *super-save-enabled* + "Super-save mode: on (buffers saved automatically)" + "Super-save mode: off"))) + +(def (super-save-maybe! app) + "Save current buffer if super-save is enabled and buffer is modified." + (when *super-save-enabled* + (let* ((buf (current-buffer-from-app app)) + (path (and buf (buffer-file-path buf))) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (modified (not (= (send-message ed SCI_GETMODIFY 0 0) 0)))) + (when (and path modified) + (execute-command! app 'save-buffer))))) + +;; --- Feature 6: Beginend (smart beginning/end of buffer) --- + +(def (cmd-beginend-beginning app) + "Smart beginning of buffer: skip headers/comments." + (let* ((ed (edit-window-editor (current-window (app-state-frame app)))) + (pos (send-message ed SCI_GETCURRENTPOS 0 0))) + (if (= pos 0) + ;; Already at beginning — go to first non-comment line + (let* ((text (editor-get-text ed)) + (lines (string-split text #\newline))) + (let loop ((ls lines) (offset 0)) + (cond ((null? ls) (editor-goto-pos ed 0)) + ((string-empty? (string-trim (car ls))) + (loop (cdr ls) (+ offset (string-length (car ls)) 1))) + ((string-prefix? ";;" (string-trim (car ls))) + (loop (cdr ls) (+ offset (string-length (car ls)) 1))) + ((string-prefix? "#" (string-trim (car ls))) + (loop (cdr ls) (+ offset (string-length (car ls)) 1))) + (else (editor-goto-pos ed offset))))) + (editor-goto-pos ed 0)))) + +(def (cmd-beginend-end app) + "Smart end of buffer: skip trailing whitespace." + (let* ((ed (edit-window-editor (current-window (app-state-frame app)))) + (text (editor-get-text ed)) + (len (string-length text)) + (pos (send-message ed SCI_GETCURRENTPOS 0 0))) + (if (= pos len) + ;; Already at end — go to last non-blank line + (let loop ((i (- len 1))) + (if (<= i 0) (editor-goto-pos ed len) + (let ((ch (string-ref text i))) + (if (or (char=? ch #\space) (char=? ch #\newline) (char=? ch #\tab)) + (loop (- i 1)) + (editor-goto-pos ed (+ i 1)))))) + (editor-goto-pos ed len)))) + +;; --- Feature 7: Fancy Battery --- + +(def (cmd-fancy-battery app) + "Show battery status." + (let* ((echo (app-state-echo app))) + (if (not (file-exists? "/sys/class/power_supply/BAT0/capacity")) + (echo-message! echo "No battery detected") + (let* ((capacity (string-trim (read-file-string "/sys/class/power_supply/BAT0/capacity"))) + (status (if (file-exists? "/sys/class/power_supply/BAT0/status") + (string-trim (read-file-string "/sys/class/power_supply/BAT0/status")) + "Unknown")) + (pct (or (string->number capacity) 0)) + (bar-len 20) + (filled (quotient (* pct bar-len) 100)) + (bar (string-append "[" (make-string filled #\#) + (make-string (- bar-len filled) #\-) "]"))) + (echo-message! echo + (string-append "Battery: " bar " " capacity "% (" status ")")))))) + +;; --- Feature 8: Memory Report --- + +(def (cmd-memory-report app) + "Show system memory usage." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win))) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports "free -h 2>&1" '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 "Memory Report\n" + (make-string 60 #\=) "\n" + (string-join (reverse lines) "\n"))) + (buf (make-buffer "*memory-report*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "Memory report displayed"))) + (loop (cons line lines)))))))) + +;; --- Feature 9: Color Picker --- + +(def (cmd-color-picker app) + "Interactive color picker — browse named colors and insert hex." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (colors '("red=#FF0000" "green=#00FF00" "blue=#0000FF" + "yellow=#FFFF00" "cyan=#00FFFF" "magenta=#FF00FF" + "white=#FFFFFF" "black=#000000" "orange=#FFA500" + "purple=#800080" "pink=#FFC0CB" "brown=#A52A2A" + "gray=#808080" "silver=#C0C0C0" "gold=#FFD700" + "navy=#000080" "teal=#008080" "olive=#808000" + "maroon=#800000" "lime=#00FF00" "aqua=#00FFFF" + "coral=#FF7F50" "salmon=#FA8072" "khaki=#F0E68C" + "plum=#DDA0DD" "orchid=#DA70D6" "sienna=#A0522D" + "tomato=#FF6347" "wheat=#F5DEB3" "ivory=#FFFFF0")) + (choice (echo-read-string-with-completion echo "Color: " colors row width))) + (when (and choice (not (string-empty? choice))) + (let ((eq (string-contains choice "="))) + (when eq + (let* ((hex (substring choice (+ eq 1) (string-length choice))) + (ed (edit-window-editor (current-window (app-state-frame app))))) + (send-message ed SCI_REPLACESEL 0 (string->alien/nul hex)) + (echo-message! echo (string-append "Inserted: " hex)))))))) + +;; --- Feature 10: Insert Timestamp --- + +(def (cmd-insert-timestamp app) + "Insert current date and time at point." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (now (current-time)) + (d (time-utc->date now 0)) + (timestamp (string-append + (number->string (date-year d)) "-" + (let ((m (date-month d))) (if (< m 10) (string-append "0" (number->string m)) (number->string m))) "-" + (let ((day (date-day d))) (if (< day 10) (string-append "0" (number->string day)) (number->string day))) " " + (let ((h (date-hour d))) (if (< h 10) (string-append "0" (number->string h)) (number->string h))) ":" + (let ((mn (date-minute d))) (if (< mn 10) (string-append "0" (number->string mn)) (number->string mn))) ":" + (let ((s (date-second d))) (if (< s 10) (string-append "0" (number->string s)) (number->string s)))))) + (send-message ed SCI_REPLACESEL 0 (string->alien/nul timestamp)) + (echo-message! echo (string-append "Inserted: " timestamp)))) + +(def (cmd-insert-date app) + "Insert current date at point (YYYY-MM-DD)." + (let* ((ed (edit-window-editor (current-window (app-state-frame app)))) + (now (current-time)) + (d (time-utc->date now 0)) + (date-str (string-append + (number->string (date-year d)) "-" + (let ((m (date-month d))) (if (< m 10) (string-append "0" (number->string m)) (number->string m))) "-" + (let ((day (date-day d))) (if (< day 10) (string-append "0" (number->string day)) (number->string day)))))) + (send-message ed SCI_REPLACESEL 0 (string->alien/nul date-str)) + (echo-message! (app-state-echo app) (string-append "Inserted: " date-str))))