Search code examples
emacselisp

Emacs -- modifying `fill-column-indicator.el` to display over whitespace


I am looking for some assistance, please, to modify fill-column-indicator.el by Alp Aker so that the vertical line is visible over whitespace (regardless of whether whitespace-mode is active).

Here is the link to the Github repository for the library:

https://github.com/alpaker/Fill-Column-Indicator/blob/master/fill-column-indicator.el

At the present time, the vertical line is not visible over whitespace.

The following code, when combined with fill-column-indicator.el, creates a vertical line that tracks the current cursor column position. I've examined the code of fill-column-indicator.el, however, I haven't been able to locate the portion of code that prevents the vertical line from appearing when whitespace is present.

(defun fci-mode-current-column ()
  (setq fill-column (current-column))
  (setq cursor-type '(hbar . 2))
  (fci-mode t))

(add-hook 'post-command-hook 'fci-mode-current-column)

Example
(source: lawlist.com)


Solution

  • May 1, 2014:  Created a first working draft.

    May 2, 2014:  Modified several fci-mode functions, and portions of the prior draft have been included.

    May 3, 2014:  Fixed highlighting of column to the right of a tab. Incorporated a quasi-post-command-hook to control precisely when the buffer is redrawn with the vertical ruler, and removed the hooks previously used by fci-mode.

    May 4, 2014:  Added partial compatibility with whitespace-mode using settings of (setq whitespace-style '(face space-mark tab-mark newline-mark) ). The foreground for tab-mark and newline-mark are highlighted. However, the background is not highlighted due to the fact each mark spans more than one column (yet the width of point is only equal to one).


    ;;;;;;;;;;;;;;;;;;;;;;;;; LAWLIST MODIFICATIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;; http://stackoverflow.com/a/23418459/2112489
    ;;
    ;; In order to use these modifications to enable vertical highlighting of the
    ;; current column, the library `fill-column-indicator.el` by Alp Aker is needed.
    ;;   https://github.com/alpaker/Fill-Column-Indicator
    ;; The code set forth hereinbelow is intended to replace functions or variables
    ;; within the aforementioned library that contain the same names.  There are
    ;; also a few new functions and variables below.
    
    (define-minor-mode fci-mode
      :group 'fci-mode
      :lighter " fci"
      :global nil
      :init-value nil
      (if fci-mode
          ;; Enabling.
          (condition-case error
              (progn
                (fci-check-user-options)
                (fci-process-display-table)
                (fci-set-local-vars)
                (fci-get-frame-dimens)
                ;; (dolist (hook fci-hook-assignments)
                ;;   (add-hook (car hook) (nth 1 hook) nil (nth 2 hook)))
                (setq fci-column (current-column))
                (setq fci-tab-width tab-width)
                (setq fci-limit
                  (if fci-newline
                    (1+ (- fci-column (length fci-saved-eol)))
                    fci-column))
                (fci-make-overlay-strings)
                (fci-update-all-windows t)
                (if linum-mode
                (linum-update-current)))
            (error
             (fci-mode 0)
             (signal (car error) (cdr error))))
        ;; Disabling.
        (fci-restore-display-table)
        (fci-restore-local-vars)
        (dolist (hook fci-hook-assignments)
          (remove-hook (car hook) (nth 1 hook) (nth 2 hook)))
        (fci-delete-overlays-buffer)
        (dolist (var fci-internal-vars)
          (set var nil))))
    
    (defvar my-column-overlay nil
      "The overlays used in this buffer.")
    (make-variable-buffer-local 'my-column-overlay)
    
    (defvar my-cursor-point nil
    "Point used to prevent the formation of a cursor overlay.
    It must be set within the function `fci-redraw-region`.")
    (make-variable-buffer-local 'my-cursor-point)
    
    (defun fci-put-overlays-region (start end)
    "Place overlays displaying the fill-column rule between START and END."
      (let* (my-last-column fci-overlay my-overlay-beg my-overlay-end)
        (setq cursor-type 'hollow)
        (goto-char end)
        (while (re-search-backward "\n" start t)
          (setq my-last-column (current-column))
          (setq fci-overlay (make-overlay (match-beginning 0) (match-beginning 0)))
          (overlay-put fci-overlay 'fci t)
          (cond
           ((< my-last-column fci-limit)
            (overlay-put fci-overlay 'after-string fci-pre-limit-string))
           ((> my-last-column fci-limit)
            (overlay-put fci-overlay 'after-string fci-post-limit-string))
           (t
            (overlay-put fci-overlay 'after-string fci-at-limit-string)))
          (setq my-overlay-beg (progn (move-to-column fci-column) (point)))
          (setq my-overlay-end (+ 1 my-overlay-beg))
          (setq my-column-overlay (make-overlay my-overlay-beg my-overlay-end ))
          (cond
            ;; text, excluding tabs
            ((and
                (not (save-excursion (move-to-column (+ 1 fci-column))
                  (eq (preceding-char) 9)))
                (not (eq my-cursor-point my-overlay-beg))
                (< fci-column my-last-column))
              (overlay-put my-column-overlay 'face
                '(:background "DarkRed") ) )
            ;; tab with text to the right
            ((and
                (not (bobp)) ;; do NOT try to go beyond the beginning of the buffer
                (not (not (save-excursion (move-to-column fci-column)
                  (backward-char 1) (eq (char-after (point)) 9))))
                (not (save-excursion (move-to-column (+ 1 fci-column))
                  (eq (char-after (point)) 9)))
                (save-excursion (move-to-column fci-column)
                  (eq (char-after (point)) 9))
                (not (eq my-cursor-point my-overlay-beg))
                (< fci-column my-last-column))
              (overlay-put my-column-overlay 'face
                '(:foreground "Red" :weight bold) ) )
            ;; tab with text to the left
            ((and
                (not (bobp)) ;; do NOT try to go beyond the beginning of the buffer
                (not (save-excursion (move-to-column fci-column)
                  (backward-char 1) (eq (char-after (point)) 9)))
                (save-excursion (move-to-column fci-column)
                  (eq (char-after (point)) 9))
                (not (eq my-cursor-point my-overlay-beg))
                (< fci-column my-last-column))
              (overlay-put my-column-overlay 'face
                '(:foreground "Red" :weight bold) ) )
            ;; tab sandwiched between a tab on each side
            ((and
                (not (bobp)) ;; do NOT try to go beyond the beginning of the buffer
                (save-excursion (move-to-column fci-column)
                  (eq (char-after (point)) 9))
                (not (eq
                  (save-excursion (move-to-column fci-column)
                    (re-search-backward "\t" (point-at-bol) t) (point))
                  (save-excursion (move-to-column (+ fci-column 1))
                    (re-search-backward "\t" (point-at-bol) t) (point))))
                (not (eq my-cursor-point my-overlay-beg))
                (< fci-column my-last-column))
              (overlay-put my-column-overlay 'face
                '(:foreground "Red" :weight bold) ) )
            ;; end of line
            ((= fci-column my-last-column)
              (overlay-put my-column-overlay 'face
                '(:foreground "Red" :weight bold) ) ) 
            ;; cursor
            ((and
                (eq my-cursor-point my-overlay-beg)
                (not (eq (preceding-char) 9))
                (< fci-column my-last-column))
              (overlay-put my-column-overlay 'face
                '(:weight bold) ) )) )))
    
    (defun fci-delete-overlays-region (start end)
      "Delete overlays displaying the fill-column rule between START and END."
      (mapc #'(lambda (o) (if (overlay-get o 'fci) (delete-overlay o)))
            (overlays-in start end))
      (let ((ovs (overlays-in start end)))
        (dolist (ov ovs)
          (unless (member ov (list hl-line-overlay))
            (delete-overlay ov)))) )
    
    (defun fci-redraw-region (start end _ignored)
      "Erase and redraw the fill-column rule between START and END."
      ;; Needed to prevent and then ultimately create a cursor overlay.
      (setq my-cursor-point (point))
      (save-match-data
        (save-excursion
          (let ((inhibit-point-motion-hooks t))
            (goto-char end)
            (setq end (line-beginning-position 2))
            (fci-delete-overlays-region start end)
            (fci-put-overlays-region start end)))))
    
    (defvar quasi-this-command-functions '(next-line previous-line left-char right-char
      self-insert-command newline delete-backward-char delete-forward-char
      indent-for-tab-command mwheel-scroll lawlist-mwheel-scroll end-of-visual-line
      beginning-of-visual-line end-of-buffer beginning-of-buffer lawlist-forward-entity
      lawlist-backward-entity left-word right-word forward-word backward-word
      lawlist-forward-element lawlist-backward-element)
    "Variable list of functions that trigger the `fci-quasi-post-command-hook`.")
    
    (defvar fci-quasi-major-mode-inclusions '(text-mode emacs-lisp-mode perl-mode
      js-mode css-mode dired-mode lawlist-tex-mode c-mode html-mode snippet-mode)
    "Variable list of major modes where the `fci-quasi-post-command-hook` operates.")
    
    (defun fci-quasi-post-command-hook ()
      (unless (minibufferp)
        (when
          (and
            (memq major-mode fci-quasi-major-mode-inclusions)
            (memq this-command quasi-this-command-functions))
          (fci-mode 1))))
    
    (add-hook 'post-command-hook 'fci-quasi-post-command-hook)
    
    (add-hook 'change-major-mode-hook 'fci-quasi-post-command-hook)
    
    (add-hook 'window-configuration-change-hook 'fci-quasi-post-command-hook)
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    

    Example
    (source: lawlist.com)