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

   1 ;;; vlf-ediff.el --- VLF ediff functionality
   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 ;;;###autoload
  38 (defun vlf-ediff-buffers (buffer-A buffer-B)
  39   "Run batch by batch ediff over VLF buffers BUFFER-A and BUFFER-B.
  40 Batch size is determined by the size in BUFFER-A.
  41 Requesting next or previous difference at the end or beginning
  42 respectively of difference list, runs ediff over the adjacent chunks."
  43   (interactive
  44    (let (bf)
  45      (list (setq bf (read-buffer "Buffer A to compare: "
  46                                  (ediff-other-buffer "") t))
  47            (read-buffer "Buffer B to compare: "
  48                         (progn
  49                           ;; realign buffers so that two visible bufs will be
  50                           ;; at the top
  51                           (save-window-excursion (other-window 1))
  52                           (ediff-other-buffer bf))
  53                         t))))
  54   (set-buffer buffer-A)
  55   (setq buffer-A (current-buffer)) ;names change, so reference by buffer object
  56   (let ((batch-size vlf-batch-size))
  57     (set-buffer buffer-B)
  58     (setq buffer-B (current-buffer))
  59     (vlf-set-batch-size batch-size))
  60   (ediff-buffers buffer-A buffer-B
  61                  '((lambda () (setq vlf-ediff-session t)
  62                      (vlf-ediff-next ediff-buffer-A ediff-buffer-B
  63                                      ediff-control-buffer
  64                                      'vlf-next-chunk)))))
  65
  66 ;;;###autoload
  67 (defun vlf-ediff-files (file-A file-B batch-size)
  68   "Run batch by batch ediff over FILE-A and FILE-B.
  69 Files are processed with VLF with BATCH-SIZE chunks.
  70 Requesting next or previous difference at the end or beginning
  71 respectively of difference list, runs ediff over the adjacent chunks."
  72   (interactive
  73    (let ((dir-A (if ediff-use-last-dir
  74                     ediff-last-dir-A
  75                   default-directory))
  76          dir-B f)
  77      (list (setq f (ediff-read-file-name
  78                     "File A to compare"
  79                     dir-A
  80                     (ediff-get-default-file-name)
  81                     'no-dirs))
  82            (ediff-read-file-name "File B to compare"
  83                                  (setq dir-B
  84                                        (if ediff-use-last-dir
  85                                            ediff-last-dir-B
  86                                          (file-name-directory f)))
  87                                  (progn
  88                                    (ediff-add-to-history
  89                                     'file-name-history
  90                                     (ediff-abbreviate-file-name
  91                                      (expand-file-name
  92                                       (file-name-nondirectory f)
  93                                       dir-B)))
  94                                    (ediff-get-default-file-name f 1)))
  95            (read-number "Batch size (in bytes): " vlf-batch-size))))
  96   (let ((buffer-A (vlf file-A)))
  97     (set-buffer buffer-A)
  98     (vlf-set-batch-size batch-size)
  99     (let ((buffer-B (vlf file-B)))
 100       (vlf-ediff-buffers buffer-A buffer-B))))
 101
 102 (defadvice ediff-next-difference (around vlf-ediff-next-difference
 103                                          compile activate)
 104   "Move to the next VLF chunk and search for difference if at the end\
 105 of difference list."
 106   (if (and vlf-ediff-session
 107            (<= (1- ediff-number-of-differences)
 108                ediff-current-difference))
 109       (let ((buffer-A ediff-buffer-A)
 110             (buffer-B ediff-buffer-B)
 111             (ediff-buffer (current-buffer)))
 112         (save-excursion
 113           (set-buffer buffer-A)
 114           (vlf-next-chunk)
 115           (set-buffer buffer-B)
 116           (vlf-next-chunk)
 117           (vlf-ediff-next buffer-A buffer-B ediff-buffer
 118                           'vlf-next-chunk))
 119         (or (zerop ediff-number-of-differences)
 120             (ediff-jump-to-difference 1)))
 121     ad-do-it))
 122
 123 (defadvice ediff-previous-difference (around vlf-ediff-prev-difference
 124                                              compile activate)
 125   "Move to the previous VLF chunk and search for difference if at the\
 126 beginning of difference list."
 127   (if (and vlf-ediff-session
 128            (<= ediff-current-difference 0))
 129       (let ((buffer-A ediff-buffer-A)
 130             (buffer-B ediff-buffer-B)
 131             (ediff-buffer (current-buffer)))
 132         (save-excursion
 133           (set-buffer buffer-A)
 134           (vlf-prev-chunk)
 135           (set-buffer buffer-B)
 136           (vlf-prev-chunk)
 137           (vlf-ediff-next buffer-A buffer-B ediff-buffer
 138                           'vlf-prev-chunk))
 139         (or (zerop ediff-number-of-differences)
 140             (ediff-jump-to-difference -1)))
 141     ad-do-it))
 142
 143 (defun vlf-next-chunk ()
 144   "Move to next chunk."
 145   (vlf-move-to-chunk vlf-end-pos (+ vlf-end-pos vlf-batch-size) t))
 146
 147 (defun vlf-prev-chunk ()
 148   "Move to previous chunk."
 149   (vlf-move-to-chunk (- vlf-start-pos vlf-batch-size) vlf-start-pos t))
 150
 151 (defun vlf-ediff-next (buffer-A buffer-B ediff-buffer
 152                                 &optional next-func)
 153   "Find next pair of chunks that differ in BUFFER-A and BUFFER-B\
 154 governed by EDIFF-BUFFER.  NEXT-FUNC is used to jump to the next
 155 logical chunks in case there is no difference at the current ones."
 156   (set-buffer buffer-A)
 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     (font-lock-mode 0)
 165     (set-buffer buffer-B)
 166     (setq buffer-B (current-buffer)
 167           min-file-size (min min-file-size vlf-file-size))
 168     (let ((tramp-verbose (min 2 tramp-verbose))
 169           (end-B (= vlf-start-pos vlf-end-pos))
 170           (chunk-B (cons vlf-start-pos vlf-end-pos))
 171           (font-lock-B font-lock-mode)
 172           (done nil)
 173           (reporter (make-progress-reporter
 174                      "Searching for difference..."
 175                      (if forward-p vlf-start-pos
 176                        (- min-file-size vlf-end-pos))
 177                      min-file-size)))
 178       (font-lock-mode 0)
 179       (unwind-protect
 180           (progn
 181             (while (and (or (not end-A) (not end-B))
 182                         (or (zerop (compare-buffer-substrings
 183                                     buffer-A (point-min) point-max-A
 184                                     buffer-B (point-min) (point-max)))
 185                             (with-current-buffer ediff-buffer
 186                               (ediff-update-diffs)
 187                               (and (not end-A) (not end-B)
 188                                    (vlf-ediff-refine buffer-A
 189                                                      buffer-B))
 190                               (zerop ediff-number-of-differences))))
 191               (funcall next-func)
 192               (setq end-B (= vlf-start-pos vlf-end-pos))
 193               (with-current-buffer buffer-A
 194                 (funcall next-func)
 195                 (setq end-A (= vlf-start-pos vlf-end-pos)
 196                       point-max-A (point-max)))
 197               (progress-reporter-update reporter
 198                                         (if forward-p vlf-end-pos
 199                                           (- vlf-file-size
 200                                              vlf-start-pos))))
 201             (progress-reporter-done reporter)
 202             (if (or (not end-A) (not end-B))
 203                 (progn (vlf-update-buffer-name)
 204                        (set-buffer buffer-A)
 205                        (vlf-update-buffer-name))
 206               (if forward-p
 207                   (let ((max-file-size vlf-file-size))
 208                     (vlf-move-to-chunk (- max-file-size vlf-batch-size)
 209                                        max-file-size)
 210                     (set-buffer buffer-A)
 211                     (setq max-file-size (max max-file-size
 212                                              vlf-file-size))
 213                     (vlf-move-to-chunk (- max-file-size
 214                                           vlf-batch-size)
 215                                        max-file-size))
 216                 (vlf-beginning-of-file)
 217                 (set-buffer buffer-A)
 218                 (vlf-beginning-of-file))
 219               (set-buffer ediff-buffer)
 220               (ediff-update-diffs)
 221               (if (or (not forward-p)
 222                       (and (not end-A) (not end-B)))
 223                   (vlf-ediff-refine buffer-A buffer-B)))
 224             (setq done t))
 225         (when font-lock-A
 226           (set-buffer buffer-A)
 227           (font-lock-mode 1))
 228         (when font-lock-B
 229           (set-buffer buffer-B)
 230           (font-lock-mode 1))
 231         (unless done
 232           (set-buffer buffer-A)
 233           (set-buffer-modified-p nil)
 234           (vlf-move-to-chunk (car chunk-A) (cdr chunk-A))
 235           (set-buffer buffer-B)
 236           (set-buffer-modified-p nil)
 237           (vlf-move-to-chunk (car chunk-B) (cdr chunk-B))
 238           (set-buffer ediff-buffer)
 239           (ediff-update-diffs)
 240           (vlf-ediff-refine buffer-A buffer-B))))))
 241
 242 (defun vlf-ediff-refine (buffer-A buffer-B)
 243   "Try to minimize differences between BUFFER-A and BUFFER-B.
 244 This can happen if first or last difference is at the start/end of
 245 buffer."
 246   (or (zerop ediff-number-of-differences)
 247       (let ((adjust-p (vlf-ediff-adjust buffer-A buffer-B)))
 248         (setq adjust-p (or (vlf-ediff-adjust buffer-A buffer-B t)
 249                            adjust-p))
 250         (if adjust-p (ediff-update-diffs)))))
 251
 252 (defun vlf-ediff-adjust (buf-A buf-B &optional end)
 253   "Additionally adjust buffer borders for BUF-A and BUF-B.
 254 Adjust beginning if END is nil.  Return t if refining is needed,
 255 nil otherwise."
 256   (let* ((diff-num (if end (1- ediff-number-of-differences) 0))
 257          (diff-A (ediff-get-diff-overlay diff-num 'A))
 258          (diff-B (ediff-get-diff-overlay diff-num 'B))
 259          diff-A-str diff-B-str adjust-p)
 260     (with-current-buffer buf-A
 261       (setq adjust-p (if end (= (overlay-end diff-A) (point-max))
 262                        (= (overlay-start diff-A) (point-min)))
 263             diff-A-str (and adjust-p (buffer-substring-no-properties
 264                                       (overlay-start diff-A)
 265                                       (overlay-end diff-A))))
 266       (set-buffer buf-B)
 267       (setq adjust-p (and adjust-p
 268                           (if end (= (overlay-end diff-B) (point-max))
 269                             (= (overlay-start diff-B) (point-min))))
 270             diff-B-str (and adjust-p (buffer-substring-no-properties
 271                                       (overlay-start diff-B)
 272                                       (overlay-end diff-B))))
 273       (if adjust-p
 274           (let ((len-A (length diff-A-str))
 275                 (len-B (length diff-B-str))
 276                 (adjust-func (if end 'vlf-ediff-adjust-end
 277                                'vlf-ediff-adjust-start)))
 278             (cond
 279              ((< len-A len-B)
 280               (or (funcall adjust-func diff-A-str diff-B-str buf-B)
 281                   (setq adjust-p nil)))
 282              ((< len-B len-A)
 283               (or (funcall adjust-func diff-B-str diff-A-str buf-A)
 284                   (setq adjust-p nil)))
 285              (t (setq adjust-p nil))))))
 286     adjust-p))
 287
 288 (defun vlf-ediff-adjust-start (diff-short diff-long vlf-buffer)
 289   "Remove difference between DIFF-SHORT and DIFF-LONG from beginning\
 290 of VLF-BUFFER."
 291   (when (string-suffix-p diff-short diff-long)
 292     (set-buffer vlf-buffer)
 293     (vlf-move-to-chunk (+ vlf-start-pos
 294                           (length (encode-coding-string
 295                                    (substring diff-long 0
 296                                               (- (length diff-long)
 297                                                  (length diff-short)))
 298                                    buffer-file-coding-system t)))
 299                        vlf-end-pos)))
 300
 301 (defun vlf-ediff-adjust-end (diff-short diff-long vlf-buffer)
 302   "Remove difference between DIFF-SHORT and DIFF-LONG from the end of\
 303 VLF-BUFFER."
 304   (when (string-prefix-p diff-short diff-long)
 305     (set-buffer vlf-buffer)
 306     (vlf-move-to-chunk vlf-start-pos
 307                        (- vlf-end-pos
 308                           (length (encode-coding-string
 309                                    (substring diff-long
 310                                               (length diff-short))
 311                                    buffer-file-coding-system t))))))
 312
 313 (unless (fboundp 'string-suffix-p)
 314   (defun string-suffix-p (suffix string  &optional ignore-case)
 315     "Return non-nil if SUFFIX is a suffix of STRING.
 316 If IGNORE-CASE is non-nil, the comparison is done without paying
 317 attention to case differences."
 318     (let ((start-pos (- (length string) (length suffix))))
 319       (and (>= start-pos 0)
 320            (eq t (compare-strings suffix nil nil string start-pos nil
 321                                   ignore-case))))))
 322
 323 (provide 'vlf-ediff)
 324
 325 ;;; vlf-ediff.el ends here