* Re: word-wrap "indentation"
2008-06-26 14:00 ` Chong Yidong
@ 2008-06-27 22:56 ` Stephen Berman
0 siblings, 0 replies; 6+ messages in thread
From: Stephen Berman @ 2008-06-27 22:56 UTC (permalink / raw)
To: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 1452 bytes --]
On Thu, 26 Jun 2008 10:00:55 -0400 Chong Yidong <cyd@stupidchicken.com> wrote:
> Miles Bader <miles@gnu.org> writes:
>
>> So obviously what's needed is someway to tell the display word-wrapping
>> a string to insert after each wrap-point.
>>
>> Any comments? Anyone already hacking on this sort of thing, or should I
>> give it a go?
>
> Go ahead and give it a shot.
A long time ago I started to modify longlines.el to get wrapped long
lines with indentation a la fill-prefix using a display property. Over
time I've revised and tweaked it so that it works fairly well for my
purposes (it also supports adaptive filling and has (incomplete and too
simple) visual line-based commands), but the code is still very rough
and has some bugs I haven't been able to fix. Now that Emacs will have
C level word wrapping, longlines.el will presumably become obsolete, and
with it my modifications. So I'm posting it here now (attached) in the
hope that it may contain one or two ideas that the C level
implementation could adapt or extend (I am not competent to write C
level code).
If anyone wants to try it without subjecting themselves to looking at
the code, load it, then set ll-fill-prefix to a suitable string value,
e.g. " ", and call ll-mode on a file with long lines. Alternatively,
leave ll-fill-prefix nil and call ll-mode on a long line file that has
different levels of indentation, to see the effect of adaptive filling.
Steve Berman
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: modified longlines.el with fill prefix --]
[-- Type: text/x-emacs-lisp, Size: 32401 bytes --]
;;; longlines_tp.el --- automatically wrap long lines, with optional fill prefix
;; Copyright (C) 2000, 2001, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Authors: Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
;; Alex Schroeder <alex@gnu.org>
;; Chong Yidong <cyd@stupidchicken.com>
;; Reimplemented using display property to support optional
;; fill prefix and visual line-based commands by
;; Stephen Berman <Stephen.Berman@gmx.net>
;; Keywords: convenience, wp
;; This file is NOT part of GNU Emacs.
;; GNU Emacs 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, or (at your option)
;; any later version.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;;_ Commentary:
;; Some text editors save text files with long lines, and they
;; automatically break these lines at whitespace, without actually
;; inserting any newline characters. When doing `M-q' in Emacs, you
;; are inserting newline characters. Longlines_Tp mode provides a file
;; format which wraps the long lines when reading a file and unwraps
;; the lines when saving the file. It can also wrap and unwrap
;; automatically as editing takes place.
;; Special thanks to Rod Smith for many useful bug reports.
;;;_ Code:
(defgroup longlines_tp nil
"Automatic wrapping of long lines when loading files."
:group 'fill
:prefix "ll-")
(defcustom ll-auto-wrap t
"Non-nil means long lines are automatically wrapped after each command.
Otherwise, you can perform filling using `fill-paragraph' or
`auto-fill-mode'. In any case, the soft newlines will be removed
when the file is saved to disk."
:group 'longlines_tp
:type 'boolean)
(defcustom ll-wrap-follows-window-size nil
"Non-nil means wrapping and filling happen at the edge of the window.
Otherwise, `fill-column' is used, regardless of the window size. This
does not work well when the buffer is displayed in multiple windows
with differing widths.
If the value is an integer, that specifies the distance from the
right edge of the window at which wrapping occurs. For any other
non-nil value, wrapping occurs 2 characters from the right edge."
:group 'longlines_tp
:type 'boolean)
(defcustom ll-show-hard-newlines nil
"Non-nil means each hard newline is marked on the screen.
\(The variable `ll-show-effect' controls what they look like.)
You can also enable the display temporarily, using the command
`ll-show-hard-newlines'."
:group 'longlines_tp
:type 'boolean)
(defcustom ll-show-effect (propertize "|\n" 'face 'escape-glyph)
"A string to display when showing hard newlines.
This is used when `ll-show-hard-newlines' is on."
:group 'longlines_tp
:type 'string)
(defcustom ll-fill-prefix nil
"A string for filling to insert at front of new line, or nil for none."
:type '(choice (const :tag "None" nil)
string)
:group 'longlines_tp)
(make-variable-buffer-local 'll-fill-prefix)
;;;###autoload(put 'll-fill-prefix 'safe-local-variable 'string-or-null-p)
;;;_. Internal variables
(defvar ll-wrap-beg nil)
(defvar ll-wrap-end nil)
(defvar ll-wrap-point nil)
(defvar ll-showing nil)
(defvar ll-adaptive-fill nil)
(defvar ll-temp-goal-column nil)
(defvar ll-goal-column-changed-flag nil)
(make-variable-buffer-local 'll-wrap-beg)
(make-variable-buffer-local 'll-wrap-end)
(make-variable-buffer-local 'll-wrap-point)
(make-variable-buffer-local 'll-showing)
(make-variable-buffer-local 'll-adaptive-fill)
(make-variable-buffer-local 'll-temp-goal-column)
(make-variable-buffer-local 'll-goal-column-changed-flag)
;;;_. Mode
(defvar ll-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-a" 'll-move-beginning-of-line)
;; (define-key map [home] 'll-move-beginning-of-line)
(define-key map "\C-e" 'll-move-end-of-line)
;; (define-key map [end] 'll-move-end-of-line)
(define-key map "\C-k" 'll-kill-line)
(define-key map "\C-n" 'll-next-line)
(define-key map [down] 'll-next-line)
(define-key map "\C-p" 'll-previous-line)
(define-key map [up] 'll-previous-line)
(define-key map "\C-v" 'll-scroll-up)
(define-key map [next] 'll-scroll-up)
(define-key map "\M-v" 'll-scroll-down)
(define-key map [prior] 'll-scroll-down)
(define-key map "\C-\M-o" 'll-split-line)
;; (define-key map "\M-q" 'll-fill-paragraph)
(define-key map [mouse-4] 'll-mwheel-scroll)
(define-key map [mouse-5] 'll-mwheel-scroll)
map)
"Longlines mode keymap.")
;; FIXME: should ll-mode variables be made permanent local to allow
;; changing the major mode?
;;;###autoload
(define-minor-mode ll-mode
"Toggle Long Lines mode.
In Long Lines mode, long lines are wrapped if they extend beyond
`fill-column'. The soft newlines used for line wrapping will not
show up when the text is yanked or saved to disk.
If the variable `ll-auto-wrap' is non-nil, lines are automatically
wrapped whenever the buffer is changed. You can always call
`fill-paragraph' to fill individual paragraphs.
If the variable `ll-show-hard-newlines' is non-nil, hard newlines
are indicated with a symbol.
\\{ll-mode-map}"
:group 'longlines_tp :lighter " lltp" :keymap ll-mode-map
(if ll-mode
;; Turn on longlines_tp mode
(progn
;; FIXME: see <http://permalink.gmane.org/gmane.emacs.devel/90167>
(if auto-composition-mode (auto-composition-mode -1))
;; (use-hard-newlines 1 'never) ; FIXME: need for fill-paragraph?
(set (make-local-variable 'require-final-newline) nil)
(add-hook 'change-major-mode-hook 'll-mode-off nil t)
(add-hook 'before-revert-hook 'll-before-revert-hook nil t)
(make-local-variable 'buffer-substring-filters)
(make-local-variable 'll-auto-wrap)
(add-to-list 'yank-excluded-properties 'display)
(when ll-wrap-follows-window-size
(let ((dw (if (and (integerp ll-wrap-follows-window-size)
(>= ll-wrap-follows-window-size 0)
(< ll-wrap-follows-window-size
(window-width)))
ll-wrap-follows-window-size
2)))
(set (make-local-variable 'fill-column)
(- (window-width) dw)))
(add-hook 'window-configuration-change-hook
'll-window-change-function nil t))
(let ((buffer-undo-list t)
(inhibit-read-only t)
(after-change-functions nil)
(mod (buffer-modified-p))
buffer-file-name buffer-file-truename)
;; Turning off undo is OK since (spaces + newlines) is
;; conserved, except for a corner case in
;; ll-wrap-lines that we'll never encounter from here
(save-restriction
(widen)
(ll-wrap-region (window-start) (window-end)))
(set-buffer-modified-p mod))
(when (and ll-show-hard-newlines
(not ll-showing))
(ll-show-hard-newlines))
(add-hook 'after-change-functions 'll-after-change-function nil t)
(add-hook 'post-command-hook 'll-post-command-function nil t)
(when ll-auto-wrap
(auto-fill-mode 0)))
;; Turn off longlines_tp mode
;; FIXME: see <http://permalink.gmane.org/gmane.emacs.devel/90167>
(unless auto-composition-mode (auto-composition-mode 1))
(setq yank-excluded-properties
(delete 'display yank-excluded-properties))
(if ll-showing
(ll-unshow-hard-newlines))
(let ((buffer-undo-list t)
(after-change-functions nil)
(inhibit-read-only t)
buffer-file-name buffer-file-truename)
(save-restriction
(widen)
(ll-unwrap-region (point-min) (point-max))))
(remove-hook 'change-major-mode-hook 'll-mode-off t)
(remove-hook 'after-change-functions 'll-after-change-function t)
(remove-hook 'post-command-hook 'll-post-command-function t)
(remove-hook 'before-revert-hook 'll-before-revert-hook t)
(remove-hook 'window-configuration-change-hook
'll-window-change-function t)
(when ll-wrap-follows-window-size
(kill-local-variable 'fill-column))
(kill-local-variable 'isearch-search-fun-function)
(kill-local-variable 'require-final-newline)))
(defun ll-mode-off ()
"Turn off longlines_tp mode.
This function exists to be called by `change-major-mode-hook' when the
major mode changes."
(ll-mode 0))
;;;_. Showing the effect of hard newlines in the buffer
(defun ll-show-hard-newlines (&optional arg)
"Make hard newlines visible by adding a face.
With optional argument ARG, make the hard newlines invisible again."
(interactive "P")
(if arg
(ll-unshow-hard-newlines)
(setq ll-showing t)
(ll-show-region (point-min) (point-max))))
(defun ll-show-region (beg end)
"Make hard newlines between BEG and END visible."
(let ((pmin (min beg end))
(pmax (max beg end))
(mod (buffer-modified-p))
(buffer-undo-list t)
(inhibit-read-only t)
(inhibit-modification-hooks t)
buffer-file-name buffer-file-truename)
(goto-char pmin)
(while (search-forward "\n" pmax t)
(put-text-property (1- (point)) (point) 'display
(copy-sequence ll-show-effect)))
(restore-buffer-modified-p mod)))
(defun ll-unshow-hard-newlines ()
"Make hard newlines invisible again."
(interactive)
(setq ll-showing nil)
(goto-char (point-min))
(let ((mod (buffer-modified-p))
(buffer-undo-list t)
(inhibit-read-only t)
(inhibit-modification-hooks t)
buffer-file-name buffer-file-truename)
(while (search-forward "\n" (point-max) t)
(remove-text-properties (1- (point)) (point) '(display)))
(restore-buffer-modified-p mod)))
;;;_. Wrapping the paragraphs.
;; FIXME: When typing at (window-end) and the display bug at (window-start)
;; (see <http://permalink.gmane.org/gmane.emacs.devel/90167> and followups) is
;; in effect, line feed fails. -- Is this reproducible?
(defun ll-wrap-region (beg end)
"Wrap each successive line, starting with the line before BEG.
Stop when we reach lines after END that don't need wrapping, or the
end of the buffer."
(let ((mod (buffer-modified-p)))
(setq ll-wrap-point (point)
ll-adaptive-fill (or (null ll-fill-prefix)
(string= ll-fill-prefix "")))
(goto-char beg)
;; Need to check if previous line is short enough to merge with next
(goto-char (1- (previous-single-property-change
(point) 'display nil (line-beginning-position))))
;; Two successful ll-wrap-line's in a row mean successive
;; lines don't need wrapping.
(while (null (and (ll-wrap-line)
(or (eobp)
(and (>= (point) end)
(ll-wrap-line))))))
(goto-char ll-wrap-point)
(when ll-adaptive-fill (setq ll-fill-prefix ""))
(set-buffer-modified-p mod)))
(defun ll-wrap-line ()
"If the current line needs to be wrapped, wrap it and return nil.
If wrapping is performed, point remains on the line. If the line does
not need to be wrapped, move point to the next line and return t."
(when (and adaptive-fill-mode ll-adaptive-fill)
(setq ll-fill-prefix (fill-context-prefix (line-beginning-position)
(line-end-position))))
(if (ll-set-breakpoint)
(progn
;; FIXME: If breakpoint is at (window-width), this displays a
;; continuation glyph and the cursor is invisible here.
;; Compare with longlines-mode, which put the cursor in the
;; fringe. This case is fixed by using "\n" instead of " \n"
;; but that lets the cursor appear at the beginning of the
;; display margin when ll-fill-prefix is not the empty string
;; "", see ll-test43.
(let ((p (point))
(n (skip-chars-forward " ")))
(if (zerop n)
(put-text-property (1- (point)) (point)
'display (concat " \n" ll-fill-prefix))
(put-text-property p (point)
'display (concat "\n" ll-fill-prefix))))
;; (put-text-property (1- p) (point)
;; 'display (concat (char-to-string (char-before))
;; "\n" ll-fill-prefix)))
(save-excursion
(goto-char (next-single-property-change
(point) 'display nil (line-end-position)))
(unless (eolp)
(remove-text-properties (point) (1+ (point)) '(display))))
nil)
(if (ll-merge-lines-p)
(progn
(remove-text-properties (point) (1+ (point)) '(display))
nil)
;; Advance to next soft line segment if present, else next line
(if (looking-at "\n")
(forward-line 1)
(goto-char (next-single-property-change
(point) 'display nil (line-end-position))))
t)))
(defun ll-set-breakpoint ()
"Place point where we should break the current line, and return t.
If the line should not be broken, return nil; point remains on the
line."
(let* ((seol (save-excursion
(or (and (equal (get-text-property (point) 'display)
(concat " \n" ll-fill-prefix))
(point))
(goto-char (next-single-property-change
(point) 'display nil (line-end-position))))))
(scol (save-excursion (goto-char seol) (current-column)))
(fcol (cond ((eolp)
(current-column))
((> (ll-soft-line) 1)
(move-to-column (min scol (ll-fill-column)))
(current-column))
(t (move-to-column (min scol fill-column))
(current-column)))))
(unless (or (<= scol fcol)
;; Don't break on white space inserted just before
;; seol (because to insert a new word you first have
;; to insert white space)
(and (> (skip-chars-forward " " seol) 0)
(equal (get-text-property (point) 'display)
(concat " \n" ll-fill-prefix))))
(if (or (and (re-search-forward "[^ ]" (line-end-position) 1)
(> (current-column) fcol))
;; line may end in white space
(looking-at "\n"))
;; This line is too long. Can we break it?
(or (ll-find-break-backward)
(progn (move-to-column fcol)
(ll-find-break-forward)))))))
(defun ll-find-break-backward ()
"Move point backward to the first available breakpoint and return t.
If no breakpoint is found, return nil."
(let ((beg (save-excursion (ll-move-beginning-of-line 1) (point))))
(and (search-backward " " (previous-single-property-change
(point) 'display nil
(line-beginning-position)) 1)
(save-excursion
(skip-chars-backward " " beg)
(not (= (point) beg)))
(progn (forward-char 1)
(if (and fill-nobreak-predicate
(run-hook-with-args-until-success
'fill-nobreak-predicate))
(progn (skip-chars-backward " " beg)
(ll-find-break-backward))
t)))))
(defun ll-find-break-forward ()
"Move point forward to the first available breakpoint and return t.
If no break point is found, return nil."
;; FIXME: need `end' or just use (line-end-position) ?
(let ((end ;; (save-excursion (ll-move-end-of-line 1) (point))
(line-end-position)))
(and (search-forward " " end 1)
(progn (skip-chars-forward " " end)
(not (= (point) end)))
;; If the last non-whitespace character is at (window-width),
;; set the break point there rather than after the
;; whitespace, in order to avoid having the next soft line
;; segment begin with whitespace (ll-test43, ll-test43a)
(let ((p (point)))
(goto-char (match-beginning 0))
(or (= (ll-soft-current-column) (window-width))
(goto-char p)))
(if (and fill-nobreak-predicate
(run-hook-with-args-until-success
'fill-nobreak-predicate))
(ll-find-break-forward)
t))))
(defun ll-merge-lines-p ()
"Return t if part of the next line can fit onto the current line.
Otherwise, return nil. Text cannot be moved across hard newlines."
(unless (or (looking-at "^$") (looking-at "\n")
;; Don't try to merge if there is no soft newline
;; (otherwise induces args out of range error when
;; wrapping line)
(not (next-single-property-change (point) 'display)))
(let ((col (save-excursion
(search-forward " " (line-end-position) 1)
(current-column))))
(<= col (ll-fill-column)))))
(defun ll-soft-line ()
"Return the number of the soft line segment at point."
(save-excursion
(let ((count (if (= (current-column)
(ll-soft-bol-col)) 2 1)))
(while (not (bolp))
(goto-char (previous-single-property-change
(point) 'display nil
(line-beginning-position)))
(setq count (1+ count)))
(/ count 2))))
(defun ll-soft-bol-col ()
"Return the number of the first column of the soft line segment at point."
(save-excursion
(unless (or (bobp) (get-text-property (1- (point)) 'display))
(goto-char (previous-single-property-change
(point) 'display nil
(line-beginning-position))))
(current-column)))
(defun ll-fill-column ()
"Return fill column of the current soft segment of the long line."
(if (= (ll-soft-line) 1) ; FIXME: unnecessary?
fill-column
(- (+ (ll-soft-bol-col) fill-column) (length ll-fill-prefix))))
(defun ll-unwrap-region (beg end)
"Replace each soft newline between BEG and END with exactly one space.
Hard newlines are left intact."
(save-excursion
(let ((reg-max (max beg end))
(mod (buffer-modified-p)))
(goto-char (min beg end))
(while (not (eobp))
(goto-char (next-single-property-change
(point) 'display nil (point-max)))
(unless (eobp)
(remove-text-properties (point) (1+ (point)) '(display))))
(set-buffer-modified-p mod)
end)))
;;;_. Auto wrap
(defun ll-auto-wrap (&optional arg)
"Toggle automatic line wrapping.
With optional argument ARG, turn on line wrapping if and only if ARG is positive.
If automatic line wrapping is turned on, wrap the entire buffer."
(interactive "P")
(setq arg (if arg
(> (prefix-numeric-value arg) 0)
(not ll-auto-wrap)))
(if arg
(progn
(setq ll-auto-wrap t)
(ll-wrap-region (point-min) (point-max))
(message "Auto wrap enabled."))
(setq ll-auto-wrap nil)
(message "Auto wrap disabled.")))
(defun ll-after-change-function (beg end len)
"Update `ll-wrap-beg' and `ll-wrap-end'.
This is called by `after-change-functions' to keep track of the region
that has changed."
(when (and ll-auto-wrap (not undo-in-progress))
(setq ll-wrap-beg
(if ll-wrap-beg (min ll-wrap-beg beg) beg))
(setq ll-wrap-end
(if ll-wrap-end (max ll-wrap-end end) end))))
(defun ll-post-command-function ()
"Perform line wrapping on the parts of the buffer that have changed.
Also wrap the region containing the currently displayed portion of the buffer.
This is called by `post-command-hook' after each command."
(when (and ll-auto-wrap ll-wrap-beg)
(if ll-showing
(ll-show-region ll-wrap-beg ll-wrap-end))
(unless (or (eq this-command 'fill-paragraph)
(eq this-command 'fill-region)
(eq this-command 'newline) ; 'open-line too?
(eq this-command 'll-split-line))
(ll-wrap-region ll-wrap-beg ll-wrap-end)))
(unless ll-wrap-beg
;; force redisplay to update (window-start) and (window-end)
(sit-for 0)
(let* ((inhibit-read-only t)
(buffer-undo-list t)
;; (whw (* (window-height) (window-width)))
;; (start0 (- (window-start) whw))
;; (end0 (+ (window-end) whw))
;; (start (max start0 (point-min)))
;; (end (min end0 (point-max)))
(mod (buffer-modified-p)))
;; deactivate-mark) ; don't deactivate the mark
;; (ll-wrap-region start end)
;; FIXME: wrap visible lines, but only if not already wrapped
(save-excursion
(goto-char (window-start))
(while (> (window-end) (point))
(end-of-line)
(if (> (current-column) fill-column)
(progn
(ll-wrap-region (window-start) (window-end))
(goto-char (window-end)))
(forward-line))))
;; DEBUGGING
;; (message "Wrapped at %s" (format-time-string "%T")))
;; (message "wstart: %d, wend: %d\n start: %d, end: %d"
;; (window-start) (window-end) start end)
(set-buffer-modified-p mod)))
(setq ll-wrap-beg nil)
(setq ll-wrap-end nil))
(defun ll-window-change-function ()
"Re-wrap the buffer if the window width has changed.
This is called by `window-configuration-change-hook'."
(let ((dw (if (and (integerp ll-wrap-follows-window-size)
(>= ll-wrap-follows-window-size 0)
(< ll-wrap-follows-window-size (window-width)))
ll-wrap-follows-window-size
2)))
(when (/= fill-column (- (window-width) dw))
(setq fill-column (- (window-width) dw))
(ll-wrap-region (point-min) (point-max)))))
;;;_. Commands for visual (soft) lines
;; FIXME: ad hoc adaptations and simplifications of Emacs line-based
;; commands; should be extended and improved.
;; FIXME: does this respect track-eol?
(defun ll-forward-line (&optional n)
"Move N lines forward (backward if N is negative).
Precisely, if point is on line I, move to the start of line I +
N. If there isn't room, go as far as possible (no error).
Returns the count of lines left to move. If moving forward, that
is N - number of lines moved; if backward, N + number moved.
With positive N, a non-empty line at the end counts as one line
successfully moved (for the return value)."
(or n (setq n 1))
(if (> n 0)
(while (> n 0)
(goto-char (next-single-property-change
(point) 'display nil (line-end-position)))
(unless (eobp) (forward-char))
(setq n (1- n)))
(goto-char (previous-single-property-change
(point) 'display nil (line-beginning-position)))
(setq n (abs n))
(while (> n 0)
(unless (bobp) (forward-char -1))
(goto-char (previous-single-property-change
(point) 'display nil (line-beginning-position)))
(setq n (1- n)))))
;;;_ , Navigation
(defun ll-move-end-of-line (arg)
"Move point to end of current line as displayed.
\(If there's an image in the line, this disregards newlines
which are part of the text that the image rests on.)
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
(interactive "p")
(unless (equal (get-text-property (point) 'display)
(concat " \n" ll-fill-prefix))
(ll-forward-line arg)
(unless (and (eobp) (not (looking-at "^$"))) (forward-char -1))))
(defun ll-move-beginning-of-line (arg)
"Move point to beginning of current line as displayed.
\(If there's an image in the line, this disregards newlines
which are part of the text that the image rests on.)
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
(interactive "p")
(unless (equal (get-text-property (1- (point)) 'display)
(concat " \n" ll-fill-prefix))
(ll-forward-line (1- arg))))
(defvar ll-vertical-commands
'(ll-next-line ll-previous-line ll-scroll-up ll-scroll-down ll-mwheel-scroll))
;; FIXME: does this respect next-line-add-newlines?
(defun ll-move-line (&optional arg try-vscroll)
"Move cursor vertically ARG lines.
Interactively, vscroll tall lines if `auto-window-vscroll' is enabled.
If there is no character in the target line exactly under the current column,
the cursor is positioned after the character in that line which spans this
column, or at the end of the line if it is not long enough.
If there is no line in the buffer after this one, behavior depends on the
value of `next-line-add-newlines'. If non-nil, it inserts a newline character
to create a line, and moves the cursor to that line. Otherwise it moves the
cursor to the end of the buffer.
The command \\[set-goal-column] can be used to create
a semipermanent goal column for this command.
Then instead of trying to move exactly vertically (or as close as possible),
this command moves to the specified goal column (or as close as possible).
The goal column is stored in the variable `goal-column', which is nil
when there is no goal column.
If you are thinking of using this in a Lisp program, consider
using `forward-line' instead. It is usually easier to use
and more reliable (no dependence on goal column, etc.)."
(unless (memq last-command ll-vertical-commands)
(setq ll-temp-goal-column (ll-soft-current-column)))
(let ((col (if ll-goal-column-changed-flag
ll-temp-goal-column
(ll-soft-current-column))))
(ll-forward-line arg)
(while (and (< (ll-soft-current-column) col)
;; Don't advance beyond end of soft line
(not (equal (get-text-property (point) 'display)
(concat " \n" ll-fill-prefix)))
(not (eolp)))
(forward-char))
(setq ll-goal-column-changed-flag (/= (ll-soft-current-column) col))))
(defun ll-next-line (&optional arg try-vscroll)
"Move cursor vertically down ARG lines."
(interactive "p\np")
(or arg (setq arg 1))
(ll-move-line arg try-vscroll))
(defun ll-previous-line (&optional arg try-vscroll)
"Move cursor vertically up ARG lines."
(interactive "p\np")
(or arg (setq arg 1))
(setq arg (- arg))
(ll-move-line arg try-vscroll))
;; FIXME: problematic with adaptive filling
(defun ll-soft-current-column ()
(let ((first (= (previous-single-property-change
(point) 'display nil (line-beginning-position))
(line-beginning-position))))
(+ (- (current-column) (ll-soft-bol-col))
(if first 0 (length ll-fill-prefix)))))
(defun ll-scroll-up (&optional arg)
"Scroll text of current window upward ARG lines.
If ARG is omitted or nil, scroll upward by a near full screen.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll downward.
Like scroll-up, but moves a fixed amount of lines (fixed relative the
`window-height') so that pager-page-up moves back to the same line."
(interactive "P")
(if arg
(ll-scroll-screen arg)
(unless (pos-visible-in-window-p (point-max))
(ll-scroll-screen (- (1- (window-height))
next-screen-context-lines)))))
(defun ll-scroll-down (&optional arg)
"Scroll text of current window down ARG lines.
If ARG is omitted or nil, scroll down by a near full screen.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll upward.
Like scroll-down, but moves a fixed amount of lines (fixed relative the
`window-height') so that pager-page-down moves back to the same line."
(interactive "P")
(if arg
(progn (setq arg (- arg))
(ll-scroll-screen arg))
(unless (pos-visible-in-window-p (point-min))
(ll-scroll-screen (- next-screen-context-lines
(1- (window-height)))))))
;; adapted from pager-scroll-screen
(defun ll-scroll-screen (n)
"Scroll N screen lines, but keep the cursors position on screen."
(unless (memq last-command ll-vertical-commands)
(setq ll-temp-goal-column (ll-soft-current-column)))
(save-excursion
(goto-char (window-start))
(ll-move-line n)
(set-window-start (selected-window) (point)))
(ll-move-line n)
(move-to-column ll-temp-goal-column))
;; Code of mwheel-scroll with scroll-* replaced by ll-scroll-*
(defun ll-mwheel-scroll (event)
"Scroll up or down according to the EVENT.
This should only be bound to mouse buttons 4 and 5."
(interactive (list last-input-event))
(let* ((curwin (if mouse-wheel-follow-mouse
(prog1
(selected-window)
(select-window (mwheel-event-window event)))))
(mods
(delq 'click (delq 'double (delq 'triple (event-modifiers event)))))
(amt (assoc mods mouse-wheel-scroll-amount)))
;; Extract the actual amount or find the element that has no modifiers.
(if amt (setq amt (cdr amt))
(let ((list-elt mouse-wheel-scroll-amount))
(while (consp (setq amt (pop list-elt))))))
(if (floatp amt) (setq amt (1+ (truncate (* amt (window-height))))))
(when (and mouse-wheel-progressive-speed (numberp amt))
;; When the double-mouse-N comes in, a mouse-N has been executed already,
;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...).
(setq amt (* amt (event-click-count event))))
(unwind-protect
(let ((button (mwheel-event-button event)))
(cond ((eq button mouse-wheel-down-event)
(condition-case nil (ll-scroll-down amt)
;; Make sure we do indeed scroll to the beginning of
;; the buffer.
(beginning-of-buffer
(unwind-protect
(ll-scroll-down)
;; If the first scroll succeeded, then some scrolling
;; is possible: keep scrolling til the beginning but
;; do not signal an error. For some reason, we have
;; to do it even if the first scroll signalled an
;; error, because otherwise the window is recentered
;; for a reason that escapes me. This problem seems
;; to only affect scroll-down. --Stef
(set-window-start (selected-window) (point-min))))))
((eq button mouse-wheel-up-event)
(condition-case nil (ll-scroll-up amt)
;; Make sure we do indeed scroll to the end of the buffer.
(end-of-buffer (while t (ll-scroll-up)))))
(t (error "Bad binding in mwheel-scroll"))))
(if curwin (select-window curwin))))
(when (and mouse-wheel-click-event mouse-wheel-inhibit-click-time)
(if mwheel-inhibit-click-event-timer
(cancel-timer mwheel-inhibit-click-event-timer)
(add-hook 'pre-command-hook 'mwheel-filter-click-events))
(setq mwheel-inhibit-click-event-timer
(run-with-timer mouse-wheel-inhibit-click-time nil
'mwheel-inhibit-click-timeout))))
;;;_ , Other line-based commands
;; This follows longlines-mode in killing just the soft line segment
;; point is on and then rewrapping.
(defun ll-kill-line (&optional arg)
"Kill the rest of the current line; if no nonblanks there, kill thru newline.
With prefix argument, kill that many lines from point.
Negative arguments kill lines backward.
With zero argument, kills the text before point on the current line."
(interactive "P")
(kill-region (point)
(progn
(and arg (ll-move-line arg))
(cond ((or (equal (get-text-property (point) 'display)
(concat " \n" ll-fill-prefix))
(looking-at "\n"))
(forward-char))
((or (null arg) (> arg 0))
(ll-move-end-of-line 1))
(t (ll-move-beginning-of-line 1)))
;; kill soft eol but leave hard eol
(unless (or (looking-at "\n") (eobp)) (forward-char))
(point))))
;; (if arg
;; (forward-visible-line (prefix-numeric-value arg))
;; (if (eobp)
;; (signal 'end-of-buffer nil))
;; (let ((end
;; (save-excursion
;; (end-of-visible-line) (point))))
;; (if (or (save-excursion
;; ;; If trailing whitespace is visible,
;; ;; don't treat it as nothing.
;; (unless show-trailing-whitespace
;; (skip-chars-forward " \t" end))
;; (= (point) end))
;; (and kill-whole-line (bolp)))
;; (forward-visible-line 1)
;; (goto-char end))))
;; Code of split-line with current-column replaced by ll-soft-current-column
(defun ll-split-line (&optional arg)
"Split current line, moving portion beyond point vertically down.
If the current line starts with `fill-prefix', insert it on the new
line as well. With prefix ARG, don't insert `fill-prefix' on new line.
When called from Lisp code, ARG may be a prefix string to copy."
(interactive "*P")
(skip-chars-forward " \t")
(let* ((col (ll-soft-current-column))
(pos (point))
;; What prefix should we check for (nil means don't).
(prefix (cond ((stringp arg) arg)
(arg nil)
(t fill-prefix)))
;; Does this line start with it?
(have-prfx (and prefix
(save-excursion
(beginning-of-line)
(looking-at (regexp-quote prefix))))))
(newline 1)
(if have-prfx (insert-and-inherit prefix))
(indent-to col 0)
(goto-char pos)))
;; FIXME
(defun ll-kill-whole-line ()
)
;; FIXME: wrong-number-of-arguments
;; Make this the value of fill-paragraph-function in ll-mode?
(defun ll-fill-paragraph (&optional arg)
(interactive)
nil)
;;;_. Loading and saving
(defun ll-before-revert-hook ()
(add-hook 'after-revert-hook 'll-after-revert-hook nil t)
(ll-mode 0))
(defun ll-after-revert-hook ()
(remove-hook 'after-revert-hook 'll-after-revert-hook t)
(ll-mode 1))
(provide 'longlines_tp)
;; arch-tag: 3489d225-5506-47b9-8659-d8807b77c624
;;;_ longlines_tp.el ends here
^ permalink raw reply [flat|nested] 6+ messages in thread