code.delx.au - gnu-emacs-elpa/blob - packages/vlf/vlf-ediff.el

   1 ;;; vlf-ediff.el --- VLF ediff functionality  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
   4
   5 ;; Keywords: large files, compare, ediff
   6 ;; Author: Andrey Kotlarski <m00naticus@gmail.com>
   7 ;; URL: https://github.com/m00natic/vlfi
   8
   9 ;; This file is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 3, or (at your option)
  12 ;; any later version.
  13
  14 ;; This file is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25 ;; This package provides ediff functionality for VLF managed buffers
  26 ;; in face of the `vlf-ediff-buffers' and `vlf-ediff-files' commands.
  27
  28 ;;; Code:
  29
  30 (require 'vlf)
  31 (require 'ediff)
  32
  33 (defvar vlf-ediff-session nil
  34   "If non nil, specifies that ediff is done over VLF buffers.")
  35 (make-variable-buffer-local 'vlf-ediff-session)
  36
  37 (defun vlf-ediff-buffers (buffer-A buffer-B)
  38   "Run batch by batch ediff over VLF buffers BUFFER-A and BUFFER-B.
  39 Batch size is determined by the size in BUFFER-A.
  40 Requesting next or previous difference at the end or beginning
  41 respectively of difference list, runs ediff over the adjacent chunks."
  42   (interactive
  43    (let (bf)
  44      (list (setq bf (read-buffer "Buffer A to compare: "
  45                                  (ediff-other-buffer "") t))
  46            (read-buffer "Buffer B to compare: "
  47                         (progn
  48                           ;; realign buffers so that two visible bufs will be
  49                           ;; at the top
  50                           (save-window-excursion (other-window 1))
  51                           (ediff-other-buffer bf))
  52                         t))))
  53   (set-buffer buffer-A)
  54   (setq buffer-A (current-buffer)) ;names change, so reference by buffer object
  55   (let ((batch-size vlf-batch-size))
  56     (set-buffer buffer-B)
  57     (setq buffer-B (current-buffer))
  58     (vlf-set-batch-size batch-size))
  59   (ediff-buffers buffer-A buffer-B
  60                  '((lambda () (setq vlf-ediff-session t)
  61                      (vlf-ediff-next ediff-buffer-A ediff-buffer-B
  62                                      ediff-control-buffer
  63                                      'vlf-next-chunk)))))
  64
  65 ;;;###autoload
  66 (defun vlf-ediff-files (file-A file-B batch-size)
  67   "Run batch by batch ediff over FILE-A and FILE-B.
  68 Files are processed with VLF with BATCH-SIZE chunks.
  69 Requesting next or previous difference at the end or beginning
  70 respectively of difference list, runs ediff over the adjacent chunks."
  71   (interactive
  72    (let ((dir-A (if ediff-use-last-dir
  73                     ediff-last-dir-A
  74                   default-directory))
  75          dir-B f)
  76      (list (setq f (ediff-read-file-name
  77                     "File A to compare"
  78                     dir-A
  79                     (ediff-get-default-file-name)
  80                     'no-dirs))
  81            (ediff-read-file-name "File B to compare"
  82                                  (setq dir-B
  83                                        (if ediff-use-last-dir
  84                                            ediff-last-dir-B
  85                                          (file-name-directory f)))
  86                                  (progn
  87                                    (ediff-add-to-history
  88                                     'file-name-history
  89                                     (ediff-abbreviate-file-name
  90                                      (expand-file-name
  91                                       (file-name-nondirectory f)
  92                                       dir-B)))
  93                                    (ediff-get-default-file-name f 1)))
  94            (read-number "Batch size (in bytes): " vlf-batch-size))))
  95   (let ((buffer-A (vlf file-A t)))
  96     (set-buffer buffer-A)
  97     (vlf-set-batch-size batch-size)
  98     (let ((buffer-B (vlf file-B t)))
  99       (vlf-ediff-buffers buffer-A buffer-B))))
 100
 101 (defadvice ediff-next-difference (around vlf-ediff-next-difference
 102                                          compile activate)
 103   "Move to the next VLF chunk and search for difference if at the end\
 104 of difference list."
 105   (if (and vlf-ediff-session
 106            (<= (1- ediff-number-of-differences)
 107                ediff-current-difference))
 108       (let ((buffer-A ediff-buffer-A)
 109             (buffer-B ediff-buffer-B)
 110             (ediff-buffer (current-buffer)))
 111         (save-excursion
 112           (set-buffer buffer-A)
 113           (vlf-next-chunk)
 114           (set-buffer buffer-B)
 115           (vlf-next-chunk)
 116           (vlf-ediff-next buffer-A buffer-B ediff-buffer
 117                           'vlf-next-chunk))
 118         (or (zerop ediff-number-of-differences)
 119             (ediff-jump-to-difference 1)))
 120     ad-do-it))
 121
 122 (defadvice ediff-previous-difference (around vlf-ediff-prev-difference
 123                                              compile activate)
 124   "Move to the previous VLF chunk and search for difference if at the\
 125 beginning of difference list."
 126   (if (and vlf-ediff-session
 127            (<= ediff-current-difference 0))
 128       (let ((buffer-A ediff-buffer-A)
 129             (buffer-B ediff-buffer-B)
 130             (ediff-buffer (current-buffer)))
 131         (save-excursion
 132           (set-buffer buffer-A)
 133           (vlf-prev-chunk)
 134           (set-buffer buffer-B)
 135           (vlf-prev-chunk)
 136           (vlf-ediff-next buffer-A buffer-B ediff-buffer
 137                           'vlf-prev-chunk))
 138         (or (zerop ediff-number-of-differences)
 139             (ediff-jump-to-difference -1)))
 140     ad-do-it))
 141
 142 (defun vlf-next-chunk ()
 143   "Move to next chunk."
 144   (vlf-move-to-chunk vlf-end-pos (+ vlf-end-pos vlf-batch-size) t))
 145
 146 (defun vlf-prev-chunk ()
 147   "Move to previous chunk."
 148   (vlf-move-to-chunk (- vlf-start-pos vlf-batch-size) vlf-start-pos t))
 149
 150 (defun vlf-ediff-next (buffer-A buffer-B ediff-buffer
 151                                 &optional next-func)
 152   "Find next pair of chunks that differ in BUFFER-A and BUFFER-B\
 153 governed by EDIFF-BUFFER.  NEXT-FUNC is used to jump to the next
 154 logical chunks in case there is no difference at the current ones."
 155   (set-buffer buffer-A)
 156   (run-hook-with-args 'vlf-before-batch-functions 'ediff)
 157   (setq buffer-A (current-buffer)) ;names change, so reference by buffer object
 158   (let ((end-A (= vlf-start-pos vlf-end-pos))
 159         (chunk-A (cons vlf-start-pos vlf-end-pos))
 160         (point-max-A (point-max))
 161         (font-lock-A font-lock-mode)
 162         (min-file-size vlf-file-size)
 163         (forward-p (eq next-func 'vlf-next-chunk))
 164         (is-hexl (derived-mode-p 'hexl-mode)))
 165     (font-lock-mode 0)
 166     (set-buffer buffer-B)
 167     (run-hook-with-args 'vlf-before-batch-functions 'ediff)
 168     (setq buffer-B (current-buffer)
 169           min-file-size (min min-file-size vlf-file-size)
 170           is-hexl (or is-hexl (derived-mode-p 'hexl-mode)))
 171     (let ((tramp-verbose (if (boundp 'tramp-verbose)
 172                              (min tramp-verbose 2)))
 173           (end-B (= vlf-start-pos vlf-end-pos))
 174           (chunk-B (cons vlf-start-pos vlf-end-pos))
 175           (font-lock-B font-lock-mode)
 176           (done nil)
 177           (reporter (make-progress-reporter
 178                      "Searching for difference..."
 179                      (if forward-p vlf-start-pos
 180                        (- min-file-size vlf-end-pos))
 181                      min-file-size)))
 182       (font-lock-mode 0)
 183       (unwind-protect
 184           (progn
 185             (while (and (or (not end-A) (not end-B))
 186                         (or (zerop (compare-buffer-substrings
 187                                     buffer-A (point-min) point-max-A
 188                                     buffer-B (point-min) (point-max)))
 189                             (with-current-buffer ediff-buffer
 190                               (ediff-update-diffs)
 191                               (and (not end-A) (not end-B) (not is-hexl)
 192                                    (vlf-ediff-refine buffer-A
 193                                                      buffer-B))
 194                               (zerop ediff-number-of-differences))))
 195               (funcall next-func)
 196               (setq end-B (= vlf-start-pos vlf-end-pos))
 197               (with-current-buffer buffer-A
 198                 (funcall next-func)
 199                 (setq end-A (= vlf-start-pos vlf-end-pos)
 200                       point-max-A (point-max)))
 201               (progress-reporter-update reporter
 202                                         (if forward-p vlf-end-pos
 203                                           (- vlf-file-size
 204                                              vlf-start-pos))))
 205             (progress-reporter-done reporter)
 206             (if (or (not end-A) (not end-B))
 207                 (progn (vlf-update-buffer-name)
 208                        (set-buffer buffer-A)
 209                        (vlf-update-buffer-name))
 210               (if forward-p
 211                   (let ((max-file-size vlf-file-size))
 212                     (vlf-move-to-chunk (- max-file-size vlf-batch-size)
 213                                        max-file-size)
 214                     (set-buffer buffer-A)
 215                     (setq max-file-size (max max-file-size
 216                                              vlf-file-size))
 217                     (vlf-move-to-chunk (- max-file-size
 218                                           vlf-batch-size)
 219                                        max-file-size))
 220                 (vlf-beginning-of-file)
 221                 (set-buffer buffer-A)
 222                 (vlf-beginning-of-file))
 223               (set-buffer ediff-buffer)
 224               (ediff-update-diffs)
 225               (or is-hexl
 226                   (if (or (not forward-p)
 227                           (and (not end-A) (not end-B)))
 228                       (vlf-ediff-refine buffer-A buffer-B))))
 229             (setq done t))
 230         (unless done
 231           (set-buffer buffer-A)
 232           (set-buffer-modified-p nil)
 233           (vlf-move-to-chunk (car chunk-A) (cdr chunk-A))
 234           (set-buffer buffer-B)
 235           (set-buffer-modified-p nil)
 236           (vlf-move-to-chunk (car chunk-B) (cdr chunk-B))
 237           (set-buffer ediff-buffer)
 238           (ediff-update-diffs)
 239           (or is-hexl
 240               (vlf-ediff-refine buffer-A buffer-B)))
 241         (set-buffer buffer-A)
 242         (if font-lock-A (font-lock-mode 1))
 243         (run-hook-with-args 'vlf-after-batch-functions 'ediff)
 244         (set-buffer buffer-B)
 245         (if font-lock-B (font-lock-mode 1))
 246         (run-hook-with-args 'vlf-after-batch-functions 'ediff)))))
 247
 248 (defun vlf-ediff-refine (buffer-A buffer-B)
 249   "Try to minimize differences between BUFFER-A and BUFFER-B.
 250 This can happen if first or last difference is at the start/end of
 251 buffer."
 252   (or (zerop ediff-number-of-differences)
 253       (let ((adjust-p (vlf-ediff-adjust buffer-A buffer-B)))
 254         (setq adjust-p (or (vlf-ediff-adjust buffer-A buffer-B t)
 255                            adjust-p))
 256         (if adjust-p (ediff-update-diffs)))))
 257
 258 (defun vlf-ediff-adjust (buf-A buf-B &optional end)
 259   "Additionally adjust buffer borders for BUF-A and BUF-B.
 260 Adjust beginning if END is nil.  Return t if refining is needed,
 261 nil otherwise."
 262   (let* ((diff-num (if end (1- ediff-number-of-differences) 0))
 263          (diff-A (ediff-get-diff-overlay diff-num 'A))
 264          (diff-B (ediff-get-diff-overlay diff-num 'B))
 265          diff-A-str diff-B-str adjust-p)
 266     (with-current-buffer buf-A
 267       (setq adjust-p (if end (= (overlay-end diff-A) (point-max))
 268                        (= (overlay-start diff-A) (point-min)))
 269             diff-A-str (and adjust-p (buffer-substring-no-properties
 270                                       (overlay-start diff-A)
 271                                       (overlay-end diff-A))))
 272       (set-buffer buf-B)
 273       (setq adjust-p (and adjust-p
 274                           (if end (= (overlay-end diff-B) (point-max))
 275                             (= (overlay-start diff-B) (point-min))))
 276             diff-B-str (and adjust-p (buffer-substring-no-properties
 277                                       (overlay-start diff-B)
 278                                       (overlay-end diff-B))))
 279       (if adjust-p
 280           (let ((len-A (length diff-A-str))
 281                 (len-B (length diff-B-str))
 282                 (adjust-func (if end 'vlf-ediff-adjust-end
 283                                'vlf-ediff-adjust-start)))
 284             (cond
 285              ((< len-A len-B)
 286               (or (funcall adjust-func diff-A-str diff-B-str buf-B)
 287                   (setq adjust-p nil)))
 288              ((< len-B len-A)
 289               (or (funcall adjust-func diff-B-str diff-A-str buf-A)
 290                   (setq adjust-p nil)))
 291              (t (setq adjust-p nil))))))
 292     adjust-p))
 293
 294 (defun vlf-ediff-adjust-start (diff-short diff-long vlf-buffer)
 295   "Remove difference between DIFF-SHORT and DIFF-LONG from beginning\
 296 of VLF-BUFFER."
 297   (when (string-suffix-p diff-short diff-long)
 298     (set-buffer vlf-buffer)
 299     (vlf-move-to-chunk (+ vlf-start-pos
 300                           (length (encode-coding-string
 301                                    (substring diff-long 0
 302                                               (- (length diff-long)
 303                                                  (length diff-short)))
 304                                    buffer-file-coding-system t)))
 305                        vlf-end-pos)))
 306
 307 (defun vlf-ediff-adjust-end (diff-short diff-long vlf-buffer)
 308   "Remove difference between DIFF-SHORT and DIFF-LONG from the end of\
 309 VLF-BUFFER."
 310   (when (string-prefix-p diff-short diff-long)
 311     (set-buffer vlf-buffer)
 312     (vlf-move-to-chunk vlf-start-pos
 313                        (- vlf-end-pos
 314                           (length (encode-coding-string
 315                                    (substring diff-long
 316                                               (length diff-short))
 317                                    buffer-file-coding-system t))))))
 318
 319 (unless (fboundp 'string-suffix-p)
 320   (defun string-suffix-p (suffix string  &optional ignore-case)
 321     "Return non-nil if SUFFIX is a suffix of STRING.
 322 If IGNORE-CASE is non-nil, the comparison is done without paying
 323 attention to case differences."
 324     (let ((start-pos (- (length string) (length suffix))))
 325       (and (>= start-pos 0)
 326            (eq t (compare-strings suffix nil nil string start-pos nil
 327                                   ignore-case))))))
 328
 329 (provide 'vlf-ediff)
 330
 331 ;;; vlf-ediff.el ends here