diff.el

diff.el

;; Separate string with escaped '\\n' literals.
;; These '\\n' literals will be interpreted by `echo'.
;;
;;   (broken "hello")
;; = "h\\ne\\nl\\nl\\no"
(defun broken (str)
  (mapconcat
   (lambda (x) (make-string 1 x))
   str
   "\\n"))

;; Performs character-wise `diff' on two comparison strings by
;; splitting them up by newline, and then interpreting them as files.
;;
;; (my-diff "hello" "hello_world")
;; = ""5a6,11
;; > _
;; > w
;; > o
;; > r
;; > l
;; > d
;; "
(defun my-diff (old new)
  (shell-command-to-string
   (format
    "diff <(echo -e '%s') <(echo -e '%s')"
    (broken old)
    (broken new))
   )
  )

;; Computes a list (list old new):
;;  + old string, with deleted and changed marked in red, and
;;  + new string, with added and changed marked in green.
(defun diff-main (old new)
  (interactive)
  (setq lines (split-string (my-diff old new) "\n"))
  ;; double traversal
  (setq diff-commands (mapcar #'parse-diff-header (seq-filter #'parse-diff-header lines)))
  (setq parsed (go diff-commands (cons 0 0) old new "" ""))
  )

(defun go (diff-commands pos old new new1 new2)
  (if (and (setq diff-command (car diff-commands))
           (setq diff-operation (nth 0 diff-command))
           (setq old-range (nth 1 diff-command))
           (setq old-range (cons (- (car old-range) (car pos))
                                  (- (cdr old-range) (car pos))))
           (setq new-range (nth 2 diff-command))
           (setq new-range (cons (- (car new-range) (cdr pos))
                                  (- (cdr new-range) (cdr pos))))
           ;; (message "Trace(%s):\n + %s\n + %s\n + %s\n + %s\n + %s\n + %s" diff-operation diff-commands pos old new new1 new2)
           )

      (cond ; APPEND
       ((equal diff-operation :append)
        (setq num-unchanged
              (if (equal (car old-range) (cdr old-range))
                  (car old-range)
                (error "not equal, in append")))
        (setq num-append
              (and (equal (- (car new-range) num-unchanged)
                          1)
                   (- (cdr new-range) num-unchanged)))

        (setq old-unchanged (seq-take old num-unchanged))
        (setq old-rest      (seq-drop old num-unchanged))
        (setq new-unchanged (seq-take new num-unchanged))
        (setq new-append    (seq-take (seq-drop new num-unchanged) num-append))
        (setq new-rest      (seq-drop new (+ num-unchanged num-append)))
        (setq new-pos
              (cons (+ (car pos) num-unchanged)
                    (+ (cdr pos) num-unchanged num-append)
                    )
              )
        (setq new1 (concat new1 old-unchanged))
        (setq new2 (concat new2 new-unchanged (green-bg new-append)))
        ;; (message
        ;;  "Trace APPEND:\n + num-unchanged: %s\n + num-append: %s\n + old-unchanged: %s\n + old-rest: %s\n + new-unchanged: %s\n + new-append: %s\n + new-rest: %s\n + new-pos: %s\n + new1: %s\n + new2: %s"
        ;;  num-unchanged
        ;;  num-append
        ;;  old-unchanged
        ;;  old-rest
        ;;  new-unchanged
        ;;  new-append
        ;;  new-rest
        ;;  new-pos
        ;;  new1
        ;;  new2
        ;;  )
        (go (cdr diff-commands) new-pos old-rest new-rest new1 new2)
        )
       ((equal diff-operation :delete)
        (setq num-unchanged
              (if (equal (car new-range) (cdr new-range))
                  (car new-range)
                (error "not equal, in append")))
        (setq num-deleted
              (and (equal (- (car old-range) num-unchanged)
                          1)
                   (- (cdr old-range) num-unchanged)))

        (setq old-unchanged (seq-take old num-unchanged))
        (setq old-deleted   (seq-take (seq-drop old num-unchanged) num-deleted))
        (setq old-rest      (seq-drop old (+ num-unchanged num-deleted)))
        (setq new-unchanged (seq-take new num-unchanged))
        (setq new-rest      (seq-drop new num-unchanged))

        (setq new-pos
              (cons (+ (car pos) num-unchanged num-deleted)
                    (+ (cdr pos) num-unchanged)
                    )
              )
        (setq new1 (concat new1 old-unchanged (red-bg old-deleted)))
        (setq new2 (concat new2 new-unchanged))

        ;; (message
        ;;  "Trace :DELETE:\n + num-unchanged: %s\n + num-deleted: %s\n + old-unchanged: %s\n + old-deleted: %s\n + old-rest: %s\n + new-unchanged: %s\n + new-rest: %s\n + new-pos: %s\n + new1: %s\n + new2: %s"
        ;;  num-unchanged
        ;;  num-deleted
        ;;  old-unchanged
        ;;  old-deleted
        ;;  old-rest
        ;;  new-unchanged
        ;;  new-rest
        ;;  new-pos
        ;;  new1
        ;;  new2
        ;;  )
        (go (cdr diff-commands) new-pos old-rest new-rest new1 new2)
        )

       ((equal diff-operation :change)
        (setq num-unchanged-old (1- (car old-range)))
        (setq num-unchanged-new (1- (car new-range)))
        (setq num-changed-old (1+ (- (cdr old-range) (car old-range))))
        (setq num-changed-new (1+ (- (cdr new-range) (car new-range))))

        (setq old-unchanged (seq-take old num-unchanged-old))
        (setq old-changed   (seq-take (seq-drop old num-unchanged-old) (+ num-changed-old)))
        (setq old-rest      (seq-drop old (+ num-unchanged-old num-changed-old)))

        (setq new-unchanged (seq-take new num-unchanged-new))
        (setq new-changed   (seq-take (seq-drop new num-unchanged-new) (+ num-changed-new)))
        (setq new-rest      (seq-drop new (+ num-unchanged-new num-changed-new)))

        (setq new-pos
              (cons (+ (car pos) num-unchanged-old num-changed-old)
                    (+ (cdr pos) num-unchanged-new num-changed-new)
                    )
              )

        (setq new1 (concat new1 old-unchanged (red-bg old-changed)))
        (setq new2 (concat new2 new-unchanged (green-bg new-changed)))
        ;; (message
        ;;  "Trace :CHANGE:\n + num-unchanged-old: %s\n + num-unchanged-new: %s\n + num-changed-old: %s\n + num-changed-new: %s\n + old-unchanged: %s\n + old-changed: %s\n + old-rest: %s\n + new-unchanged: %s\n + new-changed: %s\n + new-rest: %s\n + new-pos: %s\n + new1: %s\n + new2: %s"
        ;;  num-unchanged-old
        ;;  num-unchanged-new
        ;;  num-changed-old
        ;;  num-changed-new
        ;;  old-unchanged
        ;;  old-changed
        ;;  old-rest
        ;;  new-unchanged
        ;;  new-changed
        ;;  new-rest
        ;;  new-pos
        ;;  new1
        ;;  new2
        ;;  )

        (go (cdr diff-commands) new-pos old-rest new-rest new1 new2)
        )
       (t
        ;; "has diff command"
        diff-operation
        )
       )
                                        ; has no diff command
    (list (concat new1 old)
          (concat new2 new))
    )
  )

;;    (parse-diff-header "1000,5a200,200")
;; => (1000 5 "a" 200 200)
(defun parse-diff-header (header)
  (if (string-match "\\([0-9]+\\)\\(,[0-9]+\\)?\\(.\\)\\([0-9]+\\)\\(,[0-9]+\\)?" header)
      (progn
        (setq listi (list (match-string 1 header) (match-string 2 header) (match-string 3 header) (match-string 4 header)  (match-string 5 header)))
        (setq one
              (cons
               (string-to-number (nth 0 listi))
               (if (nth 1 listi)
                   (if (equal "," (seq-take (nth 1 listi) 1))
                       (string-to-number (seq-drop (nth 1 listi) 1))
                     (error "parse-diff-header: two: no comma"))
                 (string-to-number (nth 0 listi)))
               )
              )
        (setq two
              (cons
               (string-to-number (nth 3 listi))
               (if (nth 4 listi)
                   (if (equal "," (seq-take (nth 4 listi) 1))
                       (string-to-number (seq-drop (nth 4 listi) 1))
                     (error "parse-diff-header: two: no comma"))
                 (string-to-number (nth 3 listi)))
               )
              )
        (setq operation
              (cond
               ((equal "a" (nth 2 listi)) :append)
               ((equal "d" (nth 2 listi)) :delete)
               ((equal "c" (nth 2 listi)) :change)))
        (list operation one two)
        )
    )
  )