Find vertical position in window - emacs

I want to know the vertical position of the cursor relative to the top of the window. I tried this
(defun cursor-line-in-window ()
(save-excursion
(let* ((current-line (line-number-at-pos (point)))
(top-of-window-line (progn (move-to-window-line 0)
(line-number-at-pos (point)))))
(- current-line top-of-window-line))))
It works, except when I'm in an org-mode file where several lines are folded in under a headline. So I would like to either:
1: find a way to count the number of visible lines in a range, or
2: find a function that gives me the vertical position directly.

Look at (nth 6 (posn-at-point)), which should be a pair (COL . ROW).

Here you have a non-very-elegant solution:
(defun cursor-line-in-window ()
(save-excursion
(beginning-of-line)
(let ((pos (point))
(r 0))
(move-to-window-line 0)
(while (<= (point) pos)
(next-line 1)
(beginning-of-line)
(incf r))
r)))

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)))

Switch parts of adjacent lines

I have this code that switch lines up/down:
;; Moving a line up or down
(defun move-text-internal (arg)
(cond
((and mark-active transient-mark-mode)
(if (> (point) (mark))
(exchange-point-and-mark))
(let ((column (current-column))
(text (delete-and-extract-region (point) (mark))))
(forward-line arg)
(move-to-column column t)
(set-mark (point))
(insert text)
(exchange-point-and-mark)
(setq deactivate-mark nil)))
(t
(let ((column (current-column)))
(beginning-of-line)
(when (or (> arg 0) (not (bobp)))
(forward-line)
(when (or (< arg 0) (not (eobp)))
(transpose-lines arg))
(forward-line -1))
(move-to-column column t)))))
(defun move-text-down (arg)
"Move region (transient-mark-mode active) or current line
arg lines down."
(interactive "*p")
(move-text-internal arg))
(global-set-key [M-S-down] 'move-text-down)
(defun move-text-up (arg)
"Move region (transient-mark-mode active) or current line
arg lines up."
(interactive "*p")
(move-text-internal (- arg)))
(global-set-key [M-S-up] 'move-text-up)
I was wondering if it is possible to tweak the move-text-internal function so it is possible to move part of line "after cursor" up or down.
Here is an example:
Before:
A X B W
Q E O P
If cursor was after X on the first line, after M-S-down:
A X O P
Q E B W
UPDATE:
Thanks to Jordan Biondo for the the his code and function.
I tweaked it to keep line moving as long as you keep invoking the command.
(defun flip-text (&optional arg)
"Flip the text from point to the end of the current line with the text
in the next line from the same column to the end of the next line.
With a prefix arg, flip text with the line above the current."
(interactive "p")
(save-excursion
(let ((tt (delete-and-extract-region (point) (point-at-eol)))
(c (current-column)))
(forward-line arg)
(move-to-column c)
(insert tt)
(let ((ot (delete-and-extract-region (point) (point-at-eol))))
(forward-line (- arg))
(goto-char (point-at-eol))
(insert ot)
))
)
(previous-line (- arg))
)
(global-set-key (kbd "C-M-z") (lambda ()
(interactive)
(flip-text 1)))
(global-set-key (kbd "C-M-c") (lambda ()
(interactive)
(flip-text -1)))
This will do what you specified but does not do multiple lines.
(defun flip-text-to-eol (&optional up)
"Flip the text from point to the end of the current line with the text
in the next line from the same column to the end of the next line.
With a prefix arg, flip text with the line above the current."
(interactive "P")
(save-excursion
(let ((tt (delete-and-extract-region (point) (point-at-eol)))
(c (current-column)))
(forward-line (if up -1 1))
(move-to-column c)
(insert tt)
(let ((ot (delete-and-extract-region (point) (point-at-eol))))
(forward-line (if up 1 -1))
(goto-char (point-at-eol))
(insert ot)))))

Resize occur window in Emacs

When entering occur mode for example (occur "test") the frame splits into two windows as shown below:
As seen the Occur buffer is taking up too much space on the frame, since there is only two matches (for the text "test"). I would like to shrink that window accordingly.
I tried the following code:
(defun test-occur ()
(interactive)
(occur "test")
(save-window-excursion
(other-window 1)
(let (( win (selected-window))
(n (count-lines (point-min) (point-max)))
(h (window-body-height)))
(let ((delta (- (- h n) 3)))
(window-resize win (- 0 delta) nil)))))
But it does not work (nothing happens with the Occur window)..
Just do this:
(add-hook 'occur-hook
(lambda ()
(save-selected-window
(pop-to-buffer "*Occur*")
(fit-window-to-buffer))))

Toggle case of next letter in elisp

I'd like to be able to toggle the case of the letter under the point. To that end, I wrote this:
(defun toggle-case-next-letter ()
"Toggles the case of the next letter, then moves the point forward one character"
(interactive)
(let* ((p (point))
(upcased (upcasep (char-after)))
(f (if upcased 'downcase-region 'upcase-region)))
(progn
(f p (+ 1 p))
(forward-char))))
However, when I run it (I've bound it to M-#), I get progn: Symbol's function definition is void: f. I assume this means f isn't bound, but I'm not sure.
Upcasep is defined as:
(defun upcasep (c) (eq c (upcase c)))
Is the problem in the let binding, or something else? (Also, if there's a better way to do this, that'd be nice as well).
Note that originally I had (upcased (upcasep (buffer-substring-no-properties p (+ 1 p)))), which I've corrected to (upcased (upcasep (char-after)), because using upcasep as defined above is always nil for strings (so I couldn't downcase again).
You've got a typical case of lisp-1 / lisp-2 confusion. Here's a fix (just a funcall):
(defun toggle-case-next-letter ()
"Toggles the case of the next letter, then moves the point forward one character"
(interactive)
(let* ((p (point))
(upcased (char-upcasep (buffer-substring-no-properties p (+ 1 p))))
(f (if upcased 'downcase-region 'upcase-region)))
(progn
(funcall f p (+ 1 p))
(forward-char))))
And here's what I have:
(global-set-key (kbd "C->") 'upcase-word-toggle)
(global-set-key (kbd "C-z") 'capitalize-word-toggle)
(defun char-upcasep (letter)
(eq letter (upcase letter)))
(defun capitalize-word-toggle ()
(interactive)
(let ((start (car
(save-excursion
(backward-word)
(bounds-of-thing-at-point 'symbol)))))
(if start
(save-excursion
(goto-char start)
(funcall
(if (char-upcasep (char-after))
'downcase-region
'upcase-region)
start (1+ start)))
(capitalize-word -1))))
(defun upcase-word-toggle ()
(interactive)
(let ((bounds (bounds-of-thing-at-point 'symbol))
beg end
regionp)
(if (eq this-command last-command)
(setq regionp (get this-command 'regionp))
(put this-command 'regionp nil))
(cond
((or (region-active-p) regionp)
(setq beg (region-beginning)
end (region-end))
(put this-command 'regionp t))
(bounds
(setq beg (car bounds)
end (cdr bounds)))
(t
(setq beg (point)
end (1+ beg))))
(save-excursion
(goto-char (1- beg))
(and (re-search-forward "[A-Za-z]" end t)
(funcall (if (char-upcasep (char-before))
'downcase-region
'upcase-region)
beg end)))))
I couldn't get #abo-abo's answer working for me but using his comments I was able to google better and found the following at http://chneukirchen.org/dotfiles/.emacs
(defun chris2-toggle-case ()
(interactive)
(let ((char (following-char)))
(if (eq char (upcase char))
(insert-char (downcase char) 1 t)
(insert-char (upcase char) 1 t)))
(delete-char 1 nil)
(backward-char))
(global-set-key (kbd "M-#") 'chris2-toggle-case)
This answers the original question if you remove (backward-char).
I realize this is a very old question, but having stumbled upon the same problem recently, I'd like to suggest a simpler solution.
I start with a pure function for toggling character case, based on char code property inspection:
(cl-defun toggle-char-case (c)
(cl-case (get-char-code-property c 'general-category)
(Lu (downcase c))
(Ll (upcase c))
(t c)))
I then use it from within an interactive function operating at point:
(cl-defun toggle-char-case-at-point ()
(interactive)
(let ((new (toggle-char-case (char-after))))
(delete-char 1)
(insert new)))
I then bound this interactive function to a keybinding of my choice:
(global-set-key (kbd "C-M-c") 'toggle-char-case-at-point)
The way this function operates is, after toggling the case it advances the point by one. So calling it repeatedly will toggle the cases of a sequence of chars. One could make it keep the point unchanged - that would require adding (backward-char) to the body.

Keyboard scrolling with acceleration

One can easily map some key to scroll up.
(defun up1()
(interactive)
(scroll-up 1))
(defun up2()
(interactive)
(scroll-up 2))
(global-set-key "\M-]" 'up2)
I am looking instead for the following behavior. The first handful of
scrolls would call up1() and the subsequent ones would call up2().
How about this:
(setq my-scroll-counter 0)
(setq my-scroll-limit 5)
(defun up1()
(interactive)
(if (eq last-command this-command)
(incf my-scroll-counter)
(setq my-scroll-counter 0))
(if (> my-scroll-counter my-scroll-limit)
(scroll-up 2)
(scroll-up 1)))
(global-set-key "\M-]" 'up1)
If you want something a little fancier, you calculate your scroll step dynamically based on how many times you repeat the command:
(setq my-scroll-counter 0)
(setq my-maximum-scroll 20)
(setq my-scroll-acceleration 4)
(defun up1()
(interactive)
(if (eq last-command this-command)
(incf my-scroll-counter)
(setq my-scroll-counter 0))
(scroll-up (min
(+ 1 (/ my-scroll-counter my-scroll-acceleration))
my-maximum-scroll)))
(global-set-key "\M-]" 'up1)