Function: rectangle--highlight-for-redisplay

rectangle--highlight-for-redisplay is a byte-compiled function defined in rect.el.gz.

Signature

(rectangle--highlight-for-redisplay ORIG START END WINDOW ROL)

Source Code

;; Defined in /usr/src/emacs/lisp/rect.el.gz
(defun rectangle--highlight-for-redisplay (orig start end window rol)
  (cond
   ((not rectangle-mark-mode)
    (funcall orig start end window rol))
   (rectangle--inhibit-region-highlight
    (funcall redisplay-unhighlight-region-function rol)
    nil)
   ((and (eq 'rectangle (car-safe rol))
         (eq (nth 1 rol) (buffer-chars-modified-tick))
         (eq start (nth 2 rol))
         (eq end (nth 3 rol))
         (equal (rectangle--crutches) (nth 4 rol)))
    rol)
   (t
    (save-excursion
      (let* ((nrol nil)
             (old (if (eq 'rectangle (car-safe rol))
                      (nthcdr 5 rol)
                    (funcall redisplay-unhighlight-region-function rol)
                    nil)))
        (cl-assert (eq (window-buffer window) (current-buffer)))
        ;; `rectangle--pos-cols' looks up the `selected-window's parameter!
        (with-selected-window window
          (apply-on-rectangle
           (lambda (leftcol rightcol)
             (let* ((mleft (move-to-column leftcol))
                    (left (point))
                    ;; BEWARE: In the presence of other overlays with
                    ;; before/after/display-strings, this happens to move to
                    ;; the column "as if the overlays were not applied", which
                    ;; is sometimes what we want, tho it can be
                    ;; considered a bug in move-to-column (it should arguably
                    ;; pay attention to the before/after-string/display
                    ;; properties when computing the column).
                    (mright (move-to-column rightcol))
                    (right (point))
                    (ol
                     (if (not old)
                         (let ((ol (make-overlay left right)))
                           (overlay-put ol 'window window)
                           (overlay-put ol 'face 'region)
                           ol)
                       (let ((ol (pop old)))
                         (move-overlay ol left right (current-buffer))
                         ol))))
               ;; `move-to-column' may stop before the column (if bumping into
               ;; EOL) or overshoot it a little, when column is in the middle
               ;; of a char.
               (cond
                ((< mleft leftcol)      ;`leftcol' is past EOL.
                 (overlay-put ol 'before-string (rectangle--space-to leftcol))
                 (setq mright (max mright leftcol)))
                ((and (> mleft leftcol) ;`leftcol' is in the middle of a char.
                      (eq (char-before left) ?\t))
                 (setq left (1- left))
                 (move-overlay ol left right)
                 (goto-char left)
                 (overlay-put ol 'before-string (rectangle--space-to leftcol)))
                ((overlay-get ol 'before-string)
                 (overlay-put ol 'before-string nil)))
               (cond
                ;; While doing rectangle--string-preview, the two sets of
                ;; overlays steps on the other's toes.  I fixed some of the
                ;; problems, but others remain.  The main one is the two
                ;; (rectangle--space-to rightcol) below which try to virtually
                ;; insert missing text, but during "preview", the text is not
                ;; missing (it's provided by preview's own overlay).
                (rectangle--string-preview-state
                 (if (overlay-get ol 'after-string)
                     (overlay-put ol 'after-string nil)))
                ((< mright rightcol)    ;`rightcol' is past EOL.
                 (let ((str (rectangle--space-to rightcol)))
                   (put-text-property 0 (length str) 'face 'region str)
                   ;; If cursor happens to be here, draw it at the right place.
                   (rectangle--place-cursor leftcol left str)
                   (overlay-put ol 'after-string str)))
                ((and (> mright rightcol) ;`rightcol's in the middle of a char.
                      (eq (char-before right) ?\t))
                 (setq right (1- right))
                 (move-overlay ol left right)
                 (if (= rightcol leftcol)
                     (overlay-put ol 'after-string nil)
                   (goto-char right)
                   (let ((str (rectangle--space-to rightcol)))
                     (put-text-property 0 (length str) 'face 'region str)
                     (when (= left right)
                       (rectangle--place-cursor leftcol left str))
                     (overlay-put ol 'after-string str))))
                ((overlay-get ol 'after-string)
                 (overlay-put ol 'after-string nil)))
               (when (and (= leftcol rightcol) (display-graphic-p))
                 ;; Make zero-width rectangles visible!
                 (overlay-put ol 'after-string
                              (concat (propertize " "
                                                  'face '(region (:height 0.2)))
                                      (overlay-get ol 'after-string))))
               (push ol nrol)))
           start end))
        (mapc #'delete-overlay old)
        `(rectangle ,(buffer-chars-modified-tick)
                    ,start ,end ,(rectangle--crutches)
                    ,@nrol))))))