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