Pin/lock/fix text - emacs

With elisp it is possible to add overlays to parts of the buffer to hide them etc. I went through all the possible overlays and couldn't find a way to pin a selection. Is it possible to have a function that, given a selection in a buffer, pins this selection so that when you scroll up or down the selection is always shown? (a bit like what you have with Excel where you can lock some rows or columns so that they always appear on screen).
I wanted to do something like this but with (overlay-put new-overlay 'lock t) but there doesn't appear to be such overlay.
(defun hide-region-hide ()
"Hides a region by making an invisible overlay over it and save the
overlay on the hide-region-overlays \"ring\""
(interactive)
(let ((new-overlay (make-overlay (mark) (point))))
(push new-overlay hide-region-overlays)
(overlay-put new-overlay 'invisible t)
(overlay-put new-overlay 'intangible t)
(overlay-put new-overlay 'before-string
(if hide-region-propertize-markers
(propertize hide-region-before-string
'font-lock-face 'hide-region-before-string-face)
hide-region-before-string))
(overlay-put new-overlay 'after-string
(if hide-region-propertize-markers
(propertize hide-region-after-string
'font-lock-face 'hide-region-after-string-face)
hide-region-after-string))))

I came up with this solution that works pretty well:
(defvar-local pinned-buffer nil
"Variable to store the buffer that contains the pinned region.")
(defun region-unpin ()
"Unpin the current region"
(interactive)
(when pinned-buffer
(let ((window (get-buffer-window pinned-buffer 'visible)))
(setq-local pinned-buffer nil)
(quit-window t window))))
(defun region-pin ()
"Pin the current region to the top."
(interactive)
(when (use-region-p)
(let* ((regionp (buffer-substring (mark) (point)))
(buffer (get-buffer-create "tmp.ml"))
(mode major-mode))
(with-current-buffer buffer
(funcall mode)
(hide-mode-line-mode)
(goto-char (window-end))
(insert regionp)
(goto-char 0))
(setq-local window-min-height 1)
(setq-local pinned-buffer buffer)
(display-buffer-in-direction buffer '((direction . above)
(inhibit-same-window . t)
(window-height . fit-window-to-buffer)))
)))
This allows me to have a temporary window with the major mode of my current one, no modeline, the height of the window fits perfectly the selection and the cursor is set to the beginning of it to have the full text displayed in it but whenever I want to pin some more text it goes to the end of the buffer, insert the selected region and goes back up.

Related

Programmatically detect if any line in a buffer is wrapping?

I have an idea for a possibly cool/probably stupid emacs script which would dynamically resize text to fill available space.
One thing I can't seem to figure out is how to query the current buffer to see if any lines are currently being wrapped. How would I do it?
You can check if any lines are wrapped in the current buffer with function like this:
(defun wrapped-lines-p ()
(save-excursion
(goto-char (point-min))
(let ((long-line-regexp
(format "^.\\{%d\\}.+$" (window-body-width))))
(search-forward-regexp long-line-regexp nil t))))
As noted in the comments, this doesn't take into account the buffer's font size. Since buffers can have a mix of different sized fonts, the window text pixel size needs to be tested. Try this:
(defun wrapped-lines-p ()
(let ((window-width-pixels (window-body-width nil t)))
(> (car (window-text-pixel-size nil nil nil (1+ window-width-pixels)))
window-width-pixels)))
Note that "any lines are currently being wrapped" is a property of the window, not the buffer.
Given a window, you can scan it from top visible line to bottom and compare line length to window-width:
(defun window-long-lines-p ()
"Return t is any visible line in the current window is longer than window width."
(save-excursion
(move-to-window-line -1)
(let ((end (point)) here
found-long-line)
(move-to-window-line 0)
(while (and (not found-long-line)
(< (setq here (point)) end))
(when (< (window-width)
(- (progn (forward-line 1)
(point))
here))
(setq found-long-line t)
(message "long line: %d" (1- (line-number-at-pos)))))
found-long-line)))

Emacs -- calculating new window-start/end without redisplay

Is it possible to calculate a new window-start/end without a redisplay occurring? If so, then an example would be greatly appreciated. If not, then what is the best way to approximate it?
Example:  We want to move to a new area of the buffer somewhere off screen, and place overlays when we get there. We might be using page-down or scroll-down or paragraph-down or end-of-buffer. When we get to that new point, we want to calculate the new window-start and the new window-end. However, we want to avoid a momentary naked looking buffer without any overlays. Ideally, the redisplay would occur once those overlays are added. I want to restrict new overlays to the new region based upon the new window-start/end.
Point-Min:  point = 1
Old Window Start:  point = 1000
Old Window End:  point = 1500
New Window Start:  point = 3500
New Window End: point = 4000
Point-Max:  point = 6000
Problem: When using the post-command-hook to try and calculate the new window-start and new window-end, the previous display positions are being used instead -- i.e., the old window-start and the old window-end.
Here is a sample of the project I am working on. Absent fixing the window-start \ window-end problem, I get the following error:
Error in post-command-hook (my-eol-ruler-function):
(error "Invalid search bound (wrong side of point)")`.
The error happens when going from (point-min) to the end of the buffer with the interactive function end-of-buffer. In the context of this error, (point-max) is beyond the old window-end.
EDIT:  Updated code to include a message: (message "point: %s | window-start: %s | window-end: %s | point-max: %s" (point) (window-start) (window-end) (point-max) ). The message is used to demonstrate that the new window-start and new window-end are not calculated within the post-command-hook because a redisplay has not yet occurred. However, I am trying to avoid a redisplay until after the new overlays have been placed -- otherwise, a naked buffer without overlays is visible for a split second.
(defvar my-eol-ruler nil
"A horizontal ruler stretching from eol (end of line) to the window edge.")
(make-variable-buffer-local 'my-eol-ruler)
(defvar my-eol-pilcrow nil
"A pilcrow symbol placed at the end of every line except the current line.")
(make-variable-buffer-local 'my-eol-pilcrow)
(defun my-eol-ruler-function ()
(let* (
(opoint (point))
(window-width (window-width))
(window-start (window-start))
(window-end (window-end))
(col-eovl
(save-excursion
(vertical-motion 1)
(skip-chars-backward " \r\n" (- (point) 1))
(- (current-column) (progn (vertical-motion 0) (current-column)))))
(my-current-line-length (- (- window-width col-eovl) 3))
(pilcrow
(propertize (char-to-string ?\u00B6)
'face '(:foreground "white")
'cursor t))
(pilcrow-underlined
(propertize (char-to-string ?\u00B6)
'face '(:foreground "white" :underline "yellow")
'cursor t))
(underline (propertize (char-to-string ?\u2009)
'display `(space :width ,my-current-line-length)
'face '(:underline "yellow")
'cursor t)))
(when (or my-eol-ruler my-eol-pilcrow)
(dolist (description `(
,my-eol-ruler
,my-eol-pilcrow ))
(remove-overlays (point-min) (point-max)
'after-string description)) )
(setq my-eol-ruler (concat pilcrow-underlined underline))
(setq my-eol-pilcrow pilcrow)
(save-excursion
(end-of-line)
(overlay-put (make-overlay (point) (point))
'after-string my-eol-ruler ) )
(message "point: %s | window-start: %s | window-end: %s | point-max: %s"
(point)
(window-start)
(window-end)
(point-max) )
(save-excursion
(goto-char window-end)
(while (re-search-backward "\n" window-start t)
(let* (
(pbol (point-at-bol))
(pbovl (save-excursion (vertical-motion 0) (point)))
(peol (point))
(peol-pbol-region-p
(if (region-active-p)
(= peol pbol)))
(eol-inside-region-p
(if (region-active-p)
(and
(<= reg-beg peol)
(> reg-end peol))))
(col-eovl
(save-excursion
(vertical-motion 1)
(skip-chars-backward " \r\n" (- (point) 1))
(- (current-column) (progn (vertical-motion 0) (current-column)))))
(my-last-column (current-column))
(window-width-bug-p (= my-last-column (- window-width 1)))
(shazbot-pbol
(save-excursion
(end-of-line)
(re-search-backward "\s\\|\t" pbol t) (+ (point) 1)))
(wrapped-window-width-bug-p (= col-eovl (- window-width 1))) )
(when
(or
(< opoint pbol)
(> opoint peol))
(overlay-put (make-overlay peol peol) 'after-string my-eol-pilcrow))))) ))
(add-hook 'post-command-hook 'my-eol-ruler-function)
Beginning of the buffer, before the error occurs.
End of the buffer -- the error occurs when executing the interactive function end-of-buffer from a point at the beginning of the buffer.
Error in post-command-hook (my-eol-ruler-function):
(error "Invalid search bound (wrong side of point)")
See also Emacs bug tracker feature request #22404 (which has not yet been implemented, but the mailing archive contains a rough draft rudimentary patch that creates a new hook for this specific issue): https://debbugs.gnu.org/cgi/bugreport.cgi?bug=22404
Minor-mode for testing window-start and window-end BEFORE visual redisplay.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; test-mode
;; A minor-mode for testing `window-start` / `window-end` BEFORE visual redisplay.
(defvar test-this-command nil
"This local variable is set within the `post-command-hook`; and,
is also used by the `window-scroll-functions` hook.")
(make-variable-buffer-local 'test-this-command)
(defun test-post-command-hook-fn ()
"A function attached to the `post-command-hook`."
(setq test-this-command this-command)
(test-demo-fn))
(defun test-window-scroll-functions-fn (win _start)
"A function attached to the `window-scroll-functions` hook."
(test-demo-fn))
(defun test-demo-fn ()
"This is a test-mode demonstration function."
(when
(and
test-mode
test-this-command
(window-live-p (get-buffer-window (current-buffer)))
(not (minibufferp))
(pos-visible-in-window-p (point)
(get-buffer-window (current-buffer) (selected-frame)) t))
(let* (
(selected-window (selected-window))
(window-start (window-start selected-window))
(window-end (window-end selected-window t)) )
(message "window-start: %s | window-end: %s" window-start window-end)
(setq test-this-command nil) )))
(define-minor-mode test-mode
"A minor-mode for testing `window-start` / `window-end` BEFORE visual redisplay."
:init-value nil
:lighter " TEST"
:keymap nil
:global nil
:group nil
(cond
(test-mode
(set (make-local-variable 'scroll-conservatively) 101)
(add-hook 'post-command-hook 'test-post-command-hook-fn nil t)
(add-hook 'window-scroll-functions 'test-window-scroll-functions-fn nil t)
(when (called-interactively-p 'any)
(message "Turned ON `test-mode`.")))
(t
(kill-local-variable 'scroll-conservatively)
(kill-local-variable 'test-this-command)
(remove-hook 'post-command-hook 'test-post-command-hook-fn t)
(remove-hook 'window-scroll-functions 'test-window-scroll-functions-fn t)
(when (called-interactively-p 'any)
(message "Turned OFF `test-mode`.") ))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Offhand, I'd say that the error is raised because you pass a BOUND arg to a search function. For example:
(re-search-backward "\n" window-start t)
(re-search-backward "\s\\|\t" pbol t)
Check your values of window-start and pbol. Remember that when you search backward the bound must not be greater than the current position (point).
I think you want to use jit-lock-register instead of post-command-hook. This way, the redisplay code will call you back once it has decided of a window-start and you'll be able to add the overlays you want before the buffer's content is displayed.

Resizing the minibuffer to fit an image displayed there

One can display an image in the current buffer by executing:
(insert-image (create-image "image.png"))
I would like to know how to display an image, not in the current buffer, but in the minibuffer at the bottom of the screen.
Using (select-window (active-minibuffer-window)) to select the minibuffer does not seem to work--for some reason (active-minibuffer-window) returns nil.
Any ideas? Many thanks!
Update:
Now I know how to display an image in the minibuffer:
(with-current-buffer (window-buffer (minibuffer-window))
(insert-image (create-image "image.png")))
What I don't know is how to resize the minibuffer so that the image fits.
OK. So after some trial and error, here's the function I wanted:
(defun my-show-image-in-minibuffer (filename)
(let* ((img (create-image filename))
(y (floor (cdr (image-size img)))))
(with-current-buffer (window-buffer (minibuffer-window))
(setq resize-mini-windows 'grow-only)
(setq resize-mini-windows nil)
(delete-minibuffer-contents)
(window-resize (minibuffer-window) y)
(insert-image img))
(clear-this-command-keys t)
(read-event)
(with-current-buffer (window-buffer (minibuffer-window))
(delete-minibuffer-contents)
(window-resize (minibuffer-window) (- 0 y))
(setq resize-mini-windows 'grow-only))
(image-flush img)
(setq unread-command-events (list last-input-event))))
Additionally, after any key is pressed, it deletes the image and returns the minibuffer to its normal size.

How to modify the buffer-list using modify-frame-parameters

I am trying to create a function that modifies a frame's buffer-list by replacing it with the buffer listing of tabs from a Tabbar group displayed on the same frame.
This is the snippet that returns a listing of tabs from the Tabbar group displayed on the selected frame:
(mapcar (lambda (tab)
(buffer-name (tabbar-tab-value tab)))
(tabbar-tabs (tabbar-current-tabset t)))
The following function returns nil instead of the desired Modified Buffer List. Any ideas would be greatly appreciated.
(defun new-buffer-list ()
(interactive)
(message "Original Buffer List: %s" (frame-parameter (selected-frame) 'buffer-list))
(setq new-list
(mapcar (lambda (tab)
(buffer-name (tabbar-tab-value tab)))
(tabbar-tabs (tabbar-current-tabset t))))
(modify-frame-parameters (selected-frame) (list (cons 'buffer-list new-list)))
(message "The variable \"new-list\": %s" new-list)
(message "Modified Buffer List: %s" (frame-parameter (selected-frame) 'buffer-list)))
(frame-parameter 'nil 'buffer-list)
returns a list of buffers, not their names; thus you might want to replace
(lambda (tab) (buffer-name (tabbar-tab-value tab)))
with 'tabbar-tab-value

In emacs, can I set up the *Messages* buffer so that it tails?

Basically I want the *Messages* buffer to always scroll to the bottom when a new message arrives.
Can I do that?
I found auto-revert-tail-mode but that works for buffers that are visiting files.
When I tried it in the Messages buffer, it popped an error:
auto-revert-tail-mode: This buffer is not visiting a file
For multiple frames you probably want:
(defadvice message (after message-tail activate)
"goto point max after a message"
(with-current-buffer "*Messages*"
(goto-char (point-max))
(walk-windows (lambda (window)
(if (string-equal (buffer-name (window-buffer window)) "*Messages*")
(set-window-point window (point-max))))
nil
t)))
Just put point at the end of the buffer M->. If you don't manually move it it will stay there -- IOW, you will always see the tail.
This code seems a bit overkill, but a the simple (goto-char (point-max)) wasn't working for me:
(defadvice message (after message-tail activate)
"goto point max after a message"
(with-current-buffer "*Messages*"
(goto-char (point-max))
(let ((windows (get-buffer-window-list (current-buffer) nil t)))
(while windows
(set-window-point (car windows) (point-max))
(setq windows (cdr windows))))))
Here's an implementation that uses the new advice style.
(defun message-buffer-goto-end-of-buffer (&rest args)
(let* ((win (get-buffer-window "*Messages*"))
(buf (and win (window-buffer win))))
(and win (not (equal (current-buffer) buf))
(set-window-point
win (with-current-buffer buf (point-max))))))
(advice-add 'message :after 'message-buffer-goto-end-of-buffer)
i run 23.3 and there were still way too many occasions where the built-in 'solution' and the orginal defadvice on the message function just didn't cut it, so i wrapped that code in a list / toggle / timer set up and it's working beautifully - no more frustration when debugging!
it's generic, so works on any buffer, although i only really use it for..
(toggle-buffer-tail "*Messages*" "on")
..hope it's useful to someone.
;alist of 'buffer-name / timer' items
(defvar buffer-tail-alist nil)
(defun buffer-tail (name)
"follow buffer tails"
(cond ((or (equal (buffer-name (current-buffer)) name)
(string-match "^ \\*Minibuf.*?\\*$" (buffer-name (current-buffer)))))
((get-buffer name)
(with-current-buffer (get-buffer name)
(goto-char (point-max))
(let ((windows (get-buffer-window-list (current-buffer) nil t)))
(while windows (set-window-point (car windows) (point-max))
(with-selected-window (car windows) (recenter -3)) (setq windows (cdr windows))))))))
(defun toggle-buffer-tail (name &optional force)
"toggle tailing of buffer NAME. when called non-interactively, a FORCE arg of 'on' or 'off' can be used to to ensure a given state for buffer NAME"
(interactive (list (cond ((if name name) (read-from-minibuffer
(concat "buffer name to tail"
(if buffer-tail-alist (concat " (" (caar buffer-tail-alist) ")") "") ": ")
(if buffer-tail-alist (caar buffer-tail-alist)) nil nil
(mapcar '(lambda (x) (car x)) buffer-tail-alist)
(if buffer-tail-alist (caar buffer-tail-alist)))) nil)))
(let ((toggle (cond (force force) ((assoc name buffer-tail-alist) "off") (t "on")) ))
(if (not (or (equal toggle "on") (equal toggle "off")))
(error "invalid 'force' arg. required 'on'/'off'")
(progn
(while (assoc name buffer-tail-alist)
(cancel-timer (cdr (assoc name buffer-tail-alist)))
(setq buffer-tail-alist (remove* name buffer-tail-alist :key 'car :test 'equal)))
(if (equal toggle "on")
(add-to-list 'buffer-tail-alist (cons name (run-at-time t 1 'buffer-tail name))))
(message "toggled 'tail buffer' for '%s' %s" name toggle)))))
edit: changed functionality to display tail at the bottom of the window
Here's an amendment over Peter's / Trey's solutions
(defun modi/messages-auto-tail (&rest _)
"Make *Messages* buffer auto-scroll to the end after each message."
(let* ((buf-name "*Messages*")
;; Create *Messages* buffer if it does not exist
(buf (get-buffer-create buf-name)))
;; Activate this advice only if the point is _not_ in the *Messages* buffer
;; to begin with. This condition is required; otherwise you will not be
;; able to use `isearch' and other stuff within the *Messages* buffer as
;; the point will keep moving to the end of buffer :P
(when (not (string= buf-name (buffer-name)))
;; Go to the end of buffer in all *Messages* buffer windows that are
;; *live* (`get-buffer-window-list' returns a list of only live windows).
(dolist (win (get-buffer-window-list buf-name nil :all-frames))
(with-selected-window win
(goto-char (point-max))))
;; Go to the end of the *Messages* buffer even if it is not in one of
;; the live windows.
(with-current-buffer buf
(goto-char (point-max))))))
(advice-add 'message :after #'modi/messages-auto-tail)