fd1210e557
Complete task002 through task016 across cache correctness, editor lifecycle, C boundaries, build and release governance, dictionary provenance, performance, interactive workflows, tests, documentation, and final cleanup.
1080 lines
47 KiB
EmacsLisp
1080 lines
47 KiB
EmacsLisp
;;; ekp-region.el --- Buffer-level justification for ekp -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2024-2026 Kinney Zhang
|
|
|
|
;; Author: Kinney Zhang <kinneyzhang666@gmail.com>
|
|
;; Keywords: wp, convenience
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
;; 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 <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Interactive layer over the ekp string API.
|
|
;;
|
|
;; - `ekp-justify-region' / `ekp-unjustify-region': justify buffer text
|
|
;; in place. Unjustification is a pure structural transform driven by
|
|
;; the text properties the renderer leaves behind (`ekp-glue',
|
|
;; `ekp-soft-break', `ekp-soft-hyphen', `ekp-hidden'), so the
|
|
;; original text — including whitespace runs stripped at line breaks —
|
|
;; is recovered exactly, even after the justified text was edited.
|
|
;;
|
|
;; - `ekp-auto-justify-mode': keeps the whole buffer justified to the
|
|
;; window width. Re-flows (debounced) when the window width changes,
|
|
;; and incrementally re-justifies only the edited paragraphs after
|
|
;; edits, so large buffers stay responsive (unchanged paragraphs hit
|
|
;; the ekp paragraph cache).
|
|
|
|
;;; Code:
|
|
|
|
(require 'ekp)
|
|
(require 'cl-lib)
|
|
(require 'easymenu)
|
|
|
|
(defvar ekp-auto-justify-mode)
|
|
|
|
(defgroup ekp-region nil
|
|
"Buffer-level justification built on ekp."
|
|
:group 'text
|
|
:prefix "ekp-")
|
|
|
|
(defcustom ekp-region-margin-pixel 2
|
|
"Pixels subtracted from the window body width when justifying.
|
|
A small safety margin that keeps justified lines from being wrapped
|
|
by the display engine due to rounding."
|
|
:type 'natnum)
|
|
|
|
(defcustom ekp-auto-justify-resize-delay 0.15
|
|
"Seconds to debounce window resize re-flows in `ekp-auto-justify-mode'."
|
|
:type 'number)
|
|
|
|
(defcustom ekp-auto-justify-edit-delay 0.3
|
|
"Idle seconds before edited paragraphs are re-justified."
|
|
:type 'number)
|
|
|
|
(defcustom ekp-auto-justify-lazy-threshold 20000
|
|
"Buffer size (characters) beyond which re-flows go visible-first.
|
|
Below it a window width change re-justifies the whole buffer at
|
|
once; above it the visible portion is done synchronously and the
|
|
rest follows in idle background chunks."
|
|
:type 'natnum)
|
|
|
|
(defcustom ekp-auto-justify-chunk-size 10
|
|
"Paragraphs re-justified per background chunk in lazy re-flows."
|
|
:type 'natnum)
|
|
|
|
(defcustom ekp-auto-justify-tick-budget 0.005
|
|
"Seconds of work per background tick in lazy re-flows.
|
|
Each tick processes chunks until the budget is exhausted (at least
|
|
one), then yields back to the command loop."
|
|
:type 'number)
|
|
|
|
(defconst ekp-region-org-skip-faces
|
|
'(org-block org-block-begin-line org-block-end-line org-code
|
|
org-verbatim org-table org-meta-line)
|
|
"Reasonable `ekp-region-skip-faces' preset for Org buffers.")
|
|
|
|
(defconst ekp-region-markdown-skip-faces
|
|
'(markdown-code-face markdown-inline-code-face markdown-pre-face
|
|
markdown-table-face)
|
|
"Reasonable `ekp-region-skip-faces' preset for Markdown buffers.")
|
|
|
|
(defcustom ekp-region-skip-faces nil
|
|
"Faces whose paragraphs are never justified (kept verbatim).
|
|
Point major-mode faces here — e.g. `org-block' and `org-code' for
|
|
Org, `markdown-code-face' for Markdown — and code blocks pass
|
|
through untouched. Checked against the `face' property of each
|
|
paragraph, symbol or list."
|
|
:type '(repeat face))
|
|
|
|
;;;###autoload
|
|
(defun ekp-org-setup ()
|
|
"Configure the current (Org) buffer for ekp justification.
|
|
Protects source blocks, tables and meta lines from justification.
|
|
Typical use: (add-hook \\='org-mode-hook #\\='ekp-org-setup)."
|
|
(setq-local ekp-region-skip-faces ekp-region-org-skip-faces))
|
|
|
|
;;;###autoload
|
|
(defun ekp-markdown-setup ()
|
|
"Configure the current (Markdown) buffer for ekp justification.
|
|
Protects code faces from justification, and stops markdown-mode's
|
|
font-lock from managing the `display' property — refontification
|
|
would otherwise strip the pixel-glue display specs and wreck the
|
|
layout. The cost: markdown's own display-based decorations (URL
|
|
hiding) are no longer cleaned up by refontification here.
|
|
Typical use: (add-hook \\='markdown-mode-hook #\\='ekp-markdown-setup)."
|
|
(setq-local ekp-region-skip-faces ekp-region-markdown-skip-faces)
|
|
(when (boundp 'font-lock-extra-managed-props)
|
|
(setq-local font-lock-extra-managed-props
|
|
(remq 'display font-lock-extra-managed-props))))
|
|
|
|
(defvar-local ekp-region-skip-predicate nil
|
|
"When non-nil, a function called with a paragraph string.
|
|
Return non-nil to keep that paragraph verbatim (no justification).
|
|
The general escape hatch for mode-specific block detection; prefer
|
|
the `ekp-verbatim' text property or `ekp-region-skip-faces' when
|
|
they suffice.")
|
|
|
|
(defvar ekp-region--inhibit nil
|
|
"Non-nil while ekp-region is modifying the buffer itself.")
|
|
|
|
(defvar-local ekp-region--write-buffer nil
|
|
"Hidden logical-text buffer used while writing justified content.")
|
|
|
|
(defvar-local ekp-region--write-source nil
|
|
"Source buffer for an `ekp-region--write-buffer'.")
|
|
|
|
(defvar-local ekp-region--previous-filter nil
|
|
"Substring filter wrapped by the EKP logical-text filter.")
|
|
|
|
(defvar-local ekp-region--previous-filter-local-p nil
|
|
"Whether `ekp-region--previous-filter' was buffer-local.")
|
|
|
|
(defvar-local ekp-region--filter-installed nil
|
|
"Non-nil while EKP owns `filter-buffer-substring-function'.")
|
|
|
|
(defmacro ekp-region--preserving-modified (&rest body)
|
|
"Run BODY, keeping the buffer unmodified if it was unmodified.
|
|
Justification is a reversible re-layout of the same logical text, so
|
|
it must not flip `buffer-modified-p' on its own — that would create
|
|
lock files, trigger auto-saves and \"buffer modified\" prompts for
|
|
buffers the user never edited."
|
|
(declare (indent 0) (debug t))
|
|
`(let ((ekp-region--modified-was (buffer-modified-p)))
|
|
(prog1 (progn ,@body)
|
|
(unless ekp-region--modified-was
|
|
(restore-buffer-modified-p nil)))))
|
|
|
|
(defvar-local ekp-region--auto-width nil
|
|
"Pixel width the buffer is currently auto-justified to.")
|
|
|
|
(defvar-local ekp-region--resize-timer nil)
|
|
(defvar-local ekp-region--edit-timer nil)
|
|
(defvar-local ekp-region--dirty nil
|
|
"Pending edited regions, as a list of (BEG-MARKER . END-MARKER).")
|
|
|
|
(defvar-local ekp-region--pending nil
|
|
"Lazy re-flow state: (WIDTH . CHUNKS), CHUNKS = ((BEG-M . END-M)...).")
|
|
|
|
(defvar-local ekp-region--chunk-timer nil)
|
|
|
|
;;;; Width
|
|
|
|
(defun ekp-region-protrusion-reserve ()
|
|
"Pixels reserved at the right margin for hanging punctuation.
|
|
Non-zero only while `ekp-protrusion' is enabled: protruding glyphs
|
|
extend past the flush edge, so the layout width must leave room."
|
|
(if ekp-protrusion
|
|
(max 2 (ceiling (* (alist-get 'cjk-close ekp-protrusion-ratios 0.5)
|
|
(ekp--measured-width "。"))))
|
|
0))
|
|
|
|
(defun ekp-region--indicator-reserve (&optional window)
|
|
"Pixels the truncation/continuation indicator eats in WINDOW.
|
|
With no right fringe (and on text terminals), Emacs draws the `$'
|
|
or `\\' indicator in the text area's LAST COLUMN — a line that
|
|
fills the body width exactly gets its final glyph displaced and
|
|
every justified line appears truncated. Reserve that column; with
|
|
a right fringe the indicator lives in the fringe and costs nothing."
|
|
(let ((win (or window (selected-window))))
|
|
(if (and (display-graphic-p (window-frame win))
|
|
(> (or (cadr (window-fringes win)) 0) 0))
|
|
0
|
|
(frame-char-width (window-frame win)))))
|
|
|
|
(defun ekp-region--window-pixel (&optional window)
|
|
"Usable text width in pixels of WINDOW (default: selected window)."
|
|
(max 1 (- (window-body-width window t)
|
|
ekp-region-margin-pixel
|
|
(ekp-region--indicator-reserve window)
|
|
(ekp-region-protrusion-reserve))))
|
|
|
|
(defun ekp-region--effective-width (&optional buffer)
|
|
"Justification width for BUFFER: the narrowest window showing it.
|
|
With the buffer in several windows only one width can be laid out;
|
|
the narrowest keeps every window free of overflow-wrapped lines.
|
|
Falls back to the selected window when the buffer is not displayed."
|
|
(let ((wins (get-buffer-window-list (or buffer (current-buffer)) nil t)))
|
|
(if wins
|
|
(apply #'min (mapcar #'ekp-region--window-pixel wins))
|
|
(ekp-region--window-pixel))))
|
|
|
|
;;;###autoload
|
|
(defun ekp-diagnose ()
|
|
"Check that ekp's measurement matches this window's real rendering.
|
|
Justifies a probe line to the window width, renders it invisibly in
|
|
this buffer, and compares the rendered pixel width against the
|
|
target. A mismatch means glyph metrics differ between measurement
|
|
and display (e.g. a face-remapping ekp does not see) and justified
|
|
lines would come out over- or under-full."
|
|
(interactive)
|
|
(let* ((win (or (get-buffer-window (current-buffer)) (selected-window)))
|
|
(target (ekp-region--window-pixel win))
|
|
(probe (ekp-pixel-justify
|
|
(concat "汉字排版像素精确性探针,中英混排 probe line with "
|
|
"Latin words, 标点。悬挂?以及 hyphenation-ready "
|
|
"vocabulary examples 结尾。")
|
|
target))
|
|
(line (car (split-string probe "\n")))
|
|
(rendered
|
|
(with-silent-modifications
|
|
(let ((beg (point-max)))
|
|
(unwind-protect
|
|
(progn
|
|
(goto-char beg)
|
|
(insert "\n" line)
|
|
(car (window-text-pixel-size win (1+ beg) (point-max))))
|
|
(delete-region beg (point-max))))))
|
|
(delta (- rendered target)))
|
|
(message (concat "ekp-diagnose: target %dpx, rendered %dpx (Δ%+d) — %s"
|
|
(if (buffer-local-value 'face-remapping-alist
|
|
(current-buffer))
|
|
" [buffer has face remappings]" ""))
|
|
target rendered delta
|
|
(if (<= (abs delta) ekp-region-margin-pixel)
|
|
"OK, measurement matches rendering"
|
|
"MISMATCH: justified lines will not fit this window"))
|
|
delta))
|
|
|
|
;;;; Pure string transforms
|
|
|
|
(defun ekp-region--split-hard (string)
|
|
"Split justified STRING on hard newlines (those without `ekp-soft-break')."
|
|
(let ((parts nil) (start 0) (i 0) (len (length string)))
|
|
(while (< i len)
|
|
(when (and (eq (aref string i) ?\n)
|
|
(not (get-text-property i 'ekp-soft-break string)))
|
|
(push (substring string start i) parts)
|
|
(setq start (1+ i)))
|
|
(setq i (1+ i)))
|
|
(push (substring string start) parts)
|
|
(nreverse parts)))
|
|
|
|
(defun ekp-region--face-hit-p (string)
|
|
"Non-nil when STRING carries any face from `ekp-region-skip-faces'."
|
|
(let ((pos 0) (len (length string)) hit)
|
|
(while (and (not hit) (< pos len))
|
|
(let ((f (get-text-property pos 'face string)))
|
|
(when (if (listp f)
|
|
(seq-intersection f ekp-region-skip-faces)
|
|
(memq f ekp-region-skip-faces))
|
|
(setq hit t))
|
|
(setq pos (or (next-single-property-change pos 'face string len)
|
|
len))))
|
|
hit))
|
|
|
|
(defun ekp-region--skip-para-p (para)
|
|
"Non-nil when the paragraph string PARA must stay verbatim.
|
|
Code blocks and other protected text: marked with the `ekp-verbatim'
|
|
property, matching `ekp-region-skip-faces', or accepted by
|
|
`ekp-region-skip-predicate'."
|
|
(or (text-property-not-all 0 (length para) 'ekp-verbatim nil para)
|
|
;; Structured buffer text (comint/eshell prompts, forms) must
|
|
;; never be re-written: fields and read-only spans stay put.
|
|
(text-property-not-all 0 (length para) 'field nil para)
|
|
(text-property-not-all 0 (length para) 'read-only nil para)
|
|
(and ekp-region-skip-faces (ekp-region--face-hit-p para))
|
|
(and ekp-region-skip-predicate
|
|
(funcall ekp-region-skip-predicate para))))
|
|
|
|
(defun ekp-region--justify-string (text pixel)
|
|
"Return TEXT justified to PIXEL with exact-recovery markers.
|
|
Hard newlines are preserved one-to-one. Whitespace-only paragraphs
|
|
\(which the string API would empty out) survive as hidden text;
|
|
verbatim paragraphs (see `ekp-region--skip-para-p') pass through
|
|
untouched."
|
|
(let* ((paras (split-string text "\n"))
|
|
(skips (mapcar #'ekp-region--skip-para-p paras))
|
|
(cores (cl-loop for p in paras for s in skips
|
|
unless (or s (string-blank-p p)) collect p))
|
|
(out (and cores
|
|
(ekp-region--split-hard
|
|
(ekp-pixel-justify (string-join cores "\n") pixel)))))
|
|
(unless (= (length out) (length cores))
|
|
(error "Paragraph count mismatch (%d vs %d)"
|
|
(length out) (length cores)))
|
|
(string-join
|
|
(cl-loop for p in paras for s in skips
|
|
collect (cond (s p)
|
|
((string-blank-p p) (ekp--hide-string p))
|
|
(t (pop out))))
|
|
"\n")))
|
|
|
|
(defun ekp-region--pos-for-offset (string offset)
|
|
"Physical position in justified STRING for logical OFFSET.
|
|
Glue characters count for the length of the original text they
|
|
replaced (their `ekp-glue' value), soft breaks for their payload,
|
|
soft hyphens for nothing; everything else (including hidden text)
|
|
is one logical character."
|
|
(let ((i 0) (len (length string)))
|
|
(while (and (< i len) (> offset 0))
|
|
(let ((glue (get-text-property i 'ekp-glue string)))
|
|
(cond
|
|
(glue
|
|
(setq offset (- offset (length glue))))
|
|
((get-text-property i 'ekp-soft-hyphen string))
|
|
((and (eq (aref string i) ?\n)
|
|
(get-text-property i 'ekp-soft-break string))
|
|
(setq offset (- offset (length (get-text-property
|
|
i 'ekp-soft-break string)))))
|
|
(t (setq offset (1- offset)))))
|
|
(setq i (1+ i)))
|
|
i))
|
|
|
|
;;;; Commands
|
|
|
|
(defun ekp-region--dwim-bounds ()
|
|
"Region bounds when the region is active, else the paragraph at point."
|
|
(if (use-region-p)
|
|
(cons (region-beginning) (region-end))
|
|
(ekp-region--para-bounds (cons (point) (point)))))
|
|
|
|
;;;###autoload
|
|
(defun ekp-justify-region (beg end &optional pixel)
|
|
"Justify the text between BEG and END to PIXEL width.
|
|
PIXEL defaults to the window text width (see `ekp-region-margin-pixel');
|
|
interactively, a numeric prefix argument supplies it explicitly.
|
|
Already-justified text is unjustified first, so the command is
|
|
idempotent and can re-flow to a new width."
|
|
(interactive
|
|
(progn
|
|
(barf-if-buffer-read-only)
|
|
(pcase-let ((`(,beg . ,end) (ekp-region--dwim-bounds)))
|
|
(list beg end
|
|
(and current-prefix-arg
|
|
(prefix-numeric-value current-prefix-arg))))))
|
|
(setq pixel (or pixel (ekp-region--window-pixel)))
|
|
(when (and font-lock-mode
|
|
(or ekp-region-skip-faces ekp-region-skip-predicate))
|
|
;; Face-based verbatim detection needs real faces: parts of the
|
|
;; region jit-lock never displayed are not fontified yet.
|
|
(font-lock-ensure (min beg end) (max beg end)))
|
|
(let ((beg (copy-marker (min beg end)))
|
|
(end (copy-marker (max beg end) t))
|
|
(ekp-region--inhibit t)
|
|
(inhibit-read-only t))
|
|
(unwind-protect
|
|
(ekp-region--preserving-modified
|
|
(atomic-change-group
|
|
;; Re-flow support: strip previous justification first.
|
|
(when (text-property-not-all beg end 'ekp-justified nil)
|
|
(ekp-region--unjustify-region beg end))
|
|
(let* ((text (buffer-substring beg end))
|
|
(justified (ekp-region--justify-string text pixel))
|
|
(point-offset (and (>= (point) beg) (< (point) end)
|
|
(- (point) beg))))
|
|
(unless (equal-including-properties text justified)
|
|
(goto-char beg)
|
|
(delete-region beg end)
|
|
(insert justified)
|
|
(when point-offset
|
|
(goto-char (+ beg (ekp-region--pos-for-offset
|
|
justified point-offset)))))
|
|
(add-text-properties beg end (list 'ekp-justified pixel))))
|
|
(ekp-region--install-integrations))
|
|
(set-marker beg nil)
|
|
(set-marker end nil))))
|
|
|
|
(defun ekp-region--after-layout-change (&rest _ignored)
|
|
"Remove integrations after external edits delete the final layout span."
|
|
(unless (or ekp-region--inhibit
|
|
ekp-auto-justify-mode
|
|
(ekp-region--justified-spans))
|
|
(ekp-region--remove-integrations)))
|
|
|
|
(defun ekp-region--install-integrations ()
|
|
"Install the buffer-local hooks justified text depends on.
|
|
Idempotent; added by `ekp-justify-region' and `ekp-auto-justify-mode'."
|
|
;; Saving writes a logical copy without mutating the display buffer.
|
|
(add-hook 'write-region-annotate-functions
|
|
#'ekp-region--write-logical-buffer nil t)
|
|
(add-hook 'kill-buffer-hook #'ekp-region--discard-write-buffer nil t)
|
|
;; Isearch searches the logical text.
|
|
(add-hook 'isearch-mode-hook #'ekp-region--isearch-begin nil t)
|
|
(add-hook 'isearch-mode-end-hook #'ekp-region--isearch-end nil t)
|
|
(add-hook 'after-change-functions #'ekp-region--after-layout-change nil t)
|
|
;; The kill ring receives the logical text.
|
|
(unless ekp-region--filter-installed
|
|
(setq ekp-region--previous-filter-local-p
|
|
(local-variable-p 'filter-buffer-substring-function)
|
|
ekp-region--previous-filter filter-buffer-substring-function
|
|
ekp-region--filter-installed t)
|
|
(setq-local filter-buffer-substring-function
|
|
#'ekp-region--filter-buffer-substring)))
|
|
|
|
(defun ekp-region--remove-integrations ()
|
|
"Remove the hooks installed by `ekp-region--install-integrations'."
|
|
(remove-hook 'write-region-annotate-functions
|
|
#'ekp-region--write-logical-buffer t)
|
|
(remove-hook 'kill-buffer-hook #'ekp-region--discard-write-buffer t)
|
|
(ekp-region--discard-write-buffer)
|
|
(remove-hook 'isearch-mode-hook #'ekp-region--isearch-begin t)
|
|
(remove-hook 'isearch-mode-end-hook #'ekp-region--isearch-end t)
|
|
(remove-hook 'after-change-functions #'ekp-region--after-layout-change t)
|
|
(when ekp-region--filter-installed
|
|
(when (eq filter-buffer-substring-function
|
|
#'ekp-region--filter-buffer-substring)
|
|
(if ekp-region--previous-filter-local-p
|
|
(setq-local filter-buffer-substring-function
|
|
ekp-region--previous-filter)
|
|
(kill-local-variable 'filter-buffer-substring-function)))
|
|
(setq ekp-region--previous-filter nil
|
|
ekp-region--previous-filter-local-p nil
|
|
ekp-region--filter-installed nil)))
|
|
|
|
(defun ekp-region--unjustify-region (beg end)
|
|
"Restore the logical text between BEG and END.
|
|
Removes synthesized glue and soft hyphens, replaces soft line breaks
|
|
with the whitespace they swallowed, and re-exposes hidden paragraph
|
|
tails. Text the user typed into the justified region is preserved."
|
|
(let ((end-m (copy-marker (max beg end) t))
|
|
(ekp-region--inhibit t)
|
|
(inhibit-read-only t))
|
|
(unwind-protect
|
|
(ekp-region--preserving-modified
|
|
(save-excursion
|
|
(goto-char (min beg end))
|
|
(while (< (point) end-m)
|
|
(let* ((pos (point))
|
|
(glue (get-text-property pos 'ekp-glue)))
|
|
(cond
|
|
(glue
|
|
(delete-region pos (1+ pos))
|
|
(when (stringp glue) (insert glue)))
|
|
((get-text-property pos 'ekp-soft-hyphen)
|
|
(delete-region pos (1+ pos)))
|
|
((and (eq (char-after pos) ?\n)
|
|
(get-text-property pos 'ekp-soft-break))
|
|
(let ((payload (get-text-property pos 'ekp-soft-break)))
|
|
(delete-region pos (1+ pos))
|
|
(insert payload)))
|
|
((get-text-property pos 'ekp-hidden)
|
|
(remove-text-properties pos (1+ pos)
|
|
'(ekp-hidden nil display nil))
|
|
(forward-char 1))
|
|
;; Plain text: our markers are sparse, so hop straight
|
|
;; to the next property boundary instead of stepping
|
|
;; char by char.
|
|
(t (goto-char (min (marker-position end-m)
|
|
(next-property-change pos nil
|
|
(marker-position
|
|
end-m))))))))
|
|
(remove-text-properties (min beg end) end-m '(ekp-justified nil))))
|
|
(set-marker end-m nil))))
|
|
|
|
;;;###autoload
|
|
(defun ekp-unjustify-region (beg end)
|
|
"Restore the logical text between BEG and END.
|
|
When the final justified span disappears outside auto mode, remove
|
|
the buffer integrations that no longer have a layout to serve."
|
|
(interactive
|
|
(progn
|
|
(barf-if-buffer-read-only)
|
|
(pcase-let ((`(,beg . ,end) (ekp-region--dwim-bounds)))
|
|
(list beg end))))
|
|
(ekp-region--unjustify-region beg end)
|
|
(unless (or ekp-auto-justify-mode (ekp-region--justified-spans))
|
|
(ekp-region--remove-integrations)))
|
|
|
|
;;;; Saving: write a logical copy, never mutate the display buffer
|
|
|
|
(defun ekp-region--justified-spans ()
|
|
"Return justified spans of the buffer as a list of (BEG END WIDTH).
|
|
BEG/END are positions; WIDTH is the span's `ekp-justified' value."
|
|
(let ((pos (point-min)) spans)
|
|
(while (< pos (point-max))
|
|
(let ((w (get-text-property pos 'ekp-justified))
|
|
(next (next-single-property-change pos 'ekp-justified
|
|
nil (point-max))))
|
|
(when w (push (list pos next w) spans))
|
|
(setq pos next)))
|
|
(nreverse spans)))
|
|
|
|
(defun ekp-region--discard-write-buffer ()
|
|
"Discard the current buffer's pending logical write buffer."
|
|
(when (buffer-live-p ekp-region--write-buffer)
|
|
(with-current-buffer ekp-region--write-buffer
|
|
(set-buffer-modified-p nil)
|
|
(let ((kill-buffer-query-functions nil))
|
|
(kill-buffer))))
|
|
(setq ekp-region--write-buffer nil))
|
|
|
|
(defun ekp-region--finish-write-buffer ()
|
|
"Dispose the current logical write buffer after a successful write."
|
|
(let ((source ekp-region--write-source)
|
|
(write-buffer (current-buffer)))
|
|
(when (buffer-live-p source)
|
|
(with-current-buffer source
|
|
(when (eq ekp-region--write-buffer write-buffer)
|
|
(setq ekp-region--write-buffer nil))))
|
|
(set-buffer-modified-p nil)
|
|
(let ((kill-buffer-query-functions nil))
|
|
(kill-buffer write-buffer))))
|
|
|
|
(defun ekp-region--make-write-buffer ()
|
|
"Return a logical-text copy of the current justified buffer."
|
|
(ekp-region--discard-write-buffer)
|
|
(let ((source (current-buffer))
|
|
(selective selective-display)
|
|
(multibyte enable-multibyte-characters)
|
|
(coding buffer-file-coding-system)
|
|
(write-buffer (generate-new-buffer " *ekp-logical-write*")))
|
|
(setq ekp-region--write-buffer write-buffer)
|
|
(with-current-buffer write-buffer
|
|
(set-buffer-multibyte multibyte)
|
|
(setq selective-display selective
|
|
buffer-file-coding-system coding
|
|
ekp-region--write-source source)
|
|
(insert-buffer-substring source)
|
|
(ekp-region--unjustify-region (point-min) (point-max))
|
|
(set-buffer-modified-p nil)
|
|
(setq-local write-region-post-annotation-function
|
|
#'ekp-region--finish-write-buffer))
|
|
write-buffer))
|
|
|
|
(defun ekp-region--write-logical-buffer (start end)
|
|
"Switch whole-buffer writes to a logical copy.
|
|
START and END are the `write-region-annotate-functions' arguments.
|
|
Region-only writes retain their normal physical-buffer semantics."
|
|
(when (and (null start) (null end) (ekp-region--justified-spans))
|
|
(set-buffer (ekp-region--make-write-buffer)))
|
|
nil)
|
|
|
|
;;;; Isearch: search the logical text
|
|
|
|
(defvar-local ekp-region--isearch-state nil
|
|
"Spans unjustified while isearch is active: ((BEG-M END-M WIDTH)...).")
|
|
|
|
(defun ekp-region--isearch-begin ()
|
|
"Show the logical text while searching.
|
|
Justified layout injects real space characters between CJK glyphs and
|
|
splits words across soft breaks and hyphens, so searching the layout
|
|
finds almost nothing. The buffer is un-justified for the duration of
|
|
the search and restored by `ekp-region--isearch-end'."
|
|
(let ((spans (and (null ekp-region--isearch-state)
|
|
(ekp-region--justified-spans))))
|
|
(when spans
|
|
(let ((buffer-undo-list t))
|
|
(setq ekp-region--isearch-state
|
|
(mapcar (pcase-lambda (`(,beg ,end ,width))
|
|
(list (copy-marker beg) (copy-marker end t) width))
|
|
spans))
|
|
(pcase-dolist (`(,beg ,end ,_w) ekp-region--isearch-state)
|
|
(ekp-region--unjustify-region beg end))))))
|
|
|
|
(defun ekp-region--isearch-end ()
|
|
"Restore the justified layout after isearch."
|
|
(when ekp-region--isearch-state
|
|
(let ((buffer-undo-list t))
|
|
(pcase-dolist (`(,beg ,end ,width) ekp-region--isearch-state)
|
|
(when (and (marker-position beg) (marker-position end))
|
|
(ekp-justify-region beg end width))
|
|
(set-marker beg nil)
|
|
(set-marker end nil)))
|
|
(setq ekp-region--isearch-state nil)))
|
|
|
|
;;;; Kill/yank: the kill ring receives the logical text
|
|
|
|
(defun ekp-region--logical-string (string)
|
|
"Return STRING with any ekp layout markers structurally inverted.
|
|
Non-justified strings are returned unchanged (same object)."
|
|
(if (cl-some (lambda (prop)
|
|
(text-property-not-all 0 (length string) prop nil string))
|
|
ekp--layout-marker-properties)
|
|
(with-temp-buffer
|
|
(insert string)
|
|
(ekp-region--unjustify-region (point-min) (point-max))
|
|
(buffer-string))
|
|
string))
|
|
|
|
(defun ekp-region--filter-buffer-substring (beg end &optional delete)
|
|
"Extract BEG..END for the kill ring as logical text.
|
|
Killing justified text and yanking it elsewhere must transport the
|
|
words, not the pixel layout of the source window (DELETE as in
|
|
`filter-buffer-substring-function')."
|
|
(let ((ekp-region--inhibit t)
|
|
extracted)
|
|
(unwind-protect
|
|
(let ((filter-buffer-substring-function ekp-region--previous-filter))
|
|
(setq extracted (filter-buffer-substring beg end delete)))
|
|
(when delete
|
|
(let ((ekp-region--inhibit nil))
|
|
(ekp-region--after-layout-change))))
|
|
(ekp-region--logical-string extracted)))
|
|
|
|
;;;###autoload
|
|
(defun ekp-justify-buffer (&optional pixel)
|
|
"Justify the whole accessible portion of the buffer to PIXEL width.
|
|
PIXEL defaults to the window text width; interactively, a numeric
|
|
prefix argument supplies it explicitly."
|
|
(interactive
|
|
(progn
|
|
(barf-if-buffer-read-only)
|
|
(list (and current-prefix-arg
|
|
(prefix-numeric-value current-prefix-arg)))))
|
|
(ekp-justify-region (point-min) (point-max) pixel))
|
|
|
|
;;;###autoload
|
|
(defun ekp-unjustify-buffer ()
|
|
"Restore the logical text of the whole accessible portion."
|
|
(interactive "*")
|
|
(ekp-unjustify-region (point-min) (point-max)))
|
|
|
|
;;;###autoload
|
|
(defun ekp-no-break-region (beg end &optional announce)
|
|
"Mark the region from BEG to END as an unbreakable typesetting atom.
|
|
Justification treats it as one rigid unit: no line break inside, no
|
|
hyphenation, spacing stays literal (inline code, product names,
|
|
numbers with units). This text property lasts only for the current
|
|
buffer session; plain-text saving does not persist it. ANNOUNCE
|
|
requests interactive feedback."
|
|
(interactive (ekp-region--interactive-protection-args))
|
|
(ekp-region--set-protection beg end 'ekp-no-break t "Marked no-break"
|
|
announce))
|
|
|
|
;;;###autoload
|
|
(defun ekp-allow-break-region (beg end &optional announce)
|
|
"Remove session-local `ekp-no-break' marking between BEG and END.
|
|
ANNOUNCE requests interactive feedback."
|
|
(interactive (ekp-region--interactive-protection-args))
|
|
(ekp-region--set-protection beg end 'ekp-no-break nil "Cleared no-break"
|
|
announce))
|
|
|
|
;;;###autoload
|
|
(defun ekp-verbatim-region (beg end &optional announce)
|
|
"Protect the paragraphs from BEG to END against justification (code blocks).
|
|
Whole paragraphs carrying the `ekp-verbatim' property pass through
|
|
`ekp-justify-region' and `ekp-auto-justify-mode' untouched. For an
|
|
unbreakable span inside prose, use `ekp-no-break-region' instead.
|
|
This text property lasts only for the current buffer session;
|
|
plain-text saving does not persist it. ANNOUNCE requests interactive
|
|
feedback."
|
|
(interactive (ekp-region--interactive-protection-args))
|
|
(ekp-region--set-protection beg end 'ekp-verbatim t "Marked verbatim"
|
|
announce))
|
|
|
|
;;;###autoload
|
|
(defun ekp-clear-verbatim-region (beg end &optional announce)
|
|
"Remove session-local `ekp-verbatim' protection between BEG and END.
|
|
ANNOUNCE requests interactive feedback."
|
|
(interactive (ekp-region--interactive-protection-args))
|
|
(ekp-region--set-protection beg end 'ekp-verbatim nil "Cleared verbatim"
|
|
announce))
|
|
|
|
(defun ekp-region--interactive-protection-args ()
|
|
"Return region arguments for an interactive protection command."
|
|
(barf-if-buffer-read-only)
|
|
(list (region-beginning) (region-end) t))
|
|
|
|
(defun ekp-region--set-protection (beg end property enabled label announce)
|
|
"Set PROPERTY to ENABLED from BEG to END and optionally ANNOUNCE LABEL."
|
|
(if enabled
|
|
(add-text-properties beg end (list property t))
|
|
(remove-text-properties beg end (list property nil)))
|
|
(when announce
|
|
(message "EKP: %s on %d characters; current buffer session only"
|
|
label (- end beg))))
|
|
|
|
;;;; Auto-justify minor mode
|
|
|
|
(defun ekp-region--para-bounds (marker-pair)
|
|
"Hard-paragraph bounds containing MARKER-PAIR, as (BEG . END)."
|
|
(let ((b (let ((x (car marker-pair)))
|
|
(if (markerp x) (marker-position x) x)))
|
|
(e (let ((x (cdr marker-pair)))
|
|
(if (markerp x) (marker-position x) x))))
|
|
(save-excursion
|
|
(goto-char (max (point-min) (min b (point-max))))
|
|
(while (and (> (point) (point-min))
|
|
(let ((prev (1- (point))))
|
|
(not (and (eq (char-after prev) ?\n)
|
|
(not (get-text-property prev 'ekp-soft-break))))))
|
|
(forward-char -1))
|
|
(setq b (point))
|
|
(goto-char (max (point-min) (min e (point-max))))
|
|
(while (and (< (point) (point-max))
|
|
(not (and (eq (char-after) ?\n)
|
|
(not (get-text-property (point) 'ekp-soft-break)))))
|
|
(forward-char 1))
|
|
(cons b (point)))))
|
|
|
|
(defun ekp-region--merge-regions (regions)
|
|
"Merge overlapping or adjacent (BEG . END) REGIONS."
|
|
(let ((sorted (sort regions (lambda (a b) (< (car a) (car b)))))
|
|
merged)
|
|
(dolist (r sorted)
|
|
(if (and merged (<= (car r) (cdr (car merged))))
|
|
(setcdr (car merged) (max (cdr (car merged)) (cdr r)))
|
|
(push (cons (car r) (cdr r)) merged)))
|
|
(nreverse merged)))
|
|
|
|
(defun ekp-region--after-change (beg end _len)
|
|
"Record the edit between BEG and END for incremental re-justification.
|
|
Changes applied by undo are not re-flowed: re-justifying behind the
|
|
user's back would fight the undo sequence (and immediately dirty what
|
|
undo just restored). The next real edit or resize re-flows normally."
|
|
(when (and ekp-auto-justify-mode (not ekp-region--inhibit)
|
|
(not undo-in-progress))
|
|
(push (cons (copy-marker beg) (copy-marker end)) ekp-region--dirty)
|
|
(when (timerp ekp-region--edit-timer)
|
|
(cancel-timer ekp-region--edit-timer))
|
|
(setq ekp-region--edit-timer
|
|
(run-with-idle-timer ekp-auto-justify-edit-delay nil
|
|
#'ekp-region--flush-dirty (current-buffer)))))
|
|
|
|
(defun ekp-region--composing-p ()
|
|
"Non-nil while an input method composition (quail preedit) is active.
|
|
Re-flowing the buffer under a live preedit overlay corrupts the
|
|
composition the user is still typing."
|
|
(and (bound-and-true-p quail-overlay)
|
|
(overlayp quail-overlay)
|
|
(overlay-buffer quail-overlay)))
|
|
|
|
(defun ekp-region--flush-dirty (buffer)
|
|
"Re-justify the paragraphs of BUFFER touched by recent edits."
|
|
(when (buffer-live-p buffer)
|
|
(with-current-buffer buffer
|
|
(if (ekp-region--composing-p)
|
|
;; Let the user finish composing; try again after the delay.
|
|
(setq ekp-region--edit-timer
|
|
(run-with-idle-timer ekp-auto-justify-edit-delay nil
|
|
#'ekp-region--flush-dirty buffer))
|
|
(when (and ekp-auto-justify-mode ekp-region--dirty ekp-region--auto-width)
|
|
(let* ((pairs (prog1 ekp-region--dirty (setq ekp-region--dirty nil)))
|
|
;; Convert all bounds to markers before the first
|
|
;; re-justification shifts later positions.
|
|
(regions (mapcar (lambda (r)
|
|
(cons (copy-marker (car r))
|
|
(copy-marker (cdr r) t)))
|
|
(ekp-region--merge-regions
|
|
(mapcar #'ekp-region--para-bounds pairs))))
|
|
(total (cl-reduce #'+ regions
|
|
:key (lambda (r) (- (cdr r) (car r)))
|
|
:initial-value 0)))
|
|
(if (> total ekp-auto-justify-lazy-threshold)
|
|
;; A huge dirty area (big paste, revert): chunk it like
|
|
;; a lazy re-flow instead of freezing the command loop.
|
|
(progn
|
|
(ekp-region--enqueue-chunks
|
|
(mapcan (lambda (r)
|
|
(prog1 (ekp-region--make-chunks (car r) (cdr r))
|
|
(set-marker (car r) nil)
|
|
(set-marker (cdr r) nil)))
|
|
regions))
|
|
(ekp-region--prioritize-visible))
|
|
(dolist (r regions)
|
|
(ekp-justify-region (car r) (cdr r) ekp-region--auto-width)
|
|
(set-marker (car r) nil)
|
|
(set-marker (cdr r) nil)))
|
|
(dolist (p pairs)
|
|
(set-marker (car p) nil)
|
|
(set-marker (cdr p) nil))))))))
|
|
|
|
(defun ekp-region--enqueue-chunks (chunks)
|
|
"Queue CHUNKS for background processing at the current auto width.
|
|
Prepends to an existing queue at the same width (edits win over the
|
|
tail of a resize re-flow); anything queued for a stale width was
|
|
already superseded and is dropped."
|
|
(when chunks
|
|
(if (and ekp-region--pending
|
|
(eql (car ekp-region--pending) ekp-region--auto-width))
|
|
(setcdr ekp-region--pending
|
|
(nconc chunks (cdr ekp-region--pending)))
|
|
(ekp-region--cancel-pending)
|
|
(setq ekp-region--pending (cons ekp-region--auto-width chunks)))
|
|
(unless (timerp ekp-region--chunk-timer)
|
|
(setq ekp-region--chunk-timer
|
|
(run-with-timer 0.02 nil #'ekp-region--process-chunk
|
|
(current-buffer))))))
|
|
|
|
(defun ekp-region--prioritize-visible ()
|
|
"Move queued chunks that intersect the visible span to the front.
|
|
Scrolling into an unprocessed area should not have to wait for the
|
|
whole queue."
|
|
(when (cdr ekp-region--pending)
|
|
(pcase-let ((`(,vbeg . ,vend) (ekp-region--visible-span)))
|
|
(let* ((chunks (cdr ekp-region--pending))
|
|
(vis (cl-remove-if-not
|
|
(lambda (c) (and (< (car c) vend) (> (cdr c) vbeg)))
|
|
chunks))
|
|
(rest (cl-remove-if
|
|
(lambda (c) (memq c vis))
|
|
chunks)))
|
|
(setcdr ekp-region--pending (nconc vis rest))))))
|
|
|
|
(defun ekp-region--on-scroll (window _start)
|
|
"Re-prioritize the lazy queue after WINDOW scrolled.
|
|
Runs off a zero timer: inside `window-scroll-functions' the window's
|
|
final extent is not known yet."
|
|
(let ((buf (window-buffer window)))
|
|
(when (buffer-live-p buf)
|
|
(run-with-timer
|
|
0 nil
|
|
(lambda ()
|
|
(when (buffer-live-p buf)
|
|
(with-current-buffer buf
|
|
(when (and ekp-auto-justify-mode ekp-region--pending)
|
|
(ekp-region--prioritize-visible)))))))))
|
|
|
|
(defun ekp-region--on-resize (window-or-frame)
|
|
"Debounced re-flow after WINDOW-OR-FRAME changed size.
|
|
Buffer-local members of `window-size-change-functions' receive the
|
|
window showing the buffer — and are not guaranteed to run with that
|
|
buffer current — so resolve both explicitly."
|
|
(let ((win (cond ((windowp window-or-frame) window-or-frame)
|
|
((framep window-or-frame)
|
|
(get-buffer-window (current-buffer) window-or-frame))
|
|
(t (get-buffer-window (current-buffer))))))
|
|
(when (window-live-p win)
|
|
(with-current-buffer (window-buffer win)
|
|
(ekp-region--schedule-reflow)))))
|
|
|
|
(defun ekp-region--on-window-change ()
|
|
"Re-check the layout width after the window configuration changed.
|
|
Catches the buffer becoming displayed (possibly for the first time),
|
|
window splits, and deletions of the narrowest window."
|
|
(ekp-region--schedule-reflow))
|
|
|
|
(defun ekp-region--on-text-scale ()
|
|
"Re-flow after a text-scale change.
|
|
Scaling remaps the default face, so every glyph metric changed: the
|
|
current layout is wrong at the same pixel width and must be re-done
|
|
under the new measurement context."
|
|
(when (and ekp-auto-justify-mode ekp-region--auto-width)
|
|
(when (timerp ekp-region--resize-timer)
|
|
(cancel-timer ekp-region--resize-timer))
|
|
(setq ekp-region--resize-timer
|
|
(run-with-timer ekp-auto-justify-resize-delay nil
|
|
#'ekp-region--reflow
|
|
(current-buffer) ekp-region--auto-width))))
|
|
|
|
(defun ekp-region--schedule-reflow ()
|
|
"Debounce a re-flow of the current buffer to its effective width."
|
|
(when ekp-auto-justify-mode
|
|
(let ((w (ekp-region--effective-width)))
|
|
(when (and ekp-region--auto-width (/= w ekp-region--auto-width))
|
|
(when (timerp ekp-region--resize-timer)
|
|
(cancel-timer ekp-region--resize-timer))
|
|
(setq ekp-region--resize-timer
|
|
(run-with-timer ekp-auto-justify-resize-delay nil
|
|
#'ekp-region--reflow
|
|
(current-buffer) w))))))
|
|
|
|
(defun ekp-region--cancel-pending ()
|
|
"Drop any queued lazy re-flow chunks."
|
|
(when (timerp ekp-region--chunk-timer)
|
|
(cancel-timer ekp-region--chunk-timer))
|
|
(setq ekp-region--chunk-timer nil)
|
|
(dolist (c (cdr ekp-region--pending))
|
|
(set-marker (car c) nil)
|
|
(set-marker (cdr c) nil))
|
|
(setq ekp-region--pending nil))
|
|
|
|
(defun ekp-region--make-chunks (beg end)
|
|
"Split [BEG, END) into marker-pair chunks of whole hard paragraphs."
|
|
(let ((chunks nil))
|
|
(save-excursion
|
|
(goto-char beg)
|
|
(while (< (point) end)
|
|
(let ((cbeg (point)) (paras 0))
|
|
(while (and (< (point) end)
|
|
(< paras ekp-auto-justify-chunk-size))
|
|
(if (search-forward "\n" end 'move)
|
|
(unless (get-text-property (match-beginning 0)
|
|
'ekp-soft-break)
|
|
(setq paras (1+ paras)))
|
|
nil))
|
|
(when (> (point) cbeg)
|
|
;; BEG has insertion-type t: the previous chunk's re-insert
|
|
;; happens exactly at this boundary, and the marker must
|
|
;; end up after that text, not before it.
|
|
(push (cons (copy-marker cbeg t) (copy-marker (point) t))
|
|
chunks)))))
|
|
(nreverse chunks)))
|
|
|
|
(defun ekp-region--visible-span ()
|
|
"Visible portion of the current buffer, as (BEG . END)."
|
|
(let ((win (get-buffer-window (current-buffer))))
|
|
(if win
|
|
(cons (window-start win) (or (window-end win t) (point-max)))
|
|
(cons (point-min) (point-max)))))
|
|
|
|
(defun ekp-region--process-chunk (buffer)
|
|
"Re-justify the next queued chunk of BUFFER, then reschedule."
|
|
(when (buffer-live-p buffer)
|
|
(with-current-buffer buffer
|
|
(setq ekp-region--chunk-timer nil)
|
|
(cond
|
|
((or (not ekp-auto-justify-mode) (null ekp-region--pending))
|
|
(ekp-region--cancel-pending))
|
|
;; a newer re-flow superseded this queue
|
|
((not (eql (car ekp-region--pending) ekp-region--auto-width))
|
|
(ekp-region--cancel-pending))
|
|
;; be polite: yield to pending input and live compositions
|
|
((or (input-pending-p) (ekp-region--composing-p))
|
|
(setq ekp-region--chunk-timer
|
|
(run-with-timer 0.1 nil #'ekp-region--process-chunk buffer)))
|
|
(t
|
|
(let ((width (car ekp-region--pending))
|
|
(deadline (+ (float-time) ekp-auto-justify-tick-budget))
|
|
(first t))
|
|
;; Work until the tick budget runs out — at least one chunk,
|
|
;; never with input waiting. Peek-then-pop: an abort inside
|
|
;; justification must not lose the chunk.
|
|
(while (and (cdr ekp-region--pending)
|
|
(or first
|
|
(and (< (float-time) deadline)
|
|
(not (input-pending-p)))))
|
|
(setq first nil)
|
|
(let ((chunk (cadr ekp-region--pending)))
|
|
(ekp-justify-region (car chunk) (cdr chunk) width)
|
|
(setcdr ekp-region--pending (cddr ekp-region--pending))
|
|
(set-marker (car chunk) nil)
|
|
(set-marker (cdr chunk) nil)))
|
|
(if (cdr ekp-region--pending)
|
|
(setq ekp-region--chunk-timer
|
|
(run-with-timer 0.02 nil
|
|
#'ekp-region--process-chunk buffer))
|
|
(setq ekp-region--pending nil))))))))
|
|
|
|
(defun ekp-region--reflow (buffer width)
|
|
"Re-justify BUFFER to WIDTH — whole buffer, or visible-first when large."
|
|
(when (buffer-live-p buffer)
|
|
(with-current-buffer buffer
|
|
(when ekp-auto-justify-mode
|
|
(setq ekp-region--auto-width width)
|
|
(ekp-region--cancel-pending)
|
|
(if (< (- (point-max) (point-min))
|
|
ekp-auto-justify-lazy-threshold)
|
|
(ekp-justify-region (point-min) (point-max) width)
|
|
;; visible part now, the rest in background chunks
|
|
(pcase-let* ((`(,vbeg . ,vend) (ekp-region--visible-span))
|
|
(`(,pbeg . ,pend)
|
|
(ekp-region--para-bounds (cons vbeg vend))))
|
|
(ekp-justify-region pbeg pend width)
|
|
(let ((chunks (nconc
|
|
;; start at PEND so the hard newline there
|
|
;; gets its ekp-justified property too
|
|
(ekp-region--make-chunks pend (point-max))
|
|
(ekp-region--make-chunks (point-min) pbeg))))
|
|
(when chunks
|
|
(setq ekp-region--pending (cons width chunks))
|
|
(setq ekp-region--chunk-timer
|
|
(run-with-timer 0.02 nil
|
|
#'ekp-region--process-chunk
|
|
buffer))))))))))
|
|
|
|
(defun ekp-refill-paragraph ()
|
|
"Re-justify the hard paragraph at point (ekp's `fill-paragraph').
|
|
Bound to \\[fill-paragraph] while `ekp-auto-justify-mode' is on:
|
|
plain `fill-paragraph' would treat glue spaces and soft breaks as
|
|
content and destroy the original whitespace."
|
|
(interactive "*")
|
|
(pcase-let ((`(,beg . ,end)
|
|
(ekp-region--para-bounds (cons (point) (point)))))
|
|
(ekp-justify-region beg end (or ekp-region--auto-width
|
|
(ekp-region--window-pixel)))))
|
|
|
|
(defvar-keymap ekp-auto-justify-mode-map
|
|
:doc "Keymap for `ekp-auto-justify-mode'."
|
|
"<remap> <fill-paragraph>" #'ekp-refill-paragraph)
|
|
|
|
(easy-menu-define ekp-auto-justify-mode-menu ekp-auto-justify-mode-map
|
|
"Menu for `ekp-auto-justify-mode'."
|
|
'("EKP"
|
|
["Justify Region or Paragraph" ekp-justify-region t]
|
|
["Unjustify Region or Paragraph" ekp-unjustify-region t]
|
|
["Justify Buffer" ekp-justify-buffer t]
|
|
["Unjustify Buffer" ekp-unjustify-buffer t]
|
|
"--"
|
|
["Mark Region No-Break" ekp-no-break-region (use-region-p)]
|
|
["Clear No-Break Region" ekp-allow-break-region (use-region-p)]
|
|
["Mark Region Verbatim" ekp-verbatim-region (use-region-p)]
|
|
["Clear Verbatim Region" ekp-clear-verbatim-region (use-region-p)]
|
|
"--"
|
|
["Diagnose Window Fit" ekp-diagnose t]))
|
|
|
|
;;;###autoload
|
|
(define-minor-mode ekp-auto-justify-mode
|
|
"Keep the buffer pixel-justified to the window width.
|
|
Re-flows when the window width changes and re-justifies edited
|
|
paragraphs incrementally. Designed for reading and previewing;
|
|
the buffer text is restored exactly when the mode is turned off.
|
|
|
|
The EKP menu exposes justify, unjustify, no-break, verbatim, and
|
|
diagnostic commands. Manual no-break and verbatim properties last
|
|
only for the current buffer session; use mode faces or
|
|
`ekp-region-skip-predicate' for protection derived from persistent
|
|
document syntax."
|
|
:lighter " EKP"
|
|
:keymap ekp-auto-justify-mode-map
|
|
(if ekp-auto-justify-mode
|
|
(progn
|
|
;; Out-of-the-box protection for the common markup modes,
|
|
;; unless the user configured their own.
|
|
(unless (or ekp-region-skip-faces ekp-region-skip-predicate)
|
|
(cond ((derived-mode-p 'org-mode) (ekp-org-setup))
|
|
((derived-mode-p 'markdown-mode) (ekp-markdown-setup))))
|
|
(setq ekp-region--auto-width (ekp-region--effective-width))
|
|
(ekp-region--reflow (current-buffer) ekp-region--auto-width)
|
|
(add-hook 'window-size-change-functions #'ekp-region--on-resize nil t)
|
|
(add-hook 'window-configuration-change-hook
|
|
#'ekp-region--on-window-change nil t)
|
|
(add-hook 'window-scroll-functions #'ekp-region--on-scroll nil t)
|
|
(add-hook 'text-scale-mode-hook #'ekp-region--on-text-scale nil t)
|
|
(add-hook 'after-change-functions #'ekp-region--after-change nil t)
|
|
(ekp-region--install-integrations)
|
|
;; Turning the major mode off/over kills local hooks silently;
|
|
;; the buffer must get its logical text back first.
|
|
(add-hook 'change-major-mode-hook #'ekp-region--teardown nil t))
|
|
(remove-hook 'window-size-change-functions #'ekp-region--on-resize t)
|
|
(remove-hook 'window-configuration-change-hook
|
|
#'ekp-region--on-window-change t)
|
|
(remove-hook 'window-scroll-functions #'ekp-region--on-scroll t)
|
|
(remove-hook 'text-scale-mode-hook #'ekp-region--on-text-scale t)
|
|
(remove-hook 'after-change-functions #'ekp-region--after-change t)
|
|
(remove-hook 'change-major-mode-hook #'ekp-region--teardown t)
|
|
(ekp-region--teardown)
|
|
;; The teardown removed all justified text; a later
|
|
;; ekp-justify-region re-installs what it needs.
|
|
(ekp-region--remove-integrations)))
|
|
|
|
(defun ekp-region--teardown ()
|
|
"Cancel timers and restore the whole buffer's logical text.
|
|
Runs when `ekp-auto-justify-mode' is turned off and, via
|
|
`change-major-mode-hook', when a major-mode switch is about to
|
|
discard the mode silently."
|
|
(when (timerp ekp-region--resize-timer)
|
|
(cancel-timer ekp-region--resize-timer))
|
|
(when (timerp ekp-region--edit-timer)
|
|
(cancel-timer ekp-region--edit-timer))
|
|
(ekp-region--cancel-pending)
|
|
(dolist (p ekp-region--dirty)
|
|
(set-marker (car p) nil)
|
|
(set-marker (cdr p) nil))
|
|
(setq ekp-region--resize-timer nil
|
|
ekp-region--edit-timer nil
|
|
ekp-region--dirty nil
|
|
ekp-region--auto-width nil)
|
|
;; Narrowing must not leave justified orphans outside the visible
|
|
;; region.
|
|
(save-restriction
|
|
(widen)
|
|
(ekp-region--unjustify-region (point-min) (point-max))))
|
|
|
|
(provide 'ekp-region)
|
|
|
|
;;; ekp-region.el ends here
|