I'm looking for some assistance, please, debugging the second example -- it should be only one (1) character wide, but ends up being two (2) characters wide.
WORKING EXAMPLE: The following code creates an overlay of just one (1) character wide, which is correct:
(let ((my-column (current-column)))
(overlay-put
(make-overlay
(save-excursion (beginning-of-line) (+ (point) my-column))
(+ 1 (save-excursion (beginning-of-line) (+ (point) my-column)) ) )
'face '(background-color . "pink")))
BROKEN EXAMPLE: The following code creates an overlay that is two (2) characters wide, which is incorrect:
(let ((my-column (current-column)))
(save-excursion
(goto-char (point-min))
(while (re-search-forward "\n" nil t)
(overlay-put
(make-overlay
(save-excursion (beginning-of-line) (+ (point) my-column))
(+ 1 (save-excursion (beginning-of-line) (+ (point) my-column)) ) )
'face '(background-color . "pink"))) ))
EDIT -- FIXED EXAMPLE: Based on the helpful guidance of #Lindydancer in the answer below, here is the revised example that now works -- perhaps it could be simplified, but at least I now understand the concept:
(let* (
(my-column (current-column))
my-line-beginning
my-line-ending
my-line-length)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "\n" nil t)
(setq my-line-beginning (point))
(end-of-line)
(setq my-line-ending (point))
(setq my-line-length (- my-line-ending my-line-beginning))
(when (< my-column my-line-length)
(overlay-put
(make-overlay
(save-excursion (beginning-of-line) (+ (point) my-column))
(+ 1 (save-excursion (beginning-of-line) (+ (point) my-column)) ) )
'face '(background-color . "pink"))) )))
I think the problem is that you add the overlay to all lines. If the line is shorter than my-column, the overlay will spill over lines below, giving the impression that some overlays are two character wide, when in reality it's two one-character overlays placed next to eachother.
Try to limit the code to put the overlay only on lines that are at least my-overlay long.
Related
What is the proper way, please, to remove after-string overlays with variable values?
When using C-u C-x =, it only shows up as after-string without stating what the value is.
For example, once I lay an overlay using (overlay-put (make-overlay (point) (point)) 'after-string my-concatenated-string), I would like to be able to delete it without programming Emacs to remember every single my-concatenated-string that was previously used in the buffer -- there might be a few different ones on every line?
Is it sufficient to use?: (remove-overlays (window-start) (window-end)) 'after-string)
Or, is it better to use?: (remove-overlays (window-start) (window-end)) 'after-string t)
Or, is there another method to get them all?
EDIT (March 17, 2014): My confusion is apparently coming from a misunderstanding between an object and a property.
In general, an overlay property is created as follows:
(overlay-put (make-overlay (point) (point)) 'my-property 'property-number-one )
In general, an overlay object is created as follows:
(overlay-put (make-overlay (point) (+ (point) 1))
'face '(:background "gray50" :foreground "black"))
Here is a unique situation where an 'after-string smells-like an object. My assumption is: if it smells-like an object, then perhaps a value needs to be included when attempting to remove it so that I'm not left with a disconnected 'after-string:
(save-excursion
(end-of-line)
(let ((eol-floating-column (+ (current-column) 10)))
(overlay-put (make-overlay (point) (point))
'after-string
(concat
(propertize (char-to-string ?\uE001)
'display
`((space :align-to ,eol-floating-column)
(space :width 0)))
(propertize (char-to-string ?\u00B6)
'face '(:background "gray50" :foreground "black")
'cursor t) ))))
The way the code is written, if you omit the last parameter, it only removes an overlay if the value is `nil' (which it doesn't appear to be in your case).
As you don't know the value of the property, I don't think you can use the function. However, you can simply write something like (assuming the value of the after-string is never nil):
(dolist (o (overlays-in (window-start) (window-end)))
(when (overlay-get o 'after-string)
(delete-overlay o))
Also note that if you do this from a post-command hook, window-end might not reflect the true value. To be safe you can do (window-end nil t), however this could be a bit slower.
When you put the overlay, add another property (like (overlay-put ol 'lawlist t), for example), after which you can remove those overlays with (remove-overlays BEG END 'lawlist t).
(defun lawlist-remove-overlays (beg end name val)
"Remove the overlays."
;; DEBUGGING
;; (unless (and beg end name val)
;; (message "ERROR -- beg: %s | end: %s | name: %s | val: %s" beg end name val))
(let* (
(point-max (point-max))
(point-min (point-min))
(narrowed-p (not (equal (- point-max point-min) (buffer-size))))
(beg (if beg beg point-min))
(end
(cond
((and
(not narrowed-p)
end)
end)
((and
(not narrowed-p)
(null end))
point-max)
((and
narrowed-p
end
(< end point-max))
end)
((and
narrowed-p
end
(= end point-max))
(1+ end))
((and
narrowed-p
(null end))
(1+ point-max)) )))
(when (and beg end name val)
(overlay-recenter end)
(dolist (o (overlays-in beg end))
(when (eq (overlay-get o name) val)
(delete-overlay o))))))
(dolist (description `(
,fci-pre-limit-string
,fci-pre-limit-active-region-string
,fci-at-limit-string
,fci-post-limit-string
,fci-wrapped-limit-string
,fci-cursor-at-eol-string
,fci-tab-text-left
,fci-tab-text-right
,fci-tab-sandwiched))
(lawlist-remove-overlays nil nil 'after-string description))
See also this related thread which deals with targeting overlays with values containing text properties:
https://emacs.stackexchange.com/a/9847/2287
I am looking for some assistance, please, to track down why the runtime of following overlay function increases with each successive run.
From what I can tell, the runtime should be the same if the text in the buffer remains the same -- i.e., just moving the cursor left / right should not increase the runtime (but it does).
I tried the following, but to no avail: (setq buffer-undo-list t); killing all local variables; (setq-default cache-long-scans nil).
This function is a scaled down version for purposes of creating a minimal working example. The full version starts of with a .1 second runtime and increases .1 seconds each successive run until the function becomes unusable.
(add-hook 'post-command-hook (lambda ()
(draw-vertical-line (window-start) (window-end))))
(defun draw-vertical-line (start end)
"Erase and redraw the vertical-line between START and END."
(measure-time
(setq my-cursor-point (point))
(setq my-current-col (current-column))
(save-excursion
(if (not (eq start (progn (goto-char start) (point-at-bol))))
(setq start (progn (goto-char start) (beginning-of-line) (point)))))
(save-excursion
(let* (my-last-column my-overlay beg-ov end-ov)
(goto-char end)
(mapc #'(lambda (o) (when (overlay-get o 'my-overlay-properties)
(delete-overlay o))) (overlays-in start end))
(goto-char end)
(while (re-search-backward "\n" start t)
(setq my-last-column (current-column))
(my-not-wrapped-line-function) )))))
(defun my-not-wrapped-line-function ()
(unless (eq (buffer-size) 0)
(setq beg-ov (save-excursion (move-to-column my-current-col) (point)))
(setq end-ov (+ 1 beg-ov))
(setq my-overlay (make-overlay beg-ov end-ov ))
(cond
;; text, excluding tabs
((and
(or
(< my-current-col my-last-column)
(and (eobp) (= my-current-col my-last-column)))
(not-tab-looking-back-p)
(not (eq my-cursor-point beg-ov)))
(overlay-put my-overlay 'my-overlay-properties t)
(overlay-put my-overlay 'text-exclude-tabs t)
(overlay-put my-overlay 'face '(:background "yellow" :foreground "black") ) )
;; tab with text to the right
((and
(tab-left-p)
(tab-looking-forward-p)
(tab-p)
(not (eq my-cursor-point beg-ov))
(< my-current-col my-last-column))
(overlay-put my-overlay 'my-overlay-properties t)
(overlay-put my-overlay 'tab-text-right t)
(overlay-put my-overlay 'face '(:foreground "purple" :weight bold) ) )
;; tab with text to the left
((and
(not-tab-left-p)
(tab-p)
(not (eq my-cursor-point beg-ov))
(< my-current-col my-last-column))
(overlay-put my-overlay 'my-overlay-properties t)
(overlay-put my-overlay 'tab-text-left t)
(overlay-put my-overlay 'face '(:foreground "green" :weight bold) ) )
;; tab sandwiched between a tab on each side
((and
(tab-p)
(tab-sandwiched-p)
(not (eq my-cursor-point beg-ov))
(< my-current-col my-last-column))
(overlay-put my-overlay 'my-overlay-properties t)
(overlay-put my-overlay 'tab-sandwiched t)
(overlay-put my-overlay 'face '(:foreground "orange" :weight bold) ) )
;; end of line, but not wrapped
((and
(= my-current-col my-last-column)
(eolp)
(not (eq my-cursor-point beg-ov)))
(overlay-put my-overlay 'my-overlay-properties t)
(overlay-put my-overlay 'eol t)
(overlay-put my-overlay 'face '(:foreground "brown" :weight bold) ) )
;; cursor -- not wrapped -- not end of line
((and
(not
(catch 'found
(dolist (ol (overlays-at beg-ov))
(and (overlay-get ol 'hl-p)
(throw 'found t)))))
(not (region-active-p))
(eq my-cursor-point beg-ov)
(not (eq (preceding-char) 9))
(< my-current-col my-last-column))
(overlay-put my-overlay 'my-overlay-properties t)
(overlay-put my-overlay 'my-cursor-not-wrapped-not-eol t)
(overlay-put my-overlay 'face '(:background "black" :weight bold) ) )
;; cursor -- end of line, but not a wrapped line
((and
(not (region-active-p))
(eq my-cursor-point beg-ov)
;; (not (eq (preceding-char) 9))
(= my-current-col my-last-column))
(overlay-put my-overlay 'my-overlay-properties t)
(overlay-put my-overlay 'my-cursor-eol-not-wrapped t)
(overlay-put my-overlay 'face '(:foreground "SteelBlue" :weight bold) ) ) )))
(defvar my-cursor-point nil
"Point used to prevent the formation of a cursor overlay.
It must be set within the function `draw-vertical-line`.")
(make-variable-buffer-local 'my-cursor-point)
(defsubst tab-left-p ()
(not (not (save-excursion
(if my-current-col
(move-to-column my-current-col)
(current-column))
(unless (bobp) (backward-char 1)) (eq (char-after (point)) 9)))))
(defsubst not-tab-left-p ()
(not (save-excursion
(if my-current-col
(move-to-column my-current-col)
(current-column))
(unless (bobp) (backward-char 1)) (eq (char-after (point)) 9))))
(defsubst tab-p ()
(save-excursion
(if my-current-col
(move-to-column my-current-col)
(current-column))
(eq (char-after (point)) 9)))
(defsubst not-tab-looking-back-p ()
(not (save-excursion
(if my-current-col
(move-to-column (+ 1 my-current-col))
(move-to-column (+ 1 (current-column))))
(eq (preceding-char) 9))))
(defsubst tab-looking-forward-p ()
(not (save-excursion
(if my-current-col
(move-to-column (+ 1 my-current-col))
(move-to-column (+ 1 current-column)))
(eq (char-after (point)) 9))))
(defsubst tab-sandwiched-p ()
(let ((my-current-col
(if my-current-col
my-current-col
(current-column))))
(not (eq
(save-excursion (move-to-column my-current-col)
(re-search-backward "\t" (point-at-bol) t) (point))
(save-excursion (move-to-column (+ my-current-col 1))
(re-search-backward "\t" (point-at-bol) t) (point))))))
(defmacro measure-time (&rest body)
"Measure the time it takes to evaluate BODY."
`(let ((time (current-time)))
,#body
(message "%.06f" (float-time (time-since time)))))
The current implementation of overlays is algorithnically very poor. Many basic operations (such as move-overlay, inserting/deleting text, or even sometimes just moving point) have time O(N), where N is the number of overlays. Sometimes you can tremendously speed things up by jusdicious use of overlay-recenter.
We know how to fix those algorithmic problems, and I'd be very happy to help someone work on the implementation.
Since my guess in the comments was correct, posting an actual answer for more visibility in case someone has a similar problem:
delete-overlay may not be doing what you expect. From the manual:
— Function: delete-overlay overlay
This function deletes overlay. The overlay continues to exist as a Lisp object, and its property list is unchanged, but it ceases to be attached to the buffer it belonged to, and ceases to have any effect on display.
A deleted overlay is not permanently disconnected. You can give it a position in a buffer again by calling move-overlay.
Maybe you have a giant pile of disconnected overlays eating up memory or causing a lot of processing.
I have been unable to come up with a method to test for a syntax condition without moving the cursor -- e.g., skip-syntax-forward and skip-chars-forward both move the cursor in order to return t or a positive value. How can I return t or nil without moving the cursor?
(defun lawlist-kill-word ()
"Mark word / symbol + whitespace to the right of the cursor, and kill same."
(interactive)
(let* (
(symbol-regexp "\\s.\\|\\s_")
(word-regexp "\\sw"))
(modify-syntax-entry ?' "_") ;; apostrophe = symbol constituent
(cond
((< 0 (skip-syntax-forward "_."))
(let ((end (point)))
(set-mark end)
(while (looking-back symbol-regexp)
(backward-char))
(let ((beg (point)))
(delete-region beg end)
(setq beg (point))
(cond
((skip-chars-forward " \t")
(setq end (point))
(set-mark end)
(delete-region beg end))))))
((< 0 (skip-syntax-forward "w"))
(let ((end (point)))
(set-mark end)
(while (looking-back word-regexp)
(backward-char))
(let ((beg (point)))
(delete-region beg end)
(setq beg (point))
(cond
((skip-chars-forward " \t")
(setq end (point))
(set-mark end)
(delete-region beg end))))))
(t
(let ((beg (point)))
(set-mark beg)
(skip-chars-forward " \t")
(let ((end (point)))
(delete-region beg end)))
(deactivate-mark)))
(modify-syntax-entry ?' "w") )) ;; apostrophe = word constituent
EDIT: lawlist-kill-word is a work in progress -- any updates to this function will be posted to a thread related to that issue -- i.e.,: Emacs: delete whitespaces or a word
As #Tobias said: wrap cursor movements in save-excursion. Save any values you want (e.g., of (point)) in variables and return them as needed.
E.g., if you want the position four lines ahead, do something like this:
(let ((posn (save-excursion (forward-line 4) (point))))
posn)
I would like to insert the contents of the kill-ring at the point using (yank), however if there is white space in the beginning of the yanked text, it should be deleted before insertion.
How can this be done?
(I have looked at save-excursion and re-search-backward but could not get it to work)..
You could try
(defun my-yank ()
(interactive)
(let ((start (point)))
(call-interactively 'yank)
(let ((end (point)))
(save-excursion
(goto-char start)
(delete-region (point)
(progn (skip-chars-forward " \t" end) (point)))))))
Here is a possible solution
(defun yank-no-spaces (&optional arg)
(interactive "*P")
(yank arg)
(save-restriction
(save-excursion
(narrow-to-region (point) (mark))
(goto-char (point-min))
(just-one-space 0))))
I would like to set up a command that put the content of the lines between two § characters without moving the point (not including the lines containg the §).
Here is my current attempt
(defun copy-section ()
"Copy current section, that is lines between two §."
(interactive)
(save-excursion
(when (not (search-backward-regexp "§" nil t))
(goto-char (point-min)) )
(forward-line 1)
(when (not (search-forward-regexp "§" nil t))
(goto-char (point-max)) )
(move-beginning-of-line nil)
(kill-ring-save (mark) (point)) ) )
It works well but the remarks in the documentation about moving around the mark being bad style make me think taht there is a better way to achieve the same result.
Does saving position into variable (which I do not know how to do it) allows for a cleaner function.
Part of the code above comes from ergoemacs.
No "regexp" form needed as only a char is looked for
(defun copy-section ()
"Copy current section, that is lines between two §."
(interactive)
(save-excursion
(let* ((start (and (search-backward "§" nil t)
(forward-line 1)
(point)))
(end (progn (and start (search-forward "§" nil t))
(forward-line -1)
(end-of-line)
(point))))
(and start end (kill-new (buffer-substring-no-properties start end))))))
This version saves the beginning and end of your section in temporary local variables, and doesn't use the mark at all:
(defun copy-section ()
"Copy current page as defined by form feed characters."
(interactive)
(let (start end)
(save-excursion
(when (not (search-backward-regexp "§" nil t))
(goto-char (point-min)) )
(forward-line 1)
(setq start (point))
(when (not (search-forward-regexp "§" nil t))
(goto-char (point-max)) )
(move-beginning-of-line nil)
(setq end (point))
(kill-ring-save start end))))