Function: smerge--refine-highlight-change

smerge--refine-highlight-change is a byte-compiled function defined in smerge-mode.el.gz.

Signature

(smerge--refine-highlight-change BEG MATCH-NUM1 MATCH-NUM2 PROPS)

Source Code

;; Defined in /usr/src/emacs/lisp/vc/smerge-mode.el.gz
(defun smerge--refine-highlight-change (beg match-num1 match-num2 props)
  ;; TODO: Add a property pointing to the corresponding text in the
  ;; other region.
  (with-current-buffer (marker-buffer beg)
    (goto-char beg)
    (let* ((startline (- (string-to-number match-num1) 1))
           (beg (progn (funcall (if smerge-refine-weight-hack
                                    #'forward-char
                                  smerge-refine-forward-function)
                                startline)
                       (point)))
           (end (if (eq t match-num2) beg
                  (funcall (if smerge-refine-weight-hack
                               #'forward-char
                             smerge-refine-forward-function)
                           (if match-num2
                               (- (string-to-number match-num2)
                                  startline)
                             1))
                  (point))))
      (cl-assert (<= beg end))
      (when (and (eq t match-num2) (not (eolp)))
        ;; FIXME: No idea where this off-by-one comes from, nor why it's only
        ;; within lines.
        (setq beg (1+ beg))
        (setq end (1+ end))
        (goto-char end))
      (let ((olbeg beg)
            (olend end))
        (cond
         ((> end beg)
          (when smerge-refine-ignore-whitespace
            (let* ((newend (progn (skip-chars-backward " \t\n" beg) (point)))
                   (newbeg (progn (goto-char beg)
                                  (skip-chars-forward " \t\n" newend) (point))))
              (unless (= newend newbeg)
                (push `(smerge--refine-adjust ,(- newbeg beg) . ,(- end newend))
                      props)
                (setq olend newend)
                (setq olbeg newbeg)))))
         (t
          (cl-assert (= end beg))
          ;; If BEG=END, we have nothing to highlight, but we still want
          ;; to create an overlay that we can find with char properties,
          ;; so as to keep track of the position where a text was
          ;; inserted/deleted, so make it span at a char.
          (push (cond
                 ((< beg (point-max))
                  (setq olend (1+ beg))
                  '(smerge--refine-adjust 0 . -1))
                 (t (cl-assert (< (point-min) end))
                    (setq olbeg (1- end))
                    '(smerge--refine-adjust -1 . 0)))
                props)))

        (let ((ol (make-overlay
                   olbeg olend nil
                   ;; Make them tend to shrink rather than spread when editing.
                   'front-advance nil)))
          ;; (overlay-put ol 'smerge--debug
          ;;                 (list match-num1 match-num2 startline))
          (overlay-put ol 'evaporate t)
          (dolist (x props)
            (if (or (> end beg)
                    (not (memq (car-safe x) '(face font-lock-face))))
                (overlay-put ol (car x) (cdr x))
              ;; Don't highlight the char we cover artificially.
              ;; FIXME: We don't want to insert any space because it
              ;; causes misalignment.  A `:box' face with a line
              ;; only on one side would be a good solution.
              ;; (overlay-put ol (if (= beg olbeg) 'before-string 'after-string)
              ;;              (propertize
              ;;               " " (car-safe x) (cdr-safe x)
              ;;               'display '(space :width 0.5)))
              ))
          ol)))))