Source

xetla / smerge.el

Full commit
youngs 873b1ac 



































































































































































































































































































































































































































































  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
;;; smerge.el --- SAM's Merge layer on top of ediff

;; Copyright (C) 2002,2003 Sean MacLennan
;; $Revision$ $Date$
;; XEmacs

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;; TODO:
;;      - keymap for buffer!
;;	- ediff needs a list of args
;;	- add more documentation!!!

;; smerge marks the file with the `smerge-merged-face' when the files
;; are merged. In the case of "only in" files, merged means you copied
;; the file over to the other directory. However, for ediffed files,
;; merged means you ran ediff on the files. This does not mean the
;; files are identical. And you are allowed to run ediff on the files
;; again. It is really just a marker that you looked at the file.

(require 'ediff)

(defmacro smerge-do-in-gnu-emacs (&rest body)
  "Execute BODY if in GNU/Emacs."
  (unless running-xemacs `(progn ,@body)))
(put 'smerge-do-in-gnu-emacs 'lisp-indent-hook 'defun)

(defmacro smerge-do-in-xemacs (&rest body)
  "Execute BODY if in XEmacs."
  (when running-xemacs `(progn ,@body)))
(put 'smerge-do-in-xemacs 'lisp-indent-hook 'defun)


(smerge-do-in-xemacs
  (defalias 'smerge-dirlist 'directory-files))

(smerge-do-in-gnu-emacs
  (require 'extent)

  (defun smerge-dirlist (directory &optional full match nosort files-only)
    (if (eq files-only nil)
	(directory-files directory full match nosort)
      (let ((rawlist (directory-files-and-attributes
		      directory full match nosort))
	    dirlist)
	(setq files-only (if (eq files-only t) nil t))
	(dolist (entry rawlist)
	  (when (eq (nth 1 entry) files-only)
	    (setq dirlist (cons (car entry) dirlist))))
	dirlist)))

  (defun temp-directory ()
    (let ((tmp (getenv "TMPDIR")))
      (if tmp tmp "/tmp")))

  (defun read-directory-name (prompt &optional dir default mustmatch)
    (let* ((dir (read-file-name prompt dir default mustmatch))
	   (attr (file-attributes dir)))
      (unless (eq (car attr) t) (error "Must be a directory"))
      dir))

  (defun kill-entire-line (&optional arg)
    (let ((kill-whole-line t)) (beginning-of-line) (kill-line arg)))
  )

(defvar smerge-diff-program ediff-diff-program
  "*Program to use to diff the directories. Must support --brief option.")

(defvar smerge-diff-options ediff-diff-options "*See `ediff-diff-options'.")

(defvar smerge-diff-excludes '("*.o" "*.obj" "*.a" "*.lib" "*~" ".#*" "CVS")
  "*List of patterns of files and subdirectories to ignore.
smerge builds a temprorary file (`smerge-exclude-file') based on this list
and passes it to `smerge-diff-program' with the --exclude-from option.
Note: These excludes are wildcard expressions as used by diff, not lisp
regular expressions.")

(defvar smerge-preserve-modes t
  "*When copying files, preserver the mode of the destination file.")

(defvar smerge-exclude-file (concat (temp-directory) "/smerge-excludes")
  "*Temporary file to hold the `smerge-excludes'.")

(defface smerge-only1-face
  '((((class color))  (:foreground "purple"))
    (t (:underline t)))
  "Face for files/directories only in directory 1.")

(defface smerge-only2-face
  '((((class color))  (:foreground "blue"))
    (t (:underline t)))
  "Face for files/directories only in directory 2.")

(defface smerge-diff-face
  '((((class color))  (:foreground "red"))
    (t (:bold t)))
  "Face for files that are different.")

(defface smerge-merged-face
  '((((class color))  (:foreground "black"))
    (t (:bold t)))
  "Face for files that are merged.")


(defvar smerge-buffer "*smerge-output*" "*Name of smerge output buffer.")

(defvar smerge-keymap nil "*Keymap used by smerge.")

(defvar smerge-cvsignore nil
  "*If non-nil, use the .cvsignore files in `dir1' to ignore files.")

;; For debugging
(defvar smerge-raw-diff-output nil
  "*If non-nil, filename to write the raw diff output to. (dbg)")
(defvar smerge-keep-cvsignore-buffer nil
  "*If non-nil, keep the raw cvsignore buffer. (dbg)")

;; Internals
;; SAM This should be a list?
(defvar smerge-flags nil)
(defvar smerge-dir1 nil)
(defvar smerge-dir2 nil)
(defvar smerge-file nil)
(defvar smerge-extent nil)


(defconst smerge-copy-menu
  (list "Copy to ..."
	[(concat smerge-dir1 smerge-file) (smerge-copy 1) (smerge-allow-dir 1)]
	[(concat smerge-dir2 smerge-file) (smerge-copy 2) (smerge-allow-dir 2)]
	))

(defun smerge-init ()
  "This creates the keymap."
  (unless smerge-keymap
    (setq smerge-keymap (make-sparse-keymap "smerge"))
    (if running-xemacs
	(progn
	  (define-key smerge-keymap 'button1 'smerge-mousable)
	  (define-key smerge-keymap 'button2 'smerge-mousable)
	  (define-key smerge-keymap 'button3 'smerge-menu))
      (define-key smerge-keymap [mouse-1] 'smerge-mousable)
      (define-key smerge-keymap [mouse-2] 'smerge-mousable)
      (define-key smerge-keymap [mouse-3] 'smerge-menu))

    (define-key smerge-keymap "\C-m" 'smerge-ediff-or-copy)
    (define-key smerge-keymap "g"    'smerge-reload)
    (define-key smerge-keymap "r"    'smerge-reload)
    (define-key smerge-keymap "n"    'smerge-next)
    (define-key smerge-keymap "p"    'smerge-prev)
    ))

;;;###autoload
(defun smerge (flags &optional dir1 dir2)
  "Merge two directories recursively."
  (interactive "p")
  (smerge-init)
  (unless dir1
    (setq dir1 (read-directory-name "Directory 1: " nil nil t)))
  (unless dir2
    (setq dir2 (read-directory-name "Directory 2: " nil nil t)))
  (switch-to-buffer smerge-buffer) ;; Yes I want to be in the output buffer
  (toggle-read-only 0) ;; writable
  (setq smerge-flags flags)
  (setq smerge-dir1 (file-name-as-directory (expand-file-name dir1)))
  (setq smerge-dir2 (file-name-as-directory (expand-file-name dir2)))
  (smerge-recursive-diff)
  (smerge-fixup-filenames)
  (when smerge-cvsignore (smerge-cvsignore smerge-dir1))
  (smerge-post-process flags)
  (toggle-read-only 1) ;; read-only
  )

(defun smerge-reload ()
  "Rediff two directories recursively."
  (interactive)
  (smerge smerge-flags smerge-dir1 smerge-dir2))

(defun smerge-recursive-diff ()
  (let (rc)
    (erase-buffer)
    (dolist (exclude smerge-diff-excludes) (insert (concat exclude "\n")))
    (write-region (point-min) (point-max) smerge-exclude-file nil 'no-message)
    (erase-buffer)
    (let ((diff-options (concat "--exclude-from=" smerge-exclude-file
			      " -r" " --brief " smerge-diff-options)))
      ;; Since we are tightly coupled with ediff, use their program!
      ;; This erases the diff buffer automatically.
      (ediff-exec-process smerge-diff-program
			  (current-buffer)
			  'synchronize
			  diff-options
			  smerge-dir1 smerge-dir2))
    (delete-file smerge-exclude-file)
    (when smerge-raw-diff-output
      (write-region (point-min) (point-max) smerge-raw-diff-output))
    (and (numberp rc) (eq rc 0))))

(defun smerge-fixup-filenames ()
  "Diff splits the `Only in' files into directory and filename.
Top level directories end in /, subdirs do not."
  (goto-char (point-min))
  (while (re-search-forward "^\\(Only in [^:]*\\)\\(.\\): " nil t)
    (if (string= (match-string 2) "/")
	(replace-match "\\1/" nil nil)
      (replace-match "\\1\\2/" nil nil))))

(defun smerge-post-process (flags)
  (let (match extent file start)
    (goto-char (point-min))
    (insert (format "Diff %s and %s\n\n" smerge-dir1 smerge-dir2))
    (setq start (point))

    (cond ((> flags 4) ;; c-u c-u
	   ;; Remove different files
	   (while (re-search-forward "^Files .*\n" nil t)
	     (replace-match "")))
	  ((> flags 1) ;; c-u
	   ;; Remove the unique files
	   (while (re-search-forward "^Only in .*\n" nil t)
	     (replace-match ""))))

    ;; Only in 1
    (setq match (format "^Only in %s\\(.*\\)$" smerge-dir1))
    (goto-char (point-min))
    (while (re-search-forward match nil t)
      (setq file (match-string 1))
      (setq extent
	    (smerge-make-extent (match-beginning 0) (match-end 0) 'smerge-only1-face))
      (set-extent-property extent 'type 2)
      (replace-match file)
      )

    ;; Only in 2
    (setq match (format "^Only in %s\\(.*\\)$" smerge-dir2))
    (goto-char (point-min))
    (while (re-search-forward match nil t)
      (setq file (match-string 1))
      (setq extent
	    (smerge-make-extent (match-beginning 0) (match-end 0) 'smerge-only2-face))
      (set-extent-property extent 'type 1)
      (replace-match (concat "\t\t\t\t" file))
      )

    ;; Both
    (setq match (format "^Files %s\\(.+\\) and %s.+ differ$" smerge-dir1 smerge-dir2))
    (goto-char (point-min))
    (while (re-search-forward match nil t)
      (setq file (match-string 1))
      (setq extent
	    (smerge-make-extent (match-beginning 0) (match-end 0) 'smerge-diff-face))
      (set-extent-property extent 'type 3)
      (replace-match (concat "\t\t" file))
      )

    ;; Back to start
    (goto-char start)
    (if (re-search-forward "\\w" nil t) (forward-char -1))
    ))

(autoload 'defadvice "advice" nil nil 'macro)

(defadvice ediff-quit (after smerge activate)
  (when (extentp smerge-extent)
    (set-extent-property smerge-extent 'face 'smerge-merged-face) ;; SAM
    (delete-other-windows)
    (switch-to-buffer smerge-buffer)
    (let ((next (next-extent smerge-extent))
	  start)
      (when next
	(setq start (extent-start-position next))
	(goto-char start)
	(if (re-search-forward "\\w" nil t) (forward-char -1))
	))
    (setq smerge-extent nil) ;; done
    ))

(defun smerge-file (extent)
  "Given a smerge extent, return the file name."
  (let ((file (buffer-substring
	       (extent-start-position extent)
	       (extent-end-position extent))))
    (string-match "\t*\\(.*\\)" file)
    (match-string 1 file)))

(defun smerge-menu (event)
  "This is called on a right mouse click in the display window.
Pops up a menu that allows copying the file to directory one or two."
  (interactive "e")
  (let ((extent (extent-at (event-point event))))
    (unless extent (error "No extent at point"))
    (setq smerge-file (smerge-file extent))
    (setq smerge-extent extent)
    (popup-menu smerge-copy-menu)))


(defun smerge-mousable (event)
  "This is called on a left or middle mouse click in the display window."
  (interactive "e")
  (smerge-ediff (extent-at (event-point event))))

(defun smerge-ediff-or-copy ()
  "Ediff or copy the file."
  (interactive)
  (let* ((extent (extent-at (point)))
	 (type (extent-property extent 'type)))
    (unless extent (error "No extent at point"))
    (cond ((or (eq type 1) (eq type 2))
	   (setq smerge-file (smerge-file extent))
	   (smerge-copy 1 t))
	  ((eq type 3) (smerge-ediff extent))
	  (t (beep)))))

(defun smerge-ediff (&optional extent)
  "Ediff the two files."
  (interactive)
  (let (file)
    (unless extent
      (setq extent (extent-at (point)))
      (unless extent (error "No extent at point")))
    (if (eq (extent-property extent 'type) 3)
	(progn
	  (setq smerge-extent extent)
	  (setq file (smerge-file extent))
	  (ediff-files
	   (concat smerge-dir1 file) (concat smerge-dir2 file)))
      (beep))))


(defun smerge-allow-dir (dir)
  "Are we allowed to copy to this directory."
  (let ((type (extent-property smerge-extent 'type)))
    (if type
	(> (logand (extent-property smerge-extent 'type) dir) 0)
      (message "WARNING: No type for extent!")
      0)))

;; Copy file preserving the destination modes if necessary
(defun smerge-copy-file (src dst &optional ok-if-already-exists keep-time)
  (let ((modes (file-modes dst)))
    (copy-file src dst ok-if-already-exists keep-time)
    (and smerge-preserve-modes
	 modes
	 (set-file-modes dst modes))))

(defun smerge-copy (dir &optional ask)
  "Do the copy to the directory specified."
  (let ((file1 (concat smerge-dir1 smerge-file))
	(file2 (concat smerge-dir2 smerge-file))
	src dst)
    (cond ((eq dir 1) (setq src file2 dst file1))
	  ((eq dir 2) (setq src file1 dst file2))
	  (t (error "Huh?")))
    (when (or (not ask)
	      (yes-or-no-p (format "Copy to %s? " dst)))
      (smerge-copy-file src dst t t)
      ;; Mark as merged
      (set-extent-property smerge-extent 'face 'smerge-merged-face)
      ;; If this is an "only" mark as copied
      (when (< (extent-property smerge-extent 'type) 3)
	(set-extent-property smerge-extent 'type 0))
      (setq smerge-extent nil)
      )))

(defun smerge-make-extent (start end face)
  (let (extent)
    (setq end (1+ end)) ;; include the NL
    (setq extent (make-extent start end))
    (set-extent-face extent face)
    (set-extent-mouse-face extent 'highlight)
    (set-extent-keymap extent smerge-keymap)
    extent
    ))

;; .cvsignore code

(defun smerge-find-ignores (dir)
  "Find all the .cvsignore files recursively from `dir'. `dir' must end in /."
  (let ((dirlist (smerge-dirlist dir nil "^[^.].*" nil 'dirs))
	(file (concat dir ".cvsignore"))
	filelist)
    (if (file-exists-p file) (setq filelist (list file)))
    (dolist (subdir dirlist)
      (unless (string= subdir "CVS")
	(setq filelist (append filelist
			       (smerge-find-ignores (concat dir subdir "/"))))))
    filelist))

(defun smerge-build-ignore-list (dir)
  "Build a list of files/directories to ignore. `dir' must end in /."
  (let ((list (smerge-find-ignores dir))
	(buff (get-buffer-create "*smerge-cvsignores*"))
	start)
    (save-excursion
      (set-buffer buff)
      (erase-buffer)
      (dolist (file list)
	(setq start (point))
	(insert-file-contents file)
	(goto-char start)
	(while (re-search-forward "^" nil t)
	  (insert file)))
      (goto-char (point-min))
      (while (re-search-forward ".cvsignore" nil t)
	(replace-match ""))
      ;; Protect . from regexp
      (goto-char (point-min))
      (while (search-forward "." nil t)
	(replace-match "\\\\."))
      ;; Convert * -> .*
      (goto-char (point-min))
      (while (search-forward "*" nil t)
	(replace-match ".*"))
      ;; Build the list
      (setq list nil)
      (goto-char (point-min))
      (while (re-search-forward "^.+$" nil t)
	(setq list (cons (match-string 0) list))))
    (unless smerge-keep-cvsignore-buffer
      (kill-buffer buff))
    list))

(defun smerge-cvsignore (dir)
  "smerge internal function to remove the .cvsignore matches"
  (let ((list (smerge-build-ignore-list dir))
	match)
    (dolist (ignore list)
      (goto-char (point-min))
      ;; Only match complete matches
      ;; We cannot use \b here since we are matching filenames
      (setq match (concat ignore "\\s-"))
      (while (re-search-forward match nil t)
	;; Since we match the \n at the end of some lines...
	(goto-char (match-beginning 0))
	(kill-entire-line)
	))))

;; .cvsignore code ends

(provide 'smerge)