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 ;;;###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   (run-hook-with-args 'vlf-before-batch-functions 'ediff)
 158   (setq buffer-A (current-buffer)) ;names change, so reference by buffer object
 159   (let ((end-A (= vlf-start-pos vlf-end-pos))
 160         (chunk-A (cons vlf-start-pos vlf-end-pos))
 161         (point-max-A (point-max))
 162         (font-lock-A font-lock-mode)
 163         (min-file-size vlf-file-size)
 164         (forward-p (eq next-func 'vlf-next-chunk)))
 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     (let ((tramp-verbose (if (boundp 'tramp-verbose)
 171                              (min tramp-verbose 2)))
 172           (end-B (= vlf-start-pos vlf-end-pos))
 173           (chunk-B (cons vlf-start-pos vlf-end-pos))
 174           (font-lock-B font-lock-mode)
 175           (done nil)
 176           (reporter (make-progress-reporter
 177                      "Searching for difference..."
 178                      (if forward-p vlf-start-pos
 179                        (- min-file-size vlf-end-pos))
 180                      min-file-size)))
 181       (font-lock-mode 0)
 182       (unwind-protect
 183           (progn
 184             (while (and (or (not end-A) (not end-B))
 185                         (or (zerop (compare-buffer-substrings
 186                                     buffer-A (point-min) point-max-A
 187                                     buffer-B (point-min) (point-max)))
 188                             (with-current-buffer ediff-buffer
 189                               (ediff-update-diffs)
 190                               (and (not end-A) (not end-B)
 191                                    (vlf-ediff-refine buffer-A
 192                                                      buffer-B))
 193                               (zerop ediff-number-of-differences))))
 194               (funcall next-func)
 195               (setq end-B (= vlf-start-pos vlf-end-pos))
 196               (with-current-buffer buffer-A
 197                 (funcall next-func)
 198                 (setq end-A (= vlf-start-pos vlf-end-pos)
 199                       point-max-A (point-max)))
 200               (progress-reporter-update reporter
 201                                         (if forward-p vlf-end-pos
 202                                           (- vlf-file-size
 203                                              vlf-start-pos))))
 204             (progress-reporter-done reporter)
 205             (if (or (not end-A) (not end-B))
 206                 (progn (vlf-update-buffer-name)
 207                        (set-buffer buffer-A)
 208                        (vlf-update-buffer-name))
 209               (if forward-p
 210                   (let ((max-file-size vlf-file-size))
 211                     (vlf-move-to-chunk (- max-file-size vlf-batch-size)
 212                                        max-file-size)
 213                     (set-buffer buffer-A)
 214                     (setq max-file-size (max max-file-size
 215                                              vlf-file-size))
 216                     (vlf-move-to-chunk (- max-file-size
 217                                           vlf-batch-size)
 218                                        max-file-size))
 219                 (vlf-beginning-of-file)
 220                 (set-buffer buffer-A)
 221                 (vlf-beginning-of-file))
 222               (set-buffer ediff-buffer)
 223               (ediff-update-diffs)
 224               (if (or (not forward-p)
 225                       (and (not end-A) (not end-B)))
 226                   (vlf-ediff-refine buffer-A buffer-B)))
 227             (setq done t))
 228         (unless done
 229           (set-buffer buffer-A)
 230           (set-buffer-modified-p nil)
 231           (vlf-move-to-chunk (car chunk-A) (cdr chunk-A))
 232           (set-buffer buffer-B)
 233           (set-buffer-modified-p nil)
 234           (vlf-move-to-chunk (car chunk-B) (cdr chunk-B))
 235           (set-buffer ediff-buffer)
 236           (ediff-update-diffs)
 237           (vlf-ediff-refine buffer-A buffer-B))
 238         (set-buffer buffer-A)
 239         (if font-lock-A (font-lock-mode 1))
 240         (run-hook-with-args 'vlf-after-batch-functions 'ediff)
 241         (set-buffer buffer-B)
 242         (if font-lock-B (font-lock-mode 1))
 243         (run-hook-with-args 'vlf-after-batch-functions 'ediff)))))
 244
 245 (defun vlf-ediff-refine (buffer-A buffer-B)
 246   "Try to minimize differences between BUFFER-A and BUFFER-B.
 247 This can happen if first or last difference is at the start/end of
 248 buffer."
 249   (or (zerop ediff-number-of-differences)
 250       (let ((adjust-p (vlf-ediff-adjust buffer-A buffer-B)))
 251         (setq adjust-p (or (vlf-ediff-adjust buffer-A buffer-B t)
 252                            adjust-p))
 253         (if adjust-p (ediff-update-diffs)))))
 254
 255 (defun vlf-ediff-adjust (buf-A buf-B &optional end)
 256   "Additionally adjust buffer borders for BUF-A and BUF-B.
 257 Adjust beginning if END is nil.  Return t if refining is needed,
 258 nil otherwise."
 259   (let* ((diff-num (if end (1- ediff-number-of-differences) 0))
 260          (diff-A (ediff-get-diff-overlay diff-num 'A))
 261          (diff-B (ediff-get-diff-overlay diff-num 'B))
 262          diff-A-str diff-B-str adjust-p)
 263     (with-current-buffer buf-A
 264       (setq adjust-p (if end (= (overlay-end diff-A) (point-max))
 265                        (= (overlay-start diff-A) (point-min)))
 266             diff-A-str (and adjust-p (buffer-substring-no-properties
 267                                       (overlay-start diff-A)
 268                                       (overlay-end diff-A))))
 269       (set-buffer buf-B)
 270       (setq adjust-p (and adjust-p
 271                           (if end (= (overlay-end diff-B) (point-max))
 272                             (= (overlay-start diff-B) (point-min))))
 273             diff-B-str (and adjust-p (buffer-substring-no-properties
 274                                       (overlay-start diff-B)
 275                                       (overlay-end diff-B))))
 276       (if adjust-p
 277           (let ((len-A (length diff-A-str))
 278                 (len-B (length diff-B-str))
 279                 (adjust-func (if end 'vlf-ediff-adjust-end
 280                                'vlf-ediff-adjust-start)))
 281             (cond
 282              ((< len-A len-B)
 283               (or (funcall adjust-func diff-A-str diff-B-str buf-B)
 284                   (setq adjust-p nil)))
 285              ((< len-B len-A)
 286               (or (funcall adjust-func diff-B-str diff-A-str buf-A)
 287                   (setq adjust-p nil)))
 288              (t (setq adjust-p nil))))))
 289     adjust-p))
 290
 291 (defun vlf-ediff-adjust-start (diff-short diff-long vlf-buffer)
 292   "Remove difference between DIFF-SHORT and DIFF-LONG from beginning\
 293 of VLF-BUFFER."
 294   (when (string-suffix-p diff-short diff-long)
 295     (set-buffer vlf-buffer)
 296     (vlf-move-to-chunk (+ vlf-start-pos
 297                           (length (encode-coding-string
 298                                    (substring diff-long 0
 299                                               (- (length diff-long)
 300                                                  (length diff-short)))
 301                                    buffer-file-coding-system t)))
 302                        vlf-end-pos)))
 303
 304 (defun vlf-ediff-adjust-end (diff-short diff-long vlf-buffer)
 305   "Remove difference between DIFF-SHORT and DIFF-LONG from the end of\
 306 VLF-BUFFER."
 307   (when (string-prefix-p diff-short diff-long)
 308     (set-buffer vlf-buffer)
 309     (vlf-move-to-chunk vlf-start-pos
 310                        (- vlf-end-pos
 311                           (length (encode-coding-string
 312                                    (substring diff-long
 313                                               (length diff-short))
 314                                    buffer-file-coding-system t))))))
 315
 316 (unless (fboundp 'string-suffix-p)
 317   (defun string-suffix-p (suffix string  &optional ignore-case)
 318     "Return non-nil if SUFFIX is a suffix of STRING.
 319 If IGNORE-CASE is non-nil, the comparison is done without paying
 320 attention to case differences."
 321     (let ((start-pos (- (length string) (length suffix))))
 322       (and (>= start-pos 0)
 323            (eq t (compare-strings suffix nil nil string start-pos nil
 324                                   ignore-case))))))
 325
 326 (provide 'vlf-ediff)
 327
 328 ;;; vlf-ediff.el ends here