diff --git a/markdown-table-wrap-buffer.el b/markdown-table-wrap-buffer.el new file mode 100644 index 0000000..0b22eeb --- /dev/null +++ b/markdown-table-wrap-buffer.el @@ -0,0 +1,516 @@ +;;; markdown-table-wrap-buffer.el --- Wrap tables in place to a target width -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 SayreBlades + +;; Author: SayreBlades +;; Maintainer: SayreBlades +;; URL: https://github.com/SayreBlades/markdown-table-wrap +;; Package-Requires: ((emacs "28.1") (markdown-table-wrap "0.2.0")) +;; Keywords: text, markdown, org, tables +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is part of the markdown-table-wrap package (fork). +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; In-buffer table wrapping that rewrites the raw table text to fit a +;; given character width, using `markdown-table-wrap' as the engine. +;; +;; Unlike a display-overlay approach (which leaves raw text canonical +;; and shows a wrapped view), this REWRITES the buffer so that the +;; wrapped text *is* the buffer text: links stay clickable, +;; isearch/yank/copy work, and point moves naturally. +;; +;; Supports GFM pipe tables (markdown-mode / gfm-mode / md-ts-mode) and +;; Org tables. Org tables are converted to pipe form via +;; `org-table-to-lisp', wrapped, and reinserted as pipe text (which Org +;; still recognizes as a table). Org tables carrying a `#+TBLFM:' +;; formula line are refused (feature to be added later). +;; +;; Entry points: +;; `markdown-table-wrap-table-at-point' -- wrap the table at point +;; `markdown-table-wrap-buffer' -- wrap every table in buffer +;; `markdown-table-wrap-buffer-region' -- wrap tables in a region +;; `markdown-table-wrap-buffer-mode' -- minor mode: TAB wraps on table +;; +;; Width selection: +;; - default: `markdown-table-wrap-buffer-width' or window width +;; - prefix arg: `SPC u 60' (doom) or `C-u 60' (plain emacs) +;; +;; TAB behavior (minor mode on): +;; - markdown / gfm / md-ts: TAB wraps when on a table, else falls +;; through to `markdown-cycle'. +;; - org: a function on `org-tab-first-hook' wraps when +;; `org-at-table-p' and returns t to consume the TAB; otherwise +;; returns nil so `org-cycle' runs normally (visibility cycling, +;; src-block indent, etc. unaffected off-table). This mirrors how +;; doom's own `+org-*' hooks participate in `org-tab-first-hook'. +;; Org's native TAB already does layout (via `org-table-next-field' +;; which calls `org-table-align' when the table is dirty), so this +;; slots into the same layout role. +;; +;; Re-wrapping at a new width: +;; The command unwraps first (via `markdown-table-wrap-unwrap') *only +;; when the table shows wrap markers* (the all-empty-cell spacer rows +;; that `markdown-table-wrap' inserts between wrapped logical rows), +;; then wraps at the requested width, within a single undo boundary. +;; Unwrap is best-effort: force-broken headers at very narrow widths +;; may not rejoin cleanly; undo to recover. We do NOT unwrap +;; never-wrapped tables because `markdown-table-wrap-unwrap' is not +;; idempotent on them (its continuation-row heuristic can merge +;; consecutive full rows). +;; +;; All behaviors are opt-in: loading this file changes nothing until +;; `markdown-table-wrap-buffer-mode' is enabled (typically via hooks). + +;;; Code: + +(require 'cl-lib) +(require 'subr-x) +(require 'markdown-table-wrap) + +;; Quiet the byte compiler for mode-specific functions we call lazily. +(declare-function markdown-cycle "markdown-mode") +(declare-function org-cycle "org-cycle") +(declare-function org-at-table-p "org-table") +(declare-function org-table-to-lisp "org-table") +(declare-function markdown-table-wrap-inside-code-fence-p + "markdown-table-wrap") + + +;;;; Customization + +(defgroup markdown-table-wrap-buffer nil + "In-buffer table wrapping to a target width." + :group 'text + :prefix "markdown-table-wrap-buffer-") + +(defcustom markdown-table-wrap-buffer-width nil + "Default wrap width in characters. +nil means use `window-max-chars-per-line' of the selected window. +A positive integer pins the width regardless of window size." + :type '(choice (const :tag "Window width" nil) + (integer :tag "Fixed width")) + :group 'markdown-table-wrap-buffer) + +(defcustom markdown-table-wrap-buffer-max-cell-height nil + "Cap cell height when wrapping; nil means unlimited. +Passed through to `markdown-table-wrap' as MAX-CELL-HEIGHT." + :type '(choice (const :tag "Unlimited" nil) + (integer :tag "Max lines per cell")) + :group 'markdown-table-wrap-buffer) + +(defcustom markdown-table-wrap-buffer-tab-override t + "When the minor mode is on, bind TAB to wrap when on a table. +Off-table, TAB falls through to the major mode's normal binding. +If nil, only `markdown-table-wrap-buffer-key' wraps." + :type 'boolean + :group 'markdown-table-wrap-buffer) + +(defcustom markdown-table-wrap-buffer-key (kbd "C-c C-w") + "Key that wraps the table at point (always active in the minor mode)." + :type 'key-sequence + :group 'markdown-table-wrap-buffer) + + +;;;; Width resolution + +(defun markdown-table-wrap-buffer--effective-width (&optional pfx) + "Return the wrap width to use. +PFX, when a numeric prefix, overrides the configured width." + (let ((p (and pfx (prefix-numeric-value pfx)))) + (cond + ((and p (> p 0)) p) + (markdown-table-wrap-buffer-width) + (t (max 10 (or (window-max-chars-per-line) 80)))))) + + +;;;; Table region detection + +;; A table region is a maximal run of lines beginning with `|' (after +;; optional leading whitespace). This matches GFM pipe tables and Org +;; pipe tables alike, and works in markdown-mode, gfm-mode, md-ts-mode +;; and org-mode without mode-specific APIs. + +(defconst markdown-table-wrap-buffer--table-line-re "^[ \t]*|" + "Regexp matching the first column of a pipe/org table line.") + +(defun markdown-table-wrap-buffer--table-region-at-point () + "Return (BEG . END) for the table surrounding point, or nil. +BEG is the start of the first table line; END is the start of the +line following the last table line (an insertion position). Returns +nil if point is not on a table line." + (save-excursion + (beginning-of-line) + (if (not (looking-at-p markdown-table-wrap-buffer--table-line-re)) + nil + ;; Walk backward to the first table line so point anywhere in + ;; the table (header, separator, or a data row) captures the + ;; whole table, not just the suffix from point onward. + (while (and (not (bobp)) + (save-excursion + (forward-line -1) + (looking-at-p markdown-table-wrap-buffer--table-line-re))) + (forward-line -1)) + (let ((start (point))) + (while (looking-at-p markdown-table-wrap-buffer--table-line-re) + (forward-line 1)) + (cons start (point)))))) + +(defun markdown-table-wrap-buffer--table-regions-in (beg end) + "Return a list of (BEG . END) table regions between BEG and END. +Skips tables inside fenced code blocks (markdown only, via +`markdown-table-wrap-inside-code-fence-p')." + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let (regions) + (while (re-search-forward markdown-table-wrap-buffer--table-line-re + nil t) + (let ((line-start (line-beginning-position))) + (unless (and (fboundp 'markdown-table-wrap-inside-code-fence-p) + (markdown-table-wrap-inside-code-fence-p line-start)) + (goto-char line-start) + (let ((start (point))) + (while (looking-at-p markdown-table-wrap-buffer--table-line-re) + (forward-line 1)) + (push (cons start (point)) regions))))) + (nreverse regions))))) + + +;;;; Org conversion + +;; Org tables use `|---+---|' separators and optional width cookies +;; `|<[lrc]?[0-9]*>|'. `org-table-to-lisp' parses robustly and returns +;; a list of rows, each a list of strings or the symbol `hline'. We +;; emit canonical GFM pipe text, wrap it, and reinsert: GFM pipe text +;; is itself valid Org pipe text, so no back-conversion is needed. + +(defconst markdown-table-wrap-buffer--width-cookie-re + "<\\([lrc]\\)?[0-9]*>" + "Regexp matching an Org column width cookie like `<5>' or `'.") + +(defun markdown-table-wrap-buffer--org-table-has-formula-p (_beg end) + "Return non-nil if a `#+TBLFM:' line follows the org table ending at END." + (save-excursion + (goto-char end) + (skip-chars-forward " \t\n") + (looking-at-p "#\\+TBLFM:"))) + +(defun markdown-table-wrap-buffer--org-to-pipe (beg end) + "Return canonical GFM pipe-table text for the org table at BEG..END. +Strips width cookies. Assumes no `#+TBLFM' (caller guards)." + (let* ((raw (buffer-substring-no-properties beg end)) + (parsed (with-temp-buffer + (insert raw) + (goto-char (point-min)) + (org-table-to-lisp)))) + (if (not parsed) + raw + (let* ((rows (mapcar + (lambda (row) + (if (eq row 'hline) + 'hline + (mapcar (lambda (cell) + (string-trim + (replace-regexp-in-string + markdown-table-wrap-buffer--width-cookie-re + "" cell))) + row))) + parsed)) + (ncols (apply #'max (mapcar + (lambda (r) (if (listp r) (length r) 1)) + rows))) + (hline-text (concat "| " + (mapconcat #'identity + (make-list ncols "---") + " | ") + " |"))) + (mapconcat + (lambda (row) + (if (eq row 'hline) + hline-text + (let ((cells (append row + (make-list (max 0 (- ncols (length row))) + "")))) + (concat "| " + (mapconcat #'identity cells " | ") + " |")))) + rows + "\n"))))) + + +;;;; Wrap core + +(defun markdown-table-wrap-buffer--spacer-line-p (line) + "Return non-nil if LINE is an all-empty-cell pipe row (a wrap marker). +Such rows are inserted by `markdown-table-wrap' between wrapped +logical data rows; their presence signals a previously-wrapped table." + (and (string-prefix-p "|" (string-trim-left line)) + (string-blank-p (replace-regexp-in-string "[| \\t]" "" line)))) + +(defun markdown-table-wrap-buffer--previously-wrapped-p (text) + "Return non-nil if TEXT looks like output of `markdown-table-wrap'. +Detects the spacer rows (all-empty-cell pipe rows) that +`markdown-table-wrap' inserts between wrapped logical rows." + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (let (found) + (while (and (not found) (not (eobp))) + (let ((line (buffer-substring (line-beginning-position) + (line-end-position)))) + (when (markdown-table-wrap-buffer--spacer-line-p line) + (setq found t))) + (forward-line 1)) + found))) + +(defun markdown-table-wrap-buffer--wrap-text (text width) + "Wrap table TEXT to WIDTH, returning the wrapped text. +TEXT is canonical pipe text (org tables are converted to pipe form +by the caller first; the wrapped GFM output is valid Org pipe text). + +If TEXT was previously wrapped (contains spacer rows), unwrap it +first so we never double-wrap. `markdown-table-wrap-unwrap' is NOT +safe on arbitrary never-wrapped tables (its continuation-row +heuristic can merge consecutive full rows), so we only unwrap when +spacer rows indicate a prior wrap." + (let ((base (if (markdown-table-wrap-buffer--previously-wrapped-p text) + (markdown-table-wrap-unwrap text) + text))) + (markdown-table-wrap base + width + markdown-table-wrap-buffer-max-cell-height + nil nil))) + +(defun markdown-table-wrap-buffer--wrap-region-1 (beg end width) + "Wrap the single table at BEG..END to WIDTH in place. +BEG..END is a table region as returned by detection. Returns t if +the buffer was modified, nil if the table already fit. +Dialect is inferred from the major mode." + (let* ((dialect (if (derived-mode-p 'org-mode) 'org 'gfm)) + (raw-text (if (eq dialect 'org) + (markdown-table-wrap-buffer--org-to-pipe beg end) + (buffer-substring-no-properties beg end))) + ;; Normalize: compare on trailing-newline-stripped text so a + ;; table that fits (wrap returns it aligned, no trailing nl) + ;; compares equal to the raw content sans its trailing nl. + (raw-norm (string-trim-right raw-text "\n")) + (wrapped (condition-case err + (markdown-table-wrap-buffer--wrap-text raw-norm width) + (error + (message "markdown-table-wrap: %s" + (error-message-string err)) + nil)))) + (when (and wrapped (not (equal wrapped raw-norm))) + (let ((inhibit-read-only t) + (handle (prepare-change-group))) + ;; A single undo boundary so the user can recover the previous + ;; form with one `undo'. Preserve the trailing newline that the + ;; detected region includes (the start of the line after the + ;; table) so blank-line separation after the table survives. + (let ((inserted (if (string-suffix-p "\n" wrapped) + wrapped + (concat wrapped "\n")))) + (unwind-protect + (progn + (delete-region beg end) + (save-excursion + (goto-char beg) + (insert inserted))) + (undo-amalgamate-change-group handle)))) + t))) + +(defun markdown-table-wrap-buffer-region (beg end &optional width) + "Wrap every table between BEG and END to WIDTH. +WIDTH, when non-nil (e.g. from a numeric prefix arg), overrides the +configured width. Returns the number of tables wrapped. Leaves one +undo boundary per table. Org tables with `#+TBLFM' are skipped with +a message." + (interactive "r\nP") + (let ((width (markdown-table-wrap-buffer--effective-width + (and (consp width) (car width)))) + (count 0)) + ;; Process regions back-to-front so earlier replacements don't + ;; invalidate the buffer positions of later regions. + (dolist (region (nreverse + (markdown-table-wrap-buffer--table-regions-in beg end))) + (if (and (derived-mode-p 'org-mode) + (markdown-table-wrap-buffer--org-table-has-formula-p + (car region) (cdr region))) + (message "markdown-table-wrap: skipping org table with #+TBLFM at %d" + (car region)) + (when (markdown-table-wrap-buffer--wrap-region-1 + (car region) (cdr region) width) + (cl-incf count)))) + (when (called-interactively-p 'interactive) + (message "markdown-table-wrap: %d table(s) wrapped to width %d" + count width)) + count)) + +(defun markdown-table-wrap-buffer (&optional _width) + "Wrap every table in the current buffer to the effective width. +A numeric prefix overrides it (`SPC u 60' in doom, `C-u 60' otherwise)." + (interactive "P") + (markdown-table-wrap-buffer-region + (point-min) (point-max) + (and (consp current-prefix-arg) current-prefix-arg))) + +(defun markdown-table-wrap-table-at-point (&optional width) + "Wrap the table at point to WIDTH. +WIDTH defaults to the effective width; a numeric prefix overrides +it (`SPC u 60' in doom). Signals `user-error' if point is not on a +table." + (interactive "P") + (if-let* ((region (markdown-table-wrap-buffer--table-region-at-point))) + (let ((width (markdown-table-wrap-buffer--effective-width width))) + (if (and (derived-mode-p 'org-mode) + (markdown-table-wrap-buffer--org-table-has-formula-p + (car region) (cdr region))) + (user-error + "Org table has #+TBLFM: wrapping would drop the formula; remove it first") + (when (markdown-table-wrap-buffer--wrap-region-1 + (car region) (cdr region) width) + (message "markdown-table-wrap: wrapped table to width %d" width)))) + (user-error "Not on a table"))) + +(defun markdown-table-wrap-buffer-set-width (width) + "Set the default wrap width for this buffer to WIDTH." + (interactive "nWidth: ") + (setq-local markdown-table-wrap-buffer-width width) + (message "markdown-table-wrap: buffer width set to %d" width)) + + +;;;; Minor mode: context-sensitive TAB + +(defun markdown-table-wrap-buffer--markdown-cycle-a (orig &rest args) + "Around-advice on `markdown-cycle': wrap when on a table. +When point is on a pipe table, wrap it (consuming the TAB) and +return t; otherwise call ORIG with ARGS (the normal +`markdown-cycle' behavior). This works under evil because doom +binds normal-state TAB to `markdown-cycle' in +`evil-markdown-mode-map', so intercepting `markdown-cycle' catches +TAB regardless of evil state, without fighting evil's keymap +priority (a minor-mode-map TAB binding would be overridden by +the evil state map). Mirrors the org `org-tab-first-hook' pattern. + +`current-prefix-arg' is honored: a numeric prefix (`SPC u 60' in +doom, `C-u 60' otherwise) wraps to that width." + (if-let* ((region (markdown-table-wrap-buffer--table-region-at-point))) + (let ((width (markdown-table-wrap-buffer--effective-width + current-prefix-arg))) + (markdown-table-wrap-buffer--wrap-region-1 + (car region) (cdr region) width)) + (apply orig args))) + +(defun markdown-table-wrap-buffer--org-tab-h () + "Hook for `org-tab-first-hook': wrap the org table at point. +Returns t to consume the TAB when on a table (after wrapping), nil +otherwise so `org-cycle' runs normally. Refuses tables with +`#+TBLFM' (falls through to `org-cycle'). + +When point is on an org table, wrap it to the effective width and +return t to consume the TAB; off-table return nil so `org-cycle' runs +(visibility cycling, src-block indent, etc.). This mirrors how +doom's own `+org-*' hooks participate in `org-tab-first-hook'. + +`current-prefix-arg' is honored: a numeric prefix (`SPC u 60' in +doom, `C-u 60' otherwise) wraps to that width. Tables carrying a +`#+TBLFM:' formula line are refused (return nil) so `org-cycle' +handles them untouched. + +Note: `--table-region-at-point' walks backward to the table start, +so TAB anywhere in the table (header, hline, or a data row) wraps +the whole table. (An earlier revision that did not walk backward +mangled tables when TAB was pressed on a data row; that was the +regression that prompted temporarily disabling this hook.)" + (when (and (derived-mode-p 'org-mode) + (org-at-table-p)) + (if-let* ((region (markdown-table-wrap-buffer--table-region-at-point))) + (if (markdown-table-wrap-buffer--org-table-has-formula-p + (car region) (cdr region)) + nil ; let org-cycle handle it + (let ((width (markdown-table-wrap-buffer--effective-width + current-prefix-arg))) + (markdown-table-wrap-buffer--wrap-region-1 + (car region) (cdr region) width) + t)) ; consume the TAB + nil))) + +(defvar markdown-table-wrap-buffer-mode-map + (let ((map (make-sparse-keymap))) + (define-key map markdown-table-wrap-buffer-key + #'markdown-table-wrap-table-at-point) + map) + "Keymap for `markdown-table-wrap-buffer-mode'. +Only `markdown-table-wrap-buffer-key' (default `C-c C-w') is bound +here. TAB is intercepted via advice on `markdown-cycle' (markdown) +and `org-tab-first-hook' (org), so it works under evil without +fighting evil's state-map key priority.") + +;;;###autoload +(define-minor-mode markdown-table-wrap-buffer-mode + "Toggle in-buffer table wrapping on TAB. +When on, TAB wraps the pipe/org table at point to the effective +width (window width, or `markdown-table-wrap-buffer-width'). +Off-table, TAB falls through to the major mode's normal binding. +A numeric prefix (`SPC u 60' in doom, `C-u 60' otherwise) wraps to +that width. + +`C-c C-w' wraps the table at point regardless of TAB override. + +Tables are rewritten in place, so wrapped text is real buffer text: +links stay clickable, isearch/yank/copy work. Re-wrapping at a new +width unwraps first (best-effort; undo to recover if a force-broken +header mangles). Org tables with `#+TBLFM' are refused. + +In markdown-family modes, TAB is intercepted via `:around' advice on +`markdown-cycle' (works under evil because doom binds normal-state +TAB to `markdown-cycle'). In org, TAB is wired via +`org-tab-first-hook' (so visibility cycling and src-block indent +off-table are unaffected). Both off-table paths are unchanged." + :lighter " TWrap" + :group 'markdown-table-wrap-buffer + (cond + (markdown-table-wrap-buffer-mode + ;; Markdown-family: advise `markdown-cycle' (catches TAB under evil + ;; because doom binds normal-state TAB to `markdown-cycle'). + (when markdown-table-wrap-buffer-tab-override + (advice-add 'markdown-cycle :around + #'markdown-table-wrap-buffer--markdown-cycle-a)) + ;; Org: register on `org-tab-first-hook' (buffer-local). + (add-hook 'org-tab-first-hook + #'markdown-table-wrap-buffer--org-tab-h nil t)) + (t + (advice-remove 'markdown-cycle + #'markdown-table-wrap-buffer--markdown-cycle-a) + (remove-hook 'org-tab-first-hook + #'markdown-table-wrap-buffer--org-tab-h t)))) + +;;;###autoload +(defun markdown-table-wrap-buffer-turn-on () + "Enable `markdown-table-wrap-buffer-mode' in the current buffer. +Suitable for `markdown-mode-hook', `md-ts-mode-hook', `org-mode-hook'. +Covers `gfm-mode' automatically (it derives from `markdown-mode', so +`markdown-mode-hook' fires for it). Skips `pi-coding-agent-chat-mode' +(which derives from `md-ts-mode') so this minor mode doesn't shadow +pi's own TAB in chat buffers — pi handles its chat tables separately." + (unless (derived-mode-p 'pi-coding-agent-chat-mode) + (markdown-table-wrap-buffer-mode 1))) + +(provide 'markdown-table-wrap-buffer) +;;; markdown-table-wrap-buffer.el ends here