Function: track-changes--before

track-changes--before is a byte-compiled function defined in track-changes.el.gz.

Signature

(track-changes--before BEG END)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/track-changes.el.gz
(defun track-changes--before (beg end)
  (cl-assert track-changes--state)
  (cl-assert (<= beg end))
  (let* ((size (- end beg))
         (reset (lambda ()
                  (cl-assert track-changes--before-clean)
                  (setq track-changes--before-clean 'set)
                  (setf track-changes--before-string
                        (buffer-substring-no-properties beg end))
                  (setf track-changes--before-beg beg)
                  (setf track-changes--before-end end)))

         (signal-if-disjoint
          (lambda (pos1 pos2)
            (let ((distance (- pos2 pos1)))
              (when (> distance
                       ;; If the distance is smaller than the size of the
                       ;; current change, then we may as well consider it
                       ;; as "near".
                       (max (length track-changes--before-string)
                            size
                            (- track-changes--before-end
                               track-changes--before-beg)))
                (dolist (tracker track-changes--disjoint-trackers)
                  (funcall (track-changes--tracker-signal tracker)
                           tracker distance))
                ;; Return non-nil if the state was cleaned along the way.
                track-changes--before-clean)))))

    (if track-changes--before-clean
        (progn
          ;; Detect disjointedness with previous changes here as well,
          ;; so that if a client calls `track-changes-fetch' all the time,
          ;; it doesn't prevent others from getting a disjointedness signal.
          (when (and track-changes--before-beg
                     (let ((found nil))
                       (dolist (tracker track-changes--disjoint-trackers)
                         (unless (memq tracker track-changes--clean-trackers)
                           (setq found t)))
                       found))
            ;; There's at least one `tracker' that wants to know about disjoint
            ;; changes *and* it has unseen pending changes.
            ;; FIXME: This can occasionally signal a tracker that's clean.
            (if (< beg track-changes--before-beg)
                (funcall signal-if-disjoint end track-changes--before-beg)
              (funcall signal-if-disjoint track-changes--before-end beg)))
          (funcall reset))
      (save-restriction
        (widen)
        (cl-assert (<= (point-min)
                       track-changes--before-beg
                       track-changes--before-end
                       (point-max)))
        (when (< beg track-changes--before-beg)
          (if (and track-changes--disjoint-trackers
                   (funcall signal-if-disjoint end track-changes--before-beg))
              (funcall reset)
            (let* ((old-bbeg track-changes--before-beg)
                   ;; To avoid O(N²) behavior when faced with many small
                   ;; changes, we copy more than needed.
                   (new-bbeg
                    (min beg (max (point-min)
                                  (- old-bbeg
                                     (length track-changes--before-string))))))
              (setf track-changes--before-beg new-bbeg)
              (cl-callf (lambda (old new) (concat new old))
                  track-changes--before-string
                (buffer-substring-no-properties new-bbeg old-bbeg)))))

        (when (< track-changes--before-end end)
          (if (and track-changes--disjoint-trackers
                   (funcall signal-if-disjoint track-changes--before-end beg))
              (funcall reset)
            (let* ((old-bend track-changes--before-end)
                   ;; To avoid O(N²) behavior when faced with many small
                   ;; changes, we copy more than needed.
                   (new-bend
                    (max end (min (point-max)
                                  (+ old-bend
                                     (length track-changes--before-string))))))
              (setf track-changes--before-end new-bend)
              (cl-callf concat track-changes--before-string
                (buffer-substring-no-properties old-bend new-bend)))))))))