Search code examples
emacselisp

Emacs -- debugging an overlay in conjunction with syntax skipping


I'm looking for some assistance, please to debug my test function so that the yellow vertical line looks exactly the same as the red line. I have decided to exclude highlighting tabs because they are two (2) characters wide and it makes the vertical line like distorted. In my attempt to exclude tabs, however, I lose highlighting of any text to the immediate right. My attempts at fixing this breaks the functionality of the blue and/or red lines.

In a nutshell, the blue and red lines are working as desired, but the yellow line is broken (to the immediate right of a tab) -- the yellow line should look just like the red line.

The problem with my test function lies in the following code snippet:

(not (save-excursion (move-to-column my-col-b)
   (< 0 (skip-chars-forward "\t"))))

(not (save-excursion (move-to-column my-col-b)
    (> 0 (skip-chars-backward "\t")))))

The following functions were used to create the image of buffer depicted in the screenshot below:

(defun test ()
(interactive)
  (let* (my-last-column
      my-o-beg-a my-o-end-a (my-col-a 3)
      my-o-beg-b my-o-end-b (my-col-b 28)
      my-o-beg-c my-o-end-c (my-col-c 29) )
    (generate-test-buffer)
    (goto-char (point-max))
    (while (re-search-backward "\n" (point-min) t)
      (setq my-last-column (current-column))
      (setq my-o-beg-a (progn (move-to-column my-col-a) (point)))
      (setq my-o-end-a (+ 1 my-o-beg-a))
      (setq my-o-beg-b (progn (move-to-column my-col-b) (point)))
      (setq my-o-end-b (+ 1 my-o-beg-b))
      (setq my-o-beg-c (progn (move-to-column my-col-c) (point)))
      (setq my-o-end-c (+ 1 my-o-beg-c))
      (when (and
          (< my-col-a my-last-column)
          (not (save-excursion (move-to-column my-col-a)
              (< 0 (skip-chars-forward "\t"))))
          (not (save-excursion (move-to-column my-col-a)
              (> 0 (skip-chars-backward "\t")))))
        (overlay-put (make-overlay my-o-beg-a my-o-end-a) 'face '(
          (background-color . "cyan")
          (foreground-color . "black") )))
      (when (and
          (< my-col-b my-last-column)
          (not (save-excursion (move-to-column my-col-b)
              (< 0 (skip-chars-forward "\t"))))
          (not (save-excursion (move-to-column my-col-b)
              (> 0 (skip-chars-backward "\t")))))
        (overlay-put (make-overlay my-o-beg-b my-o-end-b) 'face '(
          (background-color . "yellow")
          (foreground-color . "black") )))
      (when (and
          (< my-col-b my-last-column)
          (not (save-excursion (move-to-column my-col-c)
              (< 0 (skip-chars-forward "\t"))))
          (not (save-excursion (move-to-column my-col-c)
              (> 0 (skip-chars-backward "\t")))))
        (overlay-put (make-overlay my-o-beg-c my-o-end-c) 'face '(
          (background-color . "red")
          (foreground-color . "black") ))) )))

(defun generate-test-buffer ()
  (if (get-buffer "foo.el")
    (with-current-buffer "foo.el"
      (erase-buffer))
    (get-buffer-create "foo.el"))
  (switch-to-buffer (get-buffer "foo.el"))
  (setq whitespace-style '(face space-mark tab-mark newline-mark) )
  (setq indent-tabs-mode t)
  (setq tab-stop-list (number-sequence 4 200 4))
  (setq tab-width 4)
  (setq indent-line-function 'insert-tab)
  (whitespace-mode t)
  (insert ";;;;")
  (insert-tabs 1)
  (insert "(defun test ()\n;;;;")
  (insert-tabs 1)
  (insert "(interactive)\n;;;;")
  (insert-tabs 2)
  (insert "(let* (my-last-column\n;;;;")
  (insert-tabs 4)
  (insert "my-o-beg-a my-o-end-a (my-col-a 1)\n;;;;")
  (insert-tabs 4)
  (insert "my-o-beg-b my-o-end-b (my-col-b 11)\n;;;;")
  (insert-tabs 4)
  (insert "my-o-beg-c my-o-end-c (my-col-c 16) )\n;;;;")
  (insert-tabs 3)
  (insert "(generate-test-buffer)\n;;;;")
  (insert-tabs 3)
  (insert "(goto-char (point-max))\n;;;;")
  (insert-tabs 3)
  (insert "(while (re-search-backward \"\\n\" (point-min) t)\n;;;;")
  (insert-tabs 4)
  (insert "(setq my-last-column (current-column))\n;;;;")
  (insert-tabs 4)
  (insert "(setq my-o-beg-a (progn (move-to-column my-col-a) (point)))\n;;;;")
  (insert-tabs 4)
  (insert "(setq my-o-end-a (+ 1 my-o-beg-a))\n;;;;")
  (insert-tabs 4)
  (insert "(setq my-o-beg-b (progn (move-to-column my-col-b) (point)))\n;;;;")
  (insert-tabs 4)
  (insert "(setq my-o-end-b (+ 1 my-o-beg-b))\n;;;;")
  (insert-tabs 4)
  (insert "(setq my-o-beg-c (progn (move-to-column my-col-c) (point)))\n;;;;")
  (insert-tabs 4)
  (insert "(setq my-o-end-c (+ 1 my-o-beg-c))\n;;;;")
  (insert-tabs 4)
  (insert "(when (and\n;;;;")
  (insert-tabs 6)
  (insert "(< my-col-a my-last-column)\n;;;;")
  (insert-tabs 6)
  (insert "(not (save-excursion (move-to-column my-col-a)\n;;;;")
  (insert-tabs 7)
  (insert "(< 0 (skip-chars-forward \"\t\"))))\n;;;;")
  (insert-tabs 6)
  (insert "(not (save-excursion (move-to-column my-col-a)\n;;;;")
  (insert-tabs 7)
  (insert "(> 0 (skip-chars-backward \"\t\")))))\n;;;;")
  (insert-tabs 5)
  (insert "(overlay-put (make-overlay my-o-beg-a my-o-end-a) 'face '(\n;;;;")
  (insert-tabs 6)
  (insert "(background-color . \"cyan\")\n;;;;")
  (insert-tabs 6)
  (insert "(foreground-color . \"black\") )))\n;;;;")
  (insert-tabs 4)
  (insert "(when (and\n;;;;")
  (insert-tabs 6)
  (insert "(< my-col-b my-last-column)\n;;;;")
  (insert-tabs 7)
  (insert "(not (save-excursion (move-to-column my-col-b)\n;;;;")
  (insert-tabs 7)
  (insert "(< 0 (skip-chars-forward \"\t\"))))\n;;;;")
  (insert-tabs 6)
  (insert "(not (save-excursion (move-to-column my-col-b)\n;;;;")
  (insert-tabs 7)
  (insert "(> 0 (skip-chars-backward \"\t\")))))\n;;;;")
  (insert-tabs 5)
  (insert "(overlay-put (make-overlay my-o-beg-b my-o-end-b) 'face '(\n;;;;")
  (insert-tabs 6)
  (insert "(background-color . \"yellow\")\n;;;;")
  (insert-tabs 6)
  (insert "(foreground-color . \"black\") )))\n;;;;")
  (insert-tabs 4)
  (insert "(when (and\n;;;;")
  (insert-tabs 6)
  (insert "(< my-col-b my-last-column)\n;;;;")
  (insert-tabs 6)
  (insert "(not (save-excursion (move-to-column my-col-c)\n;;;;")
  (insert-tabs 7)
  (insert "(< 0 (skip-chars-forward \"\t\"))))\n;;;;")
  (insert-tabs 6)
  (insert "(not (save-excursion (move-to-column my-col-c)\n;;;;")
  (insert-tabs 7)
  (insert "(> 0 (skip-chars-backward \"\t\")))))\n;;;;")
  (insert-tabs 5)
  (insert "(overlay-put (make-overlay my-o-beg-c my-o-end-c) 'face '(\n;;;;")
  (insert-tabs 6)
  (insert "(background-color . \"red\")\n;;;;")
  (insert-tabs 6)
  (insert "(foreground-color . \"black\") ))) )))\n" ))

(defun insert-tabs (n)
;; http://stackoverflow.com/a/11830118/2112489
  "Inserts N number of tabs"
  (interactive "nNumber of tabs: ")
  (dotimes (i n)
    (indent-for-tab-command)))

Example
(source: lawlist.com)


Solution

  • May 3, 2014:  Initial answer -- apparent working solution.

    • A tab has a character code of 9.

    • The width of a tab is equal to only one (1) point.

    • A tab can be equal to one or more columns wide, depending upon the tab-width.

    • When dealing with tabs, determining the type of character that follows a particular column is problematic because . . . [to be filled in when I understand more].

    • When dealing with tabs, moving forward one (1) point and looking back is also problematic because . . . [to be filled in when I understand more].

    The working solution is to move one (1) column ahead and check the preceding character code -- if it is still a character code of 9, then do not place an overlay (at that preceding column). If the target column was already on a non-tab character, then moving forward one (1) column and looking back should logically yield the proper result.

    (defun test ()
    (interactive)
      (let* (my-last-column
          my-o-beg-a my-o-end-a (my-col-a 3)
          my-o-beg-b my-o-end-b (my-col-b 28)
          my-o-beg-c my-o-end-c (my-col-c 29) )
        (generate-test-buffer)
        (goto-char (point-max))
        (while (re-search-backward "\n" (point-min) t)
          (setq my-last-column (current-column))
          (setq my-o-beg-a (progn (move-to-column my-col-a) (point)))
          (setq my-o-end-a (+ 1 my-o-beg-a))
          (setq my-o-beg-b (progn (move-to-column my-col-b) (point)))
          (setq my-o-end-b (+ 1 my-o-beg-b))
          (setq my-o-beg-c (progn (move-to-column my-col-c) (point)))
          (setq my-o-end-c (+ 1 my-o-beg-c))
          (when (and
              (< my-col-a my-last-column)
              (not (progn (move-to-column (+ 1 my-col-a)) (eq (preceding-char) 9))))
            (overlay-put (make-overlay my-o-beg-a my-o-end-a) 'face '(
              (background-color . "cyan")
              (foreground-color . "black") )))
          (when (and
              (< my-col-b my-last-column)
              (not (progn (move-to-column (+ 1 my-col-b)) (eq (preceding-char) 9))))
            (overlay-put (make-overlay my-o-beg-b my-o-end-b) 'face '(
              (background-color . "yellow")
              (foreground-color . "black") )))
          (when (and
              (< my-col-b my-last-column)
              (not (progn (move-to-column (+ 1 my-col-c)) (eq (preceding-char) 9))))
            (overlay-put (make-overlay my-o-beg-c my-o-end-c) 'face '(
              (background-color . "red")
              (foreground-color . "black") ))) )))