Question

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)

Was it helpful?

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") ))) )))
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top