Emacs — modifying `fill-column-indicator.el` to di

2019-04-12 12:01发布

问题:

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 http://www.lawlist.com/images/fill_column_indicator.png

回答1:

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 http://www.lawlist.com/images/fill_column_indicator_b.png



标签: emacs elisp