home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / packages / emerge.el < prev    next >
Encoding:
Text File  |  1992-12-13  |  116.5 KB  |  3,116 lines

  1. ;;; Emacs subsystem to merge two files, version 5 delta
  2. ;;; Written by Dale R. Worley <drw@math.mit.edu>.
  3.  
  4. ;;;; The last line of this file is "This is the end of emerge.el."
  5.  
  6. ;; WARRANTY DISCLAIMER
  7.  
  8. ;; This software was created by Dale R. Worley and is
  9. ;; distributed free of charge.  It is placed in the public domain and
  10. ;; permission is granted to anyone to use, duplicate, modify and redistribute
  11. ;; it provided that this notice is attached.
  12.  
  13. ;; Dale R. Worley provides absolutely NO WARRANTY OF ANY KIND
  14. ;; with respect to this software.  The entire risk as to the quality and
  15. ;; performance of this software is with the user.  IN NO EVENT WILL DALE
  16. ;; R. WORLEY BE LIABLE TO ANYONE FOR ANY DAMAGES ARISING OUT THE
  17. ;; USE OF THIS SOFTWARE, INCLUDING, WITHOUT LIMITATION, DAMAGES RESULTING FROM
  18. ;; LOST DATA OR LOST PROFITS, OR FOR ANY SPECIAL, INCIDENTAL OR CONSEQUENTIAL
  19. ;; DAMAGES.
  20.  
  21. ;; Declare that we've got the subsystem loaded
  22. (provide 'emerge)
  23.  
  24. ;; LCD Archive Entry:
  25. ;; emerge|Dale R. Worley|drw@math.mit.edu
  26. ;; |File merge
  27. ;; |92-12-11|version 5 gamma|~/packages/emerge.el.Z
  28.  
  29. ;;; Macros
  30.  
  31. (defmacro emerge-eval-in-buffer (buffer &rest forms)
  32.   "Macro to switch to BUFFER, evaluate FORMS, returns to original buffer.
  33. Differs from  save-excursion  in that it doesn't save the point and mark."
  34.   (` (let ((StartBuffer (current-buffer)))
  35.     (unwind-protect
  36.     (progn
  37.       (set-buffer (, buffer))
  38.       (,@ forms))
  39.       (set-buffer StartBuffer)))))
  40.  
  41. (defvar emerge-lucid-p (string-match "Lucid" emacs-version)
  42.   "Non-nil if this is Lucid Emacs.  Don't alter manually, because it also
  43. turns on work-arounds to Lucid bugs.")
  44.  
  45. (defmacro emerge-defvar-local (var value doc) 
  46.   "Defines SYMBOL as an advertised variable.  Performs a defvar, then
  47. executes make-variable-buffer-local on the variable.  Also sets the
  48. 'preserved' property, so that kill-all-local-variables (called by major-mode
  49. setting commands) won't destroy Emerge control variables."
  50.   (` (progn
  51.        (defvar (, var) (, value) (, doc))
  52.        (make-variable-buffer-local '(, var))
  53.        (put '(, var)
  54.         ;; This "if" can't be optimized by having "(, )" wrapped arount it,
  55.         ;; because byte-compilation will then try to evaluate it while
  56.         ;; macro-expanding the uses of emerge-defvar-local, and
  57.         ;; emerge-lucid-p is not defined at that time.
  58.         (if emerge-lucid-p 'permanent-local 'preserved)
  59.         t))))
  60.  
  61. ;; Add entries to minor-mode-alist so that emerge modes show correctly
  62. (defvar emerge-minor-modes-list '((emerge-mode " Emerge")
  63.                   (emerge-fast-mode " F")
  64.                   (emerge-edit-mode " E")
  65.                   (emerge-auto-advance " A")
  66.                   (emerge-skip-prefers " S")))
  67. (if (not (assq 'emerge-mode minor-mode-alist))
  68.     (setq minor-mode-alist (append emerge-minor-modes-list
  69.                    minor-mode-alist)))
  70.  
  71. ;; We need to define this function so describe-mode can describe Emerge mode.
  72. (defun emerge-mode ()
  73.   "Emerge mode is used by the Emerge file-merging package.  It is entered only
  74. through one of the functions:
  75.     emerge-files
  76.     emerge-files-with-ancestor
  77.     emerge-buffers
  78.     emerge-buffers-with-ancestor
  79.     emerge-files-command
  80.     emerge-files-with-ancestor-command
  81.     emerge-files-remote
  82.     emerge-files-with-ancestor-remote
  83.  
  84. Commands:
  85. \\{emerge-basic-keymap}
  86. Commands must be prefixed by \\<emerge-fast-keymap>\\[emerge-basic-keymap] in 'edit' mode, but can be invoked directly
  87. in 'fast' mode.")
  88.  
  89. (defvar emerge-version "5"
  90.   "The version of Emerge.")
  91.  
  92. (defun emerge-version ()
  93.   "Return string describing the version of Emerge.  When called interactively,
  94. displays the version."
  95.   (interactive)
  96.   (if (interactive-p)
  97.       (message "Emerge version %s" (emerge-version))
  98.     emerge-version))
  99.  
  100. ;;; Emerge configuration variables
  101.  
  102. ;; Commands that produce difference files
  103. ;; All that can be configured is the name of the programs to execute
  104. ;; (emerge-diff-program and emerge-diff3-program) and the options
  105. ;; to be provided (emerge-diff-options).  The order in which the file names
  106. ;; are given is fixed.
  107. ;; The file names are always expanded (see expand-file-name) before being
  108. ;; passed to diff, thus they need not be invoked under a shell that 
  109. ;; understands '~'.
  110. ;; The code which processes the diff/diff3 output depends on all the
  111. ;; finicky details of their output, including the somewhat strange
  112. ;; way they number lines of a file.
  113. (defvar emerge-diff-program "diff"
  114.   "*Name of the program which compares two files.")
  115. (defvar emerge-diff3-program "diff3"
  116.   "*Name of the program which compares an ancestor file (first argument)
  117. and two variant files (second and third arguments).")
  118. (defvar emerge-diff-options ""
  119.   "*Options to be passed to emerge-diff/diff3-program.")
  120. (defvar emerge-match-diff-line (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)"))
  121.                  (concat "^" x "\\([acd]\\)" x "$"))
  122.   "*Pattern to match lines produced by diff that describe differences (as
  123. opposed to lines from the source files).")
  124. (defvar emerge-diff-ok-lines
  125.   "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\)"
  126.   "*Regexp that matches normal output lines from  emerge-diff-program .
  127. Lines that do not match are assumed to be error output.")
  128. (defvar emerge-diff3-ok-lines
  129.   "^\\([1-3]:\\|====\\|  \\)"
  130.   "*Regexp that matches normal output lines from  emerge-diff3-program .
  131. Lines that do not match are assumed to be error output.")
  132.  
  133. (defvar emerge-rcs-ci-program "ci"
  134.   "*Name of the program that checks in RCS revisions.")
  135. (defvar emerge-rcs-co-program "co"
  136.   "*Name of the program that checks out RCS revisions.")
  137.  
  138. (defvar emerge-process-local-variables nil
  139.   "*Non-nil if Emerge should process the local-variables list in newly created
  140. merge buffers.  (The local-variables list can be processed manually by
  141. executing \"(hack-local-variables)\".)")
  142. (defvar emerge-execute-line-deletions nil
  143.   "*If non-nil: When emerge-execute-line discovers a situation which
  144. appears to show that a file has been deleted from one version of the
  145. files being merged (when an ancestor entry is present, only one
  146. A or B entry is present, and an output entry is present), no output
  147. file will be created.
  148. If nil: In such circumstances, the A or B file that is present will be
  149. copied to the designated output file.")
  150.  
  151. ;; Hook variables
  152.  
  153. (defvar emerge-startup-hooks nil
  154.   "*Hooks to run in the merge buffer after the merge has been set up.")
  155. (defvar emerge-select-hooks nil
  156.   "*Hooks to run after a difference has been selected.
  157. `n' is the (internal) number of the difference.")
  158. (defvar emerge-unselect-hooks nil
  159.   "*Hooks to run after a difference has been unselected.
  160. `n' is the (internal) number of the difference.")
  161.  
  162. ;; Variables to control the default directories of the arguments to
  163. ;; Emerge commands.
  164.  
  165. (defvar emerge-default-last-directories nil
  166.   "*If nil, filenames for emerge-files-* commands complete in
  167.  default-directory  (like an ordinary command).
  168. If non-nil, filenames complete in the directory of the last argument of the
  169. same type to an emerge-files-* command.")
  170.  
  171. (defvar emerge-last-dir-A nil
  172.   "Last directory for the first file of an emerge-files command.")
  173. (defvar emerge-last-dir-B nil
  174.   "Last directory for the second file of an emerge-files command.")
  175. (defvar emerge-last-dir-ancestor nil
  176.   "Last directory for the ancestor file of an emerge-files command.")
  177. (defvar emerge-last-dir-output nil
  178.   "Last directory for the output file of an emerge-files command.")
  179. (defvar emerge-last-revision-A nil
  180.   "Last RCS revision use for the first file of an emerge-revisions command.")
  181. (defvar emerge-last-revision-B nil
  182.   "Last RCS revision use for the second file of an emerge-revisions command.")
  183. (defvar emerge-last-revision-ancestor nil
  184.   "Last RCS revision use for the ancestor file of an emerge-revisions command.")
  185.  
  186. ;; The flags used to mark differences in the buffers.
  187.  
  188. (defvar emerge-before-flag "vvvvvvvvvvvvvvvvvvvv\n"
  189.   "*Flag placed above the highlighted block of code.  Must end with newline.
  190. Must be set before Emerge is loaded, or  emerge-new-flags  must be run
  191. after setting.")
  192. (defvar emerge-after-flag "^^^^^^^^^^^^^^^^^^^^\n"
  193.   "*Flag placed below the highlighted block of code.  Must end with newline.
  194. Must be set before Emerge is loaded, or  emerge-new-flags  must be run
  195. after setting.")
  196. (defvar emerge-before-flag-length)
  197. (defvar emerge-after-flag-length)
  198. (defvar emerge-before-flag-lines)
  199. (defvar emerge-after-flag-lines)
  200. (defvar emerge-before-flag-match)
  201. (defvar emerge-after-flag-match)
  202.  
  203. ;; Set up the face to highlight the current difference
  204. (if emerge-lucid-p
  205.     (or (and (find-face 'emerge-highlight-face)
  206.          (face-differs-from-default-p 'emerge-highlight-face))
  207.     (copy-face 'bold-italic 'emerge-highlight-face)))
  208.  
  209. ;; These function definitions need to be up here, because they are used
  210. ;; during loading.
  211.  
  212. (defun emerge-new-flags ()
  213.   "Function to be called after emerge-{before,after}-flag are changed to
  214. compute values that depend on the flags."
  215.   (interactive)
  216.   (setq emerge-before-flag-length (length emerge-before-flag))
  217.   (setq emerge-before-flag-lines
  218.     (count-matches-string emerge-before-flag "\n"))
  219.   (setq emerge-before-flag-match (regexp-quote emerge-before-flag))
  220.   (setq emerge-after-flag-length (length emerge-after-flag))
  221.   (setq emerge-after-flag-lines
  222.     (count-matches-string emerge-after-flag "\n"))
  223.   (setq emerge-after-flag-match (regexp-quote emerge-after-flag)))
  224.  
  225. (defun count-matches-string (string regexp)
  226.   "Return the number of matches in STRING for REGEXP."
  227.   (let ((i 0)
  228.     (count 0))
  229.     (while (string-match regexp string i)
  230.       (setq count (1+ count))
  231.       (setq i (match-end 0)))
  232.     count))
  233.  
  234. ;; Calculate dependent variables
  235. (emerge-new-flags)
  236.  
  237. (defvar emerge-min-visible-lines 3
  238.   "*Number of lines that we want to show above and below the flags when we are
  239. displaying a difference.")
  240.  
  241. (defvar emerge-temp-file-prefix
  242.   (let ((env (getenv "TMPDIR"))
  243.     d)
  244.     (setq d (if (and env (> (length env) 0))
  245.         env
  246.           "/tmp"))
  247.     (if (= (aref d (1- (length d))) ?/)
  248.     (setq d (substring d 0 -1)))
  249.     (concat d "/emerge"))
  250.   "*Prefix to put on Emerge temporary file names.
  251. Do not start with '~/' or '~user-name/'.")
  252.  
  253. (defvar emerge-temp-file-mode 384    ; u=rw only
  254.   "*Mode for Emerge temporary files.")
  255.  
  256. (defvar emerge-combine-versions-template
  257.   "#ifdef NEW\n%b#else /* NEW */\n%a#endif /* NEW */\n"
  258.   "*Template for  emerge-combine-versions  to combine the two versions.
  259. The template is inserted as a string, with the following interpolations:
  260.     %a    the A version of the difference
  261.     %b    the B version of the difference
  262.     %%    the character '%'
  263. Don't forget to end the template with a newline.
  264. Note that this variable can be made local to a particular merge buffer by
  265. giving a prefix argument to  emerge-set-combine-versions-template .")
  266.  
  267. ;; Internal global variables
  268.  
  269. (defvar emerge-diff-error-buffer)
  270. (defvar emerge-globalized-difference-list)
  271. (defvar emerge-globalized-number-of-differences)
  272. ;; Variables that are always dynamically bound when they are altered
  273. (defvar A-begin)
  274. (defvar A-end)
  275. (defvar B-begin)
  276. (defvar B-end)
  277. (defvar merge-begin)
  278. (defvar merge-end)
  279. (defvar diff)
  280. (defvar diff-vector)
  281. (defvar emerge-prefix-argument)
  282. (defvar valid-diff)
  283. ;; Globals set by other packages
  284. (defvar exit-func)            ; Emacs client/server (experimental)
  285.  
  286. ;; Build keymaps
  287.  
  288. (defvar emerge-basic-keymap nil
  289.   "Keymap of Emerge commands.
  290. Directly available in 'fast' mode;
  291. must be prefixed by \\<emerge-fast-keymap>\\[emerge-basic-keymap] in 'edit' mode.")
  292.  
  293. (defvar emerge-fast-keymap nil
  294.   "Local keymap used in Emerge 'fast' mode.
  295. Makes Emerge commands directly available.")
  296.  
  297. (defvar emerge-command-prefix "\C-c"
  298.   "*Command prefix for Emerge commands in 'edit' mode.
  299. Must be set before Emerge is loaded.")
  300.  
  301. ;; This function sets up the fixed keymaps.  It is executed when the first
  302. ;; Emerge is done to allow the user maximum time to set up the global keymap.
  303. (defun emerge-setup-fixed-keymaps ()
  304.   ;; Set up the basic keymap
  305.   (setq emerge-basic-keymap (make-keymap))
  306.   (suppress-keymap emerge-basic-keymap)    ; this sets 0..9 to digit-argument and
  307.                     ; - to negative-argument
  308.   (define-key emerge-basic-keymap "p" 'emerge-previous-difference)
  309.   (define-key emerge-basic-keymap "n" 'emerge-next-difference)
  310.   (define-key emerge-basic-keymap "a" 'emerge-select-A)
  311.   (define-key emerge-basic-keymap "b" 'emerge-select-B)
  312.   (define-key emerge-basic-keymap "j" 'emerge-jump-to-difference)
  313.   (define-key emerge-basic-keymap "q" 'emerge-quit)
  314.   (define-key emerge-basic-keymap "f" 'emerge-fast-mode)
  315.   (define-key emerge-basic-keymap "e" 'emerge-edit-mode)
  316.   (define-key emerge-basic-keymap "s" nil)
  317.   (define-key emerge-basic-keymap "sa" 'emerge-auto-advance)
  318.   (define-key emerge-basic-keymap "ss" 'emerge-skip-prefers)
  319.   (define-key emerge-basic-keymap "l" 'emerge-recenter)
  320.   (define-key emerge-basic-keymap "d" nil)
  321.   (define-key emerge-basic-keymap "da" 'emerge-default-A)
  322.   (define-key emerge-basic-keymap "db" 'emerge-default-B)
  323.   (define-key emerge-basic-keymap "c" nil)
  324.   (define-key emerge-basic-keymap "ca" 'emerge-copy-as-kill-A)
  325.   (define-key emerge-basic-keymap "cb" 'emerge-copy-as-kill-B)
  326.   (define-key emerge-basic-keymap "i" nil)
  327.   (define-key emerge-basic-keymap "ia" 'emerge-insert-A)
  328.   (define-key emerge-basic-keymap "ib" 'emerge-insert-B)
  329.   (define-key emerge-basic-keymap "m" 'emerge-mark-difference)
  330.   (define-key emerge-basic-keymap "v" 'emerge-scroll-up)
  331.   (define-key emerge-basic-keymap "^" 'emerge-scroll-down)
  332.   (define-key emerge-basic-keymap "<" 'emerge-scroll-left)
  333.   (define-key emerge-basic-keymap ">" 'emerge-scroll-right)
  334.   (define-key emerge-basic-keymap "|" 'emerge-scroll-reset)
  335.   (define-key emerge-basic-keymap "x" nil)
  336.   (define-key emerge-basic-keymap "x1" 'emerge-one-line-window)
  337.   (define-key emerge-basic-keymap "xa" 'emerge-find-difference-A)
  338.   (define-key emerge-basic-keymap "xb" 'emerge-find-difference-B)
  339.   (define-key emerge-basic-keymap "xc" 'emerge-combine-versions)
  340.   (define-key emerge-basic-keymap "xC" 'emerge-combine-versions-register)
  341.   (define-key emerge-basic-keymap "xd" 'emerge-find-difference)
  342.   (define-key emerge-basic-keymap "xf" 'emerge-file-names)
  343.   (define-key emerge-basic-keymap "xj" 'emerge-join-differences)
  344.   (define-key emerge-basic-keymap "xl" 'emerge-line-numbers)
  345.   (define-key emerge-basic-keymap "xm" 'emerge-set-merge-mode)
  346.   (define-key emerge-basic-keymap "xs" 'emerge-split-difference)
  347.   (define-key emerge-basic-keymap "xt" 'emerge-trim-difference)
  348.   (define-key emerge-basic-keymap "xx" 'emerge-set-combine-versions-template)
  349.   ;; Allow emerge-basic-keymap to be referenced indirectly
  350.   (fset 'emerge-basic-keymap emerge-basic-keymap)
  351.   ;; Set up the fast mode keymap
  352.   (setq emerge-fast-keymap (copy-keymap emerge-basic-keymap))
  353.   ;; Allow prefixed commands to work in fast mode
  354.   (define-key emerge-fast-keymap emerge-command-prefix 'emerge-basic-keymap)
  355.   ;; Allow emerge-fast-keymap to be referenced indirectly
  356.   (fset 'emerge-fast-keymap emerge-fast-keymap)
  357.   ;; Suppress write-file and save-buffer
  358.   (emerge-shadow-key-definition 'write-file 'emerge-query-write-file
  359.                 (current-global-map) emerge-fast-keymap)
  360.   (emerge-shadow-key-definition 'save-buffer 'emerge-query-save-buffer
  361.                 (current-global-map) emerge-fast-keymap))
  362.  
  363. ;; Variables which control each merge.  They are local to the merge buffer.
  364.  
  365. ;; Mode variables
  366. (emerge-defvar-local emerge-mode nil
  367.   "Indicator for emerge-mode.")
  368. (emerge-defvar-local emerge-fast-mode nil
  369.   "Indicator for emerge-mode fast submode.")
  370. (emerge-defvar-local emerge-edit-mode nil
  371.   "Indicator for emerge-mode edit submode.")
  372. (emerge-defvar-local emerge-A-buffer nil
  373.   "The buffer in which the A variant is stored.")
  374. (emerge-defvar-local emerge-B-buffer nil
  375.   "The buffer in which the B variant is stored.")
  376. (emerge-defvar-local emerge-merge-buffer nil
  377.   "The buffer in which the merged file is manipulated.")
  378. (emerge-defvar-local emerge-ancestor-buffer nil
  379.   "The buffer in which the ancestor variant is stored,
  380. or nil if there is none.")
  381.  
  382. (defconst emerge-saved-variables
  383.   '((buffer-modified-p set-buffer-modified-p)
  384.     buffer-read-only
  385.     buffer-auto-save-file-name)
  386.   "Variables and properties of a buffer which are saved, modified and restored
  387. during a merge.")
  388. (defconst emerge-merging-values '(nil t nil)
  389.   "Values to be assigned to emerge-saved-variables during a merge.")
  390.  
  391. (emerge-defvar-local emerge-A-buffer-values nil
  392.   "Remembers emerge-saved-variables for emerge-A-buffer.")
  393. (emerge-defvar-local emerge-B-buffer-values nil
  394.   "Remembers emerge-saved-variables for emerge-B-buffer.")
  395.  
  396. (emerge-defvar-local emerge-difference-list nil
  397.   "Vector of differences between the variants, and markers in the buffers to
  398. show where they are.  Each difference is represented by a vector of seven
  399. elements.  The first two are markers to the beginning and end of the difference
  400. section in the A buffer, the second two are markers for the B buffer, the third
  401. two are markers for the merge buffer, and the last element is the \"state\" of
  402. that difference in the merge buffer.
  403.   A section of a buffer is described by two markers, one to the beginning of
  404. the first line of the section, and one to the beginning of the first line
  405. after the section.  (If the section is empty, both markers point to the same
  406. point.)  If the section is part of the selected difference, then the markers
  407. are moved into the flags, so the user can edit the section without disturbing
  408. the markers.
  409.   The \"states\" are:
  410.     A        the merge buffer currently contains the A variant
  411.     B        the merge buffer currently contains the B variant
  412.     default-A    the merge buffer contains the A variant by default,
  413.             but this difference hasn't been selected yet, so
  414.             change-default commands can alter it
  415.     default-B    the merge buffer contains the B variant by default,
  416.             but this difference hasn't been selected yet, so
  417.             change-default commands can alter it
  418.     prefer-A    in a three-file merge, the A variant is the prefered
  419.             choice
  420.     prefer-B    in a three-file merge, the B variant is the prefered
  421.             choice")
  422. (emerge-defvar-local emerge-current-difference -1
  423.   "The difference that is currently selected.")
  424. (emerge-defvar-local emerge-number-of-differences nil
  425.   "Number of differences found.")
  426. (emerge-defvar-local emerge-edit-keymap nil
  427.   "The local keymap for the merge buffer, with the emerge commands defined in
  428. it.  Used to save the local keymap during fast mode, when the local keymap is
  429. replaced by emerge-fast-keymap.")
  430. (emerge-defvar-local emerge-old-keymap nil
  431.   "The original local keymap for the merge buffer.")
  432. (emerge-defvar-local emerge-auto-advance nil
  433.   "*If non-nil, emerge-select-A and emerge-select-B automatically advance to
  434. the next difference.")
  435. (emerge-defvar-local emerge-skip-prefers nil
  436.   "*If non-nil, differences for which there is a preference are automatically
  437. skipped.")
  438. (emerge-defvar-local emerge-quit-hooks nil
  439.   "Hooks to run in the merge buffer after the merge has been finished.
  440. emerge-prefix-argument will be bound to the prefix argument of the emerge-quit
  441. command.
  442. This is  not  a user option, since Emerge uses it for its own processing.")
  443. (emerge-defvar-local emerge-output-description nil
  444.   "Describes output destination of the merge, for the use of
  445. emerge-file-names.")
  446.  
  447. ;;; Setup functions for two-file mode.
  448.  
  449. (defun emerge-files-internal (file-A file-B &optional startup-hooks quit-hooks
  450.                      output-file)
  451.   (if (not (file-readable-p file-A))
  452.       (error "File '%s' does not exist or is not readable" file-A))
  453.   (if (not (file-readable-p file-B))
  454.       (error "File '%s' does not exist or is not readable" file-B))
  455.   (let ((buffer-A (find-file-noselect file-A))
  456.     (buffer-B (find-file-noselect file-B)))
  457.     ;; Record the directories of the files
  458.     (setq emerge-last-dir-A (file-name-directory file-A))
  459.     (setq emerge-last-dir-B (file-name-directory file-B))
  460.     (if output-file
  461.     (setq emerge-last-dir-output (file-name-directory output-file)))
  462.     ;; Make sure the entire files are seen, and they reflect what is on disk
  463.     (emerge-eval-in-buffer 
  464.      buffer-A
  465.      (widen)
  466.      (if (emerge-remote-file-p)
  467.      (progn
  468.        ;; Store in a local file
  469.        (setq file-A (emerge-make-temp-file "A"))
  470.        (write-region (point-min) (point-max) file-A nil 'no-message)
  471.        (setq startup-hooks
  472.          (cons (` (lambda () (delete-file (, file-A))))
  473.                startup-hooks)))
  474.        ;; Verify that the file matches the buffer
  475.        (emerge-verify-file-buffer)))
  476.     (emerge-eval-in-buffer
  477.      buffer-B
  478.      (widen)
  479.      (if (emerge-remote-file-p)
  480.      (progn
  481.        ;; Store in a local file
  482.        (setq file-B (emerge-make-temp-file "B"))
  483.        (write-region (point-min) (point-max) file-B nil 'no-message)
  484.        (setq startup-hooks
  485.          (cons (` (lambda () (delete-file (, file-B))))
  486.                startup-hooks)))
  487.        ;; Verify that the file matches the buffer
  488.        (emerge-verify-file-buffer)))
  489.     (emerge-setup buffer-A file-A buffer-B file-B startup-hooks quit-hooks
  490.           output-file)))
  491.  
  492. ;; Start up Emerge on two files
  493. (defun emerge-setup (buffer-A file-A buffer-B file-B startup-hooks quit-hooks
  494.                   output-file)
  495.   (setq file-A (expand-file-name file-A))
  496.   (setq file-B (expand-file-name file-B))
  497.   (setq output-file (and output-file (expand-file-name output-file)))
  498.   (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*"))
  499.      ;; create the merge buffer from buffer A, so it inherits buffer A's
  500.      ;; default directory, etc.
  501.      (merge-buffer (emerge-eval-in-buffer
  502.             buffer-A
  503.             (get-buffer-create merge-buffer-name))))
  504.     (emerge-eval-in-buffer
  505.      merge-buffer
  506.      (emerge-copy-modes buffer-A)
  507.      (setq buffer-read-only nil)
  508.      (auto-save-mode 1)
  509.      (setq emerge-mode t)
  510.      (setq emerge-A-buffer buffer-A)
  511.      (setq emerge-B-buffer buffer-B)
  512.      (setq emerge-ancestor-buffer nil)
  513.      (setq emerge-merge-buffer merge-buffer)
  514.      (setq emerge-output-description
  515.        (if output-file
  516.            (concat "Output to file: " output-file)
  517.          (concat "Output to buffer: " (buffer-name merge-buffer))))
  518.      (insert-buffer emerge-A-buffer)
  519.      (emerge-set-keys)
  520.      (setq emerge-difference-list (emerge-make-diff-list file-A file-B))
  521.      (setq emerge-number-of-differences (length emerge-difference-list))
  522.      (setq emerge-current-difference -1)
  523.      (setq emerge-quit-hooks quit-hooks)
  524.      (emerge-remember-buffer-characteristics)
  525.      (emerge-handle-local-variables))
  526.     (emerge-setup-windows buffer-A buffer-B merge-buffer t)
  527.     (emerge-eval-in-buffer merge-buffer
  528.                (run-hooks 'startup-hooks 'emerge-startup-hooks)
  529.                (setq buffer-read-only t))))
  530.  
  531. ;; Generate the Emerge difference list between two files
  532. (defun emerge-make-diff-list (file-A file-B)
  533.   (let ((diff-buffer (get-buffer-create "*emerge-diff*")))
  534.     (emerge-eval-in-buffer
  535.      diff-buffer
  536.      (erase-buffer)
  537.      (shell-command
  538.       (format "%s %s %s %s"
  539.           emerge-diff-program emerge-diff-options
  540.           (emerge-protect-metachars file-A)
  541.           (emerge-protect-metachars file-B))
  542.       t))
  543.     (emerge-prepare-error-list emerge-diff-ok-lines diff-buffer)
  544.     (emerge-convert-diffs-to-markers
  545.      emerge-A-buffer emerge-B-buffer emerge-merge-buffer
  546.      (emerge-extract-diffs diff-buffer))))
  547.  
  548. (defun emerge-extract-diffs (diff-buffer)
  549.   (let (list)
  550.     (emerge-eval-in-buffer
  551.      diff-buffer
  552.      (goto-char (point-min))
  553.      (while (re-search-forward emerge-match-diff-line nil t)
  554.        (let* ((a-begin (string-to-int (buffer-substring (match-beginning 1)
  555.                             (match-end 1))))
  556.           (a-end  (let ((b (match-beginning 3))
  557.                 (e (match-end 3)))
  558.             (if b
  559.                 (string-to-int (buffer-substring b e))
  560.               a-begin)))
  561.           (diff-type (buffer-substring (match-beginning 4) (match-end 4)))
  562.           (b-begin (string-to-int (buffer-substring (match-beginning 5)
  563.                             (match-end 5))))
  564.           (b-end (let ((b (match-beginning 7))
  565.                (e (match-end 7)))
  566.                (if b
  567.                (string-to-int (buffer-substring b e))
  568.              b-begin))))
  569.      ;; fix the beginning and end numbers, because diff is somewhat
  570.      ;; strange about how it numbers lines
  571.      (if (string-equal diff-type "a")
  572.          (progn
  573.            (setq b-end (1+ b-end))
  574.            (setq a-begin (1+ a-begin))
  575.            (setq a-end a-begin))
  576.        (if (string-equal diff-type "d")
  577.            (progn
  578.          (setq a-end (1+ a-end))
  579.          (setq b-begin (1+ b-begin))
  580.          (setq b-end b-begin))
  581.          ;; (string-equal diff-type "c")
  582.          (progn
  583.            (setq a-end (1+ a-end))
  584.            (setq b-end (1+ b-end)))))
  585.      (setq list (cons (vector a-begin a-end
  586.                   b-begin b-end
  587.                   'default-A)
  588.               list)))))
  589.     (nreverse list)))
  590.  
  591. ;; Set up buffer of diff/diff3 error messages.
  592. (defun emerge-prepare-error-list (ok-regexp diff-buffer)
  593.   (setq emerge-diff-error-buffer (get-buffer-create "*emerge-diff-errors*"))
  594.   (emerge-eval-in-buffer
  595.    emerge-diff-error-buffer
  596.    (erase-buffer)
  597.    (insert-buffer diff-buffer)
  598.    (delete-matching-lines ok-regexp)))
  599.  
  600. ;;; Top-level and setup functions for three-file mode.
  601.  
  602. (defun emerge-files-with-ancestor-internal (file-A file-B file-ancestor
  603.                       &optional startup-hooks quit-hooks
  604.                       output-file)
  605.   (if (not (file-readable-p file-A))
  606.       (error "File '%s' does not exist or is not readable" file-A))
  607.   (if (not (file-readable-p file-B))
  608.       (error "File '%s' does not exist or is not readable" file-B))
  609.   (if (not (file-readable-p file-ancestor))
  610.       (error "File '%s' does not exist or is not readable" file-ancestor))
  611.   (let ((buffer-A (find-file-noselect file-A))
  612.     (buffer-B (find-file-noselect file-B))
  613.     (buffer-ancestor (find-file-noselect file-ancestor)))
  614.     ;; Record the directories of the files
  615.     (setq emerge-last-dir-A (file-name-directory file-A))
  616.     (setq emerge-last-dir-B (file-name-directory file-B))
  617.     (setq emerge-last-dir-ancestor (file-name-directory file-ancestor))
  618.     (if output-file
  619.     (setq emerge-last-dir-output (file-name-directory output-file)))
  620.     ;; Make sure the entire files are seen, and they reflect what is on disk
  621.     (emerge-eval-in-buffer
  622.      buffer-A
  623.      (widen)
  624.      (if (emerge-remote-file-p)
  625.      (progn
  626.        ;; Store in a local file
  627.        (setq file-A (emerge-make-temp-file "A"))
  628.        (write-region (point-min) (point-max) file-A nil 'no-message)
  629.        (setq startup-hooks
  630.          (cons (` (lambda () (delete-file (, file-A))))
  631.                startup-hooks)))
  632.        ;; Verify that the file matches the buffer
  633.        (emerge-verify-file-buffer)))
  634.     (emerge-eval-in-buffer
  635.      buffer-B
  636.      (widen)
  637.      (if (emerge-remote-file-p)
  638.      (progn
  639.        ;; Store in a local file
  640.        (setq file-B (emerge-make-temp-file "B"))
  641.        (write-region (point-min) (point-max) file-B nil 'no-message)
  642.        (setq startup-hooks
  643.          (cons (` (lambda () (delete-file (, file-B))))
  644.                startup-hooks)))
  645.        ;; Verify that the file matches the buffer
  646.        (emerge-verify-file-buffer)))
  647.     (emerge-eval-in-buffer
  648.      buffer-ancestor
  649.      (widen)
  650.      (if (emerge-remote-file-p)
  651.      (progn
  652.        ;; Store in a local file
  653.        (setq file-ancestor (emerge-make-temp-file "anc"))
  654.        (write-region (point-min) (point-max) file-ancestor nil 'no-message)
  655.        (setq startup-hooks
  656.          (cons (` (lambda () (delete-file (, file-ancestor))))
  657.                startup-hooks)))
  658.        ;; Verify that the file matches the buffer
  659.        (emerge-verify-file-buffer)))
  660.     (emerge-setup-with-ancestor buffer-A file-A buffer-B file-B
  661.                 buffer-ancestor file-ancestor
  662.                 startup-hooks quit-hooks output-file)))
  663.  
  664. ;; Start up Emerge on two files with an ancestor
  665. (defun emerge-setup-with-ancestor (buffer-A file-A buffer-B file-B
  666.                         buffer-ancestor file-ancestor
  667.                         &optional startup-hooks quit-hooks
  668.                         output-file)
  669.   (setq file-A (expand-file-name file-A))
  670.   (setq file-B (expand-file-name file-B))
  671.   (setq file-ancestor (expand-file-name file-ancestor))
  672.   (setq output-file (and output-file (expand-file-name output-file)))
  673.   (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*"))
  674.      ;; create the merge buffer from buffer A, so it inherits buffer A's
  675.      ;; default directory, etc.
  676.      (merge-buffer (emerge-eval-in-buffer
  677.             buffer-A
  678.             (get-buffer-create merge-buffer-name))))
  679.     (emerge-eval-in-buffer
  680.      merge-buffer
  681.      (emerge-copy-modes buffer-A)
  682.      (setq buffer-read-only nil)
  683.      (auto-save-mode 1)
  684.      (setq emerge-mode t)
  685.      (setq emerge-A-buffer buffer-A)
  686.      (setq emerge-B-buffer buffer-B)
  687.      (setq emerge-ancestor-buffer buffer-ancestor)
  688.      (setq emerge-merge-buffer merge-buffer)
  689.      (setq emerge-output-description
  690.        (if output-file
  691.            (concat "Output to file: " output-file)
  692.          (concat "Output to buffer: " (buffer-name merge-buffer))))
  693.      (insert-buffer emerge-A-buffer)
  694.      (emerge-set-keys)
  695.      (setq emerge-difference-list
  696.        (emerge-make-diff3-list file-A file-B file-ancestor))
  697.      (setq emerge-number-of-differences (length emerge-difference-list))
  698.      (setq emerge-current-difference -1)
  699.      (setq emerge-quit-hooks quit-hooks)
  700.      (emerge-remember-buffer-characteristics)
  701.      (emerge-select-prefer-Bs)
  702.      (emerge-handle-local-variables))
  703.     (emerge-setup-windows buffer-A buffer-B merge-buffer t)
  704.     (emerge-eval-in-buffer merge-buffer
  705.                (run-hooks 'startup-hooks 'emerge-startup-hooks)
  706.                (setq buffer-read-only t))))
  707.  
  708. ;; Generate the Emerge difference list between two files with an ancestor
  709. (defun emerge-make-diff3-list (file-A file-B file-ancestor)
  710.   (let ((diff-buffer (get-buffer-create "*emerge-diff*")))
  711.     (emerge-eval-in-buffer
  712.      diff-buffer
  713.      (erase-buffer)
  714.      (shell-command
  715.       (format "%s %s %s %s %s"
  716.           emerge-diff3-program emerge-diff-options
  717.           (emerge-protect-metachars file-ancestor)
  718.           (emerge-protect-metachars file-A)
  719.           (emerge-protect-metachars file-B))
  720.       t))
  721.     (emerge-prepare-error-list emerge-diff3-ok-lines diff-buffer)
  722.     (emerge-convert-diffs-to-markers
  723.      emerge-A-buffer emerge-B-buffer emerge-merge-buffer
  724.      (emerge-extract-diffs3 diff-buffer))))
  725.  
  726. (defun emerge-extract-diffs3 (diff-buffer)
  727.   (let (list)
  728.     (emerge-eval-in-buffer
  729.      diff-buffer
  730.      (while (re-search-forward "^====\\(.?\\)$" nil t)
  731.        ;; leave point after matched line
  732.        (beginning-of-line 2)
  733.        (let ((agreement (buffer-substring (match-beginning 1) (match-end 1))))
  734.      ;; if the A and B files are the same, ignore the difference
  735.      (if (not (string-equal agreement "1"))
  736.          (setq list
  737.            (cons 
  738.             (let ((group-2 (emerge-get-diff3-group "2"))
  739.               (group-3 (emerge-get-diff3-group "3")))
  740.               (vector (car group-2) (car (cdr group-2))
  741.                   (car group-3) (car (cdr group-3))
  742.                   (cond ((string-equal agreement "2") 'prefer-A)
  743.                     ((string-equal agreement "3") 'prefer-B)
  744.                     (t 'default-A))))
  745.             list))))))
  746.     (nreverse list)))
  747.  
  748. (defun emerge-get-diff3-group (file)
  749.   ;; This save-excursion allows emerge-get-diff3-group to be called for the
  750.   ;; various groups of lines (1, 2, 3) in any order, and for the lines to
  751.   ;; appear in any order.  The reason this is necessary is that Gnu diff3
  752.   ;; can produce the groups in the order 1, 2, 3 or 1, 3, 2.
  753.   (save-excursion
  754.     (re-search-forward
  755.      (concat "^" file ":\\([0-9]+\\)\\(,\\([0-9]+\\)\\)?\\([ac]\\)$"))
  756.     (beginning-of-line 2)
  757.     ;; treatment depends on whether it is an "a" group or a "c" group
  758.     (if (string-equal (buffer-substring (match-beginning 4) (match-end 4)) "c")
  759.     ;; it is a "c" group
  760.     (if (match-beginning 2)
  761.         ;; it has two numbers
  762.         (list (string-to-int
  763.            (buffer-substring (match-beginning 1) (match-end 1)))
  764.           (1+ (string-to-int
  765.                (buffer-substring (match-beginning 3) (match-end 3)))))
  766.       ;; it has one number
  767.       (let ((x (string-to-int
  768.             (buffer-substring (match-beginning 1) (match-end 1)))))
  769.         (list x (1+ x))))
  770.       ;; it is an "a" group
  771.       (let ((x (1+ (string-to-int
  772.             (buffer-substring (match-beginning 1) (match-end 1))))))
  773.     (list x x)))))
  774.  
  775. ;;; Functions to start Emerge on files
  776.  
  777. (defun emerge-files (arg file-A file-B file-out &optional startup-hooks
  778.              quit-hooks)
  779.   "Run Emerge on two files."
  780.   (interactive
  781.    (let (f)
  782.      (list current-prefix-arg
  783.        (setq f (emerge-read-file-name "File A to merge" emerge-last-dir-A
  784.                       nil nil 'confirm))
  785.        (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f
  786.                   'confirm)
  787.        (and current-prefix-arg
  788.         (emerge-read-file-name "Output file" emerge-last-dir-output
  789.                        f f nil)))))
  790.   (emerge-files-internal
  791.    file-A file-B startup-hooks
  792.    (if arg
  793.        (cons (` (lambda () (emerge-files-exit (, file-out))))
  794.          quit-hooks)
  795.      quit-hooks)
  796.    file-out))
  797.  
  798. (defun emerge-files-with-ancestor (arg file-A file-B file-ancestor file-out
  799.                    &optional startup-hooks quit-hooks)
  800.   "Run Emerge on two files, giving another file as the ancestor."
  801.   (interactive
  802.    (let (f)
  803.      (list current-prefix-arg
  804.        (setq f (emerge-read-file-name "File A to merge" emerge-last-dir-A
  805.                       nil nil 'confirm))
  806.        (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f
  807.                   'confirm)
  808.        (emerge-read-file-name "Ancestor file" emerge-last-dir-ancestor
  809.                   nil f 'confirm)
  810.        (and current-prefix-arg
  811.         (emerge-read-file-name "Output file" emerge-last-dir-output
  812.                        f f nil)))))
  813.   (emerge-files-with-ancestor-internal
  814.    file-A file-B file-ancestor startup-hooks
  815.    (if arg
  816.        (cons (` (lambda () (emerge-files-exit (, file-out))))
  817.          quit-hooks)
  818.      quit-hooks)
  819.    file-out))
  820.  
  821. ;; Write the merge buffer out in place of the file the A buffer is visiting.
  822. (defun emerge-files-exit (file-out)
  823.   ;; if merge was successful was given, save to disk
  824.   (if (not emerge-prefix-argument)
  825.       (emerge-write-and-delete file-out)))
  826.  
  827. ;;; Functions to start Emerge on buffers
  828.  
  829. (defun emerge-buffers (buffer-A buffer-B &optional startup-hooks quit-hooks)
  830.   "Run Emerge on two buffers."
  831.   (interactive "bBuffer A to merge: \nbBuffer B to merge: ")
  832.   (let ((emerge-file-A (emerge-make-temp-file "A"))
  833.     (emerge-file-B (emerge-make-temp-file "B")))
  834.     (emerge-eval-in-buffer
  835.      buffer-A
  836.      (write-region (point-min) (point-max) emerge-file-A nil 'no-message))
  837.     (emerge-eval-in-buffer
  838.      buffer-B
  839.      (write-region (point-min) (point-max) emerge-file-B nil 'no-message))
  840.     (emerge-setup (get-buffer buffer-A) emerge-file-A
  841.           (get-buffer buffer-B) emerge-file-B
  842.           (cons (` (lambda ()
  843.                  (delete-file (, emerge-file-A))
  844.                  (delete-file (, emerge-file-B))))
  845.             startup-hooks)
  846.           quit-hooks
  847.           nil)))
  848.  
  849. (defun emerge-buffers-with-ancestor (buffer-A buffer-B buffer-ancestor
  850.                           &optional startup-hooks
  851.                           quit-hooks)
  852.   "Run Emerge on two buffers, giving another buffer as the ancestor."
  853.   (interactive
  854.    "bBuffer A to merge: \nbBuffer B to merge: \nbAncestor buffer: ")
  855.   (let ((emerge-file-A (emerge-make-temp-file "A"))
  856.     (emerge-file-B (emerge-make-temp-file "B"))
  857.     (emerge-file-ancestor (emerge-make-temp-file "anc")))
  858.     (emerge-eval-in-buffer
  859.      buffer-A
  860.      (write-region (point-min) (point-max) emerge-file-A nil 'no-message))
  861.     (emerge-eval-in-buffer
  862.      buffer-B
  863.      (write-region (point-min) (point-max) emerge-file-B nil 'no-message))
  864.     (emerge-eval-in-buffer
  865.      buffer-ancestor
  866.      (write-region (point-min) (point-max) emerge-file-ancestor nil
  867.            'no-message))
  868.     (emerge-setup-with-ancestor (get-buffer buffer-A) emerge-file-A
  869.                 (get-buffer buffer-B) emerge-file-B
  870.                 (get-buffer buffer-ancestor)
  871.                 emerge-file-ancestor
  872.                 (cons (` (lambda ()
  873.                        (delete-file (, emerge-file-A))
  874.                        (delete-file (, emerge-file-B))
  875.                        (delete-file
  876.                         (, emerge-file-ancestor))))
  877.                       startup-hooks)
  878.                 quit-hooks
  879.                 nil)))
  880.  
  881. ;;; Functions to start Emerge from the command line
  882.  
  883. (defun emerge-files-command ()
  884.   (let ((file-a (nth 0 command-line-args-left))
  885.     (file-b (nth 1 command-line-args-left))
  886.     (file-out (nth 2 command-line-args-left)))
  887.     (setq command-line-args-left (nthcdr 3 command-line-args-left))
  888.     (emerge-files-internal
  889.      file-a file-b nil
  890.      (list (` (lambda () (emerge-command-exit (, file-out))))))))
  891.  
  892. (defun emerge-files-with-ancestor-command ()
  893.   (let (file-a file-b file-anc file-out)
  894.     ;; check for a -a flag, for filemerge compatibility
  895.     (if (string= (car command-line-args-left) "-a")
  896.     ;; arguments are "-a ancestor file-a file-b file-out"
  897.     (progn
  898.       (setq file-a (nth 2 command-line-args-left))
  899.       (setq file-b (nth 3 command-line-args-left))
  900.       (setq file-anc (nth 1 command-line-args-left))
  901.       (setq file-out (nth 4 command-line-args-left))
  902.       (setq command-line-args-left (nthcdr 5 command-line-args-left)))
  903.       ;; arguments are "file-a file-b ancestor file-out"
  904.       (setq file-a (nth 0 command-line-args-left))
  905.       (setq file-b (nth 1 command-line-args-left))
  906.       (setq file-anc (nth 2 command-line-args-left))
  907.       (setq file-out (nth 3 command-line-args-left))
  908.       (setq command-line-args-left (nthcdr 4 command-line-args-left)))
  909.     (emerge-files-with-ancestor-internal
  910.      file-a file-b file-anc nil
  911.      (list (` (lambda () (emerge-command-exit (, file-out))))))))
  912.       
  913. (defun emerge-command-exit (file-out)
  914.   (emerge-write-and-delete file-out)
  915.   (kill-emacs (if emerge-prefix-argument 1 0)))
  916.  
  917. ;;; Functions to start Emerge via remote request
  918.  
  919. (defun emerge-files-remote (file-a file-b file-out)
  920.   (emerge-files-internal
  921.    file-a file-b nil
  922.    (list (` (lambda () (emerge-remote-exit (, file-out) '(, exit-func)))))
  923.    file-out)
  924.   (throw 'client-wait nil))
  925.  
  926. (defun emerge-files-with-ancestor-remote (file-a file-b file-anc file-out)
  927.   (emerge-files-with-ancestor-internal
  928.    file-a file-b file-anc nil
  929.    (list (` (lambda () (emerge-remote-exit (, file-out) '(, exit-func)))))
  930.    file-out)
  931.   (throw 'client-wait nil))
  932.  
  933. (defun emerge-remote-exit (file-out exit-func)
  934.   (emerge-write-and-delete file-out)
  935.   (kill-buffer emerge-merge-buffer)
  936.   (funcall exit-func (if emerge-prefix-argument 1 0)))
  937.  
  938. ;;; Functions to start Emerge on RCS versions
  939.  
  940. (defun emerge-revisions (arg file revision-A revision-B
  941.              &optional startup-hooks quit-hooks)
  942.   "Emerge two RCS revisions of a file."
  943.   (interactive
  944.    (list current-prefix-arg
  945.      (read-file-name "File to merge: " nil nil 'confirm)
  946.      (read-string "Revision A to merge: " emerge-last-revision-A)
  947.      (read-string "Revision B to merge: " emerge-last-revision-B)))
  948.   (setq emerge-last-revision-A revision-A
  949.     emerge-last-revision-B revision-B)
  950.   (emerge-revisions-internal
  951.    file revision-A revision-B startup-hooks
  952.    (if arg
  953.        (cons (` (lambda ()
  954.           (shell-command
  955.            (, (format "%s %s" emerge-rcs-ci-program file)))))
  956.          quit-hooks)
  957.      quit-hooks)))
  958.  
  959. (defun emerge-revisions-with-ancestor (arg file revision-A
  960.                        revision-B ancestor
  961.                        &optional
  962.                        startup-hooks quit-hooks)
  963.   "Emerge two RCS revisions of a file, giving another revision as
  964. the ancestor."
  965.   (interactive
  966.    (list current-prefix-arg
  967.      (read-file-name "File to merge: " nil nil 'confirm)
  968.      (read-string "Revision A to merge: " emerge-last-revision-A)
  969.      (read-string "Revision B to merge: " emerge-last-revision-B)
  970.      (read-string "Ancestor: " emerge-last-revision-ancestor)))
  971.   (setq emerge-last-revision-A revision-A
  972.     emerge-last-revision-B revision-B
  973.     emerge-last-revision-ancestor ancestor)
  974.   (emerge-revision-with-ancestor-internal
  975.    file revision-A revision-B ancestor startup-hooks
  976.    (if arg
  977.        (let ((cmd ))
  978.      (cons (` (lambda ()
  979.             (shell-command
  980.              (, (format "%s %s" emerge-rcs-ci-program file)))))
  981.            quit-hooks))
  982.      quit-hooks)))
  983.  
  984. (defun emerge-revisions-internal (file revision-A revision-B &optional
  985.                       startup-hooks quit-hooks output-file)
  986.   (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A)))
  987.     (buffer-B (get-buffer-create (format "%s,%s" file revision-B)))
  988.     (emerge-file-A (emerge-make-temp-file "A"))
  989.     (emerge-file-B (emerge-make-temp-file "B")))
  990.     ;; Get the revisions into buffers
  991.     (emerge-eval-in-buffer
  992.      buffer-A
  993.      (erase-buffer)
  994.      (shell-command
  995.       (format "%s -q -p%s %s" emerge-rcs-co-program revision-A file)
  996.       t)
  997.      (write-region (point-min) (point-max) emerge-file-A nil 'no-message)
  998.      (set-buffer-modified-p nil))
  999.     (emerge-eval-in-buffer
  1000.      buffer-B
  1001.      (erase-buffer)
  1002.      (shell-command
  1003.       (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file)
  1004.       t)
  1005.      (write-region (point-min) (point-max) emerge-file-B nil 'no-message)
  1006.      (set-buffer-modified-p nil))
  1007.     ;; Do the merge
  1008.     (emerge-setup buffer-A emerge-file-A
  1009.           buffer-B emerge-file-B
  1010.           (cons (` (lambda ()
  1011.                  (delete-file (, emerge-file-A))
  1012.                  (delete-file (, emerge-file-B))))
  1013.             startup-hooks)
  1014.           (cons (` (lambda () (emerge-files-exit (, file))))
  1015.             quit-hooks)
  1016.           nil)))
  1017.  
  1018. (defun emerge-revision-with-ancestor-internal (file revision-A revision-B
  1019.                             ancestor
  1020.                             &optional startup-hooks
  1021.                             quit-hooks output-file)
  1022.   (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A)))
  1023.     (buffer-B (get-buffer-create (format "%s,%s" file revision-B)))
  1024.     (buffer-ancestor (get-buffer-create (format "%s,%s" file ancestor)))
  1025.     (emerge-file-A (emerge-make-temp-file "A"))
  1026.     (emerge-file-B (emerge-make-temp-file "B"))
  1027.     (emerge-ancestor (emerge-make-temp-file "ancestor")))
  1028.     ;; Get the revisions into buffers
  1029.     (emerge-eval-in-buffer
  1030.      buffer-A
  1031.      (erase-buffer)
  1032.      (shell-command
  1033.       (format "%s -q -p%s %s" emerge-rcs-co-program
  1034.           revision-A file)
  1035.       t)
  1036.      (write-region (point-min) (point-max) emerge-file-A nil 'no-message)
  1037.      (set-buffer-modified-p nil))
  1038.     (emerge-eval-in-buffer
  1039.      buffer-B
  1040.      (erase-buffer)
  1041.      (shell-command
  1042.       (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file)
  1043.       t)
  1044.      (write-region (point-min) (point-max) emerge-file-B nil 'no-message)
  1045.      (set-buffer-modified-p nil))
  1046.     (emerge-eval-in-buffer
  1047.      buffer-ancestor
  1048.      (erase-buffer)
  1049.      (shell-command
  1050.       (format "%s -q -p%s %s" emerge-rcs-co-program ancestor file)
  1051.       t)
  1052.      (write-region (point-min) (point-max) emerge-ancestor nil 'no-message)
  1053.      (set-buffer-modified-p nil))
  1054.     ;; Do the merge
  1055.     (emerge-setup-with-ancestor
  1056.      buffer-A emerge-file-A buffer-B emerge-file-B
  1057.      buffer-ancestor emerge-ancestor
  1058.      (cons (` (lambda ()
  1059.         (delete-file (, emerge-file-A))
  1060.         (delete-file (, emerge-file-B))
  1061.         (delete-file (, emerge-ancestor))))
  1062.        startup-hooks)
  1063.      (cons (` (lambda () (emerge-files-exit (, file))))
  1064.        quit-hooks)
  1065.      output-file)))
  1066.  
  1067. ;;; Function to start Emerge based on a line in a file
  1068.  
  1069. (defun emerge-execute-line ()
  1070.   "Process the current line, looking for entries of the form:
  1071.     a=file1
  1072.     b=file2
  1073.     ancestor=file3
  1074.     output=file4
  1075. seperated by whitespace.  Based on entries found, call emerge correctly
  1076. on the files files listed.
  1077.  
  1078. In addition, if only one of \"a=file\" or \"b=file\" is present, and \"output=file\"
  1079. is present:
  1080. If emerge-execute-line-deletions is non-nil and \"ancestor=file\" is present,
  1081. it is assumed that the file in question has been deleted, and it is
  1082. not copied to the output file.
  1083. Otherwise, the A or B file present is copied to the output file."
  1084.   (interactive)
  1085.   (let (file-A file-B file-ancestor file-out
  1086.            (case-fold-search t))
  1087.     ;; Stop if at end of buffer (even though we might be in a line, if
  1088.     ;; the line does not end with newline)
  1089.     (if (eobp)
  1090.     (error "At end of buffer"))
  1091.     ;; Go to the beginning of the line
  1092.     (beginning-of-line)
  1093.     ;; Skip any initial whitespace
  1094.     (if (looking-at "[ \t]*")
  1095.     (goto-char (match-end 0)))
  1096.     ;; Process the entire line
  1097.     (while (not (eolp))
  1098.       ;; Get the next entry
  1099.       (if (looking-at "\\([a-z]+\\)=\\([^ \t\n]+\\)[ \t]*")
  1100.       ;; Break apart the tab (before =) and the filename (after =)
  1101.       (let ((tag (downcase
  1102.               (buffer-substring (match-beginning 1) (match-end 1))))
  1103.         (file (buffer-substring (match-beginning 2) (match-end 2))))
  1104.         ;; Move point after the entry
  1105.         (goto-char (match-end 0))
  1106.         ;; Store the filename in the right variable
  1107.         (cond
  1108.          ((string-equal tag "a")
  1109.           (if file-A
  1110.           (error "This line has two 'A' entries"))
  1111.           (setq file-A file))
  1112.          ((string-equal tag "b")
  1113.           (if file-B
  1114.           (error "This line has two 'B' entries"))
  1115.           (setq file-B file))
  1116.          ((or (string-equal tag "anc") (string-equal tag "ancestor"))
  1117.           (if file-ancestor
  1118.           (error "This line has two 'ancestor' entries"))
  1119.           (setq file-ancestor file))
  1120.          ((or (string-equal tag "out") (string-equal tag "output"))
  1121.           (if file-out
  1122.           (error "This line has two 'output' entries"))
  1123.           (setq file-out file))
  1124.          (t
  1125.           (error "Unrecognized entry"))))
  1126.     ;; If the match on the entry pattern failed
  1127.     (error "Unparseable entry")))
  1128.     ;; Make sure that file-A and file-B are present
  1129.     (if (not (or (and file-A file-B) file-out))
  1130.     (error "Must have both 'A' and 'B' entries"))
  1131.     (if (not (or file-A file-B))
  1132.     (error "Must have 'A' or 'B' entry"))
  1133.     ;; Go to the beginning of the next line, so next execution will use
  1134.     ;; next line in buffer.
  1135.     (beginning-of-line 2)
  1136.     ;; Execute the correct command
  1137.     (cond
  1138.      ;; Merge of two files with ancestor
  1139.      ((and file-A file-B file-ancestor)
  1140.       (message "Merging %s and %s..." file-A file-B)
  1141.       (emerge-files-with-ancestor (not (not file-out)) file-A file-B
  1142.                   file-ancestor file-out
  1143.                   nil
  1144.                   ;; When done, return to this buffer.
  1145.                   (list
  1146.                    (` (lambda ()
  1147.                     (switch-to-buffer (, (current-buffer)))
  1148.                     (message "Merge done"))))))
  1149.      ;; Merge of two files without ancestor
  1150.      ((and file-A file-B)
  1151.       (message "Merging %s and %s..." file-A file-B)
  1152.       (emerge-files (not (not file-out)) file-A file-B file-out
  1153.             nil
  1154.             ;; When done, return to this buffer.
  1155.             (list 
  1156.              (` (lambda ()
  1157.               (switch-to-buffer (, (current-buffer)))
  1158.               (message "Merge done"))))))
  1159.      ;; There is an output file (or there would have been an error above),
  1160.      ;; but only one input file.
  1161.      ;; The file appears to have been deleted in one version; do nothing.
  1162.      ((and file-ancestor emerge-execute-line-deletions)
  1163.       (message "No action"))
  1164.      ;; The file should be copied from the version that contains it
  1165.      (t (let ((input-file (or file-A file-B)))
  1166.       (message "Copying...")
  1167.       (copy-file input-file file-out)
  1168.       (message "%s copied to %s" input-file file-out))))))
  1169.  
  1170. ;;; Sample function for creating information for emerge-execute-line
  1171.  
  1172. (defvar emerge-merge-directories-filename-regexp "[^.]"
  1173.   "Regexp describing files to be processed by emerge-merge-directories.")
  1174.  
  1175. (defun emerge-merge-directories (a-dir b-dir ancestor-dir output-dir)
  1176.   (interactive 
  1177.    (list
  1178.     (read-file-name "A directory: " nil nil 'confirm)
  1179.     (read-file-name "B directory: " nil nil 'confirm)
  1180.     (read-file-name "Ancestor directory (null for none): " nil nil 'confirm)
  1181.     (read-file-name "Output directory (null for none): " nil nil 'confirm)))
  1182.   ;; Check that we're not on a line
  1183.   (if (not (and (bolp) (eolp)))
  1184.       (error "There is text on this line"))
  1185.   ;; Turn null strings into nil to indicate directories not used.
  1186.   (if (and ancestor-dir (string-equal ancestor-dir ""))
  1187.       (setq ancestor-dir nil))
  1188.   (if (and output-dir (string-equal output-dir ""))
  1189.       (setq output-dir nil))
  1190.   ;; Canonicalize the directory names
  1191.   (setq a-dir (expand-file-name a-dir))
  1192.   (if (not (string-equal (substring a-dir -1) "/"))
  1193.       (setq a-dir (concat a-dir "/")))
  1194.   (setq b-dir (expand-file-name b-dir))
  1195.   (if (not (string-equal (substring b-dir -1) "/"))
  1196.       (setq b-dir (concat b-dir "/")))
  1197.   (if ancestor-dir
  1198.       (progn
  1199.     (setq ancestor-dir (expand-file-name ancestor-dir))
  1200.     (if (not (string-equal (substring ancestor-dir -1) "/"))
  1201.         (setq ancestor-dir (concat ancestor-dir "/")))))
  1202.   (if output-dir
  1203.       (progn
  1204.     (setq output-dir (expand-file-name output-dir))
  1205.     (if (not (string-equal (substring output-dir -1) "/"))
  1206.         (setq output-dir (concat output-dir "/")))))
  1207.   ;; Set the mark to where we start
  1208.   (push-mark)
  1209.   ;; Find out what files are in the directories.
  1210.   (let* ((a-dir-files
  1211.       (directory-files a-dir nil emerge-merge-directories-filename-regexp))
  1212.      (b-dir-files
  1213.       (directory-files b-dir nil emerge-merge-directories-filename-regexp))
  1214.      (ancestor-dir-files
  1215.       (and ancestor-dir
  1216.            (directory-files ancestor-dir nil
  1217.                 emerge-merge-directories-filename-regexp)))
  1218.      (all-files (sort (nconc (copy-sequence a-dir-files)
  1219.                  (copy-sequence b-dir-files)
  1220.                  (copy-sequence ancestor-dir-files))
  1221.               (function string-lessp))))
  1222.     ;; Remove duplicates from all-files.
  1223.     (let ((p all-files))
  1224.       (while p
  1225.     (if (and (cdr p) (string-equal (car p) (car (cdr p))))
  1226.         (setcdr p (cdr (cdr p)))
  1227.       (setq p (cdr p)))))
  1228.     ;; Generate the control lines for the various files.
  1229.     (while all-files
  1230.       (let ((f (car all-files)))
  1231.     (setq all-files (cdr all-files))
  1232.     (if (and a-dir-files (string-equal (car a-dir-files) f))
  1233.         (progn
  1234.           (insert "A=" a-dir f "\t")
  1235.           (setq a-dir-files (cdr a-dir-files))))
  1236.     (if (and b-dir-files (string-equal (car b-dir-files) f))
  1237.         (progn
  1238.           (insert "B=" b-dir f "\t")
  1239.           (setq b-dir-files (cdr b-dir-files))))
  1240.     (if (and ancestor-dir-files (string-equal (car ancestor-dir-files) f))
  1241.         (progn
  1242.           (insert "ancestor=" ancestor-dir f "\t")
  1243.           (setq ancestor-dir-files (cdr ancestor-dir-files))))
  1244.     (if output-dir
  1245.         (insert "output=" output-dir f "\t"))
  1246.     (backward-delete-char 1)
  1247.     (insert "\n")))))
  1248.  
  1249. ;;; Common setup routines
  1250.  
  1251. ;; Set up the window configuration.  If POS is given, set the points to
  1252. ;; the beginnings of the buffers.
  1253. (defun emerge-setup-windows (buffer-A buffer-B merge-buffer &optional pos)
  1254.   ;; Make sure we are not in the minibuffer window when we try to delete
  1255.   ;; all other windows.
  1256.   (if (eq (selected-window) (minibuffer-window))
  1257.       (other-window 1))
  1258.   (delete-other-windows)
  1259.   (switch-to-buffer merge-buffer)
  1260.   (emerge-refresh-mode-line)
  1261.   (split-window-vertically)
  1262.   (if emerge-lucid-p
  1263.       (split-window-vertically)        ; horizontal split is broken in Lemacs
  1264.     (split-window-horizontally))
  1265.   (switch-to-buffer buffer-A)
  1266.   (if pos
  1267.       (goto-char (point-min)))
  1268.   (other-window 1)
  1269.   (switch-to-buffer buffer-B)
  1270.   (if pos
  1271.       (goto-char (point-min)))
  1272.   (other-window 1)
  1273.   (if pos
  1274.       (goto-char (point-min)))
  1275.   ;; If diff/diff3 reports errors, display them rather than the merge buffer.
  1276.   (if (/= 0 (emerge-eval-in-buffer emerge-diff-error-buffer (buffer-size)))
  1277.       (progn
  1278.     (ding)
  1279.     (message "Errors found in diff/diff3 output.  Merge buffer is %s."
  1280.          (buffer-name emerge-merge-buffer))
  1281.     (switch-to-buffer emerge-diff-error-buffer))))
  1282.  
  1283. ;; Set up the keymap in the merge buffer
  1284. (defun emerge-set-keys ()
  1285.   ;; Set up fixed keymaps if necessary
  1286.   (if (not emerge-basic-keymap)
  1287.       (emerge-setup-fixed-keymaps))
  1288.   ;; Save the old local map
  1289.   (setq emerge-old-keymap (current-local-map))
  1290.   ;; Construct the edit keymap
  1291.   (setq emerge-edit-keymap (if emerge-old-keymap
  1292.                    (copy-keymap emerge-old-keymap)
  1293.                  (make-sparse-keymap)))
  1294.   ;; Install the Emerge commands
  1295.   (emerge-force-define-key emerge-edit-keymap emerge-command-prefix
  1296.                'emerge-basic-keymap)
  1297.   ;; Suppress write-file and save-buffer
  1298.   (emerge-recursively-substitute-key-definition 'write-file
  1299.                         'emerge-query-write-file
  1300.                         emerge-edit-keymap)
  1301.   (emerge-recursively-substitute-key-definition 'save-buffer
  1302.                         'emerge-query-save-buffer
  1303.                         emerge-edit-keymap)
  1304.   (emerge-shadow-key-definition 'write-file 'emerge-query-write-file
  1305.                 (current-global-map) emerge-edit-keymap)
  1306.   (emerge-shadow-key-definition 'save-buffer 'emerge-query-save-buffer
  1307.                 (current-global-map) emerge-edit-keymap)
  1308.   (use-local-map emerge-fast-keymap)
  1309.   (setq emerge-edit-mode nil)
  1310.   (setq emerge-fast-mode t))
  1311.  
  1312. (defun emerge-remember-buffer-characteristics ()
  1313.   "Must be called in the merge buffer.  Remembers certain properties of the
  1314. buffers being merged (read-only, modified, auto-save), and saves them in
  1315. buffer local variables.  Sets the buffers read-only and turns off auto-save.
  1316. These characteristics are restored by emerge-restore-buffer-characteristics."
  1317.   ;; force auto-save, because we will turn off auto-saving in buffers for the
  1318.   ;; duration
  1319.   (do-auto-save)
  1320.   ;; remember and alter buffer characteristics
  1321.   (setq emerge-A-buffer-values
  1322.     (emerge-eval-in-buffer
  1323.      emerge-A-buffer
  1324.      (prog1
  1325.          (emerge-save-variables emerge-saved-variables)
  1326.        (emerge-restore-variables emerge-saved-variables
  1327.                      emerge-merging-values))))
  1328.   (setq emerge-B-buffer-values
  1329.     (emerge-eval-in-buffer
  1330.      emerge-B-buffer
  1331.      (prog1
  1332.          (emerge-save-variables emerge-saved-variables)
  1333.        (emerge-restore-variables emerge-saved-variables
  1334.                      emerge-merging-values)))))
  1335.  
  1336. (defun emerge-restore-buffer-characteristics ()
  1337.   "Restores the characteristics remembered by
  1338. emerge-remember-buffer-characteristics."
  1339.   (let ((A-values emerge-A-buffer-values)
  1340.     (B-values emerge-B-buffer-values))
  1341.     (emerge-eval-in-buffer emerge-A-buffer
  1342.                (emerge-restore-variables emerge-saved-variables
  1343.                              A-values))
  1344.     (emerge-eval-in-buffer emerge-B-buffer
  1345.                (emerge-restore-variables emerge-saved-variables
  1346.                              B-values))))
  1347.  
  1348. (defun emerge-convert-diffs-to-markers (A-buffer
  1349.                     B-buffer
  1350.                     merge-buffer
  1351.                     lineno-list)
  1352.   (let* (marker-list
  1353.      (A-point-min (emerge-eval-in-buffer A-buffer (point-min)))
  1354.      (offset (1- A-point-min))
  1355.      (A-hidden-lines (emerge-eval-in-buffer
  1356.               A-buffer
  1357.               (save-restriction
  1358.                 (widen)
  1359.                 (count-lines 1 A-point-min))))
  1360.      (B-point-min (emerge-eval-in-buffer B-buffer (point-min)))
  1361.      (B-hidden-lines (emerge-eval-in-buffer
  1362.               B-buffer
  1363.               (save-restriction
  1364.                 (widen)
  1365.                 (count-lines 1 B-point-min)))))
  1366.     (while lineno-list
  1367.       (let* ((list-element (car lineno-list))
  1368.          a-begin-marker
  1369.          a-end-marker
  1370.          b-begin-marker
  1371.          b-end-marker
  1372.          merge-begin-marker
  1373.          merge-end-marker
  1374.          (a-begin (aref list-element 0))
  1375.          (a-end (aref list-element 1))
  1376.          (b-begin (aref list-element 2))
  1377.          (b-end (aref list-element 3))
  1378.          (state (aref list-element 4)))
  1379.     ;; place markers at the appropriate places in the buffers
  1380.     (emerge-eval-in-buffer
  1381.      A-buffer
  1382.      (goto-line (+ a-begin A-hidden-lines))
  1383.      (setq a-begin-marker (point-marker))
  1384.      (goto-line (+ a-end A-hidden-lines))
  1385.      (setq a-end-marker (point-marker)))
  1386.     (emerge-eval-in-buffer
  1387.      B-buffer
  1388.      (goto-line (+ b-begin B-hidden-lines))
  1389.      (setq b-begin-marker (point-marker))
  1390.      (goto-line (+ b-end B-hidden-lines))
  1391.      (setq b-end-marker (point-marker)))
  1392.     (setq merge-begin-marker (set-marker
  1393.                   (make-marker)
  1394.                   (- (marker-position a-begin-marker)
  1395.                      offset)
  1396.                   merge-buffer))
  1397.     (setq merge-end-marker (set-marker
  1398.                 (make-marker)
  1399.                 (- (marker-position a-end-marker)
  1400.                    offset)
  1401.                 merge-buffer))
  1402.     ;; record all the markers for this difference
  1403.     (setq marker-list (cons (vector a-begin-marker a-end-marker
  1404.                     b-begin-marker b-end-marker
  1405.                     merge-begin-marker merge-end-marker
  1406.                     state)
  1407.                 marker-list)))
  1408.       (setq lineno-list (cdr lineno-list)))
  1409.     ;; convert the list of difference information into a vector for
  1410.     ;; fast access
  1411.     (setq emerge-difference-list (apply 'vector (nreverse marker-list)))))
  1412.  
  1413. ;; If we have an ancestor, select all B variants that we prefer 
  1414. (defun emerge-select-prefer-Bs ()
  1415.   (let ((n 0))
  1416.     (while (< n emerge-number-of-differences)
  1417.       (if (eq (aref (aref emerge-difference-list n) 6) 'prefer-B)
  1418.       (progn
  1419.         (emerge-unselect-and-select-difference n t)
  1420.         (emerge-select-B)
  1421.         (aset (aref emerge-difference-list n) 6 'prefer-B)))
  1422.       (setq n (1+ n))))
  1423.   (emerge-unselect-and-select-difference -1))
  1424.  
  1425. ;; Process the local-variables list at the end of the merged file, if
  1426. ;; requested.
  1427. (defun emerge-handle-local-variables ()
  1428.   (if emerge-process-local-variables
  1429.       (condition-case err
  1430.       (hack-local-variables t)
  1431.     (error (message "Local-variables error in merge buffer: %s"
  1432.             (prin1-to-string err))))))
  1433.  
  1434. ;;; Common exit routines
  1435.  
  1436. (defun emerge-write-and-delete (file-out)
  1437.   ;; clear screen format
  1438.   (delete-other-windows)
  1439.   ;; delete A, B, and ancestor buffers, if they haven't been changed
  1440.   (if (not (buffer-modified-p emerge-A-buffer))
  1441.       (kill-buffer emerge-A-buffer))
  1442.   (if (not (buffer-modified-p emerge-B-buffer))
  1443.       (kill-buffer emerge-B-buffer))
  1444.   (if (and emerge-ancestor-buffer
  1445.        (not (buffer-modified-p emerge-ancestor-buffer)))
  1446.       (kill-buffer emerge-ancestor-buffer))
  1447.   ;; Write merge buffer to file
  1448.   (write-file file-out))
  1449.  
  1450. ;;; Commands
  1451.  
  1452. (defun emerge-recenter (&optional arg)
  1453.   "Bring the highlighted region of all three merge buffers into view,
  1454. if they are in windows.  If an ARGUMENT is given, the default three-window
  1455. display is reestablished."
  1456.   (interactive "P")
  1457.   ;; If there is an argument, rebuild the window structure
  1458.   (if arg
  1459.       (emerge-setup-windows emerge-A-buffer emerge-B-buffer
  1460.                 emerge-merge-buffer))
  1461.   ;; Redisplay whatever buffers are showing, if there is a selected difference
  1462.   (if (and (>= emerge-current-difference 0)
  1463.        (< emerge-current-difference emerge-number-of-differences))
  1464.       (let* ((merge-buffer emerge-merge-buffer)
  1465.          (buffer-A emerge-A-buffer)
  1466.          (buffer-B emerge-B-buffer)
  1467.          (window-A (get-buffer-window buffer-A))
  1468.          (window-B (get-buffer-window buffer-B))
  1469.          (merge-window (get-buffer-window merge-buffer))
  1470.          (diff-vector
  1471.           (aref emerge-difference-list emerge-current-difference)))
  1472.     (if window-A (progn
  1473.                (select-window window-A)
  1474.                (emerge-position-region
  1475.             (- (aref diff-vector 0)
  1476.                (1- emerge-before-flag-length))
  1477.             (+ (aref diff-vector 1)
  1478.                (1- emerge-after-flag-length))
  1479.             (1+ (aref diff-vector 0)))))
  1480.     (if window-B (progn
  1481.                (select-window window-B)
  1482.                (emerge-position-region
  1483.             (- (aref diff-vector 2)
  1484.                (1- emerge-before-flag-length))
  1485.             (+ (aref diff-vector 3)
  1486.                (1- emerge-after-flag-length))
  1487.             (1+ (aref diff-vector 2)))))
  1488.     (if merge-window (progn
  1489.                (select-window merge-window)
  1490.                (emerge-position-region
  1491.                 (- (aref diff-vector 4)
  1492.                    (1- emerge-before-flag-length))
  1493.                 (+ (aref diff-vector 5)
  1494.                    (1- emerge-after-flag-length))
  1495.                 (1+ (aref diff-vector 4))))))))
  1496.  
  1497. ;;; Window scrolling operations
  1498. ;; These operations are designed to scroll all three windows the same amount,
  1499. ;; so as to keep the text in them aligned.
  1500.  
  1501. ;; Perform some operation on all three windows (if they are showing).
  1502. ;; Catches all errors on the operation in the A and B windows, but not
  1503. ;; in the merge window.  Usually, errors come from scrolling off the
  1504. ;; beginning or end of the buffer, and this gives a nice error message:
  1505. ;; End of buffer is reported in the merge buffer, but if the scroll was
  1506. ;; possible in the A or B windows, it is performed there before the error
  1507. ;; is reported.
  1508. (defun emerge-operate-on-windows (operation arg)
  1509.   (let* ((merge-buffer emerge-merge-buffer)
  1510.      (buffer-A emerge-A-buffer)
  1511.      (buffer-B emerge-B-buffer)
  1512.      (window-A (get-buffer-window buffer-A))
  1513.      (window-B (get-buffer-window buffer-B))
  1514.      (merge-window (get-buffer-window merge-buffer)))
  1515.     (if window-A (progn
  1516.            (select-window window-A)
  1517.            (condition-case nil
  1518.                (funcall operation arg)
  1519.              (error))))
  1520.     (if window-B (progn
  1521.            (select-window window-B)
  1522.            (condition-case nil
  1523.                (funcall operation arg)
  1524.              (error))))
  1525.     (if merge-window (progn
  1526.                (select-window merge-window)
  1527.                (funcall operation arg)))))
  1528.  
  1529. (defun emerge-scroll-up (&optional arg)
  1530.   "Scroll up all three merge buffers, if they are in windows.
  1531. If an ARGUMENT is given, that is how many lines are scrolled, else nearly
  1532. the size of the merge window.  `C-u -' alone as argument scrolls half the
  1533. size of the merge window."
  1534.   (interactive "P")
  1535.   (emerge-operate-on-windows
  1536.    'scroll-up 
  1537.    ;; calculate argument to scroll-up
  1538.    ;; if there is an explicit argument
  1539.    (if (and arg (not (equal arg '-)))
  1540.        ;; use it
  1541.        (prefix-numeric-value arg)
  1542.      ;; if not, see if we can determine a default amount (the window height)
  1543.      (let ((merge-window (get-buffer-window emerge-merge-buffer)))
  1544.        (if (null merge-window)
  1545.        ;; no window, use nil
  1546.        nil
  1547.      (let ((default-amount
  1548.          (- (window-height merge-window) 1 next-screen-context-lines)))
  1549.        ;; the window was found
  1550.        (if arg
  1551.            ;; C-u as argument means half of default amount
  1552.            (/ default-amount 2)
  1553.          ;; no argument means default amount
  1554.          default-amount)))))))
  1555.  
  1556. (defun emerge-scroll-down (&optional arg)
  1557.   "Scroll down all three merge buffers, if they are in windows.
  1558. If an ARGUMENT is given, that is how many lines are scrolled, else nearly
  1559. the size of the merge window.  `C-u -' alone as argument scrolls half the
  1560. size of the merge window."
  1561.   (interactive "P")
  1562.   (emerge-operate-on-windows
  1563.    'scroll-down
  1564.    ;; calculate argument to scroll-down
  1565.    ;; if there is an explicit argument
  1566.    (if (and arg (not (equal arg '-)))
  1567.        ;; use it
  1568.        (prefix-numeric-value arg)
  1569.      ;; if not, see if we can determine a default amount (the window height)
  1570.      (let ((merge-window (get-buffer-window emerge-merge-buffer)))
  1571.        (if (null merge-window)
  1572.        ;; no window, use nil
  1573.        nil
  1574.      (let ((default-amount
  1575.          (- (window-height merge-window) 1 next-screen-context-lines)))
  1576.        ;; the window was found
  1577.        (if arg
  1578.            ;; C-u as argument means half of default amount
  1579.            (/ default-amount 2)
  1580.          ;; no argument means default amount
  1581.          default-amount)))))))
  1582.  
  1583. (defun emerge-scroll-left (&optional arg)
  1584.   "Scroll left all three merge buffers, if they are in windows.
  1585. If an ARGUMENT is given, that is how many columns are scrolled, else nearly
  1586. the width of the A and B windows.  `C-u -' alone as argument scrolls half the
  1587. width of the A and B windows."
  1588.   (interactive "P")
  1589.   (emerge-operate-on-windows
  1590.    'scroll-left
  1591.    ;; calculate argument to scroll-left
  1592.    ;; if there is an explicit argument
  1593.    (if (and arg (not (equal arg '-)))
  1594.        ;; use it
  1595.        (prefix-numeric-value arg)
  1596.      ;; if not, see if we can determine a default amount
  1597.      ;; (half the window width)
  1598.      (let ((merge-window (get-buffer-window emerge-merge-buffer)))
  1599.        (if (null merge-window)
  1600.        ;; no window, use nil
  1601.        nil
  1602.      (let ((default-amount
  1603.          (- (/ (window-width merge-window) 2) 3)))
  1604.        ;; the window was found
  1605.        (if arg
  1606.            ;; C-u as argument means half of default amount
  1607.            (/ default-amount 2)
  1608.          ;; no argument means default amount
  1609.          default-amount)))))))
  1610.  
  1611. (defun emerge-scroll-right (&optional arg)
  1612.   "Scroll right all three merge buffers, if they are in windows.
  1613. If an ARGUMENT is given, that is how many columns are scrolled, else nearly
  1614. the width of the A and B windows.  `C-u -' alone as argument scrolls half the
  1615. width of the A and B windows."
  1616.   (interactive "P")
  1617.   (emerge-operate-on-windows
  1618.    'scroll-right
  1619.    ;; calculate argument to scroll-right
  1620.    ;; if there is an explicit argument
  1621.    (if (and arg (not (equal arg '-)))
  1622.        ;; use it
  1623.        (prefix-numeric-value arg)
  1624.      ;; if not, see if we can determine a default amount
  1625.      ;; (half the window width)
  1626.      (let ((merge-window (get-buffer-window emerge-merge-buffer)))
  1627.        (if (null merge-window)
  1628.        ;; no window, use nil
  1629.        nil
  1630.      (let ((default-amount
  1631.          (- (/ (window-width merge-window) 2) 3)))
  1632.        ;; the window was found
  1633.        (if arg
  1634.            ;; C-u as argument means half of default amount
  1635.            (/ default-amount 2)
  1636.          ;; no argument means default amount
  1637.          default-amount)))))))
  1638.  
  1639. (defun emerge-scroll-reset ()
  1640.   "Reset horizontal scrolling of all three merge buffers to the left margin,
  1641. if they are in windows."
  1642.   (interactive)
  1643.   (emerge-operate-on-windows
  1644.    (function (lambda (x) (set-window-hscroll (selected-window) 0)))
  1645.    nil))
  1646.  
  1647. ;; Attempt to show the region nicely.
  1648. ;; If there are min-lines lines above and below the region, then don't do
  1649. ;; anything.
  1650. ;; If not, recenter the region to make it so.
  1651. ;; If that isn't possible, remove context lines balancedly from top and botton
  1652. ;; so the entire region shows.
  1653. ;; If that isn't possible, show the top of the region.
  1654. ;; BEG must be at the beginning of a line.
  1655. (defun emerge-position-region (beg end pos)
  1656.   ;; First test whether the entire region is visible with
  1657.   ;; emerge-min-visible-lines above and below it
  1658.   (if (not (and (<= (progn
  1659.               (move-to-window-line emerge-min-visible-lines)
  1660.               (point))
  1661.             beg)
  1662.         (<= end (progn
  1663.               (move-to-window-line
  1664.                (- (1+ emerge-min-visible-lines)))
  1665.               (point)))))
  1666.       ;; We failed that test, see if it fits at all
  1667.       ;; Meanwhile positioning it correctly in case it doesn't fit
  1668.       (progn
  1669.     (set-window-start (selected-window) beg)
  1670.     (if (pos-visible-in-window-p end)
  1671.         ;; Determine the number of lines that the region occupies
  1672.         (let ((lines 0))
  1673.           (while (> end (progn
  1674.                   (move-to-window-line lines)
  1675.                   (point)))
  1676.         (setq lines (1+ lines)))
  1677.           ;; And position the beginning on the right line
  1678.           (goto-char beg)
  1679.           (recenter (/ (1+ (- (1- (window-height (selected-window)))
  1680.                   lines))
  1681.                2))))))
  1682.   (goto-char pos))
  1683.  
  1684. (defun emerge-next-difference ()
  1685.   "Advance to the next difference."
  1686.   (interactive)
  1687.   (if (< emerge-current-difference emerge-number-of-differences)
  1688.       (let ((n (1+ emerge-current-difference)))
  1689.     (while (and emerge-skip-prefers
  1690.             (< n emerge-number-of-differences)
  1691.             (memq (aref (aref emerge-difference-list n) 6)
  1692.               '(prefer-A prefer-B)))
  1693.       (setq n (1+ n)))
  1694.     (let ((buffer-read-only nil))
  1695.       (emerge-unselect-and-select-difference n)))
  1696.     (error "At end")))
  1697.  
  1698. (defun emerge-previous-difference ()
  1699.   "Go to the previous difference."
  1700.   (interactive)
  1701.   (if (> emerge-current-difference -1)
  1702.       (let ((n (1- emerge-current-difference)))
  1703.     (while (and emerge-skip-prefers
  1704.             (> n -1)
  1705.             (memq (aref (aref emerge-difference-list n) 6)
  1706.               '(prefer-A prefer-B)))
  1707.       (setq n (1- n)))
  1708.     (let ((buffer-read-only nil))
  1709.       (emerge-unselect-and-select-difference n)))
  1710.     (error "At beginning")))
  1711.  
  1712. (defun emerge-jump-to-difference (difference-number)
  1713.   "Go to the N-th difference."
  1714.   (interactive "p")
  1715.   (let ((buffer-read-only nil))
  1716.     (setq difference-number (1- difference-number))
  1717.     (if (and (>= difference-number -1)
  1718.          (< difference-number (1+ emerge-number-of-differences)))
  1719.     (emerge-unselect-and-select-difference difference-number)
  1720.       (error "Bad difference number"))))
  1721.  
  1722. (defun emerge-quit (arg)
  1723.   "Finish an Emerge session.  Prefix ARGUMENT means to abort rather than
  1724. successfully finish.  The difference depends on how the merge was started,
  1725. but usually means to not write over one of the original files, or to signal
  1726. to some process which invoked Emerge a failure code.
  1727.  
  1728. Unselects the selected difference, if any, restores the read-only and modified
  1729. flags of the merged file buffers, restores the local keymap of the merge
  1730. buffer, and sets off various emerge flags.  Using Emerge commands in this
  1731. buffer after this will cause serious problems."
  1732.   (interactive "P")
  1733.   (if (prog1
  1734.       (y-or-n-p
  1735.        (if (not arg)
  1736.            "Do you really want to successfully finish this merge? "
  1737.          "Do you really want to abort this merge? "))
  1738.     (message ""))
  1739.       (emerge-really-quit arg)))
  1740.  
  1741. ;; Perform the quit operations.
  1742. (defun emerge-really-quit (arg)
  1743.   (setq buffer-read-only nil)
  1744.   (emerge-unselect-and-select-difference -1)
  1745.   (emerge-restore-buffer-characteristics)
  1746.   ;; null out the difference markers so they don't slow down future editing
  1747.   ;; operations
  1748.   (mapcar (function (lambda (d)
  1749.               (set-marker (aref d 0) nil)
  1750.               (set-marker (aref d 1) nil)
  1751.               (set-marker (aref d 2) nil)
  1752.               (set-marker (aref d 3) nil)
  1753.               (set-marker (aref d 4) nil)
  1754.               (set-marker (aref d 5) nil)))
  1755.       emerge-difference-list)
  1756.   ;; allow them to be garbage collected
  1757.   (setq emerge-difference-list nil)
  1758.   ;; restore the local map
  1759.   (use-local-map emerge-old-keymap)
  1760.   ;; turn off all the emerge modes
  1761.   (setq emerge-mode nil)
  1762.   (setq emerge-fast-mode nil)
  1763.   (setq emerge-edit-mode nil)
  1764.   (setq emerge-auto-advance nil)
  1765.   (setq emerge-skip-prefers nil)
  1766.   ;; restore mode line
  1767.   (kill-local-variable 'mode-line-buffer-identification)
  1768.   (let ((emerge-prefix-argument arg))
  1769.     (run-hooks 'emerge-quit-hooks)))
  1770.  
  1771. (defun emerge-select-A (&optional force)
  1772.   "Select the A variant of this difference.  Refuses to function if this
  1773. difference has been edited, i.e., if it is neither the A nor the B variant.
  1774. An ARGUMENT forces the variant to be selected even if the difference has
  1775. been edited."
  1776.   (interactive "P")
  1777.   (let ((operate
  1778.      (function (lambda ()
  1779.              (emerge-select-A-edit merge-begin merge-end A-begin A-end)
  1780.              (if emerge-auto-advance
  1781.              (emerge-next-difference)))))
  1782.     (operate-no-change
  1783.      (function (lambda ()
  1784.              (if emerge-auto-advance
  1785.              (emerge-next-difference))))))
  1786.     (emerge-select-version force operate-no-change operate operate)))
  1787.  
  1788. ;; Actually select the A variant
  1789. (defun emerge-select-A-edit (merge-begin merge-end A-begin A-end)
  1790.   (emerge-eval-in-buffer
  1791.    emerge-merge-buffer
  1792.    (delete-region merge-begin merge-end)
  1793.    (goto-char merge-begin)
  1794.    (insert-buffer-substring emerge-A-buffer A-begin A-end)
  1795.    (goto-char merge-begin)
  1796.    (aset diff-vector 6 'A)
  1797.    (emerge-refresh-mode-line)))
  1798.  
  1799. (defun emerge-select-B (&optional force)
  1800.   "Select the B variant of this difference.  Refuses to function if this
  1801. difference has been edited, i.e., if it is neither the A nor the B variant.
  1802. An ARGUMENT forces the variant to be selected even if the difference has
  1803. been edited."
  1804.   (interactive "P")
  1805.   (let ((operate
  1806.      (function (lambda ()
  1807.              (emerge-select-B-edit merge-begin merge-end B-begin B-end)
  1808.              (if emerge-auto-advance
  1809.              (emerge-next-difference)))))
  1810.     (operate-no-change
  1811.      (function (lambda ()
  1812.              (if emerge-auto-advance
  1813.              (emerge-next-difference))))))
  1814.     (emerge-select-version force operate operate-no-change operate)))
  1815.  
  1816. ;; Actually select the B variant
  1817. (defun emerge-select-B-edit (merge-begin merge-end B-begin B-end)
  1818.   (emerge-eval-in-buffer
  1819.    emerge-merge-buffer
  1820.    (delete-region merge-begin merge-end)
  1821.    (goto-char merge-begin)
  1822.    (insert-buffer-substring emerge-B-buffer B-begin B-end)
  1823.    (goto-char merge-begin)
  1824.    (aset diff-vector 6 'B)
  1825.    (emerge-refresh-mode-line)))
  1826.  
  1827. (defun emerge-default-A (force)
  1828.   "Selects the A variant for all differences from here down in the buffer
  1829. which are still defaulted, i.e., which the user has not selected and for
  1830. which there is no preference.
  1831. A prefix argument forces all differences from here down that have
  1832. selected the B version to become default-A as well."
  1833.   (interactive "P")
  1834.   (let ((buffer-read-only nil))
  1835.     (let ((selected-difference emerge-current-difference)
  1836.       (n (max emerge-current-difference 0)))
  1837.       (while (< n emerge-number-of-differences)
  1838.     (let ((diff-vector (aref emerge-difference-list n)))
  1839.       (if (or (eq (aref diff-vector 6) 'default-B)
  1840.           (and force
  1841.                (eq (aref diff-vector 6) 'B)))
  1842.           (progn
  1843.         (emerge-unselect-and-select-difference n t)
  1844.         (emerge-select-A force)
  1845.         (aset diff-vector 6 'default-A))))
  1846.     (setq n (1+ n))
  1847.     (if (= (* (/ n 10) 10) n)
  1848.         (message "Setting default to A...%d" n)))
  1849.       (emerge-unselect-and-select-difference selected-difference)))
  1850.   (message "Default A set"))
  1851.  
  1852. (defun emerge-default-B (force)
  1853.   "Selects the B variant for all differences from here down in the buffer
  1854. which are still defaulted, i.e., which the user has not selected and for
  1855. which there is no preference.
  1856. A prefix argument forces all differences from here down that have
  1857. selected the A version to become default-B as well."
  1858.   (interactive "P")
  1859.   (let ((buffer-read-only nil))
  1860.     (let ((selected-difference emerge-current-difference)
  1861.       (n (max emerge-current-difference 0)))
  1862.       (while (< n emerge-number-of-differences)
  1863.     (let ((diff-vector (aref emerge-difference-list n)))
  1864.       (if (or (eq (aref diff-vector 6) 'default-A)
  1865.           (and force
  1866.                (eq (aref diff-vector 6) 'A)))
  1867.           (progn
  1868.         (emerge-unselect-and-select-difference n t)
  1869.         (emerge-select-B force)
  1870.         (aset diff-vector 6 'default-B))))
  1871.     (setq n (1+ n))
  1872.     (if (= (* (/ n 10) 10) n)
  1873.         (message "Setting default to B...%d" n)))
  1874.       (emerge-unselect-and-select-difference selected-difference)))
  1875.   (message "Default B set"))
  1876.  
  1877. (defun emerge-fast-mode ()
  1878.   "Set fast mode, in which ordinary Emacs commands are disabled, and Emerge
  1879. commands are need not be prefixed with \\<emerge-fast-keymap>\\[emerge-basic-keymap]."
  1880.   (interactive)
  1881.   (setq buffer-read-only t)
  1882.   (use-local-map emerge-fast-keymap)
  1883.   (setq emerge-mode t)
  1884.   (setq emerge-fast-mode t)
  1885.   (setq emerge-edit-mode nil)
  1886.   (message "Fast mode set")
  1887.   ;; force mode line redisplay
  1888.   (set-buffer-modified-p (buffer-modified-p)))
  1889.  
  1890. (defun emerge-edit-mode ()
  1891.   "Set edit mode, in which ordinary Emacs commands are available, and Emerge
  1892. commands must be prefixed with \\<emerge-fast-keymap>\\[emerge-basic-keymap]."
  1893.   (interactive)
  1894.   (setq buffer-read-only nil)
  1895.   (use-local-map emerge-edit-keymap)
  1896.   (setq emerge-mode t)
  1897.   (setq emerge-fast-mode nil)
  1898.   (setq emerge-edit-mode t)
  1899.   (message "Edit mode set")
  1900.   ;; force mode line redisplay
  1901.   (set-buffer-modified-p (buffer-modified-p)))
  1902.  
  1903. (defun emerge-auto-advance (arg)
  1904.   "Toggle auto-advance mode, which causes  emerge-select-A  and
  1905.  emerge-select-B  to automatically advance to the next difference.  (See
  1906. emerge-auto-advance.)  
  1907. If a positive ARGUMENT is given, it turns on auto-advance mode.
  1908. If a negative ARGUMENT is given, it turns off auto-advance mode."
  1909.   (interactive "P")
  1910.   (setq emerge-auto-advance (if (null arg)
  1911.                 (not emerge-auto-advance)
  1912.                   (> (prefix-numeric-value arg) 0)))
  1913.   (message (if emerge-skip-prefers
  1914.            "Auto-advance set"
  1915.          "Auto-advance cleared"))
  1916.   ;; force mode line redisplay
  1917.   (set-buffer-modified-p (buffer-modified-p)))
  1918.  
  1919. (defun emerge-skip-prefers (arg)
  1920.   "Toggle skip-prefers mode, which causes  emerge-next-difference  and
  1921.  emerge-previous-difference  to automatically skip over differences for which
  1922. there is a preference.  (See emerge-skip-prefers.)  
  1923. If a positive ARGUMENT is given, it turns on skip-prefers mode.
  1924. If a negative ARGUMENT is given, it turns off skip-prefers mode."
  1925.   (interactive "P")
  1926.   (setq emerge-skip-prefers (if (null arg)
  1927.                 (not emerge-skip-prefers)
  1928.                   (> (prefix-numeric-value arg) 0)))
  1929.   (message (if emerge-skip-prefers
  1930.            "Skip-prefers set"
  1931.          "Skip-prefers cleared"))
  1932.   ;; force mode line redisplay
  1933.   (set-buffer-modified-p (buffer-modified-p)))
  1934.  
  1935. (defun emerge-copy-as-kill-A ()
  1936.   "Put the A variant of this difference in the kill ring."
  1937.   (interactive)
  1938.   (emerge-validate-difference)
  1939.   (let* ((diff-vector
  1940.       (aref emerge-difference-list emerge-current-difference))
  1941.      (A-begin (1+ (aref diff-vector 0)))
  1942.      (A-end (1- (aref diff-vector 1)))
  1943.      ;; so further kills don't append
  1944.      this-command)
  1945.     (save-excursion
  1946.       (set-buffer emerge-A-buffer)
  1947.       (copy-region-as-kill A-begin A-end))))
  1948.  
  1949. (defun emerge-copy-as-kill-B ()
  1950.   "Put the B variant of this difference in the kill ring."
  1951.   (interactive)
  1952.   (emerge-validate-difference)
  1953.   (let* ((diff-vector
  1954.       (aref emerge-difference-list emerge-current-difference))
  1955.      (B-begin (1+ (aref diff-vector 2)))
  1956.      (B-end (1- (aref diff-vector 3)))
  1957.      ;; so further kills don't append
  1958.      this-command)
  1959.     (save-excursion
  1960.       (set-buffer emerge-B-buffer)
  1961.       (copy-region-as-kill B-begin B-end))))
  1962.  
  1963. (defun emerge-insert-A (arg)
  1964.   "Insert the A variant of this difference at the point.
  1965. Leaves point after text, mark before.
  1966. With prefix argument, puts point before, mark after."
  1967.   (interactive "P")
  1968.   (emerge-validate-difference)
  1969.   (let* ((diff-vector
  1970.       (aref emerge-difference-list emerge-current-difference))
  1971.      (A-begin (1+ (aref diff-vector 0)))
  1972.      (A-end (1- (aref diff-vector 1)))
  1973.      (opoint (point))
  1974.      (buffer-read-only nil))
  1975.     (insert-buffer-substring emerge-A-buffer A-begin A-end)
  1976.     (if (not arg)
  1977.     (set-mark opoint)
  1978.       (set-mark (point))
  1979.       (goto-char opoint))))
  1980.  
  1981. (defun emerge-insert-B (arg)
  1982.   "Insert the B variant of this difference at the point.
  1983. Leaves point after text, mark before.
  1984. With prefix argument, puts point before, mark after."
  1985.   (interactive "P")
  1986.   (emerge-validate-difference)
  1987.   (let* ((diff-vector
  1988.       (aref emerge-difference-list emerge-current-difference))
  1989.      (B-begin (1+ (aref diff-vector 2)))
  1990.      (B-end (1- (aref diff-vector 3)))
  1991.      (opoint (point))
  1992.      (buffer-read-only nil))
  1993.     (insert-buffer-substring emerge-B-buffer B-begin B-end)
  1994.     (if (not arg)
  1995.     (set-mark opoint)
  1996.       (set-mark (point))
  1997.       (goto-char opoint))))
  1998.  
  1999. (defun emerge-mark-difference (arg)
  2000.   "Leaves the point before this difference and the mark after it.
  2001. With prefix argument, puts mark before, point after."
  2002.   (interactive "P")
  2003.   (emerge-validate-difference)
  2004.   (let* ((diff-vector
  2005.       (aref emerge-difference-list emerge-current-difference))
  2006.      (merge-begin (1+ (aref diff-vector 4)))
  2007.      (merge-end (1- (aref diff-vector 5))))
  2008.     (if (not arg)
  2009.     (progn
  2010.       (goto-char merge-begin)
  2011.       (set-mark merge-end))
  2012.       (goto-char merge-end)
  2013.       (set-mark merge-begin))))
  2014.  
  2015. (defun emerge-file-names ()
  2016.   "Show the names of the buffers or files being operated on by Emerge.
  2017. Use ^U L to reset the windows afterward."
  2018.   (interactive)
  2019.   (delete-other-windows)
  2020.   (let* ((temp-buffer-show-hook
  2021.      (function (lambda (buf)
  2022.              (split-window-vertically)
  2023.              (switch-to-buffer buf)
  2024.              (other-window 1))))
  2025.      (temp-buffer-show-function temp-buffer-show-hook))
  2026.     (with-output-to-temp-buffer "*Help*"
  2027.       (emerge-eval-in-buffer emerge-A-buffer
  2028.                  (if buffer-file-name
  2029.                  (progn
  2030.                    (princ "File A is: ")
  2031.                    (princ buffer-file-name))
  2032.                    (progn
  2033.                  (princ "Buffer A is: ")
  2034.                  (princ (buffer-name))))
  2035.                  (princ "\n"))
  2036.       (emerge-eval-in-buffer emerge-B-buffer
  2037.                  (if buffer-file-name
  2038.                  (progn
  2039.                    (princ "File B is: ")
  2040.                    (princ buffer-file-name))
  2041.                    (progn
  2042.                  (princ "Buffer B is: ")
  2043.                  (princ (buffer-name))))
  2044.                  (princ "\n"))
  2045.       (if emerge-ancestor-buffer
  2046.         (emerge-eval-in-buffer emerge-ancestor-buffer
  2047.                    (if buffer-file-name
  2048.                        (progn
  2049.                      (princ "Ancestor file is: ")
  2050.                      (princ buffer-file-name))
  2051.                      (progn
  2052.                        (princ "Ancestor buffer is: ")
  2053.                        (princ (buffer-name))))
  2054.                    (princ "\n")))
  2055.       (princ emerge-output-description))))
  2056.  
  2057. (defun emerge-join-differences (arg)
  2058.   "Join the selected difference with the following one.  With a prefix
  2059. argument, join with the preceeding one."
  2060.   (interactive "P")
  2061.   (let ((n emerge-current-difference))
  2062.     ;; adjust n to be first difference to join
  2063.     (if arg
  2064.     (setq n (1- n)))
  2065.     ;; n and n+1 are the differences to join
  2066.     ;; check that they are both differences
  2067.     (if (or (< n 0) (>= n (1- emerge-number-of-differences)))
  2068.     (error "Incorrect differences to join"))
  2069.     ;; remove the flags
  2070.     (emerge-unselect-difference emerge-current-difference)
  2071.     ;; decrement total number of differences
  2072.     (setq emerge-number-of-differences (1- emerge-number-of-differences))
  2073.     ;; build new differences vector
  2074.     (let ((i 0)
  2075.       (new-differences (make-vector emerge-number-of-differences nil)))
  2076.       (while (< i emerge-number-of-differences)
  2077.     (aset new-differences i
  2078.           (cond
  2079.            ((< i n) (aref emerge-difference-list i))
  2080.            ((> i n) (aref emerge-difference-list (1+ i)))
  2081.            (t (let ((prev (aref emerge-difference-list i))
  2082.             (next (aref emerge-difference-list (1+ i))))
  2083.             (vector (aref prev 0)
  2084.                 (aref next 1)
  2085.                 (aref prev 2)
  2086.                 (aref next 3)
  2087.                 (aref prev 4)
  2088.                 (aref next 5)
  2089.                 (let ((ps (aref prev 6))
  2090.                   (ns (aref next 6)))
  2091.                   (cond
  2092.                    ((eq ps ns)
  2093.                 ps)
  2094.                    ((and (or (eq ps 'B) (eq ps 'prefer-B))
  2095.                      (or (eq ns 'B) (eq ns 'prefer-B)))
  2096.                 'B)
  2097.                    (t 'A))))))))
  2098.     (setq i (1+ i)))
  2099.       (setq emerge-difference-list new-differences))
  2100.     ;; set the current difference correctly
  2101.     (setq emerge-current-difference n)
  2102.     ;; fix the mode line
  2103.     (emerge-refresh-mode-line)
  2104.     ;; reinsert the flags
  2105.     (emerge-select-difference emerge-current-difference)
  2106.     (emerge-recenter)))
  2107.  
  2108. (defun emerge-split-difference ()
  2109.   "Split the current difference where the points are in the three windows."
  2110.   (interactive)
  2111.   (let ((n emerge-current-difference))
  2112.     ;; check that this is a valid difference
  2113.     (emerge-validate-difference)
  2114.     ;; get the point values and old difference
  2115.     (let ((A-point (emerge-eval-in-buffer emerge-A-buffer
  2116.                       (point-marker)))
  2117.       (B-point (emerge-eval-in-buffer emerge-B-buffer
  2118.                       (point-marker)))
  2119.       (merge-point (point-marker))
  2120.       (old-diff (aref emerge-difference-list n)))
  2121.       ;; check location of the points, give error if they aren't in the
  2122.       ;; differences
  2123.       (if (or (< A-point (aref old-diff 0))
  2124.           (> A-point (aref old-diff 1)))
  2125.       (error "Point outside of difference in A buffer"))
  2126.       (if (or (< B-point (aref old-diff 2))
  2127.           (> B-point (aref old-diff 3)))
  2128.       (error "Point outside of difference in B buffer"))
  2129.       (if (or (< merge-point (aref old-diff 4))
  2130.           (> merge-point (aref old-diff 5)))
  2131.       (error "Point outside of difference in merge buffer"))
  2132.       ;; remove the flags
  2133.       (emerge-unselect-difference emerge-current-difference)
  2134.       ;; increment total number of differences
  2135.       (setq emerge-number-of-differences (1+ emerge-number-of-differences))
  2136.       ;; build new differences vector
  2137.       (let ((i 0)
  2138.         (new-differences (make-vector emerge-number-of-differences nil)))
  2139.     (while (< i emerge-number-of-differences)
  2140.       (aset new-differences i
  2141.         (cond
  2142.          ((< i n)
  2143.           (aref emerge-difference-list i))
  2144.          ((> i (1+ n))
  2145.           (aref emerge-difference-list (1- i)))
  2146.          ((= i n)
  2147.           (vector (aref old-diff 0)
  2148.               A-point
  2149.               (aref old-diff 2)
  2150.               B-point
  2151.               (aref old-diff 4)
  2152.               merge-point
  2153.               (aref old-diff 6)))
  2154.          (t
  2155.           (vector (copy-marker A-point)
  2156.               (aref old-diff 1)
  2157.               (copy-marker B-point)
  2158.               (aref old-diff 3)
  2159.               (copy-marker merge-point)
  2160.               (aref old-diff 5)
  2161.               (aref old-diff 6)))))
  2162.       (setq i (1+ i)))
  2163.     (setq emerge-difference-list new-differences))
  2164.       ;; set the current difference correctly
  2165.       (setq emerge-current-difference n)
  2166.       ;; fix the mode line
  2167.       (emerge-refresh-mode-line)
  2168.       ;; reinsert the flags
  2169.       (emerge-select-difference emerge-current-difference)
  2170.       (emerge-recenter))))
  2171.  
  2172. (defun emerge-trim-difference ()
  2173.   "Trim lines off the top and bottom of a difference that are the same in
  2174. both the A and B versions.  (This can happen when the A and B versions
  2175. have common lines that the ancestor version does not share.)"
  2176.   (interactive)
  2177.   ;; make sure we are in a real difference
  2178.   (emerge-validate-difference)
  2179.   ;; remove the flags
  2180.   (emerge-unselect-difference emerge-current-difference)
  2181.   (let* ((diff (aref emerge-difference-list emerge-current-difference))
  2182.      (top-a (marker-position (aref diff 0)))
  2183.      (bottom-a (marker-position (aref diff 1)))
  2184.      (top-b (marker-position (aref diff 2)))
  2185.      (bottom-b (marker-position (aref diff 3)))
  2186.      (top-m (marker-position (aref diff 4)))
  2187.      (bottom-m (marker-position (aref diff 5)))
  2188.      size success sa sb sm)
  2189.     ;; move down the tops of the difference regions as much as possible
  2190.     ;; Try advancing comparing 1000 chars at a time.
  2191.     ;; When that fails, go 500 chars at a time, and so on.
  2192.     (setq size 1000)
  2193.     (while (> size 0)
  2194.       (setq success t)
  2195.       (while success
  2196.     (setq size (min size (- bottom-a top-a) (- bottom-b top-b)
  2197.             (- bottom-m top-m)))
  2198.     (setq sa (emerge-eval-in-buffer emerge-A-buffer
  2199.                     (buffer-substring top-a
  2200.                               (+ size top-a))))
  2201.     (setq sb (emerge-eval-in-buffer emerge-B-buffer
  2202.                     (buffer-substring top-b
  2203.                               (+ size top-b))))
  2204.     (setq sm (buffer-substring top-m (+ size top-m)))
  2205.     (setq success (and (> size 0) (equal sa sb) (equal sb sm)))
  2206.     (if success
  2207.         (setq top-a (+ top-a size)
  2208.           top-b (+ top-b size)
  2209.           top-m (+ top-m size))))
  2210.       (setq size (/ size 2)))
  2211.     ;; move up the bottoms of the difference regions as much as possible
  2212.     ;; Try advancing comparing 1000 chars at a time.
  2213.     ;; When that fails, go 500 chars at a time, and so on.
  2214.     (setq size 1000)
  2215.     (while (> size 0)
  2216.       (setq success t)
  2217.       (while success
  2218.     (setq size (min size (- bottom-a top-a) (- bottom-b top-b)
  2219.             (- bottom-m top-m)))
  2220.     (setq sa (emerge-eval-in-buffer emerge-A-buffer
  2221.                     (buffer-substring (- bottom-a size)
  2222.                               bottom-a)))
  2223.     (setq sb (emerge-eval-in-buffer emerge-B-buffer
  2224.                     (buffer-substring (- bottom-b size)
  2225.                               bottom-b)))
  2226.     (setq sm (buffer-substring (- bottom-m size) bottom-m))
  2227.     (setq success (and (> size 0) (equal sa sb) (equal sb sm)))
  2228.     (if success
  2229.         (setq bottom-a (- bottom-a size)
  2230.           bottom-b (- bottom-b size)
  2231.           bottom-m (- bottom-m size))))
  2232.       (setq size (/ size 2)))
  2233.     ;; {top,bottom}-{a,b,m} are now set at the new beginnings and ends
  2234.     ;; of the difference regions.  Move them to the beginning of lines, as
  2235.     ;; appropriate.
  2236.     (emerge-eval-in-buffer emerge-A-buffer
  2237.                (goto-char top-a)
  2238.                (beginning-of-line)
  2239.                (aset diff 0 (point-marker))
  2240.                (goto-char bottom-a)
  2241.                (beginning-of-line 2)
  2242.                (aset diff 1 (point-marker)))
  2243.     (emerge-eval-in-buffer emerge-B-buffer
  2244.                (goto-char top-b)
  2245.                (beginning-of-line)
  2246.                (aset diff 2 (point-marker))
  2247.                (goto-char bottom-b)
  2248.                (beginning-of-line 2)
  2249.                (aset diff 3 (point-marker)))
  2250.     (goto-char top-m)
  2251.     (beginning-of-line)
  2252.     (aset diff 4 (point-marker))
  2253.     (goto-char bottom-m)
  2254.     (beginning-of-line 2)
  2255.     (aset diff 5 (point-marker))
  2256.     ;; put the flags back in, recenter the display
  2257.     (emerge-select-difference emerge-current-difference)
  2258.     (emerge-recenter)))
  2259.  
  2260. (defun emerge-find-difference (arg)
  2261.   "Find the difference containing the current position of the point.
  2262. If there is no containing difference and the prefix argument is positive,
  2263. it finds the nearest following difference.  A negative prefix argument finds
  2264. the nearest previous difference."
  2265.   (interactive "P")
  2266.   ;; search for the point in the merge buffer, using the markers
  2267.   ;; for the beginning and end of the differences in the merge buffer
  2268.   (emerge-find-difference1 arg (point) 4 5))
  2269.  
  2270. (defun emerge-find-difference-A (arg)
  2271.   "Find the difference containing the current position of the point in the
  2272. A buffer.  (Nonetheless, this command must be executed in the merge buffer.)
  2273. If there is no containing difference and the prefix argument is positive,
  2274. it finds the nearest following difference.  A negative prefix argument finds
  2275. the nearest previous difference."
  2276.   (interactive "P")
  2277.   ;; search for the point in the A buffer, using the markers
  2278.   ;; for the beginning and end of the differences in the A buffer
  2279.   (emerge-find-difference1 arg
  2280.                (emerge-eval-in-buffer emerge-A-buffer (point))
  2281.                0 1))
  2282.  
  2283. (defun emerge-find-difference-B (arg)
  2284.   "Find the difference containing the current position of the point in the
  2285. B buffer.  (Nonetheless, this command must be executed in the merge buffer.)
  2286. If there is no containing difference and the prefix argument is positive,
  2287. it finds the nearest following difference.  A negative prefix argument finds
  2288. the nearest previous difference."
  2289.   (interactive "P")
  2290.   ;; search for the point in the B buffer, using the markers
  2291.   ;; for the beginning and end of the differences in the B buffer
  2292.   (emerge-find-difference1 arg
  2293.                (emerge-eval-in-buffer emerge-B-buffer (point))
  2294.                2 3))
  2295.  
  2296. (defun emerge-find-difference1 (arg location begin end)
  2297.   (let* ((index
  2298.       ;; find first difference containing or after the current position
  2299.       (catch 'search
  2300.         (let ((n 0))
  2301.           (while (< n emerge-number-of-differences)
  2302.         (let ((diff-vector (aref emerge-difference-list n)))
  2303.           (if (<= location (marker-position (aref diff-vector end)))
  2304.               (throw 'search n)))
  2305.         (setq n (1+ n))))
  2306.         emerge-number-of-differences))
  2307.      (contains
  2308.       ;; whether the found difference contains the current position
  2309.       (and (< index emerge-number-of-differences)
  2310.            (<= (marker-position (aref (aref emerge-difference-list index)
  2311.                       begin))
  2312.            location)))
  2313.      (arg-value
  2314.       ;; numeric value of prefix argument
  2315.       (prefix-numeric-value arg)))
  2316.     (emerge-unselect-and-select-difference
  2317.      (cond
  2318.       ;; if the point is in a difference, select it
  2319.       (contains index)
  2320.       ;; if the arg is nil and the point is not in a difference, error
  2321.       ((null arg) (error "No difference contains point"))
  2322.       ;; if the arg is positive, select the following difference
  2323.       ((> arg-value 0)
  2324.        (if (< index emerge-number-of-differences)
  2325.        index
  2326.      (error "No difference contains or follows point")))
  2327.       ;; if the arg is negative, select the preceeding difference
  2328.       (t
  2329.        (if (> index 0)
  2330.        (1- index)
  2331.      (error "No difference contains or preceeds point")))))))
  2332.  
  2333. (defun emerge-line-numbers ()
  2334.   "Display the current line numbers of the points in the A, B, and
  2335. merge buffers."
  2336.   (interactive)
  2337.   (let* ((valid-diff
  2338.      (and (>= emerge-current-difference 0)
  2339.           (< emerge-current-difference emerge-number-of-differences)))
  2340.     (diff (and valid-diff
  2341.            (aref emerge-difference-list emerge-current-difference)))
  2342.     (merge-line (emerge-line-number-in-buf 4 5))
  2343.     (A-line (emerge-eval-in-buffer emerge-A-buffer
  2344.                        (emerge-line-number-in-buf 0 1)))
  2345.     (B-line (emerge-eval-in-buffer emerge-B-buffer
  2346.                        (emerge-line-number-in-buf 2 3))))
  2347.     (message "At lines: merge = %d, A = %d, B = %d"
  2348.          merge-line A-line B-line)))
  2349.  
  2350. (defun emerge-line-number-in-buf (begin-marker end-marker)
  2351.   (let (temp)
  2352.     (setq temp (save-excursion
  2353.          (beginning-of-line)
  2354.          (1+ (count-lines 1 (point)))))
  2355.     (if valid-diff
  2356.     (progn
  2357.       (if (> (point) (aref diff begin-marker))
  2358.           (setq temp (- temp emerge-before-flag-lines)))
  2359.       (if (> (point) (aref diff end-marker))
  2360.           (setq temp (- temp emerge-after-flag-lines)))))
  2361.     temp))
  2362.  
  2363. (defun emerge-set-combine-versions-template (start end &optional localize)
  2364.   "Copy region into  emerge-combine-versions-template  which controls how
  2365. emerge-combine-versions  will combine the two versions.
  2366. With prefix argument,  emerge-combine-versions  is made local to this
  2367. merge buffer.  Localization is permanent for any particular merge buffer."
  2368.   (interactive "r\nP")
  2369.   (if localize
  2370.       (make-local-variable 'emerge-combine-versions-template))
  2371.   (setq emerge-combine-versions-template (buffer-substring start end))
  2372.   (message
  2373.    (if (assq 'emerge-combine-versions-template (buffer-local-variables))
  2374.        "emerge-set-combine-versions-template set locally."
  2375.      "emerge-set-combine-versions-template set.")))
  2376.  
  2377. (defun emerge-combine-versions (&optional force)
  2378.   "Combine the two versions using the template in
  2379. emerge-combine-versions-template.
  2380. Refuses to function if this difference has been edited, i.e., if it is
  2381. neither the A nor the B variant.
  2382. An ARGUMENT forces the variant to be selected even if the difference has
  2383. been edited."
  2384.   (interactive "P")
  2385.   (emerge-combine-versions-internal emerge-combine-versions-template force))
  2386.  
  2387. (defun emerge-combine-versions-register (char &optional force)
  2388.   "Combine the two versions using the template in register REG.
  2389. See documentation of the variable  emerge-combine-versions-template
  2390. for how the template is interpreted.
  2391. Refuses to function if this difference has been edited, i.e., if it is
  2392. neither the A nor the B variant.
  2393. An ARGUMENT forces the variant to be selected even if the difference has
  2394. been edited."
  2395.   (interactive "cRegister containing template: \nP")
  2396.   (let ((template (get-register char)))
  2397.     (if (not (stringp template))
  2398.     (error "Register does not contain text"))
  2399.     (emerge-combine-versions-internal template force)))
  2400.  
  2401. (defun emerge-combine-versions-internal (template force)
  2402.   (let ((operate
  2403.      (function (lambda ()
  2404.              (emerge-combine-versions-edit merge-begin merge-end
  2405.                            A-begin A-end B-begin B-end
  2406.                            template)
  2407.              (if emerge-auto-advance
  2408.              (emerge-next-difference))))))
  2409.     (emerge-select-version force operate operate operate)))
  2410.  
  2411. (defun emerge-combine-versions-edit (merge-begin merge-end
  2412.                      A-begin A-end B-begin B-end
  2413.                      template)
  2414.   (emerge-eval-in-buffer
  2415.    emerge-merge-buffer
  2416.    (delete-region merge-begin merge-end)
  2417.    (goto-char merge-begin)
  2418.    (let ((i 0))
  2419.      (while (< i (length template))
  2420.        (let ((c (aref template i)))
  2421.      (if (= c ?%)
  2422.          (progn
  2423.            (setq i (1+ i))
  2424.            (setq c 
  2425.              (condition-case nil
  2426.              (aref template i)
  2427.                (error ?%)))
  2428.            (cond ((= c ?a)
  2429.               (insert-buffer-substring emerge-A-buffer A-begin A-end))
  2430.              ((= c ?b) 
  2431.               (insert-buffer-substring emerge-B-buffer B-begin B-end))
  2432.              ((= c ?%) 
  2433.               (insert ?%))
  2434.              (t
  2435.               (insert c))))
  2436.        (insert c)))
  2437.        (setq i (1+ i))))
  2438.    (goto-char merge-begin)
  2439.    (aset diff-vector 6 'combined)
  2440.    (emerge-refresh-mode-line)))
  2441.  
  2442. (defun emerge-set-merge-mode (mode)
  2443.   "Set the major mode in a merge buffer.  Overrides any change that the mode
  2444. might make to the mode line or local keymap.  Leaves merge in fast mode.
  2445. Requires kill-fix.el or Lucid Emacs to work."
  2446.   (interactive
  2447.    (list (intern (completing-read
  2448.           "New major mode for merge buffer (function name): "
  2449.           obarray 'commandp t nil))))
  2450.   (or (featurep 'kill-fix)
  2451.       emerge-lucid-p
  2452.       (error "You must have kill-fix.el loaded to use emerge-set-merge-mode!"))
  2453.   (funcall mode)
  2454.   (emerge-refresh-mode-line)
  2455.   (if emerge-fast-mode
  2456.       (emerge-fast-mode)
  2457.     (emerge-edit-mode)))
  2458.  
  2459. (defun emerge-one-line-window ()
  2460.   (interactive)
  2461.   (let ((window-min-height 1))
  2462.     (shrink-window (- (window-height) 2))))
  2463.  
  2464. ;;; Support routines
  2465.  
  2466. ;; Select a difference by placing the visual flags around the appropriate
  2467. ;; group of lines in the A, B, and merge buffers
  2468. (defun emerge-select-difference (n)
  2469.   (let ((emerge-globalized-difference-list emerge-difference-list)
  2470.     (emerge-globalized-number-of-differences emerge-number-of-differences))
  2471.     (emerge-place-flags-in-buffer emerge-A-buffer n 0 1)
  2472.     (emerge-place-flags-in-buffer emerge-B-buffer n 2 3)
  2473.     (emerge-place-flags-in-buffer nil n 4 5))
  2474.   (run-hooks 'emerge-select-hooks))
  2475.  
  2476. (defun emerge-place-flags-in-buffer (buffer difference before-index
  2477.                         after-index)
  2478.   (if buffer
  2479.       (emerge-eval-in-buffer
  2480.        buffer
  2481.        (emerge-place-flags-in-buffer1 difference before-index after-index))
  2482.     (emerge-place-flags-in-buffer1 difference before-index after-index)))
  2483.  
  2484. (defun emerge-place-flags-in-buffer1 (difference before-index after-index)
  2485.   (if emerge-lucid-p
  2486.       ;; Lucid highlights the difference
  2487.       (emerge-place-flags-in-buffer1-lucid difference before-index after-index)
  2488.     ;; Else insert character flags
  2489.     (let ((buffer-read-only nil))
  2490.       ;; insert the flag before the difference
  2491.       (let ((before (aref (aref emerge-globalized-difference-list difference)
  2492.               before-index))
  2493.         here)
  2494.     (goto-char before)
  2495.     ;; insert the flag itself
  2496.     (insert-before-markers emerge-before-flag)
  2497.     (setq here (point))
  2498.     ;; Put the marker(s) referring to this position 1 character before the
  2499.     ;; end of the flag, so it won't be damaged by the user.
  2500.     ;; This gets a bit tricky, as there could be a number of markers
  2501.     ;; that have to be moved.
  2502.     (set-marker before (1- before))
  2503.     (let ((n (1- difference)) after-marker before-marker diff-list)
  2504.       (while (and
  2505.           (>= n 0)
  2506.           (progn
  2507.             (setq diff-list (aref emerge-globalized-difference-list n)
  2508.               after-marker (aref diff-list after-index))
  2509.             (= after-marker here)))
  2510.         (set-marker after-marker (1- after-marker))
  2511.         (setq before-marker (aref diff-list before-index))
  2512.         (if (= before-marker here)
  2513.         (setq before-marker (1- before-marker)))
  2514.         (setq n (1- n)))))
  2515.       ;; insert the flag after the difference
  2516.       (let* ((after (aref (aref emerge-globalized-difference-list difference)
  2517.               after-index))
  2518.          (here (marker-position after)))
  2519.     (goto-char here)
  2520.     ;; insert the flag itself
  2521.     (insert emerge-after-flag)
  2522.     ;; Put the marker(s) referring to this position 1 character after the
  2523.     ;; beginning of the flag, so it won't be damaged by the user.
  2524.     ;; This gets a bit tricky, as there could be a number of markers
  2525.     ;; that have to be moved.
  2526.     (set-marker after (1+ after))
  2527.     (let ((n (1+ difference)) before-marker after-marker diff-list)
  2528.       (while (and
  2529.           (< n emerge-globalized-number-of-differences)
  2530.           (progn
  2531.             (setq diff-list (aref emerge-globalized-difference-list n)
  2532.               before-marker (aref diff-list before-index))
  2533.             (= before-marker here)))
  2534.         (set-marker before-marker (1+ before-marker))
  2535.         (setq after-marker (aref diff-list after-index))
  2536.         (if (= after-marker here)
  2537.         (setq after-marker (1+ after-marker)))
  2538.         (setq n (1+ n))))))))
  2539.  
  2540. (defun emerge-place-flags-in-buffer1-lucid (difference before-index
  2541.                                after-index)
  2542.   (let* ((before (aref (aref emerge-globalized-difference-list difference)
  2543.                before-index))
  2544.      (after (aref (aref emerge-globalized-difference-list difference)
  2545.               after-index))
  2546.      (extent (make-extent (marker-position before) (marker-position after)
  2547.                   (current-buffer))))
  2548.     (set-extent-face extent 'emerge-highlight-face)
  2549.     (if (fboundp 'set-extent-priority) ; this is a 19.4 function.
  2550.     ;; Assert that this extent is slightly more important than random other
  2551.     ;; extents that may have been inserted by things like font-lock-mode.
  2552.     ;; This way, any conflict between the display of a highlighting face
  2553.     ;; and the emerge face will be resolved in emerge's favor.
  2554.     (set-extent-priority extent 1))
  2555.     (set-extent-data extent 'emerge)))
  2556.  
  2557. ;; Unselect a difference by removing the visual flags in the buffers.
  2558. (defun emerge-unselect-difference (n)
  2559.   (let ((diff-vector (aref emerge-difference-list n)))
  2560.     (emerge-remove-flags-in-buffer emerge-A-buffer
  2561.                    (aref diff-vector 0) (aref diff-vector 1))
  2562.     (emerge-remove-flags-in-buffer emerge-B-buffer
  2563.                    (aref diff-vector 2) (aref diff-vector 3))
  2564.     (emerge-remove-flags-in-buffer emerge-merge-buffer
  2565.                    (aref diff-vector 4) (aref diff-vector 5)))
  2566.   (run-hooks 'emerge-unselect-hooks))
  2567.  
  2568. (defun emerge-remove-flags-in-buffer (buffer before after)
  2569.   (if emerge-lucid-p
  2570.       ;; Lucid -- remove highlighting
  2571.       (emerge-remove-flags-in-buffer-lucid buffer before after)
  2572.     ;; Else remove character flags
  2573.     (emerge-eval-in-buffer
  2574.      buffer
  2575.      (let ((buffer-read-only nil))
  2576.        ;; remove the flags, if they're there
  2577.        (goto-char (- before (1- emerge-before-flag-length)))
  2578.        (if (looking-at emerge-before-flag-match)
  2579.        (delete-char emerge-before-flag-length)
  2580.      ;; the flag isn't there
  2581.      (ding)
  2582.      (message "Trouble removing flag"))
  2583.        (goto-char (1- after))
  2584.        (if (looking-at emerge-after-flag-match)
  2585.        (delete-char emerge-after-flag-length)
  2586.      ;; the flag isn't there
  2587.      (ding)
  2588.      (message "Trouble removing flag"))))))
  2589.  
  2590. (defun emerge-remove-flags-in-buffer-lucid (buffer before after)
  2591.   (map-extents (function (lambda (x y)
  2592.                (if (eq (extent-data x) 'emerge)
  2593.                    (delete-extent x))))
  2594.                buffer (marker-position before) (marker-position after) nil))
  2595.  
  2596. ;; Select a difference, removing any flags that exist now.
  2597. (defun emerge-unselect-and-select-difference (n &optional suppress-display)
  2598.   (if (and (>= emerge-current-difference 0)
  2599.        (< emerge-current-difference emerge-number-of-differences))
  2600.       (emerge-unselect-difference emerge-current-difference))
  2601.   (if (and (>= n 0) (< n emerge-number-of-differences))
  2602.       (progn
  2603.     (emerge-select-difference n)
  2604.     (let* ((diff-vector (aref emerge-difference-list n))
  2605.            (selection-type (aref diff-vector 6)))
  2606.       (if (eq selection-type 'default-A)
  2607.           (aset diff-vector 6 'A)
  2608.         (if (eq selection-type 'default-B)
  2609.         (aset diff-vector 6 'B))))))
  2610.   (setq emerge-current-difference n)
  2611.   (if (not suppress-display)
  2612.       (progn
  2613.     (emerge-recenter)
  2614.     (emerge-refresh-mode-line))))
  2615.  
  2616. ;; Perform tests to see whether user should be allowed to select a version
  2617. ;; of this difference:
  2618. ;;   a valid difference has been selected; and
  2619. ;;   the difference text in the merge buffer is:
  2620. ;;     the A version (execute a-version), or
  2621. ;;     the B version (execute b-version), or
  2622. ;;     empty (execute neither-version), or
  2623. ;;     argument FORCE is true (execute neither-version)
  2624. ;; Otherwise, signal an error.
  2625. (defun emerge-select-version (force a-version b-version neither-version)
  2626.   (emerge-validate-difference)
  2627.   (let ((buffer-read-only nil))
  2628.     (let* ((diff-vector
  2629.         (aref emerge-difference-list emerge-current-difference))
  2630.        (A-begin (1+ (aref diff-vector 0)))
  2631.        (A-end (1- (aref diff-vector 1)))
  2632.        (B-begin (1+ (aref diff-vector 2)))
  2633.        (B-end (1- (aref diff-vector 3)))
  2634.        (merge-begin (1+ (aref diff-vector 4)))
  2635.        (merge-end (1- (aref diff-vector 5))))
  2636.       (if (emerge-compare-buffers emerge-A-buffer A-begin A-end
  2637.                   emerge-merge-buffer merge-begin
  2638.                   merge-end)
  2639.       (funcall a-version)
  2640.     (if (emerge-compare-buffers emerge-B-buffer B-begin B-end
  2641.                     emerge-merge-buffer merge-begin
  2642.                     merge-end)
  2643.         (funcall b-version)
  2644.       (if (or force (= merge-begin merge-end))
  2645.           (funcall neither-version)
  2646.         (error "This difference region has been edited")))))))
  2647.  
  2648. ;; Read a file name, handling all of the various defaulting rules.
  2649.  
  2650. (defun emerge-read-file-name (prompt alternative-default-dir default-file
  2651.                   A-file mustmatch)
  2652.   ;; 'prompt' should not have trailing ": ", so that it can be modified
  2653.   ;; according to context.
  2654.   ;; If alternative-default-dir is non-nil, it should be used as the default
  2655.   ;; directory instead if default-directory, if emerge-default-last-directories
  2656.   ;; is set.
  2657.   ;; If default-file is set, it should be used as the default value.
  2658.   ;; If A-file is set, and its directory is different from
  2659.   ;; alternative-default-dir, and if emerge-default-last-directories is set,
  2660.   ;; the default file should be the last part of A-file in the default
  2661.   ;; directory.  (Overriding default-file.)
  2662.   ;; 'mustmatch' controlls whether non-existant file names are allowed;
  2663.   ;; see the fourth argument of read-file-name for interpretations of values.
  2664.   (cond
  2665.    ;; If this is not the A-file argument (shown by non-nil A-file), and
  2666.    ;; if emerge-default-last-directories is set, and
  2667.    ;; the default directory exists but is not the same as the directory of the
  2668.    ;; A-file,
  2669.    ;; then make the default file have the same name as the A-file, but in
  2670.    ;; the default directory.
  2671.    ((and emerge-default-last-directories
  2672.      A-file
  2673.      alternative-default-dir
  2674.      (not (string-equal alternative-default-dir
  2675.                 (file-name-directory A-file))))
  2676.     (read-file-name (format "%s (default %s): "
  2677.                 prompt (file-name-nondirectory A-file))
  2678.             alternative-default-dir
  2679.             (concat alternative-default-dir
  2680.                 (file-name-nondirectory A-file))
  2681.             mustmatch))
  2682.    ;; If there is a default file, use it.
  2683.    (default-file
  2684.      (read-file-name (format "%s (default %s): " prompt default-file)
  2685.              ;; If emerge-default-last-directories is set, use the
  2686.              ;; directory from the same argument of the last call of
  2687.              ;; Emerge as the default for this argument.
  2688.              (and emerge-default-last-directories
  2689.               alternative-default-dir)
  2690.              default-file mustmatch))
  2691.    (t
  2692.     (read-file-name (concat prompt ": ")
  2693.             ;; If emerge-default-last-directories is set, use the
  2694.             ;; directory from the same argument of the last call of
  2695.             ;; Emerge as the default for this argument.
  2696.             (and emerge-default-last-directories
  2697.              alternative-default-dir)
  2698.             nil mustmatch))))
  2699.  
  2700. ;; Revise the mode line to display which difference we have selected
  2701.  
  2702. (defun emerge-refresh-mode-line ()
  2703.   (setq mode-line-buffer-identification
  2704.     (list (format "Emerge: %%b   diff %d of %d%s"
  2705.               (1+ emerge-current-difference)
  2706.               emerge-number-of-differences
  2707.               (if (and (>= emerge-current-difference 0)
  2708.                    (< emerge-current-difference
  2709.                   emerge-number-of-differences))
  2710.               (cdr (assq (aref (aref emerge-difference-list
  2711.                          emerge-current-difference)
  2712.                        6)
  2713.                      '((A . " - A")
  2714.                        (B . " - B")
  2715.                        (prefer-A . " - A*")
  2716.                        (prefer-B . " - B*")
  2717.                        (combined . " - comb"))))
  2718.             ""))))
  2719.   ;; Force mode-line redisplay
  2720.   (set-buffer-modified-p (buffer-modified-p)))
  2721.  
  2722. ;; compare two regions in two buffers for containing the same text
  2723. (defun emerge-compare-buffers (buffer-x x-begin x-end buffer-y y-begin y-end)
  2724.   ;; first check that the two regions are the same length
  2725.   (if (not (and (= (- x-end x-begin) (- y-end y-begin))))
  2726.       nil
  2727.     (catch 'exit
  2728.       (while (< x-begin x-end)
  2729.     ;; bite off and compare no more than 1000 characters at a time
  2730.     (let* ((compare-length (min (- x-end x-begin) 1000))
  2731.            (x-string (emerge-eval-in-buffer 
  2732.               buffer-x
  2733.               (buffer-substring x-begin
  2734.                         (+ x-begin compare-length))))
  2735.            (y-string (emerge-eval-in-buffer
  2736.               buffer-y
  2737.               (buffer-substring y-begin
  2738.                         (+ y-begin compare-length)))))
  2739.       (if (not (string-equal x-string y-string))
  2740.           (throw 'exit nil)
  2741.         (setq x-begin (+ x-begin compare-length))
  2742.         (setq y-begin (+ y-begin compare-length)))))
  2743.       t)))
  2744.  
  2745. ;; Construct a unique buffer name.
  2746. ;; The first one tried is prefixsuffix, then prefix<2>suffix, 
  2747. ;; prefix<3>suffix, etc.
  2748. (defun emerge-unique-buffer-name (prefix suffix)
  2749.   (if (null (get-buffer (concat prefix suffix)))
  2750.       (concat prefix suffix)
  2751.     (let ((n 2))
  2752.       (while (get-buffer (format "%s<%d>%s" prefix n suffix))
  2753.     (setq n (1+ n)))
  2754.       (format "%s<%d>%s" prefix n suffix))))
  2755.  
  2756. ;; Verify that we have a difference selected.
  2757. (defun emerge-validate-difference ()
  2758.   (if (not (and (>= emerge-current-difference 0)
  2759.         (< emerge-current-difference emerge-number-of-differences)))
  2760.       (error "No difference selected")))
  2761.  
  2762. ;;; Functions for saving and restoring a batch of variables
  2763.  
  2764. ;; These functions save (get the values of) and restore (set the values of)
  2765. ;; a list of variables.  The argument is a list of symbols (the names of
  2766. ;; the variables).  A list element can also be a list of two functions,
  2767. ;; the first of which (when called with no arguments) gets the value, and
  2768. ;; the second (when called with a value as an argment) sets the value.
  2769. ;; A "function" is anything that funcall can handle as an argument.
  2770.  
  2771. (defun emerge-save-variables (vars)
  2772.   (mapcar (function (lambda (v) (if (symbolp v)
  2773.                     (symbol-value v)
  2774.                   (funcall (car v)))))
  2775.       vars))
  2776.  
  2777. (defun emerge-restore-variables (vars values)
  2778.   (while vars
  2779.     (let ((var (car vars))
  2780.       (value (car values)))
  2781.       (if (symbolp var)
  2782.       (set var value)
  2783.     (funcall (car (cdr var)) value)))
  2784.     (setq vars (cdr vars))
  2785.     (setq values (cdr values))))
  2786.  
  2787. ;; Make a temporary file that only we have access to.
  2788. ;; PREFIX is appended to emerge-temp-file-prefix to make the filename prefix.
  2789. (defun emerge-make-temp-file (prefix)
  2790.   (let ((f (make-temp-name (concat emerge-temp-file-prefix prefix))))
  2791.     ;; create the file
  2792.     (write-region (point-min) (point-min) f nil 'no-message)
  2793.     (set-file-modes f emerge-temp-file-mode)
  2794.     f))
  2795.  
  2796. ;;; Functions that query the user before he can write out the current buffer.
  2797.  
  2798. (defun emerge-query-write-file ()
  2799.   "Query the user if he really wants to write out the incomplete merge.
  2800. If he says yes, call  write-file  to do so.  See  emerge-query-and-call
  2801. for details of the querying process."
  2802.   (interactive)
  2803.   (emerge-query-and-call 'write-file))
  2804.  
  2805. (defun emerge-query-save-buffer ()
  2806.   "Query the user if he really wants to write out the incomplete merge.
  2807. If he says yes, call  save-buffer  to do so.  See  emerge-query-and-call
  2808. for details of the querying process."
  2809.   (interactive)
  2810.   (emerge-query-and-call 'save-buffer))
  2811.  
  2812. (defun emerge-query-and-call (command)
  2813.   "Query the user if he really wants to write out the incomplete merge.
  2814. If he says yes, call COMMAND interactively.  During the call, the flags
  2815. around the current difference are removed."
  2816.   (if (yes-or-no-p "Do you really write to write out this unfinished merge? ")
  2817.       ;; He really wants to do it -- unselect the difference for the duration
  2818.       (progn
  2819.     (if (and (>= emerge-current-difference 0)
  2820.          (< emerge-current-difference emerge-number-of-differences))
  2821.         (emerge-unselect-difference emerge-current-difference))
  2822.     ;; call-interactively takes the value of current-prefix-arg as the
  2823.     ;; prefix argument value to be passed to the command.  Thus, we have
  2824.     ;; to do nothing special to make sure the prefix argument is
  2825.     ;; transmitted to the command.
  2826.     (call-interactively command)
  2827.     (if (and (>= emerge-current-difference 0)
  2828.          (< emerge-current-difference emerge-number-of-differences))
  2829.         (progn
  2830.           (emerge-select-difference emerge-current-difference)
  2831.           (emerge-recenter))))
  2832.     ;; He's being smart and not doing it
  2833.     (message "Not written")))
  2834.  
  2835. ;; Make sure the current buffer (for a file) has the same contents as the
  2836. ;; file on disk, and attempt to remedy the situation if not.
  2837. ;; Signal an error if we can't make them the same, or the user doesn't want
  2838. ;; to do what is necessary to make them the same.
  2839. (defun emerge-verify-file-buffer ()
  2840.   ;; First check if the file has been modified since the buffer visited it.
  2841.   (if (verify-visited-file-modtime (current-buffer))
  2842.       (if (buffer-modified-p)
  2843.       ;; If buffer is not obsolete and is modified, offer to save
  2844.       (if (yes-or-no-p (format "Save file %s? " buffer-file-name))
  2845.           (save-buffer)
  2846.         (error "Buffer out of sync for file %s" buffer-file-name))
  2847.     ;; If buffer is not obsolete and is not modified, do nothing
  2848.     nil)
  2849.     (if (buffer-modified-p)
  2850.     ;; If buffer is obsolete and is modified, give error
  2851.     (error "Buffer out of sync for file %s" buffer-file-name)
  2852.       ;; If buffer is obsolete and is not modified, offer to revert
  2853.       (if (yes-or-no-p (format "Revert file %s? " buffer-file-name))
  2854.           (revert-buffer t t)
  2855.     (error "Buffer out of sync for file %s" buffer-file-name)))))
  2856.  
  2857. ;; Returns true if the file visited in the current buffer is not accessible
  2858. ;; through its filename, or for some other reason should be stored in a
  2859. ;; temporary file for input to diff.
  2860. ;; As written, checks whether this is an ange-ftp file.  It may be modified
  2861. ;; for customization.
  2862. (defun emerge-remote-file-p ()
  2863.   (and (boundp 'ange-ftp-path-format)
  2864.        ange-ftp-path-format
  2865.        (string-match (car ange-ftp-path-format) buffer-file-name)))
  2866.  
  2867. ;; Utilities that might have value outside of Emerge.
  2868.  
  2869. ;; Set up the mode in the current buffer to duplicate the mode in another
  2870. ;; buffer.
  2871. (defun emerge-copy-modes (buffer)
  2872.   ;; Set the major mode
  2873.   (funcall (emerge-eval-in-buffer buffer major-mode)))
  2874.  
  2875. ;; Define a key, even if a prefix of it is defined
  2876. (defun emerge-force-define-key (keymap key definition)
  2877.   "Like define-key, but is not stopped if a prefix of KEY is a defined 
  2878. command."
  2879.   ;; Find out if a prefix of key is defined
  2880.   (let ((v (lookup-key keymap key)))
  2881.     ;; If so, undefine it
  2882.     (if (integerp v)
  2883.     (define-key keymap (substring key 0 v) nil)))
  2884.   ;; Now define the key
  2885.   (define-key keymap key definition))
  2886.  
  2887. ;;; Improvements to describe-mode, so that it describes minor modes as well
  2888. ;;; as the major mode
  2889. (defun describe-mode (&optional minor)
  2890.   "Display documentation of current major mode.
  2891. If optional MINOR is non-nil (or prefix argument is given if interactive),
  2892. display documentation of acive minor modes as well.
  2893. For this to work correctly for a minor mode, the mode's indicator variable
  2894. (listed in minor-mode-alist) must also be a function whose documentation
  2895. describes the minor mode."
  2896.   (interactive)
  2897.   (with-output-to-temp-buffer "*Help*"
  2898.     (princ mode-name)
  2899.     (princ " Mode:\n")
  2900.     (princ (documentation major-mode))
  2901.     (let ((minor-modes minor-mode-alist)
  2902.       (locals (buffer-local-variables)))
  2903.       (while minor-modes
  2904.     (let* ((minor-mode (car (car minor-modes)))
  2905.            (indicator (car (cdr (car minor-modes))))
  2906.            (local-binding (assq minor-mode locals)))
  2907.       ;; Document a minor mode if it is listed in minor-mode-alist,
  2908.       ;; bound locally in this buffer, non-nil, and has a function
  2909.       ;; definition.
  2910.       (if (and local-binding
  2911.            (cdr local-binding)
  2912.            (fboundp minor-mode))
  2913.           (progn
  2914.         (princ (format "\n\n\n%s minor mode (indicator%s):\n"
  2915.                    minor-mode indicator))
  2916.         (princ (documentation minor-mode)))))
  2917.     (setq minor-modes (cdr minor-modes))))
  2918.     (print-help-return-message)))
  2919.  
  2920. ;; Adjust things so that keyboard macro definitions are documented correctly.
  2921. (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
  2922.  
  2923. ;; Function to shadow a definition in a keymap with definitions in another.
  2924. (defun emerge-shadow-key-definition (olddef newdef keymap shadowmap)
  2925.   "Shadow OLDDEF with NEWDEF for any keys in KEYMAP with entries in SHADOWMAP.
  2926. In other words, insert into SHADOWMAP a binding to NEWDEF wherever a
  2927. binding of OLDDEF appears in KEYMAP.  Thus, if KEYMAP is the global map and
  2928. SHADOWMAP is the local map, OLDDEF will be shadowed everywhere by NEWDEF.
  2929. Does not affect keys that are already bound in SHADOWMAP, including
  2930. those whose definition is OLDDEF."
  2931.   ;; loop through all keymaps accessible from keymap
  2932.   (let ((maps (accessible-keymaps keymap)))
  2933.     (while maps
  2934.       (let ((prefix (car (car maps)))
  2935.         (map (cdr (car maps))))
  2936.     ;; examine a keymap
  2937.     (cond
  2938.      ((arrayp map)
  2939.         ;; v18 array keymap
  2940.         (let ((len (length map))
  2941.           (i 0))
  2942.           (while (< i len)
  2943.         (if (eq (aref map i) olddef)
  2944.             ;; set the shadowing definition
  2945.             (let ((key (concat prefix (char-to-string i))))
  2946.               (emerge-define-key-if-possible shadowmap key newdef)))
  2947.         (setq i (1+ i)))))
  2948.      ((consp map)
  2949.       ;; v18 sparse keymap
  2950.       (while map
  2951.         (if (eq (cdr-safe (car-safe map)) olddef)
  2952.         ;; set the shadowing definition
  2953.         (let ((key
  2954.                (concat prefix (char-to-string (car (car map))))))
  2955.           (emerge-define-key-if-possible shadowmap key newdef)))
  2956.         (setq map (cdr map))))
  2957.      (t
  2958.       ;; v19 map
  2959.       (map-keymap
  2960.        (function
  2961.         (lambda (okey val)
  2962.           (if (eq val olddef)
  2963.           ;; set the shadowing definition
  2964.           (let ((key (vconcat prefix (list okey))))
  2965.             (emerge-define-key-if-possible shadowmap key newdef)))))
  2966.        map))))
  2967.       (setq maps (cdr maps)))))
  2968.  
  2969. ;; Define a key if it (or a prefix) is not already defined in the map.
  2970. (defun emerge-define-key-if-possible (keymap key definition)
  2971.   ;; This code depends rather sensitively on the actions of lookup-key
  2972.   ;; and define-key.
  2973.   (let ((present (lookup-key keymap key)))
  2974.     (if (or (null present) (integerp present))
  2975.     ;; If we get here, the key is too long for the map, or it is
  2976.     ;; an entry in the map that is undefined.  Prefix keys and entries
  2977.     ;; that are defined have been excluded.
  2978.     (condition-case ()
  2979.         ;; define-key will give an error if a prefix of the key is already
  2980.         ;; defined.  Otherwise it will define the key in the map.
  2981.         (define-key keymap key definition)
  2982.       (error nil)))))
  2983.  
  2984. (defun emerge-recursively-substitute-key-definition (olddef newdef keymap)
  2985.   "Like substitute-key-definition, but examines and substitutes in all
  2986. keymaps accessible from KEYMAP.  Make sure that subordinate keymaps aren't
  2987. shared with other keymaps!  (copy-keymap will suffice.)"
  2988.   ;; Loop through all keymaps accessible from keymap
  2989.   (let ((maps (accessible-keymaps keymap)))
  2990.     (while maps
  2991.       ;; Substitute in this keymap
  2992.       (substitute-key-definition olddef newdef (cdr (car maps)))
  2993.       (setq maps (cdr maps)))))
  2994.  
  2995. ;; Show the name of the file in the buffer.
  2996. (defun emerge-show-file-name ()
  2997.   "Displays the name of the file loaded into the current buffer.
  2998. If the name won't fit on one line, the minibuffer is expanded to hold it,
  2999. and the command waits for a keystroke from the user.  If the keystroke is
  3000. SPC, it is ignored\; if it is anything else, it is processed as a command."
  3001.   (interactive)
  3002.   (let ((name (buffer-file-name)))
  3003.     (or name
  3004.     (setq name "Buffer has no file name."))
  3005.     (save-window-excursion
  3006.       (select-window (minibuffer-window))
  3007.       (erase-buffer)
  3008.       (insert name)
  3009.       (if (not (pos-visible-in-window-p))
  3010.       (let ((echo-keystrokes 0))
  3011.         (while (and (not (pos-visible-in-window-p))
  3012.             (> (1- (screen-height)) (window-height)))
  3013.           (enlarge-window 1))
  3014.         (if emerge-lucid-p
  3015.         (let ((e (next-command-event (allocate-event))))
  3016.           (if (not (eq 32 (event-to-character e)))
  3017.               (setq unread-command-event e)))
  3018.           (let ((c (read-char)))
  3019.         (if (/= c 32)
  3020.             (setq unread-command-char c)))))))))
  3021.  
  3022. ;; Improved auto-save file names.
  3023. ;; This function fixes many problems with the standard auto-save file names:
  3024. ;; Auto-save files for non-file buffers get put in the default directory
  3025. ;; for the buffer, whether that makes sense or not.
  3026. ;; Auto-save files for file buffers get put in the directory of the file,
  3027. ;; regardless of whether we can write into it or not.
  3028. ;; Auto-save files for non-file buffers don't use the process id, so if a
  3029. ;; user runs more than on Emacs, they can make auto-save files that overwrite
  3030. ;; each other.
  3031. ;; To use this function, do:
  3032. ;;    (fset 'make-auto-save-file-name
  3033. ;;          (symbol-function 'emerge-make-auto-save-file-name))
  3034. (defun emerge-make-auto-save-file-name ()
  3035.   "Return file name to use for auto-saves of current buffer.
  3036. Does not consider auto-save-visited-file-name; that is checked
  3037. before calling this function.
  3038. You can redefine this for customization.
  3039. See also auto-save-file-name-p."
  3040.   (if buffer-file-name
  3041.       ;; if buffer has a file, try the format <file directory>/#<file name>#
  3042.       (let ((f (concat (file-name-directory buffer-file-name)
  3043.                "#"
  3044.                (file-name-nondirectory buffer-file-name)
  3045.                "#")))
  3046.     (if (file-writable-p f)
  3047.         ;; the file is writable, so use it
  3048.         f
  3049.       ;; the file isn't writable, so use the format
  3050.       ;; ~/#&<file name>&<hash of directory>#
  3051.       (concat (getenv "HOME")
  3052.           "/#&"
  3053.           (file-name-nondirectory buffer-file-name)
  3054.           "&"
  3055.           (hash-string-into-string
  3056.            (file-name-directory buffer-file-name))
  3057.           "#")))
  3058.     ;; if buffer has no file, use the format ~/#%<buffer name>%<process id>#
  3059.     (expand-file-name (concat (getenv "HOME")
  3060.                   "/#%"
  3061.                   ;; quote / into \! and \ into \\
  3062.                   (unslashify-name (buffer-name))
  3063.                   "%"
  3064.                   (make-temp-name "")
  3065.                   "#"))))
  3066.  
  3067. ;; Hash a string into five characters more-or-less suitable for use in a file
  3068. ;; name.  (Allowed characters are ! through ~, except /.)
  3069. (defun hash-string-into-string (s)
  3070.   (let ((bins (vector 0 0 0 0 0))
  3071.     (i 0))
  3072.     (while (< i (length s))
  3073.       (aset bins (% i 5) (% (+ (* (aref bins (% i 5)) 35)
  3074.                    (aref s i))
  3075.                 65536))
  3076.       (setq i (1+ i)))
  3077.     (mapconcat (function (lambda (b)
  3078.                (setq b (+ (% b 93) ?!))
  3079.                (if (>= b ?/)
  3080.                    (setq b (1+ b)))
  3081.                (char-to-string b)))
  3082.            bins "")))
  3083.  
  3084. ;; Quote any /s in a string by replacing them with \!.
  3085. ;; Also, replace any \s by \\, to make it one-to-one.
  3086. (defun unslashify-name (s)
  3087.   (let ((limit 0))
  3088.     (while (string-match "[/\\]" s limit)
  3089.       (setq s (concat (substring s 0 (match-beginning 0))
  3090.               (if (string= (substring s (match-beginning 0)
  3091.                           (match-end 0))
  3092.                    "/")
  3093.               "\\!"
  3094.             "\\\\")
  3095.               (substring s (match-end 0))))
  3096.       (setq limit (1+ (match-end 0)))))
  3097.   s)
  3098.  
  3099. ;; Metacharacters that have to be protected from the shell when executing
  3100. ;; a diff/diff3 command.
  3101. (defvar emerge-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]"
  3102.   "Characters that must be quoted with \\ when used in a shell command
  3103. line, specified as a [...] regexp.")
  3104.  
  3105. ;; Quote metacharacters (using \) when executing a diff/diff3 command.
  3106. (defun emerge-protect-metachars (s)
  3107.   (let ((limit 0))
  3108.     (while (string-match emerge-metachars s limit)
  3109.       (setq s (concat (substring s 0 (match-beginning 0))
  3110.               "\\"
  3111.               (substring s (match-beginning 0))))
  3112.       (setq limit (1+ (match-end 0)))))
  3113.   s)
  3114.  
  3115. ;;;; This is the end of emerge.el.
  3116.