From acda08134d78b59483d9694c87b53c110d21ee8e Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Sun, 21 Jun 2026 18:07:46 +0200 Subject: [PATCH] First commit Co-Authored-By: Claude Opus 4.8 (1M context) --- .gitignore | 12 + README.md | 236 ++++++ early-init.el | 69 ++ init.el | 981 ++++++++++++++++++++++++ lisp/cabal-source-repo.el | 282 +++++++ lisp/emacs-solo-abbrev.el | 37 + lisp/emacs-solo-ace-window.el | 66 ++ lisp/emacs-solo-dired-gutter.el | 91 +++ lisp/emacs-solo-exec-path-from-shell.el | 45 ++ lisp/emacs-solo-gutter.el | 181 +++++ lisp/emacs-solo-highlight-keywords.el | 56 ++ lisp/emacs-solo-mode-line.el | 62 ++ lisp/emacs-solo-rainbow-delimiters.el | 37 + lisp/haskell-literate-ts-mode.el | 59 ++ 14 files changed, 2214 insertions(+) create mode 100644 .gitignore create mode 100644 README.md create mode 100755 early-init.el create mode 100644 init.el create mode 100644 lisp/cabal-source-repo.el create mode 100644 lisp/emacs-solo-abbrev.el create mode 100644 lisp/emacs-solo-ace-window.el create mode 100644 lisp/emacs-solo-dired-gutter.el create mode 100644 lisp/emacs-solo-exec-path-from-shell.el create mode 100644 lisp/emacs-solo-gutter.el create mode 100644 lisp/emacs-solo-highlight-keywords.el create mode 100644 lisp/emacs-solo-mode-line.el create mode 100644 lisp/emacs-solo-rainbow-delimiters.el create mode 100644 lisp/haskell-literate-ts-mode.el diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..1540acc --- /dev/null +++ b/.gitignore @@ -0,0 +1,12 @@ +eln-cache +history +places.eld +projects.eld +recentf.eld +straight +tree-sitter +auto-save-list +backups +transient +org-clock-save.el +custom.el \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..31b6a02 --- /dev/null +++ b/README.md @@ -0,0 +1,236 @@ +# Emacs configuration — keybindings + +A built-in-first Emacs (32) configuration. This file lists the keybindings, +grouped by concept. + +- **Bold "default"** notes mark bindings *provided by a package/Emacs* that this + config relies on but does not set itself. +- Everything else is defined in `init.el` or the modules under `lisp/`. + +Conventions: `C-x` = Control-x, `M-x` = Alt/Meta-x, `RET` = Return, `SPC` = Space. + +--- + +## Completion & minibuffer + +The minibuffer uses built-in `icomplete-vertical` (no vertico/consult). + +| Key | Action | +|-----|--------| +| `C-n` / `` | Next candidate | +| `C-p` / `` | Previous candidate | +| `C-v` | Toggle vertical display | +| `TAB` | Complete; in file completion, **descend into the selected directory** | +| `RET` | Accept & exit; in file completion, **descend into the selected directory** | +| `DEL` | Delete char; in file completion, **go up a directory level** | +| `C-j` | Accept raw input exactly as typed (don't force-complete) | + +File navigation mirrors the old `vertico-directory`: while completing a path, +`TAB`/`RET` drill into directories (the list refreshes to their contents) and +`DEL` climbs back up — no need to re-invoke `C-x C-f`. + +In-buffer completion uses built-in `completion-preview-mode` (grey inline text): + +| Key | Action | +|-----|--------| +| `TAB` | Insert the previewed completion | +| `M-n` | Next completion candidate | +| `M-p` | Previous completion candidate | +| `M-/` | `hippie-expand` (expand word/line/filename from buffers, kill-ring, files) | + +--- + +## Buffers, files & navigation + +| Key | Action | +|-----|--------| +| `C-x k` | Kill the current buffer (no prompt) | +| `C-x C-b` | `ibuffer` (grouped buffer list) | +| `C-x C-j` | `dired-jump` (open Dired at the current file) | +| `M-g r` | Open a recent file (`recentf-open`) | +| `M-g i` | Jump to a definition in this buffer (`imenu`) | +| `M-g g` | (default) Go to line | +| `M-.` / `M-?` / `M-,` | (default) Jump to definition / find references / go back (`xref`) | +| `C-x C-e` | Eval last sexp, result shown inline as an overlay | + +--- + +## Windows & layout + +| Key | Action | +|-----|--------| +| `M-o` | Jump to a window by number (ace-window style) | +| `C-x o` | (default) Other window | +| `C-x w t` | Transpose the window layout | +| `C-x w r` | Rotate the window layout clockwise | +| `C-x w f h` | Flip layout left↔right | +| `C-x w f v` | Flip layout top↔bottom | +| `C-c ←` / `C-c →` | (default, `winner-mode`) Undo / redo window layout | +| `M-I` | Toggle / focus the `speedbar` file tree | + +`repeat-mode` is on: after `C-x o`, press `o o o…`; after `C-x ^`, press `^ ^…`; +after `C-x {`/`}`, keep pressing `{`/`}`. + +--- + +## Editing + +| Key | Action | +|-----|--------| +| `C-x ;` | Comment / uncomment line | +| `M-J` | Duplicate line or region (`duplicate-dwim`) | +| `M-K` | Kill paragraph | +| `M-Z` | Zap *up to* char | +| `M-F` | Forward to next word start | +| `M-B` | Backward to previous word end | +| `C-M-z` | Delete the surrounding pair of delimiters | +| `M-\` | `cycle-spacing` (collapse/restore whitespace) | +| `M-c` / `M-l` / `M-u` | Capitalize / downcase / upcase — act on the **region** when active | +| `M-SPC` | (default) `just-one-space` | + +Multiple cursors is available (package `multiple-cursors`) but unbound — bind or +`M-x mc/...` as you like. + +--- + +## Search + +| Key | Action | +|-----|--------| +| `M-s g` | `grep` (ripgrep-backed) | +| `M-s r` | `rgrep` (recursive) | +| `M-s f` | `find-name-dired` (find files by name) | +| `M-s l` | `occur` (matching lines in buffer) | +| `C-s` / `C-r` | (default) isearch fwd/back, with live match count | +| `C-x p g` | (default) `project-find-regexp` (search the project) | + +--- + +## Version control (Git) + +Magit is the main interface; built-in `vc` and a git-gutter complement it. + +| Key | Action | +|-----|--------| +| `C-x g` | (magit default) `magit-status` | +| `C-x M-g` | (magit default) `magit-dispatch` | +| `C-c M-g` | (magit default) `magit-file-dispatch` | +| `M-9` / `M-0` | Jump to previous / next changed hunk | +| `C-c g p` / `C-c g n` | Jump to previous / next changed hunk | +| `C-c g g` / `C-c g r` | Turn the git gutter on / off | +| `C-x p y` | Open the current file on the remote forge (browse-at-remote) | +| `C-x v B` | Open the repo's remote in the browser | +| `C-x v o` | Open the remote at the current branch/file/line | +| `C-x v v` / `C-x v =` / `C-x v l` | (default) vc next-action / diff / log | + +The git gutter also shows added/changed/deleted marks in the left margin, and +Dired buffers show per-file git status. + +--- + +## Code / LSP (eglot) + +LSP is built-in `eglot`. Diagnostics are built-in `flymake`. + +| Key | Action | +|-----|--------| +| `C-c o r` | Rename symbol | +| `C-c o a` | Code actions | +| `C-c o f` | Format buffer/region (via the language server) | +| `C-c o o` | Organize imports | +| `C-c o h` | Toggle inlay hints (inline types/params) | +| `M-n` / `M-p` | Next / previous diagnostic (`flymake`) | +| `C-c ! l` | This buffer's diagnostics list | +| `C-c ! P` | Project-wide diagnostics list | + +`M-x treesit-explore-mode` shows a live tree-sitter parse of the buffer. + +--- + +## Haskell & formatting + +| Key | Action | +|-----|--------| +| `C-c r` | Format buffer via the language server (`eglot-format-buffer`) | +| `C-c h r` | Insert/update a Cabal `source-repository-package` stanza | + +Format-on-save is opt-in per project via `.dir-locals.el`: + +```elisp +;; via the language server (when HLS has a formatter plugin): +((haskell-ts-mode . ((eval . (my/eglot-format-on-save-mode 1))))) + +;; or via the fourmolu/ormolu binary directly (HLS-independent): +((haskell-ts-mode . ((eval . (my/fourmolu-format-on-save-mode 1))))) +``` + +Related commands (no default binding): `M-x my/fourmolu-format-buffer`. + +Literate Haskell (`.lhs`) opens in `haskell-literate-ts-mode`: the document is +parsed with the `haskell-literate` tree-sitter grammar and the regular `haskell` +grammar is injected into code blocks. eglot/HLS manages it too (language id +`literate haskell`); the same `C-c o …` / `C-c r` bindings apply. + +--- + +## Spell checking + +Built-in `flyspell` (prose + code comments/strings). + +| Key | Action | +|-----|--------| +| `M-$` | (default) Correct word at point | +| `C-M-$` | Change dictionary | + +--- + +## Snippets / abbrev + +Snippet-like expansion uses built-in `abbrev` (type the trigger, then a +non-word char like `SPC`). Word-like triggers are **prog-mode only** so they +never fire in prose. + +| Key | Action | +|-----|--------| +| `C-x a g` | (default) Add a global abbrev | +| `C-x a l` | (default) Add a mode-local abbrev | +| `M-x edit-abbrevs` | Edit all abbrevs | + +Triggers shipped with this config: + +| Trigger | Expands to | Scope | +|---------|-----------|-------| +| `rarr` `larr` `uarr` `darr` | → ← ↑ ↓ | everywhere | +| `isodate` | current ISO timestamp | everywhere | +| `uuid8` | a fresh UUID | everywhere | +| `todo` `fixme` `note` `hack` | 👷 TODO: / 🔥 FIXME: / 📎 NOTE: / 👾 HACK: | code only | +| `lang` | `{-# LANGUAGE … #-}` (point inside) | code only | + +--- + +## Files as root + +| Key | Action | +|-----|--------| +| `C-x x @` | (default) Re-open the current file as root over TRAMP | + +--- + +## Project (built-in `project.el`) + +| Key | Action | +|-----|--------| +| `C-x p f` | Find file in project | +| `C-x p g` | Search project (regexp) | +| `C-x p p` | Switch project | +| `C-x p d` | Dired at project root | +| `C-x p b` | Switch to a project buffer | +| `C-x p y` | Browse current file on the remote forge *(set by this config)* | + +--- + +## Notes + +- Keys marked **(default)** come from Emacs or a package; the rest are set here. +- Module sources live in `lisp/` (`emacs-solo-*.el`); see `init.el` for the + rationale behind each built-in-first choice. diff --git a/early-init.el b/early-init.el new file mode 100755 index 0000000..7fd504d --- /dev/null +++ b/early-init.el @@ -0,0 +1,69 @@ +;;; early-init.el --- Early init -*- lexical-binding: t; -*- + +;;; Commentary: +;; Runs before the GUI and package system initialize. Everything here is +;; built-in; this is where startup-speed tweaks live (mirrors emacs-solo). + +;;; Code: + +(setq package-enable-at-startup nil) +(setq native-comp-async-report-warnings-errors 'silent) + +;;; -------------------- Startup performance (restored after init) + +;; Defer garbage collection while booting, then return to a sane threshold. +(setq gc-cons-threshold most-positive-fixnum + gc-cons-percentage 0.6) +(add-hook 'after-init-hook + (lambda () + (setq gc-cons-threshold (* 100 1024 1024) + gc-cons-percentage 0.1))) + +;; Skip the file-name-handler regexp on every file load while booting. +(defvar my--file-name-handler-alist file-name-handler-alist) +(setq file-name-handler-alist nil) +(add-hook 'after-init-hook + (lambda () + (setq file-name-handler-alist my--file-name-handler-alist))) + +;; Only Git is used here; not probing the other backends speeds startup. +(setq vc-handled-backends '(Git)) + +;; Don't native-compile in the background while on battery (Emacs 31+). +(setopt native-comp-async-on-battery-power nil) + +;; Don't compact font caches during GC (helps with many glyphs/icons). +(setq inhibit-compacting-font-caches t) + +;;; -------------------- Frame appearance + +;; Disable chrome via `default-frame-alist' so it never flashes on, and use a +;; dark initial background to avoid a white flash before the theme loads +;; (modus-vivendi's background). +(push '(menu-bar-lines . 0) default-frame-alist) +(push '(tool-bar-lines . 0) default-frame-alist) +(push '(vertical-scroll-bars) default-frame-alist) +(push '(background-color . "#000000") default-frame-alist) +(push '(font . "IBM Plex Mono-12.5") default-frame-alist) + +;; Don't resize the frame when fonts/menu-bar/etc. change pixel sizes. +(setq frame-resize-pixelwise t + frame-inhibit-implied-resize t + frame-title-format + '(:eval + (let ((project (and (fboundp 'project-current) (project-current)))) + (if project + (concat "Emacs - [p] " (project-name project)) + (concat "Emacs - " (buffer-name)))))) + +(when (eq system-type 'darwin) + (setq ns-use-proxy-icon nil)) + +;;; -------------------- Quieter startup + +;; Don't pop up the *Warnings* buffer for non-errors (e.g. lexical-binding). +(setq warning-minimum-level :error) +(setq warning-suppress-types '((lexical-binding))) + +(provide 'early-init) +;;; early-init.el ends here diff --git a/init.el b/init.el new file mode 100644 index 0000000..bb9326f --- /dev/null +++ b/init.el @@ -0,0 +1,981 @@ +;;; init.el --- Built-in-first Emacs configuration -*- lexical-binding: t; -*- + +;;; Commentary: +;; Configuration that prefers Emacs' built-in features (Emacs 32) over external +;; packages, following the "Emacs Solo" approach where practical. +;; +;; Packages removed in favour of built-ins: +;; vertico/consult/marginalia/orderless/embark -> icomplete-vertical + completion-styles +;; corfu/cape -> completion-preview-mode +;; moody/minions -> custom mode-line (lisp/emacs-solo-mode-line.el) +;; exec-path-from-shell -> lisp/emacs-solo-exec-path-from-shell.el +;; blamer -> git-gutter (lisp/emacs-solo-gutter.el) +;; rg -> built-in grep / project-find-regexp + ripgrep xref +;; browse-at-remote -> emacs-solo/vc-browse-remote (built-in vc) +;; ormolu -> eglot-format +;; markdown-mode -> markdown-ts-mode (built-in) +;; jinx -> flyspell (built-in) +;; yasnippet -> abbrev (built-in) +;; pulsar -> pulse.el (built-in) +;; doom-themes -> modus-themes (built-in) +;; +;; Packages removed entirely: +;; aider, claude-code-ide, vterm (AI tooling), magit-delta, treemacs, drag-stuff +;; +;; Packages kept (no good built-in equivalent): +;; magit, envrc, multiple-cursors, nerd-icons, haskell-ts-mode (no built-in +;; Haskell mode exists), nix-ts-mode, ediprolog, org-modern, org-super-agenda, +;; dashboard +;; +;; crosshairs (line+column highlight) -> global-hl-line-mode (built-in, line +;; only); the column overlay conflicted with eglot's inline overlays. +;; +;; External setup this config assumes: +;; - language servers on PATH (haskell-language-server-wrapper, rust-analyzer, nil/nixd) +;; - a spell checker (aspell or hunspell) + dictionary for flyspell +;; - tree-sitter grammars (M-x treesit-install-language-grammar; see "Language modes") + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Package management (straight.el + use-package) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Bootstrap straight.el: download and load it on first run. +(defvar bootstrap-version) +(let ((bootstrap-file + (expand-file-name + "straight/repos/straight.el/bootstrap.el" + (or (bound-and-true-p straight-base-dir) + user-emacs-directory))) + (bootstrap-version 7)) + (unless (file-exists-p bootstrap-file) + (with-current-buffer + (url-retrieve-synchronously + "https://raw.githubusercontent.com/radian-software/straight.el/develop/install.el" + 'silent 'inhibit-cookies) + (goto-char (point-max)) + (eval-print-last-sexp))) + (load bootstrap-file nil 'nomessage)) + +(straight-use-package 'org) +(straight-use-package 'use-package) +(use-package straight + :custom + ;; Treat these as built-in "pseudo packages" so straight.el doesn't download + ;; a separate copy than the one Emacs already ships. + (straight-built-in-pseudo-packages + '(emacs nadvice python image-mode project flymake xref eglot which-key + icomplete completion-preview markdown-ts-mode modus-themes flyspell vc)) + ;; Make `use-package' install packages via straight.el automatically. + (straight-use-package-by-default t)) + +;; Local lisp modules (vendored built-in helpers, cabal-source-repo, ...). +(add-to-list 'load-path (expand-file-name "lisp" user-emacs-directory)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Custom file +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Keep machine-generated `customize' settings out of this file. +(setq custom-file (expand-file-name "custom.el" user-emacs-directory)) +(load custom-file 'noerror) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; UI & appearance +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(set-fringe-mode 10) ; Give some breathing room +(global-subword-mode 1) ; Navigate inside CamelCaseWords +(column-number-mode t) ; Show column number in the mode line +(setq visible-bell t) ; Flash instead of the audible bell +(xterm-mouse-mode 1) ; Enable mouse support in the terminal +(blink-cursor-mode 0) +(setq-default fill-column 80) +(global-display-fill-column-indicator-mode t) ; Draw a line at `fill-column' + +;; Built-in theme (replaces doom-themes). modus-vivendi is a polished dark +;; theme; swap for modus-vivendi-tinted / modus-operandi (light) to taste. +(require-theme 'modus-themes) +(setq modus-themes-italic-constructs t + modus-themes-bold-constructs t + modus-themes-mixed-fonts t) +(load-theme 'modus-vivendi-tritanopia t) + +;; Inherit PATH/exec-path from the login shell (replaces exec-path-from-shell). +;; Runs asynchronously so it never blocks startup. +(require 'emacs-solo-exec-path-from-shell) +(add-hook 'after-init-hook #'emacs-solo/set-exec-path-from-shell-PATH) + +;; Briefly highlight the current line after big movements (replaces pulsar). +(require 'pulse) +(defun my/pulse-line (&rest _) + "Pulse the current line." + (pulse-momentary-highlight-one-line (point))) +(dolist (cmd '(scroll-up-command scroll-down-command + recenter-top-bottom other-window)) + (advice-add cmd :after #'my/pulse-line)) + +;; Compact built-in mode line (replaces moody + minions). +(require 'emacs-solo-mode-line) + +;; Vendored emacs-solo modules (built-in font-lock/overlays, no external deps). +(require 'emacs-solo-highlight-keywords) ; TODO/FIXME/HACK/NOTE highlighting +(require 'emacs-solo-rainbow-delimiters) ; depth-colored () [] {} +(require 'emacs-solo-ace-window) ; M-O: jump to a window by number +(require 'emacs-solo-dired-gutter) ; git status marks in Dired +(require 'emacs-solo-abbrev) ; snippet-like abbrev expansions + +;; Icons (kept for the dashboard). First run: M-x nerd-icons-install-fonts +(use-package nerd-icons) + +;; Multiple cursors (no built-in equivalent). +(use-package multiple-cursors) + +;; Highlight the current line (built-in). The column crosshair (crosshairs / +;; col-highlight / vline) is dropped: its full-height vertical overlay clashes +;; badly with eglot's inline overlays (diagnostics, inlay hints, eldoc-at-point). +(global-hl-line-mode 1) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Editing & files +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Keep versioned backups in a dedicated directory instead of next to files. +(setq + backup-by-copying t ; don't clobber symlinks + backup-directory-alist + '(("." . "~/.emacs.d/backups/")) ; don't litter my fs tree + delete-old-versions t + kept-new-versions 6 + kept-old-versions 2 + version-control t) ; use versioned backups + +;; Delete trailing whitespace on save, globally. +(add-hook 'before-save-hook 'delete-trailing-whitespace) + +(delete-selection-mode t) ; Typing replaces the active region +(setq-default indent-tabs-mode nil) ; Indent with spaces, never tabs +(setq use-short-answers t) ; Accept short y/n answers + +(global-set-key (kbd "C-x k") #'kill-current-buffer) ; Kill buffer without prompting + +;; Revert buffers when their files change on disk. +(setq global-auto-revert-non-file-buffers t) +(global-auto-revert-mode 1) + +;; Snippets via built-in abbrev (replaces yasnippet). Expansions live in the +;; abbrev table (see lisp/emacs-solo-abbrev.el); edit with M-x edit-abbrevs. +(setq save-abbrevs 'silently) +(add-hook 'text-mode-hook #'abbrev-mode) +(add-hook 'prog-mode-hook #'abbrev-mode) + +;; Smarter completion of the word/line/filename before point from open buffers, +;; the kill ring, file names, etc. (built-in). +(global-set-key (kbd "M-/") #'hippie-expand) + +;; Jump to Dired at the current file's directory, point on the file. +(global-set-key (kbd "C-x C-j") #'dired-jump) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Quality-of-life (built-in; many new in Emacs 31/32) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; --- Kill/yank & pairs --- +(setq kill-region-dwim 'emacs-word ; E31: C-w with no region kills a word back + kill-do-not-save-duplicates t + save-interprogram-paste-before-kill t + delete-pair-blink-delay 0 + delete-pair-push-mark t ; E31: easy C-x C-x after delete-pair + delete-by-moving-to-trash t) ; deletions go to the system trash + +;; --- Expanded editing/movement verbs (upper-case siblings of the defaults) --- +(global-set-key (kbd "C-x ;") #'comment-line) +(global-set-key (kbd "C-M-z") #'delete-pair) +(global-set-key (kbd "M-J") #'duplicate-dwim) +(global-set-key (kbd "M-K") #'kill-paragraph) +(global-set-key (kbd "M-Z") #'zap-up-to-char) +(global-set-key (kbd "M-F") #'forward-to-word) +(global-set-key (kbd "M-B") #'backward-to-word) +(global-set-key [remap capitalize-word] #'capitalize-dwim) ; act on the region +(global-set-key [remap downcase-word] #'downcase-dwim) +(global-set-key [remap upcase-word] #'upcase-dwim) +(global-set-key [remap delete-horizontal-space] #'cycle-spacing) + +;; --- Window management (Emacs 31) + undo/redo of window layouts --- +(global-set-key (kbd "C-x w t") #'window-layout-transpose) +(global-set-key (kbd "C-x w r") #'window-layout-rotate-clockwise) +(global-set-key (kbd "C-x w f h") #'window-layout-flip-leftright) +(global-set-key (kbd "C-x w f v") #'window-layout-flip-topdown) +(winner-mode 1) ; C-c / C-c + +;; --- Movement, scrolling, windows --- +(setq scroll-conservatively 8 + ;; scroll-margin must be 0 with pixel-scroll-precision-mode: a non-zero + ;; margin makes the wheel unable to reach the top/bottom of the buffer + ;; ("Beginning of buffer", cursor stuck ~`scroll-margin' lines down). + scroll-margin 0 + set-mark-command-repeat-pop t ; C-u C-SPC C-SPC ... cycles the mark ring + split-width-threshold 170) ; prefer vertical splits +(pixel-scroll-precision-mode 1) +(repeat-mode 1) ; e.g. C-x o o o ..., C-x ^ ^ ... to repeat + +;; --- Pairs & parens --- +(electric-pair-mode 1) +(setq show-paren-context-when-offscreen 'overlay) ; preview an off-screen match + +;; --- Display & buffers --- +(setq display-line-numbers-type 'relative) +(add-hook 'text-mode-hook #'display-line-numbers-mode) +(setq ibuffer-human-readable-size t ; E31 + view-lossage-auto-refresh t ; E31: live C-h l + uniquify-buffer-name-style 'forward + uniquify-after-kill-buffer-flag t) ; E31 +(global-set-key (kbd "C-x C-b") #'ibuffer) ; richer buffer list + +;; --- History persistence --- +(setq history-length 300 + savehist-additional-variables + '(kill-ring register-alist mark-ring global-mark-ring + search-ring regexp-search-ring) + recentf-exclude (list "^/\\(?:ssh\\|su\\|sudo\\)?:")) + +;; --- vc (built-in; used by vc-dir / vc-diff / C-x v ... alongside magit) --- +(with-eval-after-load 'vc + (setq vc-allow-rewriting-published-history t ; E31 + vc-git-print-log-follow t)) + +;; --- dired --- +(with-eval-after-load 'dired + (setq dired-dwim-target t ; default copy target = other dired pane + dired-hide-details-hide-absolute-location t ; E31 + dired-listing-switches "-alh")) + +;; --- Smarter C-g: one quit dismisses an active minibuffer from anywhere --- +(define-advice keyboard-quit + (:around (quit) quit-current-context) + "Quit the active minibuffer (from any window) before quitting in-buffer." + (if (active-minibuffer-window) + (if (minibufferp) (minibuffer-keyboard-quit) (abort-recursive-edit)) + (unless (or defining-kbd-macro executing-kbd-macro) + (funcall-interactively quit)))) + +;; --- Terminal niceties (Emacs 31) --- +(when (fboundp 'tty-tip-mode) (tty-tip-mode 1)) ; tooltips in the terminal + +;; --- Search (isearch) --- +(setq isearch-lazy-count t + lazy-count-prefix-format "(%s/%s) " + isearch-allow-motion t ; M-< / M-> move between matches in isearch + search-ring-max 200 + regexp-search-ring-max 200) + +;; --- Long lines, URLs, mouse menu, encoding --- +(global-so-long-mode 1) ; stay responsive in files with very long lines +(global-goto-address-mode 1) ; C-c RET opens URLs / emails at point +(context-menu-mode 1) ; right-click context menu +(minibuffer-electric-default-mode 1) +(modify-coding-system-alist 'file "" 'utf-8) ; don't re-prompt for encoding on tsx/etc. + +;; --- Flymake diagnostic navigation + lists --- +;; (Flymake's "error list" is `flymake-show-buffer-diagnostics'; the project-wide +;; one is `flymake-show-project-diagnostics' -- routed to a side window above.) +(with-eval-after-load 'flymake + (define-key flymake-mode-map (kbd "M-n") #'flymake-goto-next-error) + (define-key flymake-mode-map (kbd "M-p") #'flymake-goto-prev-error) + (define-key flymake-mode-map (kbd "C-c ! l") #'flymake-show-buffer-diagnostics) + (define-key flymake-mode-map (kbd "C-c ! P") #'flymake-show-project-diagnostics)) + +;; --- C-x s / C-x C-c: press "d" to preview the diff of a buffer being saved --- +(add-to-list 'save-some-buffers-action-alist + (list ?d + (lambda (buf) (diff-buffer-with-file (buffer-file-name buf))) + "show diff between the buffer and its file")) + +;; --- Show elisp eval results (C-x C-e) inline as an overlay --- +(defun my/eval-last-sexp-overlay (arg) + "Eval the sexp before point and show the result inline for a few seconds. +With prefix ARG, insert the result into the buffer instead." + (interactive "P") + (let ((val (elisp--eval-last-sexp nil))) + (if arg + (insert (format " ; => %S" val)) + (let ((ov (make-overlay (point) (point)))) + (overlay-put ov 'after-string + (propertize (format " ; => %S" val) 'face 'font-lock-comment-face)) + (run-with-timer 3 nil #'delete-overlay ov))))) +(global-set-key (kbd "C-x C-e") #'my/eval-last-sexp-overlay) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Minibuffer completion (built-in) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Vertical minibuffer completion (replaces vertico + marginalia). +(setq icomplete-delay-completions-threshold 0 + icomplete-compute-delay 0 + icomplete-show-matches-on-no-input t + icomplete-hide-common-prefix nil + icomplete-prospects-height 10 + icomplete-separator " . " + icomplete-with-completion-tables t + icomplete-in-buffer t + icomplete-max-delay-chars 0 + icomplete-scroll t + icomplete-vertical-in-buffer-adjust-list t + icomplete-vertical-render-prefix-indicator t) +(fido-mode -1) +(icomplete-vertical-mode 1) + +;; vertico-directory-style file navigation for icomplete: TAB/RET descend into +;; the selected directory (and the list refreshes to its contents) instead of +;; opening it in Dired; DEL goes up a level. +(defun my/icomplete--file-completion-p () + "Non-nil when the minibuffer is completing file names." + (eq (completion-metadata-get + (completion-metadata + (buffer-substring (minibuffer-prompt-end) (point)) + minibuffer-completion-table minibuffer-completion-predicate) + 'category) + 'file)) + +(defun my/icomplete--selected () + "The currently selected candidate string, or nil." + (car (bound-and-true-p completion-all-sorted-completions))) + +(defun my/icomplete--selected-directory-p () + "Non-nil when the selected candidate is a real subdirectory. +Excludes the `./' pseudo-entry (descending into it would loop)." + (and (my/icomplete--file-completion-p) + (let ((cand (my/icomplete--selected))) + (and (stringp cand) (string-suffix-p "/" cand) (not (equal cand "./")))))) + +(defun my/icomplete-tab () + "Descend into the selected directory; otherwise complete as usual." + (interactive) + (if (my/icomplete--selected-directory-p) + (icomplete-force-complete) + (minibuffer-complete))) + +(defun my/icomplete-ret () + "Descend into a subdirectory; open the dir on `./'; else accept and exit." + (interactive) + (cond + ((my/icomplete--selected-directory-p) (icomplete-force-complete)) + ;; `./' = open the directory currently typed (don't insert it, just accept). + ((and (my/icomplete--file-completion-p) + (equal (my/icomplete--selected) "./")) + (exit-minibuffer)) + (t (icomplete-force-complete-and-exit)))) + +(defun my/icomplete-del () + "Delete the last path component (go up a level) when completing files." + (interactive) + (if (and (my/icomplete--file-completion-p) (eq (char-before) ?/)) + (save-excursion + (goto-char (1- (point))) + (when (search-backward "/" (minibuffer-prompt-end) t) + (delete-region (1+ (point)) (point-max)))) + (call-interactively #'delete-backward-char))) + +(let ((m icomplete-minibuffer-map)) + (define-key m (kbd "C-n") #'icomplete-forward-completions) + (define-key m (kbd "C-p") #'icomplete-backward-completions) + (define-key m (kbd "") #'icomplete-forward-completions) + (define-key m (kbd "") #'icomplete-backward-completions) + (define-key m (kbd "C-v") #'icomplete-vertical-mode) + (define-key m (kbd "TAB") #'my/icomplete-tab) + (define-key m (kbd "RET") #'my/icomplete-ret) + (define-key m (kbd "DEL") #'my/icomplete-del) + (define-key m (kbd "C-j") #'exit-minibuffer)) ; accept raw input as typed +;; Hide the *Completions* buffer after an in-buffer completion. +(advice-add 'completion-at-point :after #'minibuffer-hide-completions) + +;; Completion behaviour (replaces orderless with built-in flex matching). +(setq completion-styles '(flex partial-completion basic) + completion-category-overrides '((file (styles basic partial-completion))) + completion-ignore-case t + read-buffer-completion-ignore-case t + read-file-name-completion-ignore-case t + completions-detailed t + completion-eager-update t ; E31: update *Completions* as you type + minibuffer-visible-completions 'up-down ; E31: navigate completions in place + enable-recursive-minibuffers t + tab-always-indent 'complete) ; TAB completes when already indented +(minibuffer-depth-indicate-mode 1) +(file-name-shadow-mode 1) ; type a new path without deleting the old + +(savehist-mode) ; Persist minibuffer history across sessions +(save-place-mode 1) ; Remember point position in visited files + +(recentf-mode 1) ; Track recently opened files +(setq recentf-max-menu-items 25 + recentf-max-saved-items 1000000) +(global-set-key (kbd "M-g r") #'recentf-open) + +;; A few search/navigation bindings using built-ins (replaces consult cmds). +(global-set-key (kbd "M-s g") #'grep) +(global-set-key (kbd "M-s r") #'rgrep) +(global-set-key (kbd "M-s f") #'find-name-dired) +(global-set-key (kbd "M-s l") #'occur) +(global-set-key (kbd "M-g i") #'imenu) + +;; Show available key bindings after a prefix key (built-in which-key). +(which-key-mode) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Version control & project +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(use-package magit) + +;; Use ripgrep for grep/xref when available (replaces the rg package). +(when (executable-find "rg") + (setq xref-search-program 'ripgrep + grep-command "rg -nS --no-heading " + grep-find-template "rg --null -nH -e ")) + +(use-package project :straight nil) + +;; Nicer git diffs in vc (word-level histogram), replacing magit-delta. +(with-eval-after-load 'vc-git + (setq vc-git-diff-switches '("--patch-with-stat" "--histogram"))) + +;; Open the current file/line on the remote forge (replaces browse-at-remote). +(defun emacs-solo/vc-browse-remote (&optional current-line) + "Open the repository's remote URL in the browser. +With prefix CURRENT-LINE, point at the current branch, file, and line." + (interactive "P") + (require 'vc-git) + (let* ((remote-url (string-trim (vc-git--run-command-string nil "config" "--get" "remote.origin.url"))) + (branch (string-trim (vc-git--run-command-string nil "rev-parse" "--abbrev-ref" "HEAD"))) + (file (and (buffer-file-name) + (string-trim (file-relative-name (buffer-file-name) (vc-root-dir))))) + (line (line-number-at-pos))) + (if (and remote-url (string-match "\\(?:git@\\|https://\\)\\([^:/]+\\)[:/]\\(.+?\\)\\(?:\\.git\\)?$" remote-url)) + (let ((host (replace-regexp-in-string "^git@" "" (match-string 1 remote-url))) + (path (match-string 2 remote-url))) + (browse-url + (if (and current-line file) + (format "https://%s/%s/blob/%s/%s#L%d" host path branch file line) + (format "https://%s/%s" host path)))) + (message ">>> Could not determine repository URL")))) +(global-set-key (kbd "C-x p y") #'emacs-solo/vc-browse-remote) +(with-eval-after-load 'vc + (define-key vc-prefix-map (kbd "B") #'emacs-solo/vc-browse-remote) + (define-key vc-prefix-map (kbd "o") + (lambda () (interactive) (emacs-solo/vc-browse-remote 1)))) + +;; Git diff indicators in the left margin (replaces blamer). +(setq-default left-margin-width 1) ; room for the gutter marks +(require 'emacs-solo-gutter) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Windows, popups & sidebars (built-in) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Predictable popups: Help/Ibuffer on the right; grep/xref/Flymake/Completions +;; at the bottom; inferior REPLs at the bottom. (display-buffer-in-side-window) +(setq switch-to-buffer-obey-display-actions t) +(setq display-buffer-alist + '(("\\*\\(Backtrace\\|Warnings\\|Compile-Log\\|Messages\\|Bookmark List\\|Occur\\|eldoc\\)\\*" + (display-buffer-in-side-window) (window-height . 0.25) (side . bottom) (slot . 0)) + ("\\*\\([Hh]elp\\)\\*" + (display-buffer-in-side-window) (window-width . 80) (side . right) (slot . 0)) + ("\\*\\(Ibuffer\\)\\*" + (display-buffer-in-side-window) (window-width . 100) (side . right) (slot . 1)) + ("\\*\\(Flymake diagnostics\\|Completions\\)" + (display-buffer-in-side-window) (window-height . 0.25) (side . bottom) (slot . 2)) + ("\\*\\(grep\\|xref\\|find\\)\\*" + (display-buffer-in-side-window) (window-height . 0.25) (side . bottom) (slot . 1)) + ("\\*inferior.*" + (display-buffer-in-side-window) (window-height . 0.5) (side . bottom) (slot . 1)))) + +;; Built-in speedbar as a file/project tree sidebar (replaces treemacs). +;; M-I toggles/focuses it on a side window. +(use-package speedbar + :straight nil + :bind (("M-I" . (lambda () + (interactive) + (speedbar-window) ; E31: open speedbar in a side window + (let ((win (get-buffer-window speedbar-buffer))) + (when win (select-window win)))))) + :custom + (speedbar-window-default-width 25) ; E31 + (speedbar-window-max-width 25) ; E31 + (speedbar-show-unknown-files t) + (speedbar-directory-unshown-regexp "^$") + (speedbar-indentation-width 2) + (speedbar-use-images t) + (speedbar-update-flag nil)) + +;; Grouped buffer list (org / vc / dired / terminal / help ...). +(setq ibuffer-saved-filter-groups + '(("default" + ("org" (or (mode . org-mode) + (name . "^\\*Org Agenda\\*$"))) + ("dired" (mode . dired-mode)) + ("vc" (or (name . "^\\*vc-") (name . "^magit"))) + ("terminal" (or (mode . term-mode) (mode . shell-mode) (mode . eshell-mode))) + ("help" (or (name . "^\\*Help\\*$") (name . "^\\*info\\*$"))) + ("emacs" (or (name . "^\\*scratch\\*$") + (name . "^\\*Messages\\*$") + (name . "^\\*Warnings\\*$")))))) +(setq ibuffer-show-empty-filter-groups nil) +(add-hook 'ibuffer-mode-hook + (lambda () (ibuffer-switch-to-saved-filter-groups "default"))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Programming (general) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(add-hook 'prog-mode-hook #'display-line-numbers-mode) ; Line numbers in code buffers + +;; Spell checking via built-in flyspell (replaces jinx). Needs aspell/hunspell. +(add-hook 'text-mode-hook #'flyspell-mode) +(add-hook 'prog-mode-hook #'flyspell-prog-mode) +;; M-$ runs `ispell-word' by default; C-M-$ to change dictionary. +(global-set-key (kbd "C-M-$") #'ispell-change-dictionary) + +;; LSP performance knobs (relevant to eglot). +(setq read-process-output-max (* 1024 1024)) + +;; In-buffer completion popup -> built-in inline preview (replaces corfu+cape). +;; Grey suggestion text completed with TAB; cycle with M-n / M-p. +(setq completion-preview-minimum-symbol-length 2) +(add-hook 'prog-mode-hook #'completion-preview-mode) +(add-hook 'text-mode-hook #'completion-preview-mode) +(with-eval-after-load 'completion-preview + (define-key completion-preview-active-mode-map (kbd "M-n") #'completion-preview-next-candidate) + (define-key completion-preview-active-mode-map (kbd "M-p") #'completion-preview-prev-candidate) + (define-key completion-preview-active-mode-map (kbd "TAB") #'completion-preview-insert)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; LSP (eglot, built-in) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Show eldoc for the symbol at point automatically, not just in the echo area. +(setq eldoc-help-at-pt t) ; E31 + +(use-package eglot + :straight nil ; use the built-in version + :hook ((haskell-ts-mode . eglot-ensure) + (haskell-literate-ts-mode . eglot-ensure) + (rust-ts-mode . eglot-ensure) + (nix-ts-mode . eglot-ensure)) + :bind (:map eglot-mode-map + ("C-c o r" . eglot-rename) + ("C-c o a" . eglot-code-actions) + ("C-c o f" . eglot-format) + ("C-c o o" . eglot-code-action-organize-imports) + ("C-c o h" . eglot-inlay-hints-mode)) ; toggle inline type/param hints + :custom + (eglot-events-buffer-size 0) ; don't log LSP traffic (faster) + (eglot-code-action-indications nil) ; E31: no inline code-action hints + (eglot-documentation-renderer 'markdown-ts-view-mode) ; E31: render docs via markdown-ts + :config + ;; Tell haskell-language-server to format with fourmolu. + (setq-default eglot-workspace-configuration + '(:haskell (:formattingProvider "fourmolu")))) +;; Workspace/document symbols via built-in imenu/xref (replaces consult-eglot): +;; M-g i -> imenu C-M-. -> xref-find-apropos + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Language modes +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Tree-sitter grammar *sources* (the URL map). This is still required: there +;; is no built-in registry, and the auto-install fallback for an unlisted +;; language is an interactive prompt. nix (non-standard repo) and markdown +;; (needs a branch + subdir recipe) in particular cannot be auto-guessed. +(setq treesit-language-source-alist + '((rust . ("https://github.com/tree-sitter/tree-sitter-rust")) + (nix . ("https://github.com/nix-community/tree-sitter-nix")) + (haskell . ("https://github.com/tree-sitter/tree-sitter-haskell")) + (haskell-literate . ("https://github.com/LaurentRDC/tree-sitter-haskell-literate")) + (markdown . ("https://github.com/tree-sitter-grammars/tree-sitter-markdown" + "split_parser" "tree-sitter-markdown/src")) + (markdown-inline . ("https://github.com/tree-sitter-grammars/tree-sitter-markdown" + "split_parser" "tree-sitter-markdown-inline/src")))) +;; Auto-enable every available built-in tree-sitter mode (rust, markdown, +;; python, c, js, go, json, ...): this populates `major-mode-remap-alist' so +;; .rs/.md/etc. are routed to their *-ts-mode automatically -- no per-language +;; auto-mode-alist entries needed for built-in modes. External ts packages +;; (nix-ts-mode, haskell-ts-mode) are NOT covered here and still set :mode. +;; NOTE: must be `setopt' -- this defcustom's :set is what does the remapping. +(setopt treesit-enabled-modes t) +;; And auto-install a grammar (from the sources above) the first time a +;; tree-sitter mode needs it. +(setopt treesit-auto-install-grammar 'always) + +;; External ts-modes (haskell-ts-mode, nix-ts-mode) check the grammar with +;; `treesit-ready-p', which never auto-installs -- so `treesit-auto-install- +;; grammar' is not consulted and you'd just get an error. This helper installs +;; the grammar first (honoring that option), then enables the mode. +(defun my/ensure-ts-grammar-then (lang mode) + "Install LANG's tree-sitter grammar if missing, then call MODE." + (treesit-ensure-installed lang) + (funcall mode)) + +;; Tree-sitter Haskell mode (external; no built-in Haskell mode exists). IDE +;; features (rename, format-via-fourmolu, code actions) come from eglot/HLS. +(use-package haskell-ts-mode + :commands haskell-ts-mode + :init + (defun my/haskell-ts-mode () + "Ensure the Haskell grammar, then enable `haskell-ts-mode'." + (interactive) + (my/ensure-ts-grammar-then 'haskell #'haskell-ts-mode)) + (add-to-list 'auto-mode-alist '("\\.hs\\'" . my/haskell-ts-mode))) + +;; Literate Haskell (.lhs): the `haskell-literate' grammar parses the document +;; and the `haskell' grammar is injected into code blocks (see +;; lisp/haskell-literate-ts-mode.el). Needs both grammars. +(use-package haskell-literate-ts-mode + :straight nil + :commands haskell-literate-ts-mode + :init + (defun my/haskell-literate-ts-mode () + "Ensure the haskell + haskell-literate grammars, then enable the mode." + (interactive) + (treesit-ensure-installed 'haskell) + (treesit-ensure-installed 'haskell-literate) + (require 'haskell-literate-ts-mode) + (haskell-literate-ts-mode)) + (add-to-list 'auto-mode-alist '("\\.lhs\\'" . my/haskell-literate-ts-mode))) + +;; eglot/HLS supports literate Haskell; register the mode with the HLS contact +;; and the "literate haskell" language id (HLS keys off the .lhs extension too). +(with-eval-after-load 'eglot + (add-to-list 'eglot-server-programs + '((haskell-literate-ts-mode :language-id "literate haskell") + . ("haskell-language-server-wrapper" "--lsp")))) + +;; Format Haskell (and other eglot-managed buffers) via the language server, +;; which is configured above to use fourmolu (replaces the ormolu package). +(with-eval-after-load 'eglot + (define-key eglot-mode-map (kbd "C-c r") #'eglot-format-buffer)) + +;; Opt-in format-on-save (replaces ormolu-format-on-save-mode). Enable it +;; per-project from .dir-locals.el; it formats via eglot only when a language +;; server is actually connected, so saves never error without one. +(defun my/eglot-format-buffer-maybe () + "Format the buffer via eglot when managed; otherwise report why it skipped." + (if (and (fboundp 'eglot-managed-p) (eglot-managed-p)) + (eglot-format-buffer) + (message ">>> format-on-save skipped: no eglot server connected to %s" + (buffer-name)))) + +(define-minor-mode my/eglot-format-on-save-mode + "Format the current buffer with eglot before each save." + :lighter " Fmt" + (if my/eglot-format-on-save-mode + (add-hook 'before-save-hook #'my/eglot-format-buffer-maybe nil t) + (remove-hook 'before-save-hook #'my/eglot-format-buffer-maybe t))) + +;; Direct fourmolu/ormolu formatting (the true replacement for the ormolu +;; package, which ran the binary itself -- independent of HLS). Use this when +;; the project's HLS lacks the fourmolu/ormolu formatter plugin. Picks up the +;; binary from the buffer's environment, so envrc/nix-shell PATH is honored. +(defun my/fourmolu-format-buffer () + "Format the current Haskell buffer with the external `fourmolu' (or `ormolu')." + (interactive) + (let ((exe (or (executable-find "fourmolu") (executable-find "ormolu")))) + (if (not exe) + (message ">>> fourmolu/ormolu not found on PATH for this buffer") + ;; Capture stdout (the formatted source) in a buffer and stderr (fourmolu's + ;; "Loaded config from: ..." diagnostics) in a separate file, so the + ;; diagnostics never get mixed into the buffer contents. + (let ((out (generate-new-buffer " *fourmolu-out*")) + (errfile (make-temp-file "fourmolu-err")) + (pt (point)) + (wstart (window-start))) + (unwind-protect + (if (zerop (call-process-region + (point-min) (point-max) exe nil (list out errfile) nil + "--stdin-input-file" (or buffer-file-name "Main.hs"))) + (progn + (replace-buffer-contents out) + (goto-char pt) + (set-window-start (selected-window) wstart)) + (message ">>> %s failed:\n%s" + (file-name-nondirectory exe) + (with-temp-buffer (insert-file-contents errfile) (buffer-string)))) + (kill-buffer out) + (delete-file errfile)))))) + +(define-minor-mode my/fourmolu-format-on-save-mode + "Run `fourmolu'/`ormolu' on the buffer before each save." + :lighter " 4mol" + (if my/fourmolu-format-on-save-mode + (add-hook 'before-save-hook #'my/fourmolu-format-buffer nil t) + (remove-hook 'before-save-hook #'my/fourmolu-format-buffer t))) + +;; Look up / insert the source-repository-package stanza for a Cabal dependency. +(use-package cabal-source-repo + :straight nil + :load-path "~/.emacs.d/lisp" + :bind ("C-c h r" . cabal-source-repo-upsert)) + +(use-package nix-ts-mode + :commands nix-ts-mode + :init + (defun my/nix-ts-mode () + "Ensure the Nix grammar, then enable `nix-ts-mode'." + (interactive) + (my/ensure-ts-grammar-then 'nix #'nix-ts-mode)) + (add-to-list 'auto-mode-alist '("\\.nix\\'" . my/nix-ts-mode))) + +;; rust-ts-mode (.rs) and markdown-ts-mode (.md/.markdown/.mdx) are built-in and +;; auto-routed by `treesit-enabled-modes' above -- no auto-mode-alist needed. + +;; Prolog: treat .pl files as Prolog (not Perl) and add an interaction helper. +(add-to-list 'auto-mode-alist '("\\.pl\\'" . prolog-mode)) +(use-package ediprolog) + +;; Build a self-contained HTML preview of a Markdown buffer (used with +;; impatient-mode / strapdown for live preview in a browser). +(defun markdown-html (buffer) + (princ (with-current-buffer buffer + (format "Impatient Markdown %s " (buffer-substring-no-properties (point-min) (point-max)))) + (current-buffer))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Environment & toolchains +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Make the locally-built Cardano toolchain (binaries, pkg-config, shared libs) +;; visible to Emacs and to subprocesses it launches. +(setenv "PATH" (concat "/usr/local/opt/cardano/bin:" (getenv "PATH"))) +(setenv "PKG_CONFIG_PATH" (concat "/usr/local/opt/cardano/lib/pkgconfig:" (getenv "PKG_CONFIG_PATH"))) +(setenv "LD_LIBRARY_PATH" "/usr/local/opt/cardano/bin") + +;; Buffer-local direnv environment (no built-in equivalent). +(use-package envrc + :hook (after-init . envrc-global-mode)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Fonts (emoji & symbols) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Pick the first available emoji font for emoji codepoints. +(set-fontset-font + t + 'emoji + (cond + ((member "Apple Color Emoji" (font-family-list)) "Apple Color Emoji") + ((member "Noto Color Emoji" (font-family-list)) "Noto Color Emoji") + ((member "Noto Emoji" (font-family-list)) "Noto Emoji") + ((member "Segoe UI Emoji" (font-family-list)) "Segoe UI Emoji") ; 🧗 + ((member "Symbola" (font-family-list)) "Symbola"))) + +;; Pick the first available font for generic symbol codepoints. +(set-fontset-font + t + 'symbol + (cond + ((member "Segoe UI Symbol" (font-family-list)) "Segoe UI Symbol") + ((member "Apple Symbols" (font-family-list)) "Apple Symbols") + ((member "Symbola" (font-family-list)) "Symbola"))) + +;; On Windows, route the Misc Symbols and Pictographs block to Segoe UI Symbol. +(cond + ((eq system-type 'windows-nt) + (set-fontset-font t '(#x1F300 . #x1F5FF) "Segoe UI Symbol"))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Clipboard (OSC-52 / tmux) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun tmux-osc52-direct-copy (text) + "Copy TEXT to the clipboard. +In a terminal frame, use the OSC-52 escape sequence through tmux's passthrough. +In a graphical frame, use the normal system clipboard." + (if (display-graphic-p) + ;; Graphical frame: ordinary clipboard, no terminal escape sequences. + (gui-select-text text) + ;; Terminal frame: send OSC-52 to the selected frame's terminal. + (let* ((b64 (base64-encode-string text t)) + (sequence (format "\ePtmux;\e\e]52;c;%s\a\e\\" b64))) + (send-string-to-terminal sequence (frame-terminal))))) + +;; Always install the hook; the function decides what to do at runtime. +(setq interprogram-cut-function #'tmux-osc52-direct-copy) +(setq tty-select-enable-set-clipboard t) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Server & org-protocol +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Start the Emacs server so emacsclient can reuse this instance. +(require 'server) +(unless (server-running-p) (server-start)) + +;; Custom org-protocol handler: open external file:// links at a given line, +;; bypassing org's project-alist path remapping. +(require 'org-protocol) +(defun my/org-protocol-open-source (fname) + "Open a file:// URL with line, bypassing the project-alist remap." + (let* ((data (org-protocol-parse-parameters fname nil '(:url :line))) + (uri (plist-get data :url)) + (line (plist-get data :line)) + (path (cond + ((string-prefix-p "file://" uri) (url-unhex-string (substring uri 7))) + (t (url-unhex-string uri))))) + (find-file path) + (when line + (goto-char (point-min)) + (forward-line (1- (string-to-number line)))) + nil)) ; nil = handled, don't pass through + +(add-to-list 'org-protocol-protocol-alist + '("open-source-local" + :protocol "open-source" + :function my/org-protocol-open-source + :kill-client nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Org mode, agenda & dashboard +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; --- 1. Modern look (org-modern) --- +(use-package org-modern + :ensure t + :hook ((org-mode . org-modern-mode) + (org-agenda-finalize . org-modern-agenda)) + :config + (setq org-modern-star '("◉" "○" "◈" "◇") + org-modern-todo nil ; Let org-super-agenda handle TODO colors + org-modern-priority nil + org-modern-keyword nil)) + +;; --- 2. Organization engine (org-super-agenda) --- +(use-package org-super-agenda + :ensure t + :config + (org-super-agenda-mode 1) + ;; Defines how the default agenda is grouped/displayed. + (setq org-agenda-custom-commands + '(("a" "Agenda" + ;; --- Date-based block: only SCHEDULED / DEADLINE / timestamped items --- + ((agenda "" ((org-agenda-span 'week) + (org-super-agenda-groups + '((:name "🔥 PRIORIDAD ALTA" + :priority "A") + (:name "📅 PARA HOY" + :time-grid t + :date today) + (:name "⚠️ VENCIDO" + :deadline past) + (:discard (:anything t)))))) + ;; --- All TODOs, grouped by state/tag, regardless of scheduling --- + (alltodo "" ((org-agenda-overriding-header "") + (org-super-agenda-groups + '((:name "🛠️ EN PROGRESO" + :todo ("WAITING" "STRT" "INPROGRESS" "NEXT")) + (:name "💼 TRABAJO" + :tag "work") + (:name "🏠 PERSONAL" + :tag "home") + (:name "📋 OTROS" + :anything t)))))))))) + +;; Colors for custom TODO keywords. +(setq org-todo-keyword-faces + '(("INPROGRESS" . "orange") + ("NEXT" . "cyan") + ("WAITING" . "yellow") + ("OVERSEE" . "magenta"))) + +(setq org-agenda-sorting-strategy + '((agenda todo-state-up priority-down time-up) + (todo todo-state-up priority-down))) + +;; --- 3. Org mode settings --- +(setq org-agenda-files '("~/org/")) ; Folder scanned for agenda entries +(setq org-agenda-format-date "\n%A, %d de %B") ; More readable agenda date headers +;; Hide finished/cancelled entries from the agenda. +(setq org-agenda-skip-function-global + '(org-agenda-skip-entry-if 'todo '("DONE" "CANCELLED"))) + +;; --- 3b. Time tracking (org-clock) --- +(setq org-clock-into-drawer t) ; keep CLOCK lines in a :LOGBOOK: drawer +(setq org-clock-persist 'history) ; remember the running clock across restarts +(org-clock-persistence-insinuate) +(setq org-clock-out-remove-zero-time-clocks t) +(setq org-clock-report-include-clocking-task t) +(setq org-clock-history-length 15) ; keep enough recent tasks for org-mru-clock +(setq org-duration-format '(h:mm)) ; show 1:30, not 1.5h +;; Clock report defaults for the weekly review (C-c C-c on a #+BEGIN: clocktable). +(setq org-clock-clocktable-default-properties + '(:scope agenda :block thisweek :maxlevel 3 :compact t)) +;; Terminal-safe clock bindings (C-i is indistinguishable from TAB in a tty). +(global-set-key (kbd "C-c c o") #'org-clock-out) ; clock OUT +(global-set-key (kbd "C-c c j") #'org-clock-goto) ; JUMP to the running clock +(global-set-key (kbd "C-c c q") #'org-clock-cancel) ; cancel/abort the running clock +(global-set-key (kbd "C-c c r") #'org-clock-report) ; insert/refresh a clock table + +;; Pick a project from a completing-read list of recent tasks, from anywhere. +(use-package org-mru-clock + :bind (("C-c c i" . org-mru-clock-in) ; clock IN via recent-task menu + ("C-c c s" . org-mru-clock-select-recent-task)) + :config + (setq org-mru-clock-how-many 20 + org-mru-clock-completing-read #'completing-read)) + +;; --- 4. Startup screen (dashboard) --- +(defun my/dashboard-agenda-actionable () + "Dashboard agenda filter: keep only actionable entries. +This is used as the SKIP predicate of `org-map-entries', so the sense is +inverted: return the point to EXCLUDE an entry, return nil to INCLUDE it. +An entry is kept when it is an open TODO or carries a scheduled/deadline +date; plain container headings -- such as the work.org project list -- +are skipped." + (let ((kw (org-get-todo-state))) + (unless (or (and kw (not (member kw '("DONE" "CANCELLED")))) + (org-get-scheduled-time (point)) + (org-get-deadline-time (point))) + (point)))) + +(use-package dashboard + :ensure t + :config + (dashboard-setup-startup-hook) + ;; Visual configuration. + (setq dashboard-banner-logo-title "Bienvenido a tu Segundo Cerebro") + (setq dashboard-startup-banner 'official) ; Or a path to a PNG/SVG + (setq dashboard-center-content t) + (setq dashboard-show-shortcuts t) + (setq dashboard-set-heading-icons t) + (setq dashboard-set-file-icons t) + (setq dashboard-icon-type 'nerd-icons) + + ;; Sections shown on the dashboard. + (setq dashboard-items '((recents . 5) + (agenda . 10) ; Shows the super-agenda here + (projects . 5))) + + ;; Make the dashboard agenda use org-super-agenda's grouping. + (setq dashboard-week-agenda t) + (setq dashboard-filter-agenda-entry 'my/dashboard-agenda-actionable) + (setq dashboard-agenda-sort-strategy '(todo-state-up priority-down time-up))) + +(defun my/dashboard-fix-client (frame) + "Show the dashboard in a new emacsclient FRAME, then raise and focus it. +The dashboard refresh is wrapped so that an error there (e.g. agenda +parsing) can never abort frame creation -- which would otherwise leave +the launcher with no visible window." + (when (and (daemonp) (frame-parameter frame 'client)) + (with-selected-frame frame + ;; Never let a dashboard/agenda error escape this frame hook. + (with-demoted-errors "dashboard: %S" + (dashboard-refresh-buffer) + (switch-to-buffer "*dashboard*"))) + ;; Always make the new frame visible and focused, even if the above failed. + (select-frame-set-input-focus frame) + (raise-frame frame))) + +;; Runs every time an emacsclient frame is created. +(add-hook 'after-make-frame-functions #'my/dashboard-fix-client) +(setq initial-buffer-choice (lambda () (get-buffer-create "*dashboard*"))) + +;;; init.el ends here diff --git a/lisp/cabal-source-repo.el b/lisp/cabal-source-repo.el new file mode 100644 index 0000000..327285c --- /dev/null +++ b/lisp/cabal-source-repo.el @@ -0,0 +1,282 @@ +;;; cabal-source-repo.el --- Upsert source-repository-package stanzas -*- lexical-binding: t; -*- + +(require 'project) +(require 'subr-x) + +(defun cabal-source-repo--shell (dir program &rest args) + "Run PROGRAM with ARGS in DIR; return trimmed stdout or signal." + (with-temp-buffer + (let* ((default-directory (file-name-as-directory (expand-file-name dir))) + (exit (apply #'call-process program nil t nil args))) + (unless (zerop exit) + (error "`%s %s' failed in %s: %s" + program (string-join args " ") dir (buffer-string))) + (string-trim (buffer-string))))) + +(defun cabal-source-repo--prefetch-hash (dir ref) + "Return SRI hash from nix-prefetch-git on DIR @ REF." + (message "nix-prefetch-git %s %s..." dir ref) + (with-temp-buffer + (let ((exit (call-process-shell-command + (format "nix-prefetch-git --quiet %s %s | jq -r .hash" + (shell-quote-argument (expand-file-name dir)) + (shell-quote-argument ref)) + nil t))) + (unless (zerop exit) + (error "nix-prefetch-git failed: %s" (buffer-string))) + (string-trim (buffer-string))))) + +(defun cabal-source-repo--to-https (url) + "Rewrite SSH-style git URLs to https://." + (cond + ;; git@host:owner/repo(.git) + ((string-match "\\`git@\\([^:]+\\):\\(.+\\)\\'" url) + (format "https://%s/%s" (match-string 1 url) (match-string 2 url))) + ;; ssh://[user@]host/owner/repo(.git) + ((string-match "\\`ssh://\\(?:[^@/]+@\\)?\\([^/]+\\)/\\(.+\\)\\'" url) + (format "https://%s/%s" (match-string 1 url) (match-string 2 url))) + (t url))) + +(defun cabal-source-repo--remotes (dir) + "Return alist of (NAME . URL) for git remotes in DIR (fetch URLs)." + (with-temp-buffer + (let ((default-directory (file-name-as-directory (expand-file-name dir)))) + (unless (zerop (call-process "git" nil t nil "remote" "-v")) + (error "git remote -v failed in %s: %s" dir (buffer-string))) + (let (result seen) + (goto-char (point-min)) + (while (re-search-forward + "^\\([^ \t]+\\)[ \t]+\\([^ \t]+\\)[ \t]+(fetch)" nil t) + (let ((name (match-string 1)) (url (match-string 2))) + (unless (member name seen) + (push name seen) + (push (cons name url) result)))) + (nreverse result))))) + +(defun cabal-source-repo--remote-url (dir) + "Pick a git remote in DIR and return its HTTPS URL." + (let ((remotes (cabal-source-repo--remotes dir))) + (cond + ((null remotes) + (error "No git remotes in %s" dir)) + ((= 1 (length remotes)) + (cabal-source-repo--to-https (cdar remotes))) + (t + (let* ((labels (mapcar (lambda (r) + (format "%s %s" (car r) + (cabal-source-repo--to-https (cdr r)))) + remotes)) + (default (or (seq-find (lambda (l) (string-prefix-p "origin " l)) labels) + (car labels))) + (pick (completing-read "Remote: " labels nil t nil nil default)) + (name (car (split-string pick)))) + (cabal-source-repo--to-https (cdr (assoc name remotes)))))))) + +(defun cabal-source-repo--resolve-ref (dir ref) + (cabal-source-repo--shell dir "git" "rev-parse" ref)) + +(defun cabal-source-repo--current-project-file () + "Return cabal.project at current project root, or signal." + (let* ((proj (project-current)) + (root (if proj (project-root proj) default-directory)) + (cabal (expand-file-name "cabal.project" root))) + (unless (file-exists-p cabal) + (error "No cabal.project in %s" root)) + cabal)) + +(defun cabal-source-repo--package-name (cabal-file) + (with-temp-buffer + (insert-file-contents cabal-file) + (goto-char (point-min)) + (if (re-search-forward "^[ \t]*name:[ \t]*\\([^ \t\n]+\\)" nil t) + (match-string 1) + (file-name-base cabal-file)))) + +(defun cabal-source-repo--expand-pattern (pattern root) + "Expand a cabal.project PACKAGES entry PATTERN under ROOT to .cabal files." + (let ((abs (expand-file-name pattern root))) + (cond + ((string-match-p "\\.cabal\\'" abs) + (or (file-expand-wildcards abs) + (and (file-exists-p abs) (list abs)))) + (t + (let* ((dir (directory-file-name abs)) + (dirs (if (string-match-p "[*?]" dir) + (seq-filter #'file-directory-p + (file-expand-wildcards dir)) + (and (file-directory-p dir) (list dir))))) + (mapcan (lambda (d) (directory-files d t "\\.cabal\\'")) dirs)))))) + +(defun cabal-source-repo--collect-patterns (file visited) + "Walk FILE and its `import:' chain; return (PATTERNS . VISITED'). + PATTERNS is a list of (DIR . PATTERN) cons cells, where DIR is the + directory of the cabal-project file the pattern came from." + (setq file (expand-file-name file)) + (if (or (member file visited) (not (file-exists-p file))) + (cons nil visited) + (push file visited) + (let ((dir (file-name-directory file)) + patterns imports) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward "^packages:[ \t]*" nil t) + (let* ((start (point)) + (end (save-excursion + (forward-line 1) + (while (and (not (eobp)) + (or (looking-at "^[ \t]") + (looking-at "^[ \t]*\\(--.*\\)?$"))) + (forward-line 1)) + (point))) + (text (replace-regexp-in-string + "--[^\n]*" "" + (buffer-substring-no-properties start end)))) + (dolist (pat (split-string text "[ \t\n,]+" t)) + (push (cons dir pat) patterns)))) + (goto-char (point-min)) + (while (re-search-forward "^import:[ \t]*\\([^\n]+\\)" nil t) + (let ((imp (string-trim + (replace-regexp-in-string + "--.*" "" (match-string 1))))) + (unless (string-empty-p imp) + (push (expand-file-name imp dir) imports))))) + (setq patterns (nreverse patterns) + imports (nreverse imports)) + (dolist (imp imports) + (let ((sub (cabal-source-repo--collect-patterns imp visited))) + (setq patterns (append patterns (car sub)) + visited (cdr sub)))) + (cons patterns visited)))) + +(defun cabal-source-repo--find-packages (repo-dir) + "Return alist of (SUBDIR . PKGNAME) for all packages reachable from + REPO-DIR/cabal.project, including via `import:' directives." + (let ((cabal (expand-file-name "cabal.project" repo-dir))) + (unless (file-exists-p cabal) + (error "No cabal.project in %s" repo-dir)) + (let ((patterns (car (cabal-source-repo--collect-patterns cabal nil))) + result) + (dolist (p patterns) + (let ((dir (car p)) (pat (cdr p))) + (dolist (cf (cabal-source-repo--expand-pattern pat dir)) + (let* ((rel (file-relative-name (file-name-directory cf) repo-dir)) + (subdir (directory-file-name rel)) + (pkg (cabal-source-repo--package-name cf))) + (push (cons (if (equal subdir ".") "" subdir) pkg) result))))) + (delete-dups (nreverse result))))) + +(defun cabal-source-repo--select-subdirs (packages) + "Prompt user to multi-select subdirs from PACKAGES alist." + (let* ((alist (mapcar (lambda (p) + (cons (format "%s (%s)" + (if (string-empty-p (car p)) "." (car p)) + (cdr p)) + (car p))) + packages)) + (picks (completing-read-multiple + "Subdirs (comma-separated, TAB to complete): " + alist nil t))) + (mapcar (lambda (p) (cdr (assoc p alist))) picks))) + +(defun cabal-source-repo--stanza-bounds () + "If point is on a source-repository-package header, return (START . END)." + (save-excursion + (beginning-of-line) + (when (looking-at "^source-repository-package\\b") + (let ((start (point))) + (forward-line 1) + (while (and (not (eobp)) + (or (looking-at "^[ \t]") + (looking-at "^[ \t]*\\(--.*\\)?$"))) + (forward-line 1)) + (cons start (point)))))) + +(defun cabal-source-repo--find-stanza (url) + "Return (START . END) of stanza whose location matches URL, or nil." + (save-excursion + (goto-char (point-min)) + (let (found) + (while (and (not found) + (re-search-forward "^source-repository-package\\b" nil t)) + (beginning-of-line) + (let ((b (cabal-source-repo--stanza-bounds))) + (when b + (save-excursion + (goto-char (car b)) + (when (re-search-forward + (format "^[ \t]+location:[ \t]*%s[ \t]*$" + (regexp-quote url)) + (cdr b) t) + (setq found b))) + (goto-char (cdr b))))) + found))) + +(defun cabal-source-repo--update-stanza (bounds commit sha256) + "Overwrite tag:/--sha256: within stanza at BOUNDS." + (save-excursion + (save-restriction + (narrow-to-region (car bounds) (cdr bounds)) + (goto-char (point-min)) + (if (re-search-forward "^\\([ \t]+\\)tag:[ \t]*.*$" nil t) + (replace-match (format "\\1tag: %s" commit) t nil) + (error "No tag: field in existing stanza")) + (goto-char (point-min)) + (if (re-search-forward "^\\([ \t]+\\)--sha256:[ \t]*.*$" nil t) + (replace-match (format "\\1--sha256: %s" sha256) t nil) + (goto-char (point-min)) + (re-search-forward "^\\([ \t]+\\)tag:.*$") + (end-of-line) + (insert (format "\n%s--sha256: %s" (match-string 1) sha256)))))) + +(defun cabal-source-repo--append-stanza (url commit sha256 subdirs) + (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (unless (looking-back "\n\n" 2) (insert "\n")) + (insert "source-repository-package\n" + " type: git\n" + (format " location: %s\n" url) + (format " tag: %s\n" commit) + (format " --sha256: %s\n" sha256)) + (when subdirs + (insert " subdir:\n") + (dolist (s subdirs) + (insert (format " %s\n" (if (string-empty-p s) "." s)))))) + +;;;###autoload +(defun cabal-source-repo-upsert (repo-dir ref) + "Upsert a source-repository-package stanza in the current project's + cabal.project for REPO-DIR pinned at REF." + (interactive + (list (read-directory-name "Upstream repository: " nil nil t) + (let ((r (read-string "Git ref [HEAD]: " nil nil "HEAD"))) + (if (string-empty-p r) "HEAD" r)))) + (let* ((repo-dir (expand-file-name repo-dir)) + (cabal (cabal-source-repo--current-project-file)) + (url (cabal-source-repo--remote-url repo-dir)) + (commit (cabal-source-repo--resolve-ref repo-dir ref)) + (sha256 (cabal-source-repo--prefetch-hash repo-dir commit)) + (buf (find-file-noselect cabal)) + (bounds (with-current-buffer buf + (cabal-source-repo--find-stanza url))) + (subdirs (unless bounds + (let ((pkgs (cabal-source-repo--find-packages repo-dir))) + (cond + ((null pkgs) + (error "No packages found in %s/cabal.project" repo-dir)) + ((and (= 1 (length pkgs)) + (string-empty-p (caar pkgs))) + nil) + (t + (cabal-source-repo--select-subdirs pkgs))))))) + (with-current-buffer buf + (save-excursion + (if bounds + (cabal-source-repo--update-stanza bounds commit sha256) + (cabal-source-repo--append-stanza url commit sha256 subdirs))) + (save-buffer)) + (message "%s source-repository-package: %s @ %s" + (if bounds "Updated" "Added") + url (substring commit 0 (min 12 (length commit)))))) + +(provide 'cabal-source-repo) diff --git a/lisp/emacs-solo-abbrev.el b/lisp/emacs-solo-abbrev.el new file mode 100644 index 0000000..833594c --- /dev/null +++ b/lisp/emacs-solo-abbrev.el @@ -0,0 +1,37 @@ +;;; emacs-solo-abbrev.el --- Snippet-like expansions via built-in abbrev -*- lexical-binding: t; -*- +;; +;; Adapted from Emacs Solo (https://github.com/LionyxML/emacs-solo). +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: +;; Snippet-like expansions via built-in abbrev (the yasnippet->abbrev payoff). +;; +;; Triggers that are real words (todo/note/...) live in a PROG-ONLY table so +;; they never expand in prose -- important when writing Spanish, where "todo" +;; (all) and arrow keys like "la" (the) would otherwise expand. Only non-word +;; triggers are global. +;; +;; Add your own: `C-x a g' (global), `C-x a l' (mode-local), or M-x edit-abbrevs. + +;;; Code: + +;; Safe everywhere -- triggers are not words in any language. +(define-abbrev-table 'global-abbrev-table + '(("rarr" "→") ("larr" "←") ("uarr" "↑") ("darr" "↓") + ("isodate" "" (lambda () (insert (format-time-string "%Y-%m-%dT%H:%M:%S")))) + ("uuid8" "" (lambda () (require 'org-id) (insert (org-id-uuid)))))) + +;; Prog-only -- real-word triggers, so they never fire in prose. +(define-abbrev-table 'emacs-solo/code-abbrev-table + '(("todo" "👷 TODO:") + ("fixme" "🔥 FIXME:") + ("note" "📎 NOTE:") + ("hack" "👾 HACK:") + ;; Haskell LANGUAGE pragma; point lands inside the braces. + ("lang" "{-# LANGUAGE #-}" (lambda () (backward-char 4))))) + +(add-hook 'prog-mode-hook + (lambda () (setq-local local-abbrev-table emacs-solo/code-abbrev-table))) + +(provide 'emacs-solo-abbrev) +;;; emacs-solo-abbrev.el ends here diff --git a/lisp/emacs-solo-ace-window.el b/lisp/emacs-solo-ace-window.el new file mode 100644 index 0000000..f120739 --- /dev/null +++ b/lisp/emacs-solo-ace-window.el @@ -0,0 +1,66 @@ +;;; emacs-solo-ace-window.el --- Quick window switching with labels -*- lexical-binding: t; -*- +;; +;; Vendored from Emacs Solo (https://github.com/LionyxML/emacs-solo). +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: +;; Labels visible windows with number keys for fast switching (M-O). +;; Inspired by the ace-window package, built entirely on overlays. + +;;; Code: + +(require 'cl-lib) + +(defvar emacs-solo-ace-window/quick-window-overlays nil + "List of overlays used to temporarily display window labels.") + +(defun emacs-solo-ace-window/get-windows () + "Return windows in the current frame, top-to-bottom, left-to-right." + (sort (window-list nil 'no-mini) + (lambda (w1 w2) + (let ((edges1 (window-edges w1)) + (edges2 (window-edges w2))) + (or (< (car edges1) (car edges2)) + (and (= (car edges1) (car edges2)) + (< (cadr edges1) (cadr edges2)))))))) + +(defun emacs-solo-ace-window/add-window-key-overlays (window-map) + "Add temporary overlays to windows in WINDOW-MAP with their key labels." + (setq emacs-solo-ace-window/quick-window-overlays nil) + (dolist (entry window-map) + (let* ((key (car entry)) + (window (cdr entry)) + (start (window-start window)) + (overlay (make-overlay start start (window-buffer window)))) + (overlay-put overlay 'after-string + (propertize (format " [%s] " key) + 'face '(:inherit font-lock-keyword-face :weight bold))) + (overlay-put overlay 'window window) + (push overlay emacs-solo-ace-window/quick-window-overlays)))) + +(defun emacs-solo-ace-window/remove-window-key-overlays () + "Remove all temporary window-label overlays." + (mapc 'delete-overlay emacs-solo-ace-window/quick-window-overlays) + (setq emacs-solo-ace-window/quick-window-overlays nil)) + +(defun emacs-solo-ace-window/quick-window-jump () + "Jump to a window by typing its assigned character label." + (interactive) + (let* ((window-list (emacs-solo-ace-window/get-windows)) + (window-keys (seq-take '("1" "2" "3" "4" "5" "6" "7" "8") + (length window-list))) + (window-map (cl-pairlis window-keys window-list))) + (emacs-solo-ace-window/add-window-key-overlays window-map) + (let ((key (read-key (format "Select window [%s]: " (string-join window-keys ", "))))) + (emacs-solo-ace-window/remove-window-key-overlays) + (if-let* ((selected-window (cdr (assoc (char-to-string key) window-map)))) + (select-window selected-window) + (message ">>> emacs-solo: No window assigned to key %c" key))))) + +;; NOTE: bound to M-o (lowercase), NOT M-O. In a terminal, arrow/keypad keys +;; send SS3 sequences (ESC O A/B/C/D = M-O ...), so binding M-O breaks the +;; arrow keys under `emacsclient -nw'. M-o (ESC o) has no such conflict. +(global-set-key (kbd "M-o") #'emacs-solo-ace-window/quick-window-jump) + +(provide 'emacs-solo-ace-window) +;;; emacs-solo-ace-window.el ends here diff --git a/lisp/emacs-solo-dired-gutter.el b/lisp/emacs-solo-dired-gutter.el new file mode 100644 index 0000000..c71f520 --- /dev/null +++ b/lisp/emacs-solo-dired-gutter.el @@ -0,0 +1,91 @@ +;;; emacs-solo-dired-gutter.el --- Git status indicators in Dired -*- lexical-binding: t; -*- +;; +;; Vendored from Emacs Solo (https://github.com/LionyxML/emacs-solo). +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: +;; Overlays per-file Git status indicators on the first column of Dired +;; buffers using `git status --porcelain'. + +;;; Code: + +(require 'dired) +(require 'vc-git) + +(defvar emacs-solo-dired-gutter-enabled t + "When non-nil, show git status indicators in Dired.") + +(defvar emacs-solo/dired-git-status-overlays nil + "List of active overlays in Dired for Git status.") + +(defun emacs-solo/dired--git-status-face (code) + "Return a cons cell (STATUS . FACE) for a given Git porcelain CODE." + (let* ((git-status-untracked "??") + (git-status-modified " M") + (git-status-modified-alt "M ") + (git-status-deleted "D ") + (git-status-added "A ") + (git-status-renamed "R ") + (git-status-copied "C ") + (git-status-ignored "!!") + (status (cond + ((string-match-p "\\?\\?" code) git-status-untracked) + ((string-match-p "^ M" code) git-status-modified) + ((string-match-p "^M " code) git-status-modified-alt) + ((string-match-p "^D" code) git-status-deleted) + ((string-match-p "^A" code) git-status-added) + ((string-match-p "^R" code) git-status-renamed) + ((string-match-p "^C" code) git-status-copied) + ((string-match-p "\\!\\!" code) git-status-ignored) + (t " "))) + (face (cond + ((string= status git-status-ignored) 'shadow) + ((string= status git-status-untracked) 'warning) + ((string= status git-status-modified) 'font-lock-function-name-face) + ((string= status git-status-modified-alt) 'font-lock-function-name-face) + ((string= status git-status-deleted) 'error) + ((string= status git-status-added) 'success) + (t 'font-lock-keyword-face)))) + (cons status face))) + +(defun emacs-solo/dired-git-status-overlay () + "Overlay Git status indicators on the first column in Dired." + (interactive) + (require 'vc-git) + (let ((git-root (ignore-errors (vc-git-root default-directory)))) + (when (and git-root + (not (file-remote-p default-directory)) + emacs-solo-dired-gutter-enabled) + (setq git-root (expand-file-name git-root)) + (let* ((git-status (vc-git--run-command-string nil "status" "--porcelain" "--ignored" "--untracked-files=normal")) + (status-map (make-hash-table :test 'equal))) + (mapc #'delete-overlay emacs-solo/dired-git-status-overlays) + (setq emacs-solo/dired-git-status-overlays nil) + + (dolist (line (split-string git-status "\n" t)) + (when (string-match "^\\(..\\) \\(.+\\)$" line) + (let* ((code (match-string 1 line)) + (file (match-string 2 line)) + (fullpath (expand-file-name file git-root)) + (status-face (emacs-solo/dired--git-status-face code))) + (puthash fullpath status-face status-map)))) + + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let* ((file (ignore-errors (expand-file-name (dired-get-filename nil t))))) + (when file + (setq file (if (file-directory-p file) (concat file "/") file)) + (let* ((status-face (gethash file status-map (cons " " 'font-lock-keyword-face))) + (status (car status-face)) + (face (cdr status-face)) + (status-str (propertize (format " %s " status) 'face face)) + (ov (make-overlay (line-beginning-position) (1+ (line-beginning-position))))) + (overlay-put ov 'before-string status-str) + (push ov emacs-solo/dired-git-status-overlays)))) + (forward-line 1))))))) + +(add-hook 'dired-after-readin-hook #'emacs-solo/dired-git-status-overlay) + +(provide 'emacs-solo-dired-gutter) +;;; emacs-solo-dired-gutter.el ends here diff --git a/lisp/emacs-solo-exec-path-from-shell.el b/lisp/emacs-solo-exec-path-from-shell.el new file mode 100644 index 0000000..88c2e28 --- /dev/null +++ b/lisp/emacs-solo-exec-path-from-shell.el @@ -0,0 +1,45 @@ +;;; emacs-solo-exec-path-from-shell.el --- Sync shell PATH into Emacs -*- lexical-binding: t; -*- +;; +;; Vendored from Emacs Solo (https://github.com/LionyxML/emacs-solo). +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: +;; Loads the user's login-shell PATH into Emacs, asynchronously so it never +;; blocks startup. Replaces the `exec-path-from-shell' package. Supports +;; bash, zsh, and fish. + +;;; Code: + +(defun emacs-solo/set-exec-path-from-shell-PATH () + "Set up Emacs' `exec-path' and PATH the same as the user's shell." + (interactive) + (let* ((shell (getenv "SHELL")) + (shell-name (file-name-nondirectory (or shell ""))) + (command + (cond + ((string= shell-name "fish") "fish -c 'string join : $PATH'") + ((string= shell-name "zsh") "zsh -i -c 'printenv PATH'") + ((string= shell-name "bash") "bash --login -c 'echo $PATH'") + (t nil)))) + (if (not command) + (message ">>> emacs-solo: `%s' shell is not supported" shell-name) + (let ((output "")) + (make-process + :name "emacs-solo-exec-path" + :buffer nil + :noquery t + :connection-type 'pipe + :command (list shell-file-name shell-command-switch command) + :filter (lambda (_proc chunk) (setq output (concat output chunk))) + :sentinel + (lambda (_proc event) + (when (string-prefix-p "finished" event) + (let ((path-from-shell + (replace-regexp-in-string "[ \t\n]*$" "" output))) + (when (and path-from-shell (not (string= path-from-shell ""))) + (setenv "PATH" path-from-shell) + (setq exec-path (split-string path-from-shell path-separator)) + (message ">>> emacs-solo: PATH loaded from `%s' shell" shell-name)))))))))) + +(provide 'emacs-solo-exec-path-from-shell) +;;; emacs-solo-exec-path-from-shell.el ends here diff --git a/lisp/emacs-solo-gutter.el b/lisp/emacs-solo-gutter.el new file mode 100644 index 0000000..b2f2e2b --- /dev/null +++ b/lisp/emacs-solo-gutter.el @@ -0,0 +1,181 @@ +;;; emacs-solo-gutter.el --- Git diff gutter indicators in buffers -*- lexical-binding: t; -*- +;; +;; Vendored from Emacs Solo (https://github.com/LionyxML/emacs-solo). +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: +;; Displays git diff indicators (added/changed/deleted) in the left margin of +;; file-visiting buffers, refreshing on save, revert, and focus changes. +;; Replaces the inline-blame `blamer' package with margin diff marks. + +;;; Code: + +(require 'cl-lib) +(require 'vc-git) + +(defvar-local git-gutter-diff-info nil + "Buffer-local alist of (LINE . STATUS) for the current git diff.") + +(defun emacs-solo/goto-next-hunk () + "Jump cursor to the closest next hunk." + (interactive) + (let* ((current-line (line-number-at-pos)) + (line-numbers (mapcar #'car git-gutter-diff-info)) + (sorted-line-numbers (sort line-numbers '<)) + (next-line-number + (if (not (member current-line sorted-line-numbers)) + (cl-find-if (lambda (line) (> line current-line)) sorted-line-numbers) + (let ((last-line nil)) + (cl-loop for line in sorted-line-numbers + when (and (> line current-line) + (or (not last-line) + (/= line (1+ last-line)))) + return line + do (setq last-line line)))))) + (when next-line-number + (goto-char (point-min)) + (forward-line (1- next-line-number))))) + +(defun emacs-solo/goto-previous-hunk () + "Jump cursor to the closest previous hunk." + (interactive) + (let* ((current-line (line-number-at-pos)) + (line-numbers (mapcar #'car git-gutter-diff-info)) + (sorted-line-numbers (sort line-numbers '<)) + (previous-line-number + (if (not (member current-line sorted-line-numbers)) + (cl-find-if (lambda (line) (< line current-line)) (reverse sorted-line-numbers)) + (let ((previous-line nil)) + (dolist (line sorted-line-numbers) + (when (and (< line current-line) + (not (member (1- line) line-numbers))) + (setq previous-line line))) + previous-line)))) + (when previous-line-number + (goto-char (point-min)) + (forward-line (1- previous-line-number))))) + +(defun emacs-solo/git-gutter-process-git-diff () + "Process git diff for adds/mods/removals. +Marks lines as added, deleted, or changed." + (interactive) + (let* ((result '()) + (file-path (buffer-file-name)) + (grep-command (if (executable-find "rg") "rg -Po" "grep -Po")) + (output (shell-command-to-string + (format + "git diff --unified=0 %s | %s '^@@ -[0-9]+(,[0-9]+)? \\+\\K[0-9]+(,[0-9]+)?(?= @@)'" + (shell-quote-argument file-path) + grep-command))) + (lines (split-string output "\n"))) + (dolist (line lines) + (if (string-match "\\(^[0-9]+\\),\\([0-9]+\\)\\(?:,0\\)?$" line) + (let ((num (string-to-number (match-string 1 line))) + (count (string-to-number (match-string 2 line)))) + (if (= count 0) + (push (cons (+ 1 num) "deleted") result) + (dotimes (i count) + (push (cons (+ num i) "changed") result)))) + (if (string-match "\\(^[0-9]+\\)$" line) + (push (cons (string-to-number line) "added") result)))) + (setq-local git-gutter-diff-info result) + result)) + +(defun emacs-solo/git-gutter-add-mark (&rest _args) + "Add symbols to the left margin based on Git diff statuses." + (interactive) + (remove-overlays (point-min) (point-max) 'emacs-solo--git-gutter-overlay t) + (let ((lines-status (or (emacs-solo/git-gutter-process-git-diff) '()))) + (save-excursion + (dolist (line-status lines-status) + (let* ((line-num (car line-status)) + (status (cdr line-status)) + (symbol (cond + ((string= status "added") "┃") + ((string= status "changed") "┃") + ((string= status "deleted") "┃"))) + (face (cond + ((string= status "added") 'success) + ((string= status "changed") 'warning) + ((string= status "deleted") 'error)))) + (when (and line-num status) + (goto-char (point-min)) + (forward-line (1- line-num)) + (let ((overlay (make-overlay (line-beginning-position) (line-beginning-position)))) + (overlay-put overlay 'emacs-solo--git-gutter-overlay t) + (overlay-put overlay 'before-string + (propertize " " + 'display + `((margin left-margin) + ,(propertize symbol 'face face))))))))))) + +(defun emacs-solo/timed-git-gutter-on () + (let ((buf (current-buffer))) + (run-at-time 0.1 nil (lambda () + (when (buffer-live-p buf) + (with-current-buffer buf + (emacs-solo/git-gutter-add-mark))))))) + +(defun emacs-solo/git-gutter-refresh-visible () + "Refresh gutter marks in all visible file-visiting buffers." + (when (frame-focus-state) + (dolist (win (window-list)) + (let ((buf (window-buffer win))) + (when (and (buffer-file-name buf) + (not (string-match-p "^\\*" (buffer-name buf))) + (vc-git-root (buffer-file-name buf))) + (with-current-buffer buf + (emacs-solo/timed-git-gutter-on))))))) + +(defvar emacs-solo/git-gutter--switch-timer nil + "Debounce timer for `emacs-solo/git-gutter-on-window-switch'.") + +(defun emacs-solo/git-gutter-on-window-switch (_frame) + "Refresh gutter marks in the newly selected window's buffer (debounced)." + (when (timerp emacs-solo/git-gutter--switch-timer) + (cancel-timer emacs-solo/git-gutter--switch-timer)) + (setq emacs-solo/git-gutter--switch-timer + (run-at-time + 0.2 nil + (lambda () + (setq emacs-solo/git-gutter--switch-timer nil) + (let ((buf (window-buffer (selected-window)))) + (when (and (buffer-file-name buf) + (not (string-match-p "^\\*" (buffer-name buf))) + (with-current-buffer buf + (vc-git-root (buffer-file-name buf)))) + (with-current-buffer buf + (emacs-solo/git-gutter-add-mark)))))))) + +(defun emacs-solo/git-gutter-off () + "Remove all gutter marks and disable refresh hooks." + (interactive) + (remove-overlays (point-min) (point-max) 'emacs-solo--git-gutter-overlay t) + (remove-hook 'find-file-hook #'emacs-solo/timed-git-gutter-on) + (remove-hook 'after-save-hook #'emacs-solo/git-gutter-add-mark) + (remove-hook 'after-revert-hook #'emacs-solo/timed-git-gutter-on) + (remove-function after-focus-change-function #'emacs-solo/git-gutter-refresh-visible) + (remove-hook 'window-selection-change-functions #'emacs-solo/git-gutter-on-window-switch)) + +(defun emacs-solo/git-gutter-on () + "Enable git gutter marks and refresh hooks." + (interactive) + (add-hook 'find-file-hook #'emacs-solo/timed-git-gutter-on) + (add-hook 'after-save-hook #'emacs-solo/git-gutter-add-mark) + (add-hook 'after-revert-hook #'emacs-solo/timed-git-gutter-on) + (add-function :after after-focus-change-function #'emacs-solo/git-gutter-refresh-visible) + (add-hook 'window-selection-change-functions #'emacs-solo/git-gutter-on-window-switch) + (when (not (string-match-p "^\\*" (buffer-name))) + (emacs-solo/git-gutter-add-mark))) + +(global-set-key (kbd "M-9") 'emacs-solo/goto-previous-hunk) +(global-set-key (kbd "M-0") 'emacs-solo/goto-next-hunk) +(global-set-key (kbd "C-c g p") 'emacs-solo/goto-previous-hunk) +(global-set-key (kbd "C-c g r") 'emacs-solo/git-gutter-off) +(global-set-key (kbd "C-c g g") 'emacs-solo/git-gutter-on) +(global-set-key (kbd "C-c g n") 'emacs-solo/goto-next-hunk) + +(add-hook 'after-init-hook #'emacs-solo/git-gutter-on) + +(provide 'emacs-solo-gutter) +;;; emacs-solo-gutter.el ends here diff --git a/lisp/emacs-solo-highlight-keywords.el b/lisp/emacs-solo-highlight-keywords.el new file mode 100644 index 0000000..cbcae4f --- /dev/null +++ b/lisp/emacs-solo-highlight-keywords.el @@ -0,0 +1,56 @@ +;;; emacs-solo-highlight-keywords.el --- Highlight TODO/FIXME in comments -*- lexical-binding: t; -*- +;; +;; Vendored from Emacs Solo (https://github.com/LionyxML/emacs-solo). +;; Code borrowed from `alternateved'. SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: +;; Highlights TODO/FIXME/HACK/NOTE/HERE keywords in comments and strings +;; via font-lock. + +;;; Code: + +(defcustom +highlight-keywords-faces + '(("TODO" . error) + ("FIXME" . error) + ("HACK" . warning) + ("NOTE" . warning) + ("HERE" . compilation-info)) + "Alist of keywords to highlight and their face." + :group '+highlight-keywords + :type '(alist :key-type (string :tag "Keyword") + :value-type (symbol :tag "Face"))) + +(defvar +highlight-keywords--keywords + (when +highlight-keywords-faces + (let ((keywords (mapcar #'car +highlight-keywords-faces))) + `((,(regexp-opt keywords 'words) + (0 (when (nth 8 (syntax-ppss)) + (cdr (assoc (match-string 0) +highlight-keywords-faces))) + prepend))))) + "Keywords and faces for `emacs-solo/highlight-keywords-mode'.") + +(defun emacs-solo/highlight-keywords-mode-on () + (when (not (string-match-p "^\\*" (buffer-name))) + (font-lock-add-keywords nil +highlight-keywords--keywords t) + (font-lock-flush))) + +(defun emacs-solo/highlight-keywords-mode-off () + (font-lock-remove-keywords nil +highlight-keywords--keywords) + (font-lock-flush)) + +(define-minor-mode emacs-solo/highlight-keywords-mode + "Highlight TODO and similar keywords in comments and strings." + :lighter " +HL" + :group '+highlight-keywords + (if emacs-solo/highlight-keywords-mode + (emacs-solo/highlight-keywords-mode-on) + (emacs-solo/highlight-keywords-mode-off))) + +(add-hook 'prog-mode-hook + (lambda () + (when (and buffer-file-name + (not (string-match-p "^\\*" (buffer-name)))) + (run-with-idle-timer 1 nil #'emacs-solo/highlight-keywords-mode-on)))) + +(provide 'emacs-solo-highlight-keywords) +;;; emacs-solo-highlight-keywords.el ends here diff --git a/lisp/emacs-solo-mode-line.el b/lisp/emacs-solo-mode-line.el new file mode 100644 index 0000000..b0ca65a --- /dev/null +++ b/lisp/emacs-solo-mode-line.el @@ -0,0 +1,62 @@ +;;; emacs-solo-mode-line.el --- Custom mode-line format -*- lexical-binding: t; -*- +;; +;; Vendored from Emacs Solo (https://github.com/LionyxML/emacs-solo). +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: +;; A compact, built-in mode-line: shortened VC branch, project name, and +;; collapsed minor modes. Replaces the `moody' + `minions' packages. +;; Requires Emacs 31+ (`mode-line-collapse-minor-modes'). + +;;; Code: + +;; Shorten long branch names. +(defun emacs-solo/shorten-vc-mode (vc) + "Shorten VC string to at most 20 characters. +Replacing `Git-' with a branch symbol." + (let* ((vc (replace-regexp-in-string "^ Git[:-]" + (if (char-displayable-p ?\N{U+E0A0}) "\N{U+E0A0} " "Git: ") + vc))) + (if (> (length vc) 20) + (concat (substring vc 0 20) + (if (char-displayable-p ?…) "…" "...")) + vc))) + +(setq-default mode-line-format + '("%e" " " + (:propertize + (:eval (if (char-displayable-p ?λ) "λ " " ") face font-lock-keyword-face)) + (:propertize + ("" mode-line-mule-info mode-line-client mode-line-modified mode-line-remote)) + mode-line-frame-identification + mode-line-buffer-identification + " " + mode-line-position + mode-line-format-right-align + " " + (project-mode-line project-mode-line-format) + " " + (vc-mode (:eval (emacs-solo/shorten-vc-mode vc-mode))) + " " + mode-line-modes + mode-line-misc-info + " ") + project-mode-line t + mode-line-buffer-identification '(" %b") + mode-line-position-column-line-format '(" %l:%c")) + +(setq mode-line-modes-delimiters '("" . "")) + +(setq mode-line-collapse-minor-modes + '(abbrev-mode + auto-revert-mode + eldoc-mode + flyspell-mode + outline-minor-mode + completion-preview-mode + which-key-mode + envrc-mode + subword-mode)) + +(provide 'emacs-solo-mode-line) +;;; emacs-solo-mode-line.el ends here diff --git a/lisp/emacs-solo-rainbow-delimiters.el b/lisp/emacs-solo-rainbow-delimiters.el new file mode 100644 index 0000000..ae7980d --- /dev/null +++ b/lisp/emacs-solo-rainbow-delimiters.el @@ -0,0 +1,37 @@ +;;; emacs-solo-rainbow-delimiters.el --- Rainbow delimiters via font-lock -*- lexical-binding: t; -*- +;; +;; Vendored from Emacs Solo (https://github.com/LionyxML/emacs-solo). +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: +;; Colorizes matching () [] {} by nesting depth using font-lock. + +;;; Code: + +(defun emacs-solo/rainbow-delimiters () + "Apply rainbow coloring to (), [] and {} in the current buffer." + (interactive) + (let ((colors '(font-lock-function-name-face + font-lock-builtin-face + font-lock-type-face + font-lock-keyword-face + font-lock-variable-name-face + font-lock-constant-face + font-lock-string-face))) + (font-lock-add-keywords + nil + `((,(rx (or "(" ")" "[" "]" "{" "}")) + (0 (let* ((char (char-after (match-beginning 0))) + (depth (save-excursion + (if (member char '(?\) ?\] ?\})) + (progn (backward-char) (car (syntax-ppss))) + (car (syntax-ppss))))) + (face (nth (mod depth ,(length colors)) ',colors))) + (list 'face face))))))) + (font-lock-flush) + (font-lock-ensure)) + +(add-hook 'prog-mode-hook #'emacs-solo/rainbow-delimiters) + +(provide 'emacs-solo-rainbow-delimiters) +;;; emacs-solo-rainbow-delimiters.el ends here diff --git a/lisp/haskell-literate-ts-mode.el b/lisp/haskell-literate-ts-mode.el new file mode 100644 index 0000000..acc6499 --- /dev/null +++ b/lisp/haskell-literate-ts-mode.el @@ -0,0 +1,59 @@ +;;; haskell-literate-ts-mode.el --- Tree-sitter literate Haskell (.lhs) -*- lexical-binding: t; -*- +;; +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: +;; Major mode for literate Haskell (`.lhs'). The document skeleton (prose, +;; Bird `>' lines, LaTeX/Markdown code blocks) is parsed with the +;; `haskell-literate' grammar from +;; https://github.com/LaurentRDC/tree-sitter-haskell-literate +;; and the regular `haskell' grammar is INJECTED into every `haskell_code' +;; node, so the embedded code is highlighted with `haskell-ts-mode's rules. +;; +;; Caveat: each Bird `>' line is a separate `haskell_code' node; tree-sitter +;; parses the embedded ranges together, so multi-line constructs split across +;; bare `>' lines may highlight imperfectly. LaTeX/Markdown blocks (contiguous +;; ranges) parse cleanly. HLS (via eglot) handles the file correctly regardless. + +;;; Code: + +(require 'treesit) +(require 'haskell-ts-mode) + +;;;###autoload +(define-derived-mode haskell-literate-ts-mode prog-mode "Haskell-Lit" + "Major mode for literate Haskell (`.lhs') using tree-sitter." + (unless (treesit-ready-p 'haskell-literate) + (error "Tree-sitter grammar `haskell-literate' is not available")) + (treesit-parser-create 'haskell-literate) + ;; Embed the real Haskell grammar in every code node. + (setq-local treesit-range-settings + (treesit-range-rules + :embed 'haskell + :host 'haskell-literate + '((haskell_code) @cap))) + ;; Literate skeleton highlighting (prose as comments, block markers as + ;; keywords) combined with haskell-ts-mode's rules for the embedded code. + (setq-local treesit-font-lock-settings + (append + (treesit-font-lock-rules + :language 'haskell-literate + :feature 'literate + '((prose_line) @font-lock-comment-face + (latex_begin) @font-lock-keyword-face + (latex_end) @font-lock-keyword-face + (markdown_begin) @font-lock-keyword-face + (markdown_end) @font-lock-keyword-face)) + (and (treesit-ready-p 'haskell t) haskell-ts-font-lock))) + ;; Add the `literate' feature to level 1, keep haskell-ts's other levels. + (setq-local treesit-font-lock-feature-list + (let ((fl (copy-tree haskell-ts-font-lock-feature-list))) + (setcar fl (cons 'literate (car fl))) + fl)) + (setq-local treesit-font-lock-level haskell-ts-font-lock-level) + (setq-local comment-start "-- ") + (setq-local comment-end "") + (treesit-major-mode-setup)) + +(provide 'haskell-literate-ts-mode) +;;; haskell-literate-ts-mode.el ends here -- 2.54.0