Mercurial > emacs
changeset 7267:4aa70d4d981c
Initial revision
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Mon, 02 May 1994 05:16:59 +0000 |
| parents | f87808bd90e9 |
| children | e10dea2787a8 |
| files | lisp/ediff.el lisp/ielm.el lisp/mail/mail-hist.el lisp/mldrag.el lisp/rsz-mini.el lisp/tempo.el |
| diffstat | 6 files changed, 4599 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/ediff.el Mon May 02 05:16:59 1994 +0000 @@ -0,0 +1,3076 @@ +;;; ediff.el --- a visual interface to diff & patch +;;; Copyright (C) 1994 Free Software Foundation, Inc. + +;; Author: Michael Kifer <kifer@cs.sunysb.edu> +;; Created: February 2, 1994 +;; Version: 1.31 +;; Keywords: comparing, merging, patching, version control. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;; Commentary: +;; ---------- + +;; Never read those diff(1) outputs again! +;; Apply patch(1) selectively, like a pro! + +;; This package provides a convenient way of simultaneous brousing through +;; the differences between a pair of files or buffers. The two files being +;; compared (file-A and file-B) are shown in separate windows (side by +;; side, one above the another, or in separate frames), and the differences +;; are highlighted as you step through them. You can also copy difference +;; regions from one buffer to another (and recover old differences if you +;; change your mind). + +;; In addition, Ediff can apply a patch to a file and then let you step +;; though both files, the patched and the original one, simultateously, +;; difference-by-difference. You can even apply a patch right out of a +;; mail buffer, i.e., patches received by mail don't even have to be saved. +;; Since Ediff lets you copy differences between buffers, you can, in +;; effect, apply patches selectively (i.e., you can copy a difference +;; region from file.orig to file, thereby undoing any particular patch that +;; you don't like). + +;; This package is based on emerge.el. It uses a few utilities and +;; variables defined there and several other Ediff's functions are +;; adaptations from emerge.el. + +;; Ediff is complimentary to Emerge. While Emerge is better at heavy-duty +;; tasks that involve merging of files, Ediff is by far superior +;; for browsing through files compared via diff(1) and for patching files +;; with patch(1). Furthermore, I feel that Ediff is more convenient for +;; merging tasks where one of the files is a designated output. This +;; situation arises while patching files or when comparing an old version +;; of a file with a newer version (in such cases, it is often desirable to +;; selectively revert some portions of the new file to its old state). + +;; This version of Ediff is much faster than the previous ones and than +;; Emerge (in Emacs 19.23, Emerge will become much faster as well). +;; The difference in startup time is dramatic for large files with many +;; differences. + +;; Window configuration: +;; ---------------------- + +;; By default, Ediff sets things up in one frame, splitting it between a +;; small control window and the two windows for file-A and file-B. The +;; split between these latter windows can be horizontal or vertical, which +;; can be changed interactively by hitting 's' while the cursor is in the +;; control window. +;; +;; In a multi-frame situation, Ediff would work as follows. When it starts, +;; it will place the control window in the frame that was selected at the +;; time of the invocation. If file-A or file-B is seen in one of the +;; frames, Ediff will leave it there. If a file (A/B) is not visible in any +;; frame, Ediff will arrange that it will share a frame with the control +;; window. (If none of the files is visible, then both will share the +;; control window frame.) The same algorithm works when you hit 'c' +;; (ediff-recenter), 'p' (ediff-previous-difference), 'n', etc. +;; +;; Thus, you can compare files in one frame or in different frames. +;; The former is done by default, while the latter can be achieved by +;; arranging files A and B to be seen in different frames. Ediff +;; respects these arrangements, automatically adapting itself to +;; the multi-frame mode. + + +;; A note to heavy-duty users: + +;; Ediff lets the user run multiple sessions at once, i.e., you can invoke +;; Ediff on different functions several times in a row, without exiting +;; the previous Ediff sessions. Different sessions may even operate on the +;; same pair of files. So, in principle, it is possible to do, say, +;; pairwise comparison of three (or more) different files. Each session +;; would have its own *ediff-control* buffer and all the regarding a +;; particular session is local to the associated *ediff-control* buffer. +;; You can switch between sessions by suspending one session and then +;; switching to another *ediff-control* buffer. (Different such buffers +;; are distinguished by a numerical suffix, e.g., *ediff-control*<3>.) +;; This, if you would like to compare three files pairwise, you can do +;; this by preparing three different frames, each with its own control +;; window. (This would require a very wide screen, and I never claimed +;; that such 3-way comparison is very easy to do.) +;; +;; If you need to conduct multiple Ediff sessions on the same file, one +;; thing should be kept in mind: each time you invoke Ediff on a buffer that +;; already participates in another Ediff session, that buffer should not +;; have any ASCII Ediff flags in it. (Highlighting with faces is OK.) If +;; flags are not removed, difference overlays won't be set correctly +;; for the second invocation of Ediff. The simplest way to remove ASCII +;; flags from an Ediff buffer is to switch to that buffer and try to insert +;; or delete something. If ASCII flags have been inserted by an Ediff +;; session, Ediff will ignore this first editing operation, but it will +;; remove all flags and notify you that this buffer can now be edited. +;; +;; To rehighlight Ediff buffers, hit 'c' in ediff-control buffer. + + +;;; Remarks: +;; ------- + +;; 1. Ediff is unlikely to run under Emacs 18 without some further work. +;; 2. If running Lucid Emacs, Ediff requires at least version 19.9. +;; 3. I didn't test Ediff on FSF versions older than 19.19. +;; 4. The function vc-ediff requires the vc.el version that comes with +;; Emacs 19.22. + + +;;; Installation and use: +;; -------------------- + +;; You can invoke Ediff interactively using the following functions: +;; +;; ediff-buffers - compare buffers +;; ediff (alias for ediff-files) +;; ediff-files - compare files +;; ediff-patch-file - patch file then compare +;; epatch (alias for ediff-patch-file) +;; ediff-patch-buffer - patch buffer then compare +;; vc-ediff - compare buffer & version +;; using vc.el package +;; (Emacs 19.22 and up). +;; rcs-ediff - same using rcs.el; rcs.el +;; is not part of the +;; standard Emacs distribution. +;; +;; There is also the function ediff-files-remote, which can be invoked only +;; from within another Emacs Lisp function, i.e., non-interactively. +;; +;; To use Ediff, put this in your .emacs file: +;; +;; (autoload 'ediff-buffers "ediff" "Visual interface to diff(1)" t) +;; (autoload 'ediff "ediff" "Visual interface to diff(1)" t) +;; (autoload 'ediff-files "ediff" "Visual interface to diff(1)" t) +;; (autoload 'ediff-files-remote "ediff" "Visual interface to diff(1)") +;; (autoload 'epatch "ediff" "Visual interface to patch(1)" t) +;; (autoload 'ediff-patch-file "ediff" "Visual interface to patch(1)" t) +;; (autoload 'ediff-patch-buffer "ediff" "Visual interface to patch(1)" t) +;; (autoload 'vc-ediff "ediff" +;; "Interface to diff & version control via vc.el" t) +;; (autoload 'rcs-ediff "ediff" +;; "Interface to diff & version control via rcs.el" t) +;; +;; +;; If you want Ediff to be loaded from the very beginning, you should have +;; +;; (require 'ediff) +;; +;; in your .emacs file. This way it is also easier to figure out changes +;; to the default Ediff setting, if such changes become necessary --- see +;; Customization. +;; + +;;; Compilation +;; ----------- +;; +;; When you byte-compile Ediff, you will get some warnings about functions +;; being undefined. These can be safely ignored. +;; +;; Warning: +;; ======= +;; +;; If you are using advice.el (directly or indirectly, via one of the +;; other packages), Ediff may not compile properly. In this case, you +;; should do: +;; +;; M-x ad-deactivate-all RET +;; +;; M-x byte-compile-file RET ediff.el RET +;; +;; M-x ad-activate-all RET +;; +;; This precaution will not be needed starting with GNU Emacs 19.23 and +;; Lucid Emacs 19.10, due to fixing a bug in advice.el. + + +;;; Customization: +;; ------------- + +;; If you don't like the default setting, you can change it through the +;; various variables and hooks. In particular, the following hooks are +;; available: + +;; ediff-load-hooks +;; ediff-before-setup-windows-hooks +;; ediff-startup-hooks +;; ediff-select-hooks +;; ediff-unselect-hooks +;; ediff-suspend-hooks +;; ediff-quit-hooks +;; ediff-prepare-buffer-hooks + +;; The hooks in ediff-load-hooks can be used to change defaults after Ediff +;; is loaded. +;; The hooks in ediff-before-setup-windows-hooks, ediff-suspend-hooks, and +;; ediff-quit-hooks can be used to save and then restore whatever window +;; configuration you want. However, make sure you understand what you are +;; doing. Many variables that drive Ediff are local to the different +;; *ediff-control* buffers. Take a look at ediff-default-suspend-hook and +;; ediff-default-quit-hook to see what's involved. +;; The hooks in ediff-prepare-buffer-hooks are executed for each Ediff buffer +;; (A and B) right after these buffers are arranged. +;; +;; The second group of Ediff variables that could be changed, if you so +;; wish, is: +;; +;; ediff-before-flag-eol +;; ediff-after-flag-eol +;; ediff-before-flag-mol +;; ediff-after-flag-mol +;; +;; ediff-current-diff-face-A +;; ediff-current-diff-face-B +;; ediff-even-diff-face-A +;; ediff-even-diff-face-B +;; ediff-odd-diff-face-A +;; ediff-odd-diff-face-B +; +;; The first four are ASCII strings that mark the beginning and the end of +;; the differences found in file-A and file-B. Ediff uses different flags +;; to highlight regions that begin/end at the beginning of a line or in a +;; middle of a line. + +;; The rest are the faces used to highlight text on X displays. On X +;; displays, Ediff uses ediff-current-diff-face-A and +;; ediff-current-diff-face-B to highlight the current difference regions. +;; Other (non-current) difference regions are displayed in alternating +;; faces: ediff-even/odd-diff-face-A/B. (In GNU Emacs, the odd and the even +;; faces are actually identical on monochrome displays, because it is +;; rather poor in what you can do on such a display. So, I chose to use +;; italics to highlight other differences. Any ideas would be welcome. In +;; Lucid Emacs, the situation is better because it supports pixmaps.) +;; There are two ways to change the default setting for highlighting faces: +;; either change the variables, as in +;; +;; (setq ediff-current-diff-face-A (internal-get-face 'bold-italic)) +;; +;; (`internal-get-face' should be `get-face' if you are using Lucid Emacs) +;; or by selectively modifying the defaults: +;; +;; (add-hook 'ediff-load-hooks +;; (function (lambda () +;; (set-face-foreground ediff-current-diff-face-B "blue") +;; (set-face-background ediff-current-diff-face-B "red") +;; (make-face-italic ediff-current-diff-face-B)))) +;; +;; You may also want to take a look at how the above faces are defined in +;; Ediff. +;; +;; The last pair of variables in this group, +;; +;; ediff-want-faces +;; ediff-highlight-selected-only +;; +;; indicate whether---on a window system---you want differences to be +;; marked using ASCII strings (like on a dumb terminal) or using colors and +;; highlighting. If ediff-want-faces is t, then highlighting with faces is +;; used. Normally, Ediff highlights all differences, but the selected +;; difference is highlighted more visibly. If you prefer that unselected +;; differences won't be highlighted, you can set +;; ediff-highlight-selected-only to t. +;; +;; If you plan on changing these variables, they must be set +;; BEFORE ediff.el is loaded. +;; +;; Note: Ediff lets you switch between the two types of highlighting. That +;; is you can switch, interactively, from highlighting using faces to +;; highlighting using ASCII flags, and back. Of course, toggling has +;; effect only on a window system. On a dumb terminal or in an xterm +;; window, the only available option is highlighting with ASCII flags. +;; +;; The third group of variables controls miscellaneous functions: +;; +;; ediff-patch-program +;; ediff-patch-options +;; ediff-diff-program +;; ediff-diff-options +;; +;; These specify the functions that produce differences and do patching. +;; The *-options variables specify which options to pass to these programs. +;; It is unlikely that you would want to change these. One possible +;; exception is when you may want to generate differences with context +;; lines in order to send a patch file through email. Then, you might want +;; to set ediff-diff-options to '-c'. Sometimes, you may also want to tell +;; diff(1) to ignore spaces and such. Use the option '-w' for that. Diff(1) +;; has several other useful options (type 'man diff' to find out). +;; +;; The output from diff(1) is found in *ediff-diff* buffer. However, this +;; makes sense only if you also intend to use Ediff to browse through the +;; diff'ed files before sending the patch. This is because diff.el is much +;; faster in yielding the output of diff(1) ;; (Ediff is a big gun, if used +;; for this simple purpose). +;; +;; The last set of variables that can be modified is +;; +;; ediff-split-window-function +;; ediff-use-last-dir +;; ediff-nix-help-in-control-buffer +;; +;; ediff-split-window-function controls the way you want the window be +;; split between file-A and file-B. It defaults to vertical split, but you +;; can set it to 'split-window-horizontally, if you want. Ediff lets you +;; toggle the way windows are split, so you can try different settings +;; interactively. Note: if file-A and file-B are in different frames, +;; windows are not split, regardless of the value +;; ediff-split-window-function. Instead, other windows on these frames are +;; deleted and Ediff starts displaying file-A and file-B using these two +;; frames, one file per frame. You can then switch to one-frame mode +;; simply by hiding the file-A/B buffer that is displayed on a frame other +;; than the control-window frame. +;; +;; Note that if Ediff sees that the two buffers it compares are residing in +;; separate frames, it assumes that the user wants them to be so displayed +;; and stops splitting windows. Instead, it will arrange each buffer to +;; occupy its own frame (possibly shared with Ediff's help window). +;; +;; The variable ediff-use-last-dir controls the way Ediff presents the +;; default directory when it prompts the user for files to compare. If nil, +;; Ediff will use the default directory of the current buffer when it +;; prompts the user for file names. Otherwise, it will use the +;; directories it had previously used for file-A and file-B. +;; +;; The ediff-nix-help-in-control-buffer, if set to t, makes C-h behave like +;; the DEL key, i.e., it will move you back to the previous difference +;; rather than invoking help. This is useful when, in an xterm window or on +;; a dumb terminal, the Backspace key is bound to C-h and is positioned +;; more conveniently than the DEL key. + + +;;; Commands +;; -------- + +;; All Ediff commands are displayed in a help window, unless you hit '?' to +;; shrink it to just one line. You can redisplay the help window by hitting +;; '?' again. +;; +;; Many Ediff commands take numeric prefix arguments. For instance, if you +;; hit a number, n, and then 'j' (ediff-jump-to-difference), Ediff will +;; take you to n-th difference. Hitting a number, n, and then 'ab' +;; (ediff-diff-to-diff) will copy n-th difference from buffer A to buffer B. +;; Hitting 'ba' does copying in the other direction. +;; Likewise, a number, n, followed by 'ra' will restore the n-th difference +;; region in buffer A (if it was previously saved as a result of copying +;; from B to A). +;; +;; Without the prefix argument, all commands operate on the current +;; difference region. +;; +;; The total number of differences and the current difference number are +;; always displayed in the mode line of the control window. + +;;; Display Modes +;; ------------- + +;; Ediff can display files in one frame, stacked side-by-side or one on top +;; of another; or it can display the files in different frames. When you +;; start Ediff, it assumes a 1-frame mode. You can toggle the side-by-side +;; and one-on-top-of-another displays by simply hitting 's'. +;; +;; Ediff switches to the multi-frame mode when: +;; +;; 1. file-A and file-B are in different frames (you have to put them into +;; different frames manually); or +;; 2. *ediff-control* buffer is visible in one frame and one other file (A +;; or B) is visible in another frame. If, say, fileA is visible in a +;; different frame than *ediff-control*, fileB doesn't have to be +;; visible. If it is, Ediff will continue displaying fileB in the frame +;; where it was visible before. If it isn't then Ediff will arrange for +;; fileB to share a frame with *ediff-control*. +;; +;; If all three buffers are in separate frames, Ediff will switch to a +;; 3-frame mode. If Ediff buffers are currently visible only in two +;; frames, Ediff will work in a 2-frame mode. In this mode, one of the +;; frames will be shared by *ediff-control* and file-A or file-B +;; (whichever is appropriate). + + +;;; Bugs: +;; ---- + +;; 1. The undo command doesn't restore deleted regions well. That is, if +;; you delete all characters in a difference region and then invoke +;; `undo', the reinserted text will most likely be reinserted outside of +;; what Ediff thinks is the current difference region. This bug seems to +;; be present only in GNU Emacs. Lucid Emacs does fine in this respect. + +;; 2. You may get an error if your colormap doesn't have the colors requested +;; by Ediff (on a color display). If this happens, you should create your +;; own faces using available colors. See `ediff-current-diff-face-A', +;; ediff-current-diff-face-B, ediff-even-diff-face-A, ediff-even-diff-face-B, +;; ediff-odd-diff-face-A, and ediff-odd-diff-face-B to get an idea on how +;; to do this. + + +;;; Change Log: +;; ---------- + +;; Thu Feb 3, 1994 + +;; Added ediff-read-file-name, which is a stub that takes care of Lemacs +;; versions of Emerge. (Thanks to Alastair Burt <burt@dfki.uni-kl.de>.) +;; +;; Fixed a bug in ediff-setup-windows that caused control window to +;; appear in a wrong place when split-window-keep-point is nil +;; (Thanks to Kevin Broadey <KevinB@bartley.demon.co.uk>.) +;; +;; Added mechanism for using faces instead of before/after flags. This +;; looks much better on an X display, especially on a color one. +;; (Thanks to Boris Goldowsky <boris@cs.rochester.edu> for the code +;; that led to ediff-highlight-diff. +;; Also, thanks to Kevin Esler <esler@ch.hp.com> for suggestions +;; regarding highlighting differences on X displays.) +;; +;; Added functions to apply patches. +;; (Thanks to Kevin Broadey <KevinB@bartley.demon.co.uk> for this +;; suggestion.) + +;; Fri Feb 4, 1994 + +;; Added mechanism for toggling vertical/horizontal window split. +;; (Inspired by a suggestion from Allan Gottlieb +;; <gottlieb@allan.ultra.nyu.edu> -- thanks.) +;; +;; Added mechanism for toggling between highlighting using faces and +;; highlighting using ASCII flags. +;; +;; Fixed a problem with undo. Now, Ediff has smartened up and doesn't +;; keep undo info on ASCII flags inserted in buffer-A and buffer-B. +;; So, if you edit the files while browsing through them, undo behaves +;; as you would expect, i.e., faces/flags don't get in the way. + +;; Sun Feb 6, 1994 + +;; Added horizontal scrolling. Added ediff-position-region to ensure +;; that difference regions in buffer-A and buffer-B are aligned with +;; each other. Disabled ediff-toggle-split when buffers are displayed +;; in different frames. + +;; Mon Feb 7, 1994 + +;; Added toggle-window help (Suggested by Boris Goldowsky +;; <boris@cs.rochester.edu>.) +;; Added functions to copy differences from one buffer to another and to +;; recover old differences. +;; Added prefix arguments to ediff-next-difference and +;; ediff-previous-difference. + +;; Tue Feb 8, 1994 + +;; Replaced text properties with overlays. Fixed ediff-setup-windows. +;; Added ediff-save-buffer to local-write-file-hooks to prevent user +;; from saving corrupted states. (Thanks to <boris@cs.rochester.edu> +;; for suggestion.) Instead, Ediff now has a pair of functions for +;; safe saving of buffers. +;; Changed ediff-read-file-name to be more intuitive on ediff-files. +;; Added ediff-prepare-buffer-hooks. (Thanks to Kevin Esler +;; <esler@ch.hp.com> for the idea.) + +;; Wed Feb 9, 1994 + +;; Cleanups in ediff-patch-file. Protected ediff-copy-diff against +;; a bug that Emacs has in kill-region. + +;; Thu Feb 10, 1994 + +;; Added support for Lemacs. (Thanks to Alastair Burt +;; <burt@dfki.uni-kl.de> for coercing Ediff into working under Lemacs.) +;; Added ediff-kill-buffer-carefully and other suggestions by Boris +;; Goldowsky <boris@cs.rochester.edu>. +;; Refined the protection against interference with highlighting caused +;; by Hilit19. Added the variable ediff-third-party-highlighting. +;; Added mechanisn for unhighlighting regions highlighted with Hilit19 +;; before hightlighting them with Ediff's overlays. (And for +;; rehighlighting them with Hilit19, when the current difference moves on.) + +;; Sun Feb 13, 1994 + +;; Added ediff-place-flags-in-buffer and ediff-remote-exit, which are +;; modifications of Emerge's similar functions. The difference is that +;; in Ediff they make ediff-before-flag and ediff-after-flag into +;; read-only regions, so the user can't change them by mistake. +;; +;; Adopted a suggestion by Boris Goldowsky <boris@cs.rochester.edu> +;; that led to a more elegant treatment of faces. +;; +;; Added protection against interference with Font-Lock highlighting +;; similar to that of Hilit19's protection. + +;; Tue Feb 15, 1994 + +;; Deleted spurious (auto-save-mode 1) in ediff-control-buffer, which +;; was causing this buffer to be auto-saved for no good reason. +;; Added read-only protection to ediff-before/after-flags in Lemacs. +;; (Thanks to Alastair Burt <burt@dfki.uni-kl.de> for help in testing.) + +;; Wed Feb 16, 1994 + +;; Further fixes in the Lemacs part. Changed highlighted region in +;; ediff-highlight-diff so that an extra character will be highlighted +;; only if a difference is empty (thereby allowing the user to see where an +;; insertion or a deletion has taken place). +;; +;; Simplified interaction with other highlighting packages by giving +;; Ediff overlays the highest priority. (Taking a cue from +;; ediff-highlight-diff-lemacs written by Alastair Burt +;; <burt@dfki.uni-kl.de>.) Zapped ediff-third-party-highlighting +;; variable and hooks that were previously used to +;; unhighlight/rehighlight buffers when hilit19/font-lock are on. + +;; Fri Feb 18, 1994 + +;; Added a bit more sophistication to ediff-read-file-name. Now, +;; ediff-files remembers both, the file-A and the file-B directories. +;; They are offered as defaults when ediff-use-last-dir is set to t. + +;; Fri Feb 22, 1994 + +;; Added ediff-before-change-guard to remove ASCII highlighting when +;; the user attempts to change buffer-A/B. This is needed because +;; otherwise the undo info may become screwed up in those buffers. +;; Hitting 'h' (ediff-toggle-hilit) on a dumb terminal will toggle +;; between ASCII highlighting and no highlighting. + +;; Fri Feb 24, 1994 + +;; Fixed problems with multiple Ediff sessions running simultaneously. + +;; Tue Mar 1, 1994 + +;; Added vc-ediff, the Ediff interface to vc.el. (Thanks to Eric +;; Freudenthal <freudent@jan.ultra.nyu.edu> for contributing this +;; function.) + +;; Sun Mar 6, 1994 + +;; Added rcs-ediff, an Ediff interface to RCS via rcs.el. (Thanks to +;; Alastair Burt <burt@dfki.uni-kl.de>.) +;; Some minor improvements. + +;; Tue March 15, 1994 + +;; Fixed a buglet in defining ediff-current-diff-face-A/B. +;; (Thanks to Job Ganzevoort <Job.Ganzevoort@cwi.nl>.) + +;; Tue March 22, 1994 + +;; Fixed a bug with ediffing narrowed buffers, reported by Kevin +;; Broadey <KevinB@bartley.demon.co.uk>. +;; Made Ediff to work with files that have incomplete last line. +;; Made Ediff execute diff(1) and patch(1) using Bourne Shell, which +;; should eliminate problems with $prompt that some people had. + +;; Thu March 24, 1994 + +;; Achieved quadratic speedup in the size of the file by replacing the +;; slow goto-line by forward-line. Ediff is now *much* faster than +;; Emerge on large files. Converted demarkation of difference regions +;; from markers to overlays. This will later allow us to highlight all +;; diffs, not just the current one. + +;; Wed March 30, 1994 + +;; Under X, Ediff now highlights all differences in dim colors and the +;; current difference in bright colors. Improved Lucid Emacs support. + +;; Thu March 31, 1994 + +;; Changed toggle hilit to cycle through 3 states: highlighting all +;; diffs, highlighting only the current diff, and highlighting using +;; ASCII flags. +;; Added support for difference regions that are not full lines. + +;; Fri April 1, 1994 + +;; Fixed bugs related to writing buffers A and B. +;; Added commands 'ga', 'gb' to jump directly to the closest diff in +;; buffer A and B, respectively. + + +;;; Code: + +(require 'emerge) ;; Ediff is based on emerge + + +;;; Macros +(defmacro ediff-if-lucid () + (` (string-match "Lucid" emacs-version))) +(defmacro ediff-odd-p (arg) + (` (eq (logand (, arg) 1) 1))) +(defmacro ediff-buffer-live-p (buf) + (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf)))))) + + +(defun ediff-mode () + "Ediff mode is used by the Ediff file-difference package. +It is entered only through one of the following commands: + ``ediff'' + ``ediff-files'' + ``ediff-buffers'' + ``epatch'' + ``ediff-patch-file'' + ``ediff-patch-buffer'' + ``vc-ediff'' + ``rcs-ediff'' +or through a non-interactive Emacs Lisp function + ``ediff-files-remote'' + +Commands: +\\{ediff-mode-map}" + (interactive) + (kill-all-local-variables) + (setq major-mode 'ediff-mode) + (setq mode-name "Ediff")) + +(defvar ediff-version "1.31" + "The current version of Ediff.") + +(defun ediff-version () + "Return string describing the version of Ediff. +When called interactively, displays the version." + (interactive) + (if (interactive-p) + (message "Ediff version %s" (ediff-version)) + ediff-version)) + + +;; Hook variables + +(defvar ediff-before-setup-windows-hooks nil + "* Hooks to run before Ediff sets its own window config. This can be used +to save the previous window config, which can be restored on ediff-quit or +ediff-suspend.") +(defvar ediff-startup-hooks nil + "*Hooks to run in the control buffer after Ediff has been set up.") +(defvar ediff-select-hooks nil + "*Hooks to run after a difference has been selected.") +(defvar ediff-unselect-hooks nil + "*Hooks to run after a difference has been unselected.") +(defvar ediff-prepare-buffer-hooks nil + "*Hooks called after buffers A and B are set up.") +(defvar ediff-load-hooks nil + "* Hook run after Ediff is loaded. Can be used to change defaults.") + +(defvar ediff-suspend-hooks 'ediff-default-suspend-hook + "* Hooks to run in the Ediff control buffer each time Ediff is +suspended.") +(defvar ediff-quit-hooks 'ediff-default-quit-hook + "* Hooks to run in the Ediff control buffer after the ediff has been +finished.") + +(make-variable-buffer-local 'local-write-file-hooks) +(make-variable-buffer-local 'before-change-function) + +;; Help messages + +(defconst ediff-help-message-long +"p,DEL - prev diff c - recenter ab - diff A to B l - line numbers +n,SPC - next diff v/V - scroll up/dn ba - diff B to A f - file names + j - jump to diff </> - scroll lt/rt ra - restore A z - suspend Ediff + ga - goto pt in A s - toggle split rb - restore B q - quit Ediff + gb - goto pt in B h - toggle hilit +wa/wb - save buf A/B A/B - toggle read-only buf A/B ? - toggle help") + +(defconst ediff-help-message-short +" ? - toggle help window") + +(defvar ediff-help-message ediff-help-message-long + "* The actual help message.") + + +(defvar ediff-diff-program "diff" + "* Name of the program that compares two files.") +(defvar ediff-diff-options "" + "* Options to pass to ``ediff-diff-program''.") + + +;; Support for patches + +(defvar ediff-patch-program "patch" + "* Name of the program that applies patches.") +(defvar ediff-patch-options "" + "* Options to pass to ediff-patch-program.") + +(defvar ediff-shell "sh" + "* The shell used to run diff(1) and patch(1). If user's .profile or +.cshrc files are set up correctly, any shell will do. However, some people +set $prompt or other things incorrectly, which leads to undesirable output +messages. These may cause Ediff to fail. In such a case, set ediff-shell +to a shell that you are not using or, better, fix your shell's startup file.") + +(defvar ediff-diff-ok-lines-regexp + "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\|Warning:\\)" + "*Regexp that matches normal output lines from ``ediff-diff-program''. +This is mostly lifted from Emerge, except that Ediff also considers the +'Missing newline' message to be 'normal output.' +Lines that do not match are assumed to be error messages.") + +(defvar ediff-match-diff-line (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)")) + (concat "^" x "\\([acd]\\)" x "$")) + "*Pattern to match lines produced by diff that describe differences.") + +(defvar ediff-patch-buf nil + "The buffer of the patch file.") +(defvar ediff-patch-diagnostics nil + "The buffer where patch(1) would display its diagnostics.") + + +;; Copying diffs betw buffers. + +(emerge-defvar-local ediff-killed-diffs-alist nil + "A list of killed diffs. A diff is saved here if it is replaced by a diff +from another buffer. This alist has the form: +((num (A . diff) (B . diff)) ...), where A or B parts may be missing.") + + +;; Highlighting +(defvar ediff-before-flag-bol + ;"vvvvvvvvvvvvvvvv---- ediff ----vvvvvvvvvvvvvvv\n" + ">>--->>>\n" + "*Flag placed above the highlighted block of differences. Must end with +newline. Must be set before Ediff is loaded. If set to nil, the flags from +emerge.el are used.") +(defvar ediff-after-flag-bol + ;"^^^^^^^^^^^^^^^^---- ediff ----^^^^^^^^^^^^^^^\n" + "<<<---<<\n" + "*Flag placed below the highlighted block of differences. Must end with +newline. Must be set before Ediff is loaded. If set to nil, the flags from +emerge.el are used.") + +(defvar ediff-before-flag-mol ">>--->>>" + "*This is like ediff-before-flag, except it is used when a difference +region starts in the middle of a line.") +(defvar ediff-after-flag-mol "<<<---<<" + "*This is like ediff-after-flag, except it is used when a difference +region starts in the middle of a line.") + +(emerge-defvar-local ediff-before-flag-A nil + "This is the actual ASCII before-flag in effect in buffer A. +It is either `ediff-before-flag-mol' or `ediff-before-flag-bol' depending +on whether the selected difference region starts in the middle of a line +or at the beginning of a line.") +(emerge-defvar-local ediff-after-flag-A nil + "This is the actual ASCII after-flag in effect in buffer A. +It is either `ediff-before-flag-mol' or `ediff-before-flag-bol' depending +on whether the selected difference region starts in the middle of a line +or at the beginning of a line.") +(emerge-defvar-local ediff-before-flag-B nil + "This is the actual ASCII before-flag in effect in buffer B. +It is either `ediff-before-flag-mol' or `ediff-before-flag-bol' depending +on whether the selected difference region starts in the middle of a line +or at the beginning of a line.") +(emerge-defvar-local ediff-after-flag-B nil + "This is the actual ASCII after-flag in effect in buffer B. +It is either `ediff-before-flag-mol' or `ediff-before-flag-bol' depending +on whether the selected difference region starts in the middle of a line +or at the beginning of a line.") + + +(emerge-defvar-local ediff-want-faces t + "If t, differences will be highlighted using faces on a window +system. If nil, they will be highlighted using ASCII flags, ediff-before-flag +and ediff-after-flag. On a non-window system, differences are always +highlighted using ASCII flags. + +This is not a user option. Can be set either in .emacs or toggled +interactively, using ediff-toggle-hilit.") + +(emerge-defvar-local ediff-highlight-selected-only nil + "If t, only the selected differences are highlighted. + +This is not a user option. Can be set either in .emacs or toggled +interactively, using ediff-toggle-hilit.") + +(emerge-defvar-local ediff-highlighting-style nil + "A var local to each ediff-control buffer. Indicates highlighting style +in effect for this buffer: 'face, 'ascii, nil -- temporarily unhighlighted, +'off -- turned off \(on a dumb terminal only\).") + + + +;; Variables that control each Ediff session. They are local to the +;; control buffer. + +;; Mode variables +(emerge-defvar-local ediff-A-buffer nil + "The buffer in which the A variant is stored.") +(emerge-defvar-local ediff-B-buffer nil + "The buffer in which the B variant is stored.") +(emerge-defvar-local ediff-control-buffer nil + "The control buffer of ediff. ") + +(emerge-defvar-local ediff-control-buffer-suffix nil + "The suffix of the control buffer name. ") + +(defvar ediff-control-window nil + "The control window.") + + +(emerge-defvar-local ediff-A-buffer-values nil + "Keeps working values of ediff-saved-variables for ediff-A-buffer.") +(emerge-defvar-local ediff-B-buffer-values nil + "Keeps working values of ediff-saved-variables for ediff-B-buffer.") + +(emerge-defvar-local ediff-A-buffer-values-setup nil + "Remembers ediff-saved-variables for ediff-A-buffer as they were at setup.") +(emerge-defvar-local ediff-B-buffer-values-setup nil + "Remembers ediff-saved-variables for ediff-B-buffer as they were at setup.") + +(emerge-defvar-local ediff-difference-vector nil + "Vector of differences between the variants. Each difference is +represented by a vector of two overlays. The first overlays the difference +section in the A buffer and the second overlays the diff in the B buffer. +If a difference section is empty, the corresponding overlay's endpoints +councide. ") + +(emerge-defvar-local ediff-current-difference -1 + "The difference that is currently selected.") +(emerge-defvar-local ediff-number-of-differences nil + "Number of differences found.") + +(emerge-defvar-local ediff-diff-buffer nil + "Buffer containing the output of diff(1), which is used by Ediff to step +through files.") +(emerge-defvar-local ediff-diff-error-buffer nil + "Buffer containing the output of diff(1) when diff returns errors.") + +(emerge-defvar-local ediff-this-buffer-control-sessions nil + "Keeps the list of ediff-control buffers associated with each buffer A/B +involved in an ediff session.") + +(defvar ediff-disturbed-overlays nil + "A list of difference overlays that were disturbed by copying or recovery +of the current diff.") + +(defvar ediff-shaded-overlay-priority + (if (ediff-if-lucid) + (1+ mouse-highlight-priority) + 100) ;; 100 is a kludge. There is a bug in insert-in-front-hooks + ;; in Emacs < 19.23. When this is fixed, I will get rid of + ;; this kludge. + "Priority of non-selected overlays.") + + +(if (ediff-if-lucid) + (progn + (fset 'ediff-overlayp (symbol-function 'extentp)) + (fset 'ediff-make-overlay (symbol-function 'make-extent)) + (fset 'ediff-delete-overlay (symbol-function 'delete-extent)) + (fset 'ediff-overlay-put (symbol-function 'set-extent-property)) + (fset 'ediff-move-overlay (symbol-function 'set-extent-endpoints)) + (fset 'ediff-overlay-start (symbol-function 'extent-start-position)) + (fset 'ediff-overlay-end (symbol-function 'extent-end-position)) + (fset 'ediff-overlay-get (symbol-function 'extent-property))) + ;; GNU definitions + (fset 'ediff-overlayp (symbol-function 'overlayp)) + (fset 'ediff-make-overlay (symbol-function 'make-overlay)) + (fset 'ediff-delete-overlay (symbol-function 'delete-overlay)) + (fset 'ediff-overlay-put (symbol-function 'overlay-put)) + (fset 'ediff-move-overlay (symbol-function 'move-overlay)) + (fset 'ediff-overlay-start (symbol-function 'overlay-start)) + (fset 'ediff-overlay-end (symbol-function 'overlay-end)) + (fset 'ediff-overlay-get (symbol-function 'overlay-get))) + +(if window-system + (if (ediff-if-lucid) + (progn + (fset 'ediff-select-frame (symbol-function 'select-screen)) + (fset 'ediff-window-frame (symbol-function 'window-screen)) + (fset 'ediff-display-color-p (symbol-function 'x-color-display-p)) + (fset 'ediff-get-face (symbol-function 'get-face))) + (fset 'ediff-window-frame (symbol-function 'window-frame)) + (fset 'ediff-select-frame (symbol-function 'select-frame)) + (fset 'ediff-display-color-p (symbol-function 'x-display-color-p)) + (fset 'ediff-get-face (symbol-function 'internal-get-face))) + ;; not a window system + (fset 'ediff-window-frame (function (lambda (wind) (if wind 1 nil)) )) + (fset 'ediff-select-frame (symbol-function 'identity)) + (fset 'ediff-make-current-diff-overlay (function (lambda (type) nil))) + (fset 'ediff-unhighlight-diffs-totally (function (lambda () nil)))) + + +(if (not window-system) + () + (defvar ediff-current-diff-face-A + (progn + (make-face 'ediff-current-diff-face-A) + (cond ((ediff-display-color-p) + (set-face-foreground 'ediff-current-diff-face-A "firebrick") + (set-face-background 'ediff-current-diff-face-A "pale green")) + (t + (if (ediff-if-lucid) + (copy-face 'modeline 'ediff-current-diff-face-A) + (copy-face 'highlight 'ediff-current-diff-face-A)) + )) + (ediff-get-face 'ediff-current-diff-face-A)) + "Face for highlighting the currently selected difference in buffer A of +the Ediff display") + + (defvar ediff-current-diff-face-B + (progn + (make-face 'ediff-current-diff-face-B) + (cond ((ediff-display-color-p) + (set-face-foreground 'ediff-current-diff-face-B "DarkOrchid") + (set-face-background 'ediff-current-diff-face-B "Yellow")) + (t + (if (ediff-if-lucid) + (copy-face 'modeline 'ediff-current-diff-face-B) + (copy-face 'highlight 'ediff-current-diff-face-B)) + )) + (ediff-get-face 'ediff-current-diff-face-B)) + "Face for highlighting the currently selected difference in buffer B of +the Ediff display") + + (defvar ediff-even-diff-face-A + (progn + (make-face 'ediff-even-diff-face-A) + (cond ((ediff-display-color-p) + (set-face-background 'ediff-even-diff-face-A "light grey")) + (t + (if (ediff-if-lucid) + (progn + (copy-face 'highlight 'ediff-even-diff-face-A) + (invert-face 'ediff-even-diff-face-A)) + (make-face-italic 'ediff-even-diff-face-A)))) + (ediff-get-face 'ediff-even-diff-face-A)) + "Face used to highlight even-numbered differences in buffer A.") + + (defvar ediff-even-diff-face-B + (progn + (make-face 'ediff-even-diff-face-B) + (cond ((ediff-display-color-p) + (set-face-foreground 'ediff-even-diff-face-B "White") + (set-face-background 'ediff-even-diff-face-B "Gray")) + (t + (if (ediff-if-lucid) + (copy-face 'highlight 'ediff-even-diff-face-B) + (make-face-italic 'ediff-even-diff-face-B)))) + (ediff-get-face 'ediff-even-diff-face-B)) + "Face used to highlight even-numbered differences in buffer B.") + + (defvar ediff-odd-diff-face-A + (progn + (make-face 'ediff-odd-diff-face-A) + (cond ((ediff-display-color-p) + (set-face-foreground 'ediff-odd-diff-face-A "White") + (set-face-background 'ediff-odd-diff-face-A "Gray")) + (t + (if (ediff-if-lucid) + (copy-face 'highlight 'ediff-odd-diff-face-A) + (make-face-italic 'ediff-odd-diff-face-A)))) + (ediff-get-face 'ediff-odd-diff-face-A)) + "Face used to highlight odd-numbered differences in buffer A.") + + (defvar ediff-odd-diff-face-B + (progn + (make-face 'ediff-odd-diff-face-B) + (cond ((ediff-display-color-p) + (set-face-foreground 'ediff-odd-diff-face-B "Black") + (set-face-background 'ediff-odd-diff-face-B "light grey")) + (t + (if (ediff-if-lucid) + (progn + (copy-face 'highlight 'ediff-odd-diff-face-B) + (invert-face 'ediff-odd-diff-face-B)) + (make-face-italic 'ediff-odd-diff-face-B)))) + (ediff-get-face 'ediff-odd-diff-face-B)) + "Face used to highlight odd-numbered differences in buffer B.") + + + ;; Create *-var faces. These are the actual faces used to highlight + ;; odd-numbered difference regions. + ;; They are used as follows: when highlighting is turned on, + ;; ediff-odd/even-diff-face-A/B are copied + ;; into ediff-odd/even-diff-face-A/B-var, and all odd/even overlays become + ;; highlighted. When highlighting is turned off, then the face 'default is + ;; copied into ediff-odd/even-diff-face-A/B-var, thereby unhighlighting all + ;; difference regions. + (make-face 'ediff-even-diff-face-A-var) + (make-face 'ediff-even-diff-face-B-var) + (make-face 'ediff-odd-diff-face-A-var) + (make-face 'ediff-odd-diff-face-B-var) + + ;; initialize *-var faces + (defun ediff-init-var-faces () + (copy-face (if (and ediff-want-faces (null ediff-highlight-selected-only)) + ediff-even-diff-face-A 'default) + 'ediff-even-diff-face-A-var) + (copy-face (if (and ediff-want-faces (null ediff-highlight-selected-only)) + ediff-even-diff-face-B 'default) + 'ediff-even-diff-face-B-var) + (copy-face (if (and ediff-want-faces (null ediff-highlight-selected-only)) + ediff-odd-diff-face-A 'default) + 'ediff-odd-diff-face-A-var) + (copy-face (if (and ediff-want-faces (null ediff-highlight-selected-only)) + ediff-odd-diff-face-B 'default) + 'ediff-odd-diff-face-B-var)) + + + ;;; Overlays + + (emerge-defvar-local ediff-current-diff-overlay-A nil + "Overlay in buffer A.") + (emerge-defvar-local ediff-current-diff-overlay-B nil + "Overlay in buffer B.") + + (defun ediff-make-current-diff-overlay (type) + (let ((overlay (if (eq type 'A) + 'ediff-current-diff-overlay-A + 'ediff-current-diff-overlay-B)) + (buffer (if (eq type 'A) ediff-A-buffer ediff-B-buffer)) + (face (if (eq type 'A) + (face-name ediff-current-diff-face-A) + (face-name ediff-current-diff-face-B)))) + (set overlay (ediff-make-overlay (point-max) (point-max) buffer)) + (ediff-overlay-put (eval overlay) 'face face) + (ediff-overlay-put (eval overlay) 'ediff ediff-control-buffer) + )) + + ;; Computes priority of ediff overlay. + (defun ediff-highest-priority (start end buffer) + (let ((pos (max 1 (1- start))) + ovr-list) + (if (ediff-if-lucid) + (+ 2 mouse-highlight-priority) + (emerge-eval-in-buffer + buffer + (while (< pos (min (point-max) (1+ end))) + (setq ovr-list (append (overlays-at pos) ovr-list)) + (setq pos (next-overlay-change pos))) + (1+ (eval + (cons '+ + (mapcar (function + (lambda (ovr) + (if ovr + (or (ediff-overlay-get ovr 'priority) 0) + 0))) + ovr-list) + ))) + )))) + +) ; end of window-system-only code. + + + +;;; Misc + +(defvar ediff-split-window-function 'split-window-vertically + "* The function to be called to divide the main window between buffer-A +and buffer-B. You can set it to be split horizontally instead of the +default verstical split by setting this variable to +'split-window-horizontally. You can also have your own function for fancy +splits. This variable has no effect when buffer-A and buffer-B are shown in +different frames. In this case, Ediff will use those frames to display +these buffers.") + +(defconst ediff-saved-variables + '(buffer-read-only + buffer-auto-save-file-name) + "Variables and properties of a buffer which are saved, modified and restored +during an Ediff session.") + +(defconst ediff-working-values '(nil nil) + "Values to be assigned to ediff-saved-variables during diff.") + +(defvar ediff-use-last-dir nil + "* If t, Ediff will use last directory it had seen as a default +directory when prompting for file names.") + +(defvar ediff-nix-help-in-control-buffer nil + "*Don't want C-h to invoke Emacs help. Instead, C-h will jump to previous +difference.") + +(defvar ediff-temp-file-prefix + (let ((env (getenv "TMPDIR")) + d) + (setq d (if (and env (> (length env) 0)) + env + "/tmp")) + (if (= (aref d (1- (length d))) ?/) + (setq d (substring d 0 -1))) + (concat d "/ediff")) + "*Prefix to put on Ediff temporary file names. +Do not start with `~/' or `~user-name/'.") + +(defvar ediff-temp-file-mode 384 ; u=rw only + "*Mode for Ediff temporary files.") + +(defvar ediff-last-dir-A nil + "Last directory used by an Ediff command for file-A.") +(defvar ediff-last-dir-B nil + "Last directory used by an Ediff command for file-B.") + +;; Build keymaps + +(defvar ediff-mode-map nil + "Local keymap used in Ediff mode.") + + +(defun ediff-setup-keymap () + "Set up the keymap used in the control buffer of Ediff." + (setq ediff-mode-map (make-sparse-keymap)) + (suppress-keymap ediff-mode-map) + + (define-key ediff-mode-map "p" 'ediff-previous-difference) + (define-key ediff-mode-map "\C-?" 'ediff-previous-difference) + (define-key ediff-mode-map "\C-h" (if ediff-nix-help-in-control-buffer + 'ediff-previous-difference nil)) + (define-key ediff-mode-map "n" 'ediff-next-difference) + (define-key ediff-mode-map " " 'ediff-next-difference) + (define-key ediff-mode-map "j" 'ediff-jump-to-difference) + (define-key ediff-mode-map "g" nil) + (define-key ediff-mode-map "ga" 'ediff-jump-to-difference-at-point) + (define-key ediff-mode-map "gb" 'ediff-jump-to-difference-at-point) + (define-key ediff-mode-map "q" 'ediff-quit) + (define-key ediff-mode-map "z" 'ediff-suspend) + (define-key ediff-mode-map "c" 'ediff-recenter) + (define-key ediff-mode-map "s" 'ediff-toggle-split) + (define-key ediff-mode-map "h" 'ediff-toggle-hilit) + (define-key ediff-mode-map "v" 'ediff-scroll-up) + (define-key ediff-mode-map "\C-v" 'ediff-scroll-up) + (define-key ediff-mode-map "^" 'ediff-scroll-down) + (define-key ediff-mode-map "\M-v" 'ediff-scroll-down) + (define-key ediff-mode-map "V" 'ediff-scroll-down) + (define-key ediff-mode-map "<" 'ediff-scroll-left) + (define-key ediff-mode-map ">" 'ediff-scroll-right) + (define-key ediff-mode-map "f" 'ediff-file-names) + (define-key ediff-mode-map "l" 'ediff-line-numbers) + (define-key ediff-mode-map "?" 'ediff-toggle-help) + (define-key ediff-mode-map "a" nil) + (define-key ediff-mode-map "ab" 'ediff-diff-to-diff) + (define-key ediff-mode-map "b" nil) + (define-key ediff-mode-map "ba" 'ediff-diff-to-diff) + (define-key ediff-mode-map "r" nil) + (define-key ediff-mode-map "ra" 'ediff-restore-diff) + (define-key ediff-mode-map "rb" 'ediff-restore-diff) + (define-key ediff-mode-map "o" nil) + (define-key ediff-mode-map "A" 'ediff-toggle-read-only) + (define-key ediff-mode-map "B" 'ediff-toggle-read-only) + (define-key ediff-mode-map "w" nil) + (define-key ediff-mode-map "wa" 'ediff-save-buffer) + (define-key ediff-mode-map "wb" 'ediff-save-buffer) + (define-key ediff-mode-map "k" nil) + (define-key ediff-mode-map "kkk" 'ediff-reload-keymap) ;; for debug + ;; Allow ediff-mode-map to be referenced indirectly + (fset 'ediff-mode-map ediff-mode-map)) + + +;;; Setup functions + +(defun ediff-find-file (file buffer &optional last-dir) + "Visits FILE for ediff. +BUFFER is a variable symbol that is supposed to +get the buffer into which FILE is read. LAST-DIR is the directory variable +symbol where FILE's dir name should be returned. +Arguments: (file 'buffer &optional 'last-dir)" + (if (not (file-readable-p file)) + (error "File `%s' does not exist or is not readable" file)) + + ;; Record the buffer + (set buffer (find-file-noselect file)) + ;; Record the directory of the file + (if last-dir + (set last-dir (expand-file-name (file-name-directory file)))) + + ;; Make sure the entire file is seen, and it reflects what is on disk + (emerge-eval-in-buffer + (eval buffer) + (widen) + (let ((temp (file-local-copy file)) + startup-hooks) + (if temp + (setq file temp + startup-hooks + (cons (` (lambda () (delete-file (, file)))) + startup-hooks)) + ;; Verify that the file matches the buffer + (emerge-verify-file-buffer))))) + +(defun ediff-files-internal (file-A file-B &optional startup-hooks) + (let (buffer-A buffer-B) + (message "Ediff: Reading file %s ... " file-A)(sit-for .5) + (ediff-find-file file-A 'buffer-A 'ediff-last-dir-A) + (message "Ediff: Reading file %s ... " file-B)(sit-for .5) + (ediff-find-file file-B 'buffer-B 'ediff-last-dir-B) + (ediff-setup buffer-A file-A buffer-B file-B startup-hooks))) + +(defun ediff-get-patch-buffer (dir) + "Obtain patch buffer. If patch is already in a buffer---use it. +Else, read patch file into a new buffer." + (if (y-or-n-p "Is the patch file already in a buffer? ") + (setq ediff-patch-buf + (get-buffer (read-buffer "Patch buffer name: " nil t))) ;must match + (setq ediff-patch-buf + (find-file-noselect (read-file-name "Patch file name: " + dir)))) + (emerge-eval-in-buffer + ediff-patch-buf + (toggle-read-only 1)) + (setq ediff-patch-diagnostics + (get-buffer-create "*ediff patch diagnostics*")) + (emerge-eval-in-buffer + ediff-patch-diagnostics + (insert-buffer ediff-patch-buf)) + ) + +;; Start up Ediff on two files +(defun ediff-setup (buffer-A file-A buffer-B file-B startup-hooks) + (setq file-A (expand-file-name file-A)) + (setq file-B (expand-file-name file-B)) + (let* ((control-buffer-name (emerge-unique-buffer-name "*ediff-control" "*")) + (control-buffer (emerge-eval-in-buffer + buffer-A + (get-buffer-create control-buffer-name)))) + (emerge-eval-in-buffer + control-buffer + (ediff-mode) ;; in control buffer only + (setq buffer-read-only nil) + (setq ediff-A-buffer buffer-A) + (setq ediff-B-buffer buffer-B) + (setq ediff-control-buffer control-buffer) + (setq ediff-control-buffer-suffix + (if (string-match "<[0-9]*>" control-buffer-name) + (substring control-buffer-name + (match-beginning 0) (match-end 0)) + "<1>")) + (ediff-remember-buffer-characteristics t) ;; remember at setup + + (ediff-set-keys) + (setq ediff-difference-vector (ediff-make-diff-list file-A file-B)) + (setq ediff-number-of-differences (length ediff-difference-vector)) + (setq ediff-current-difference -1) + (ediff-make-current-diff-overlay 'A) + (ediff-make-current-diff-overlay 'B) + (if window-system + (ediff-init-var-faces)) + (run-hooks 'ediff-before-setup-windows-hooks) + (ediff-setup-windows buffer-A buffer-B control-buffer t) + + ;; all these must be inside emerge-eval-in-buffer control-buffer, + ;; since these vars are local to control-buffer + ;; These won't run if there are errors in diff + (emerge-eval-in-buffer + ediff-A-buffer + (run-hooks 'ediff-prepare-buffer-hooks) + (add-hook 'local-write-file-hooks 'ediff-block-write-file) + (setq before-change-function 'ediff-before-change-guard) + ;; add control-buffer to the list of sessions + (or (memq control-buffer ediff-this-buffer-control-sessions) + (setq ediff-this-buffer-control-sessions + (cons control-buffer ediff-this-buffer-control-sessions))) + (setq mode-line-buffer-identification '("A: %b"))) + (emerge-eval-in-buffer + ediff-B-buffer + (run-hooks 'ediff-prepare-buffer-hooks) + (add-hook 'local-write-file-hooks 'ediff-block-write-file) + (setq before-change-function 'ediff-before-change-guard) + ;; add control-buffer to the list of sessions + (or (memq control-buffer ediff-this-buffer-control-sessions) + (setq ediff-this-buffer-control-sessions + (cons control-buffer ediff-this-buffer-control-sessions))) + (setq mode-line-buffer-identification '("B: %b"))) + + (emerge-eval-in-buffer control-buffer + (run-hooks 'startup-hooks 'ediff-startup-hooks) + (setq buffer-read-only t))))) + +;; Generate the Ediff difference list between two files +(defun ediff-make-diff-list (file-A file-B) + (setq ediff-diff-buffer + (get-buffer-create (emerge-unique-buffer-name "*ediff-diff" "*"))) + (emerge-eval-in-buffer + ediff-diff-buffer + (erase-buffer) + ;; shell-command tends to display old shell command buffers even when it + ;; puts output in another buffer---probably an Emacs bug. + (ediff-kill-buffer-carefully "*Shell Command Output*") + (let ((shell-file-name ediff-shell)) + (message "Ediff: Computing differences ...")(sit-for .5) + (shell-command + (format "%s %s %s %s" + ediff-diff-program ediff-diff-options + (emerge-protect-metachars file-A) + (emerge-protect-metachars file-B)) + t) + )) + (ediff-prepare-error-list ediff-diff-ok-lines-regexp) + (message "Ediff: Computing differences ... Done.")(sit-for .5) + (ediff-convert-diffs-to-overlays + ediff-A-buffer ediff-B-buffer + (ediff-extract-diffs ediff-diff-buffer ediff-A-buffer ediff-B-buffer))) + +(defun ediff-prepare-error-list (ok-regexp) + (let ((diff-buff ediff-diff-buffer)) + (setq ediff-diff-error-buffer + (get-buffer-create (emerge-unique-buffer-name + "*ediff-diff-errors" "*"))) + (emerge-eval-in-buffer + ediff-diff-error-buffer + (erase-buffer) + (insert-buffer diff-buff) + (delete-matching-lines ok-regexp)))) + +;;; Function to start Ediff by patching a file + +;;;###autoload +(defun ediff-patch-file (file-to-patch &optional startup-hooks) + "Run Ediff by patching FILE-TP-PATCH." + (interactive "fFile to patch: ") + + (ediff-get-patch-buffer (file-name-directory file-to-patch)) + (let ((buf (get-file-buffer file-to-patch))) + (if buf + (progn + (emerge-eval-in-buffer + buf + (if (buffer-modified-p buf) + (if (y-or-n-p + (format + "File '%s' is already in buffer %s. Save before killing? " + file-to-patch (buffer-name buf))) + (save-buffer buf))) + (set-buffer-modified-p nil)) + (ediff-kill-buffer-carefully buf)))) + (emerge-eval-in-buffer + ediff-patch-diagnostics + (let ((shell-file-name ediff-shell)) + (message "Ediff: Applying patch ... ")(sit-for .5) + (shell-command-on-region + (point-min) (point-max) + (format "%s %s %s" + ediff-patch-program ediff-patch-options + (expand-file-name file-to-patch)) + t) + (message "Ediff: Applying patch ... Done.")(sit-for .5) + )) + (switch-to-buffer ediff-patch-diagnostics) + (sit-for 0) ;; synchronize + + (setq startup-hooks (cons 'ediff-toggle-read-only-A startup-hooks)) + (ediff-files (format "%s.orig" file-to-patch) file-to-patch startup-hooks) + + (bury-buffer ediff-patch-diagnostics) + (message "Patch diagnostics available in buffer %s." + (buffer-name ediff-patch-diagnostics))) + +(defalias 'epatch 'ediff-patch-file) + +;;; Function to start Ediff on files + +;;;###autoload +(defun ediff-files (file-A file-B &optional startup-hooks) + "Run Ediff on a pair files, FILE-A and FILE-B." + (interactive + (let (f) + (list (setq f (ediff-read-file-name "File A to compare" + (if ediff-use-last-dir + ediff-last-dir-A + default-directory) + nil nil)) + (ediff-read-file-name "File B to compare" + (if ediff-use-last-dir + ediff-last-dir-B nil) + f f) + ))) + (ediff-files-internal file-A file-B startup-hooks)) + + +(defalias 'ediff 'ediff-files) + + +;;; Function to start Ediff on buffers + +;;;###autoload +(defun ediff-buffers (buffer-A buffer-B &optional startup-hooks) + "Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B." + (interactive "bBuffer A to compare: \nbBuffer B to compare: ") + (let (ediff-file-A ediff-file-B) + (emerge-eval-in-buffer + buffer-A + (setq ediff-file-A + (ediff-make-temp-file + (format ".%s." (file-name-nondirectory (buffer-name))))) + (write-region (point-min) (point-max) ediff-file-A nil 'no-message)) + (emerge-eval-in-buffer + buffer-B + (setq ediff-file-B + (ediff-make-temp-file + (format ".%s." (file-name-nondirectory (buffer-name))))) + (write-region (point-min) (point-max) ediff-file-B nil 'no-message)) + (ediff-setup (get-buffer buffer-A) ediff-file-A + (get-buffer buffer-B) ediff-file-B + (cons (` (lambda () + (delete-file (, ediff-file-A)) + (delete-file (, ediff-file-B)))) + startup-hooks) + ))) + +;;;###autoload +(defun ediff-patch-buffer (buffer-name &optional startup-hooks) + "Run Ediff by patching BUFFER-NAME." + (interactive "bBuffer to patch: ") + + (let* ((file-buffer (get-buffer buffer-name)) + (file-name (if file-buffer (buffer-file-name file-buffer)))) + (if (not file-name) + (error "Buffer %s doesn't exist or doesn't visit any file. Why patch?" + file-name)) + + (ediff-patch-file file-name startup-hooks))) + + +;;; Versions Control functions + +;;;###autoload +(defun vc-ediff (rev) + "Run ediff on version REV of the current buffer in another window. +If the current buffer is named `F', the version is named `F.~REV~'. +If `F.~REV~' already exists, it is used instead of being re-created. +Note: this function will work starting with GNU Emacs 19.22." + (interactive "sVersion to ediff with (default is the latest version): ") + (or (featurep 'vc) + (if (locate-library "vc") ;; if vc.el is available + (progn + (require 'vc-hooks) + (define-key vc-prefix-map "=" 'vc-ediff)) + (error "The VC package is apparently not installed."))) + (let ((newvers (current-buffer)) + (oldvers (vc-version-other-window rev))) + (ediff-buffers newvers oldvers) + )) + +(defun rcs-ediff-view-revision (&optional rev) + "View previous RCS revison of current file. +With prefix argument, prompts for a revision name." + (interactive (list (if current-prefix-arg + (read-string "Revision: ")))) + (let* ((filename (buffer-file-name (current-buffer))) + (switches (append '("-p") + (if rev (list (concat "-r" rev)) nil))) + (buff (concat (file-name-nondirectory filename) ".~" rev "~"))) + (message "Working...") + (setq filename (expand-file-name filename)) + (with-output-to-temp-buffer + buff + (let ((output-buffer (rcs-get-output-buffer filename buff))) + (delete-windows-on output-buffer) + (save-excursion + (set-buffer output-buffer) + (apply 'call-process "co" nil t nil + ;; -q: quiet (no diagnostics) + (append switches rcs-default-co-switches + (list "-q" filename))))) + (message "") + buff))) + +;;;###autoload +(defun rcs-ediff (&optional rev) + "Run Ediff on the current buffer, comparing it with previous RCS revison. +With prefix argument, prompts for revision name." + (interactive (list (if current-prefix-arg + (read-string "Revision: ")))) + (or (featurep 'rcs) + (if (locate-library "rcs") + (progn + (require 'rcs) + (global-set-key "\C-cD" 'rcs-ediff)) + (error "The RCS package is apparently not installed."))) + (let ((newvers (current-buffer)) + (oldvers (rcs-ediff-view-revision rev))) + (ediff-buffers newvers oldvers) + )) + + +;;; Functions to start Ediff via remote request + +;;;###autoload +(defun ediff-files-remote (file-a file-b) + "Run Ediff on remote files, FILE-A and FILE-B." + (ediff-files-internal file-a file-b nil) + (throw 'client-wait nil)) + + +(defun ediff-remote-exit (exit-func) + "Exit remote Ediff session." + (ediff-really-quit) + (funcall exit-func)) + + + +;; Select the lowest window on the frame. +(defun ediff-select-lowest-window () + (let* ((lowest-window (selected-window)) + (bottom-edge (car (cdr (cdr (cdr (window-edges)))))) + (last-window (previous-window)) + (window-search t)) + (while window-search + (let* ((this-window (next-window)) + (next-bottom-edge (car (cdr (cdr (cdr + (window-edges this-window))))))) + (if (< bottom-edge next-bottom-edge) + (progn + (setq bottom-edge next-bottom-edge) + (setq lowest-window this-window))) + + (select-window this-window) + (if (eq last-window this-window) + (progn + (select-window lowest-window) + (setq window-search nil))))))) + +;;; Common setup routines + +;; Set up the window configuration. If POS is given, set the points to +;; the beginnings of the buffers. +(defun ediff-setup-windows (buffer-A buffer-B control-buffer &optional pos) + ;; Make sure we are not in the minibuffer window when we try to delete + ;; all other windows. + (if (eq (selected-window) (minibuffer-window)) + (other-window 1)) + (delete-other-windows) + (switch-to-buffer control-buffer) + (ediff-refresh-mode-line) + + (ediff-arrange-buffer buffer-A buffer-B (current-buffer) pos) + (ediff-arrange-buffer buffer-B buffer-A (current-buffer) pos) + ;; ediff-arrange-buffer always leaves in ctl buffer + ;; setup ctl wind if it is not set. + (ediff-setup-control-window) + + ;; If diff reports errors, display them rather than then compare buffers. + (if (/= 0 (emerge-eval-in-buffer ediff-diff-error-buffer (buffer-size))) + (let ((diff-output-buf ediff-diff-buffer)) + (switch-to-buffer ediff-diff-error-buffer) + (ediff-kill-buffer-carefully control-buffer) + (error "Errors found in diff output. Diff output buffer is %s" + diff-output-buf)))) + + +;; Arranges goal-buf on the screen. +(defun ediff-arrange-buffer (goal-buf other-buf ctl-buf &optional pos) + (let* ((ctl-wind (get-buffer-window ctl-buf t)) + (goal-wind (get-buffer-window goal-buf t)) + (other-wind (get-buffer-window other-buf t)) + (ctl-frame (ediff-window-frame ctl-wind)) + (goal-frame (if goal-wind (ediff-window-frame goal-wind))) + (other-frame (if other-wind (ediff-window-frame other-wind))) + (ctl-frame-shared (or (eq ctl-frame goal-frame) + (eq ctl-frame other-frame)))) + + (cond ((and goal-frame (not (eq goal-wind other-wind))) + ;; goal buffer is visible and we are not comparing file + ;; against itself (by mistake). + ;; Note: goal-frame != ctl-frame, as we deleted other + ;; windows on ctl-frame. + (ediff-select-frame goal-frame) + (select-window goal-wind) + (delete-other-windows)) + + ;; goal-buf invisible, ctl-frame has only ctl-buf + ;; then put goal-buf on ctl-frame + ((null ctl-frame-shared) + (ediff-select-frame ctl-frame) + (split-window-vertically) + (ediff-select-lowest-window) + (setq ctl-wind (selected-window)) + (switch-to-buffer ctl-buf) + (ediff-setup-control-window) + (other-window 1) + (switch-to-buffer goal-buf)) ; goal-buf set + ;; goal-buf invisible, ctl-frame has ctl-buf and other-buf + ;; So, put everything in one frame + (other-frame ;; share with the other buf + (ediff-select-frame ctl-frame) + (select-window other-wind) + (funcall ediff-split-window-function) + (other-window 1) + (switch-to-buffer goal-buf)) + (t ;; debug + (error "Funny window combination (Ediff bug?)"))) + + (if pos + (goto-char (point-min))) + + (ediff-select-frame ctl-frame) + (select-window ctl-wind) + (switch-to-buffer ctl-buf))) + +;; This function assumes that we are in the window where control buffer is +;; to reside. +(defun ediff-setup-control-window () + "Set up window for control buffer." + (erase-buffer) + (insert ediff-help-message) + (shrink-window-if-larger-than-buffer) + (setq ediff-control-window (selected-window)) + (goto-char (point-min)) + (skip-chars-forward " \t\n")) + + +;; Set up the keymap in the control buffer +(defun ediff-set-keys () + "Set up Ediff keymap, if necessary." + (if (null ediff-mode-map) + (ediff-setup-keymap)) + (use-local-map ediff-mode-map)) + +;; Reload Ediff keymap. For debugging only. +(defun ediff-reload-keymap () + (interactive) + (setq ediff-mode-map nil) + (ediff-set-keys)) + +(defun ediff-before-change-guard (start end) + "If buffer is highlighted with ASCII flags, remove highlighting before +changing buf. Arguments, START and END are not used, but are provided +because this is required by ``before-change-function''." + (let (notify) + (save-window-excursion + (mapcar + (function + (lambda (buf) + (if (ediff-buffer-live-p buf) + (emerge-eval-in-buffer + buf + (if (eq ediff-highlighting-style 'ascii) + (progn + (ediff-unselect-and-select-difference + ediff-current-difference + 'unselect-only 'no-recenter) + (setq notify t) + )))))) + ediff-this-buffer-control-sessions) + (if notify + (error "ASCII flags removed. You can edit now. Hit 'c' to rehighlight.")) + ))) + + +(defun ediff-remember-buffer-characteristics (&optional arg) + "Record certain properties of the buffers being compared. +Must be called in the control buffer. Saves ``read-only'', ``modified'', +and ``auto-save'' properties in buffer local variables. Turns off +``auto-save-mode''. These properties are restored via a call to +``ediff-restore-buffer-characteristics''." + + ;; remember and alter buffer characteristics + (set (if arg 'ediff-A-buffer-values-setup 'ediff-A-buffer-values) + (emerge-eval-in-buffer + ediff-A-buffer + (prog1 + (emerge-save-variables ediff-saved-variables) + (emerge-restore-variables ediff-saved-variables + ediff-working-values)))) + (set (if arg 'ediff-B-buffer-values-setup 'ediff-B-buffer-values) + (emerge-eval-in-buffer + ediff-B-buffer + (prog1 + (emerge-save-variables ediff-saved-variables) + (emerge-restore-variables ediff-saved-variables + ediff-working-values))))) + +(defun ediff-restore-buffer-characteristics (&optional arg) + "Restores properties saved by ``ediff-remember-buffer-characteristics''." + (let ((A-values (if arg ediff-A-buffer-values-setup ediff-A-buffer-values)) + (B-values (if arg ediff-B-buffer-values-setup ediff-B-buffer-values))) + (emerge-eval-in-buffer ediff-A-buffer + (emerge-restore-variables ediff-saved-variables + A-values)) + (emerge-eval-in-buffer ediff-B-buffer + (emerge-restore-variables ediff-saved-variables + B-values)))) + + +(defun ediff-extract-diffs (diff-buffer A-buffer B-buffer) + (let (diff-list + (a-prev 1) ;; this is needed to set the first diff line correctly + (b-prev 1)) + (emerge-eval-in-buffer + A-buffer + (goto-char (point-min))) + (emerge-eval-in-buffer + B-buffer + (goto-char (point-min))) + (emerge-eval-in-buffer + diff-buffer + (goto-char (point-min)) + (while (re-search-forward ediff-match-diff-line nil t) + (let* ((a-begin (string-to-int (buffer-substring (match-beginning 1) + (match-end 1)))) + (a-end (let ((b (match-beginning 3)) + (e (match-end 3))) + (if b + (string-to-int (buffer-substring b e)) + a-begin))) + (diff-type (buffer-substring (match-beginning 4) (match-end 4))) + (b-begin (string-to-int (buffer-substring (match-beginning 5) + (match-end 5)))) + (b-end (let ((b (match-beginning 7)) + (e (match-end 7))) + (if b + (string-to-int (buffer-substring b e)) + b-begin))) + a-begin-pt a-end-pt b-begin-pt b-end-pt) + ;; fix the beginning and end numbers, because diff is somewhat + ;; strange about how it numbers lines + (if (string-equal diff-type "a") + (setq b-end (1+ b-end) + a-begin (1+ a-begin) + a-end a-begin) + (if (string-equal diff-type "d") + (setq a-end (1+ a-end) + b-begin (1+ b-begin) + b-end b-begin) + ;; (string-equal diff-type "c") + (setq a-end (1+ a-end) + b-end (1+ b-end)))) + ;; convert to relative line numbers + (emerge-eval-in-buffer + A-buffer + (forward-line (- a-begin a-prev)) + (setq a-begin-pt (point)) + (forward-line (- a-end a-begin)) + (setq a-end-pt (point) + a-prev a-end)) + (emerge-eval-in-buffer + B-buffer + (forward-line (- b-begin b-prev)) + (setq b-begin-pt (point)) + (forward-line (- b-end b-begin)) + (setq b-end-pt (point) + b-prev b-end)) + (setq diff-list (nconc diff-list (list (vector a-begin-pt a-end-pt + b-begin-pt b-end-pt)))) + ))) + diff-list + )) + +(defun ediff-convert-diffs-to-overlays (A-buffer B-buffer diff-list) + (let* ((current-diff -1) + (total-diffs (length diff-list)) + (control-buffer-suffix ediff-control-buffer-suffix) + diff-overlay-list list-element + a-begin a-end b-begin b-end + a-overlay b-overlay) + + (while diff-list + (setq current-diff (1+ current-diff) + list-element (car diff-list) + a-begin (aref list-element 0) + a-end (aref list-element 1) + b-begin (aref list-element 2) + b-end (aref list-element 3)) + + ;; place overlays at the appropriate places in the buffers + (setq a-overlay (ediff-make-overlay a-begin a-end A-buffer)) + ;; priority of a-overlay and b-overlay should be equal. otherwise it + ;; won't work due to Emacs bug---insert-in-front-hooks will be called + ;; only on behalf of the buffer with higher priority. + (ediff-overlay-put a-overlay 'priority ediff-shaded-overlay-priority) + (ediff-overlay-put a-overlay 'ediff-diff-num current-diff) + (ediff-overlay-put a-overlay + 'insert-in-front-hooks '(ediff-insert-in-front)) + (ediff-overlay-put a-overlay + 'ediff-control-buffer control-buffer-suffix) + (ediff-overlay-put a-overlay + 'face (if (ediff-odd-p current-diff) ;; odd diff + 'ediff-odd-diff-face-A-var + 'ediff-even-diff-face-A-var)) + + (setq b-overlay (ediff-make-overlay b-begin b-end B-buffer)) + (ediff-overlay-put b-overlay 'priority ediff-shaded-overlay-priority) + (ediff-overlay-put b-overlay 'ediff-diff-num current-diff) + (ediff-overlay-put b-overlay + 'insert-in-front-hooks '(ediff-insert-in-front)) + (ediff-overlay-put b-overlay + 'ediff-control-buffer control-buffer-suffix) + (ediff-overlay-put b-overlay + 'face (if (ediff-odd-p current-diff) ;; odd diff + 'ediff-odd-diff-face-B-var + 'ediff-even-diff-face-B-var)) + + (if (ediff-if-lucid) ;; chars inserted at end will be inside extent + (progn + (ediff-overlay-put a-overlay + 'ediff-marker + (move-marker (make-marker) a-begin A-buffer)) + (ediff-overlay-put b-overlay + 'ediff-marker + (move-marker (make-marker) b-begin B-buffer)) + (ediff-overlay-put a-overlay 'end-open nil) + (ediff-overlay-put b-overlay 'end-open nil))) + + ;; record all overlays for this difference + (setq diff-overlay-list + (nconc diff-overlay-list (list (vector a-overlay b-overlay))) + diff-list (cdr diff-list)) + (message "Ediff: Processing diff region %d of %d" + current-diff total-diffs) + ) ;; while + ;; this is just to avoid confusing the user with diff num < total-diffs + (message "Ediff: Processing diff region %d of %d" + (1+ current-diff) total-diffs) + ;; convert the list of difference information into a vector for + ;; fast access + (setq ediff-difference-vector + (apply 'vector diff-overlay-list)))) + + + +;;; Commands + +(defun ediff-recenter (&optional no-rehighlight) + "Bring the highlighted region of all buffers A and B into view. +Reestablish the default three-window display." + (interactive) + (setq ediff-disturbed-overlays nil) ;; clear after use + (let (buffer-read-only) + (ediff-setup-windows ediff-A-buffer ediff-B-buffer ediff-control-buffer)) + ;; Redisplay whatever buffers are showing, if there is a selected difference + (if (and (>= ediff-current-difference 0) + (< ediff-current-difference ediff-number-of-differences)) + (let* ( ;; context must be saved before switching to windows A/B + (buffer-A ediff-A-buffer) + (buffer-B ediff-B-buffer) + (wind (selected-window)) + (control-buf ediff-control-buffer) + (before-flag-shift-A (if (eq ediff-highlighting-style 'ascii) + (1- (length ediff-before-flag-A)) + 0)) + (after-flag-shift-A (if (eq ediff-highlighting-style 'ascii) + (1- (length ediff-after-flag-A)) + 0)) + (before-flag-shift-B (if (eq ediff-highlighting-style 'ascii) + (1- (length ediff-before-flag-B)) + 0)) + (after-flag-shift-B (if (eq ediff-highlighting-style 'ascii) + (1- (length ediff-after-flag-B)) + 0)) + (window-A (get-buffer-window buffer-A t)) + (window-B (get-buffer-window buffer-B t))) + + (or no-rehighlight + (ediff-operate-on-flags 'insert)) + + (if window-A (progn + (select-window window-A) + (ediff-position-region + (- (ediff-get-diff-posn 'A 'beg nil control-buf) + before-flag-shift-A) + (+ (ediff-get-diff-posn 'A 'end nil control-buf) + after-flag-shift-A) + (ediff-get-diff-posn 'A 'beg nil control-buf)))) + (if window-B (progn + (select-window window-B) + (ediff-position-region + (- (ediff-get-diff-posn 'B 'beg nil control-buf) + before-flag-shift-B) + (+ (ediff-get-diff-posn 'B 'end nil control-buf) + after-flag-shift-B) + (ediff-get-diff-posn 'B 'beg nil control-buf)))) + (select-window wind)))) + +(defun ediff-toggle-split () + "Toggle vertical/horizontal window split. +Does nothing if file-A and file-B are in different frames." + (interactive) + (let* ((wind-A (get-buffer-window ediff-A-buffer t)) + (wind-B (get-buffer-window ediff-B-buffer t)) + (frame-A (if wind-A (ediff-window-frame wind-A))) + (frame-B (if wind-B (ediff-window-frame wind-B)))) + (if (eq frame-A frame-B) + (setq ediff-split-window-function + (if (eq ediff-split-window-function 'split-window-vertically) + 'split-window-horizontally + 'split-window-vertically)) + (message "Buffers A and B are residing in different frames. Why split?")) + (ediff-recenter 'no-rehighlight))) + +(defun ediff-toggle-hilit () + "Switch between highlighting using ASCII flags and highlighting using faces. +On a dumb terminal, switches between ASCII highlighting and no highlighting." + (interactive) + (if (not window-system) + (if (eq ediff-highlighting-style 'ascii) + (progn + (message "ASCII highlighting flags removed.") + (ediff-unselect-and-select-difference ediff-current-difference + 'unselect-only) + (setq ediff-highlighting-style 'off)) + (ediff-unselect-and-select-difference ediff-current-difference + 'select-only)) + (ediff-unselect-and-select-difference ediff-current-difference + 'unselect-only) + ;; cycle through highlighting + (cond ((and ediff-want-faces (null ediff-highlight-selected-only)) + (message "Ediff: Unhighlighted unselected difference regions.") + (setq ediff-highlight-selected-only t)) + (ediff-want-faces + (message "Ediff: Now using ASCII flags only.") + (setq ediff-want-faces nil)) + (t + (message "Ediff: Re-highlighted all difference regions.") + (setq ediff-want-faces t + ediff-highlight-selected-only nil))) + + (if (and ediff-want-faces (null ediff-highlight-selected-only)) + (if (not (face-differs-from-default-p 'ediff-odd-diff-face-A-var)) + (progn + (copy-face ediff-odd-diff-face-A 'ediff-odd-diff-face-A-var) + (copy-face ediff-odd-diff-face-B 'ediff-odd-diff-face-B-var) + (copy-face ediff-even-diff-face-A 'ediff-even-diff-face-A-var) + (copy-face ediff-even-diff-face-B 'ediff-even-diff-face-B-var))) + (copy-face 'default 'ediff-odd-diff-face-A-var) + (copy-face 'default 'ediff-odd-diff-face-B-var) + (copy-face 'default 'ediff-even-diff-face-A-var) + (copy-face 'default 'ediff-even-diff-face-B-var)) + + (ediff-unselect-and-select-difference + ediff-current-difference 'select-only)) + (ediff-operate-on-flags 'insert) + ) + +(defun ediff-toggle-help () + "Toggle short/long help message." + (interactive) + (let (buffer-read-only) + (erase-buffer) + (if (string= ediff-help-message ediff-help-message-long) + (setq ediff-help-message ediff-help-message-short) + (setq ediff-help-message ediff-help-message-long))) + (ediff-recenter 'no-rehighlight)) + + +(defun ediff-toggle-read-only-A () + "Used as a startup hook to set `.orig' patch file read-only." + (let ((last-command-char ?A)) + (ediff-toggle-read-only))) + +(defun ediff-toggle-read-only () + "Toggles buffer-read-only for buffer buffers A and B." + (interactive) + (emerge-eval-in-buffer + (if (eq last-command-char ?A) ediff-A-buffer ediff-B-buffer) + (setq buffer-read-only (null buffer-read-only)))) + +;;; Window scrolling operations +;; These operations are designed to scroll all three windows the same amount, +;; so as to keep the text in them aligned. + +;; Perform some operation on two file windows (if they are showing). +;; Catches all errors on the operation in the A and B windows. +;; Usually, errors come from scrolling off the +;; beginning or end of the buffer, and this gives nice nice error messages. +(defun ediff-operate-on-windows (operation arg) + (let* ((buffer-A ediff-A-buffer) + (buffer-B ediff-B-buffer) + (wind (selected-window)) + (window-A (get-buffer-window buffer-A t)) + (window-B (get-buffer-window buffer-B t))) + (if window-A (progn + (select-window window-A) + (condition-case nil + (funcall operation arg) + (error)))) + (if window-B (progn + (select-window window-B) + (condition-case nil + (funcall operation arg) + (error)))) + (select-window wind) + )) + +(defun ediff-scroll-up (&optional arg) + "Scroll up buffers A and B, if they are in windows. +With optional argument ARG, scroll ARG lines; otherwise scroll by nearly +the height of window-A." + (interactive "P") + (ediff-operate-on-windows + 'scroll-up + ;; calculate argument to scroll-up + ;; if there is an explicit argument + (if (and arg (not (equal arg '-))) + ;; use it + (prefix-numeric-value arg) + ;; if not, see if we can determine a default amount (the window height) + (let* ((window-A (get-buffer-window ediff-A-buffer t)) + (window-B (get-buffer-window ediff-B-buffer t)) + default-amount) + (if (or (null window-A) (null window-B)) + (setq default-amount 0) + (setq default-amount + (- (min (window-height window-A) (window-height window-B)) + 1 next-screen-context-lines))) + ;; the window was found + (if arg + ;; C-u as argument means half of default amount + (/ default-amount 2) + ;; no argument means default amount + default-amount))))) + +(defun ediff-scroll-down (&optional arg) + "Scroll down buffers A and B, if they are in windows. +With optional argument ARG, scroll ARG lines; otherwise scroll by nearly +the height of window-A." + (interactive "P") + (ediff-operate-on-windows + 'scroll-down + ;; calculate argument to scroll-down + ;; if there is an explicit argument + (if (and arg (not (equal arg '-))) + ;; use it + (prefix-numeric-value arg) + ;; if not, see if we can determine a default amount (the window height) + (let* ((window-A (get-buffer-window ediff-A-buffer t)) + (window-B (get-buffer-window ediff-B-buffer t)) + default-amount) + (if (or (null window-A) (null window-B)) + (setq default-amount 0) + (setq default-amount + (- (min (window-height window-A) (window-height window-B)) + 1 next-screen-context-lines))) + ;; the window was found + (if arg + ;; C-u as argument means half of default amount + (/ default-amount 2) + ;; no argument means default amount + default-amount))))) + +(defun ediff-scroll-left (&optional arg) + "Scroll left buffer-A and buffer-B, if they are in windows. +If an argument is given, that is how many columns are scrolled, else nearly +the width of the A and B windows." + (interactive "P") + (ediff-operate-on-windows + 'scroll-left + ;; calculate argument to scroll-left + ;; if there is an explicit argument + (if (and arg (not (equal arg '-))) + ;; use it + (prefix-numeric-value arg) + ;; if not, see if we can determine a default amount + ;; (half the window width) + (if (null ediff-control-window) + ;; no control window, use nil + nil + (let ((default-amount + (- (/ (window-width ediff-control-window) 2) 3))) + ;; the window was found + (if arg + ;; C-u as argument means half of default amount + (/ default-amount 2) + ;; no argument means default amount + default-amount)))))) + +(defun ediff-scroll-right (&optional arg) + "Scroll right buffer-A and buffer-B, if they are in windows. +If an argument is given, that is how many columns are scrolled, else nearly +the width of the A and B windows." + (interactive "P") + (ediff-operate-on-windows + 'scroll-right + ;; calculate argument to scroll-right + ;; if there is an explicit argument + (if (and arg (not (equal arg '-))) + ;; use it + (prefix-numeric-value arg) + ;; if not, see if we can determine a default amount + ;; (half the window width) + (if (null ediff-control-window) + ;; no control window, use nil + nil + (let ((default-amount + (- (/ (window-width ediff-control-window) 2) 3))) + ;; the window was found + (if arg + ;; C-u as argument means half of default amount + (/ default-amount 2) + ;; no argument means default amount + default-amount)))))) + +(defun ediff-position-region (beg end pos) + "This is a variation on ``emerge-position-region''. +The difference is that it always tries to align difference regions in +buffer-A and buffer-B, so that it will be easier to compare them." + (set-window-start (selected-window) beg) + (if (pos-visible-in-window-p end) + ;; Determine the number of lines that the region occupies + (let ((lines 0)) + (while (> end (progn + (move-to-window-line lines) + (point))) + (setq lines (1+ lines))) + ;; And position the beginning on the right line + (goto-char beg) + (recenter (/ (1+ (max (- (1- (window-height (selected-window))) + lines) + 1) + ) + 2)))) + (goto-char pos) + ) + + +(defun ediff-next-difference (arg) + "Advance to the next difference. +With a prefix argument, go back that many differences." + (interactive "P") + (if (< ediff-current-difference ediff-number-of-differences) + (let ((n (min ediff-number-of-differences + (+ ediff-current-difference (if arg arg 1)))) + (buffer-read-only nil)) + (ediff-unselect-and-select-difference n)) + (error "At end of the difference list."))) + +(defun ediff-previous-difference (arg) + "Go to the previous difference. +With a prefix argument, go back that many differences." + (interactive "P") + (if (> ediff-current-difference -1) + (let ((n (max -1 (- ediff-current-difference (if arg arg 1)))) + (buffer-read-only nil)) + (ediff-unselect-and-select-difference n)) + (error "At beginning of the difference list."))) + +(defun ediff-jump-to-difference (difference-number) + "Go to the difference specified as a prefix argument." + (interactive "p") + (let ((buffer-read-only nil)) + (setq difference-number (1- difference-number)) + (if (and (>= difference-number -1) + (< difference-number (1+ ediff-number-of-differences))) + (ediff-unselect-and-select-difference difference-number) + (error "Bad difference number")))) + +(defun ediff-jump-to-difference-at-point () + "Go to the difference closest to the point in buffer A or B. +If this command is invoked via `ja' or `ga' then the point in buffer A is +used. Otherwise, buffer B is used." + (interactive) + (let ((buffer-read-only nil) + (buf-type (if (eq last-command-char ?a) 'A 'B))) + + (ediff-jump-to-difference (ediff-diff-at-point buf-type)))) + + +;; find region "most related to the current point position + +(defun ediff-diff-at-point (buf-type) + (let ((buffer (if (eq buf-type 'A) ediff-A-buffer ediff-B-buffer)) + (ctl-buffer ediff-control-buffer) + (diff-no -1) + (prev-beg 0) + (beg 0)) + + (emerge-eval-in-buffer + buffer + (while (or (< (point) prev-beg) (> (point) beg)) + (setq diff-no (1+ diff-no)) + (setq prev-beg beg) + (setq beg (ediff-get-diff-posn buf-type 'beg diff-no ctl-buffer))) + + (if (< (abs (- (point) prev-beg)) + (abs (- (point) beg))) + diff-no + (1+ diff-no)) ;; jump-to-diff works with diff nums higher by 1 + ))) + +;;; Copying diffs. + +(defun ediff-diff-to-diff (arg) + "Copy buffer-A'th diff to buffer B. +If numerical prefix argument, copy this diff specified in the arg. +Otherwise, copy the difference given by ``ediff-current-difference''." + (interactive "P") + (if arg + (ediff-jump-to-difference arg)) + (ediff-copy-diff ediff-current-difference + (if (eq last-command-char ?a) 'B 'A)) + (ediff-recenter 'no-rehighlight)) + + +(defun ediff-copy-diff (n buf-type) + "Copy diff N from BUF-TYPE \(given as 'A or 'B\)." + (let* ((other-buf (if (eq buf-type 'A) + ediff-B-buffer ediff-A-buffer)) + (buf (if (eq buf-type 'A) + ediff-A-buffer ediff-B-buffer)) + (other-buf-type (if (eq buf-type 'A) 'B 'A)) + (ctrl-buf ediff-control-buffer) + reg-to-copy reg-to-delete + reg-to-delete-beg reg-to-delete-end) + + (ediff-operate-on-flags 'remove) + (setq reg-to-delete-beg + (ediff-get-diff-posn other-buf-type 'beg n ctrl-buf)) + (setq reg-to-delete-end + (ediff-get-diff-posn other-buf-type 'end n ctrl-buf)) + (setq reg-to-copy (emerge-eval-in-buffer + buf + (buffer-substring (ediff-get-diff-posn + buf-type 'beg n ctrl-buf) + (ediff-get-diff-posn + buf-type 'end n ctrl-buf)))) + (setq reg-to-delete (emerge-eval-in-buffer + other-buf + (buffer-substring reg-to-delete-beg + reg-to-delete-end))) + (setq ediff-disturbed-overlays nil) ;; clear before use + + (if (string= reg-to-delete reg-to-copy) + (progn + (ding) + (message + "Diff regions %d are identical in buffers A and B. Nothing copied." + (1+ n))) + + ;; seems ok to copy + (if (ediff-test-save-region n other-buf-type) + (condition-case conds + (let (inhibit-read-only) + (emerge-eval-in-buffer + other-buf + ;; to prevent flags from interfering if buffer is writable + (setq inhibit-read-only (null buffer-read-only)) + (let ((before-change-function nil)) + (goto-char reg-to-delete-end) + (insert-before-markers reg-to-copy) + (if (ediff-if-lucid) + (progn + (ediff-collect-extents-lucid reg-to-delete-beg) + (if (> reg-to-delete-end reg-to-delete-beg) + (progn + (kill-region reg-to-delete-beg + reg-to-delete-end) + (if (string= reg-to-copy "") + (ediff-adjust-disturbed-extents-lucid + reg-to-delete-beg))))) + (if (> reg-to-delete-end reg-to-delete-beg) + (kill-region reg-to-delete-beg reg-to-delete-end) + (ediff-move-disturbed-overlays reg-to-delete-beg))) + )) + (ediff-save-diff-region n other-buf-type reg-to-delete)) + (error (message "%s %s" + (car conds) + (mapconcat 'prin1-to-string (cdr conds) " ")) + (beep 1)))) + ) + (ediff-operate-on-flags 'insert) + )) + +(defun ediff-save-diff-region (n buf-type reg) + "Save N-th diff of buffer BUF-TYPE \('A or 'B\) on the +``ediff-killed-diffs-alist''. REG is the region to save. +It is redundant here,but is passed anyway, for convenience." + + (let* ((n-th-diff-saved (assoc n ediff-killed-diffs-alist)) + (this-buf-n-th-diff-saved (assoc buf-type (cdr n-th-diff-saved)))) + + (if this-buf-n-th-diff-saved + ;; either nothing saved for n-th diff and buffer or we OK'ed + ;; overriding + (setcdr this-buf-n-th-diff-saved reg) + (if n-th-diff-saved ;; n-th diff saved, but for another buffer + (nconc n-th-diff-saved (list (cons buf-type reg))) + (setq ediff-killed-diffs-alist ;; create record for n-th diff + (cons (list n (cons buf-type reg)) + ediff-killed-diffs-alist)))) + (message "Saved diff region #%d for buffer %S. To recover hit '%s'." + (1+ n) buf-type (if (eq buf-type 'A) "ra" "rb")))) + +(defun ediff-test-save-region (n buf-type) + "Test if saving N-th difference region of buffer BUF-TYPE is possible." + (let* ((n-th-diff-saved (assoc n ediff-killed-diffs-alist)) + (this-buf-n-th-diff-saved (assoc buf-type (cdr n-th-diff-saved)))) + + (if this-buf-n-th-diff-saved + (if (yes-or-no-p + (format + "You've previously copied diff %d from %S to %S. Confirm. " + (1+ n) (if (eq buf-type 'A) 'B 'A) buf-type)) + t + (error "Quit.")) + t))) + +(defun ediff-pop-diff (n buf-type) + "Pop last killed N-th diff region from buffer BUF-TYPE." + (let* ((n-th-record (assoc n ediff-killed-diffs-alist)) + (saved-rec (assoc buf-type (cdr n-th-record))) + (buf (if (eq buf-type 'A) ediff-A-buffer ediff-B-buffer)) + saved-diff reg-beg reg-end recovered) + + (if (cdr saved-rec) + (setq saved-diff (cdr saved-rec)) + (error "Nothing saved for diff %d in buffer %S." (1+ n) buf-type)) + + (ediff-operate-on-flags 'remove) + + (setq reg-beg (ediff-get-diff-posn buf-type 'beg n ediff-control-buffer)) + (setq reg-end (ediff-get-diff-posn buf-type 'end n ediff-control-buffer)) + (setq ediff-disturbed-overlays nil) ;; clear before use + + (condition-case conds + (emerge-eval-in-buffer + buf + (let ((inhibit-read-only (null buffer-read-only)) + (before-change-function nil)) + (goto-char reg-end) + (insert-before-markers saved-diff) + + (if (ediff-if-lucid) + (progn + (ediff-collect-extents-lucid reg-beg) + (if (> reg-end reg-beg) + (progn + (kill-region reg-beg reg-end) + (if (string= saved-diff "") + (ediff-adjust-disturbed-extents-lucid reg-beg))))) + (if (> reg-end reg-beg) + (kill-region reg-beg reg-end) + (ediff-move-disturbed-overlays reg-beg))) + + (setq recovered t) + )) + (error (message "%s %s" + (car conds) + (mapconcat 'prin1-to-string (cdr conds) " ")) + (beep 1))) + + (ediff-operate-on-flags 'insert) + (if recovered + (progn + (setq n-th-record (delq saved-rec n-th-record)) + (message "Diff region %d restored for buffer %S." (1+ n) buf-type))) + )) + +(defun ediff-restore-diff (arg) + "Restore ARG-th diff from ediff-killed-diffs-alist. +ARG is a prefix argument. If ARG is `nil', restore current-difference." + (interactive "P") + (if arg + (ediff-jump-to-difference arg)) + (ediff-pop-diff ediff-current-difference + (if (eq last-command-char ?a) 'A 'B)) + (ediff-recenter 'no-rehighlight)) + + +;;; Quitting, suspending, etc. +(defun ediff-quit () + "Finish an Ediff session and exit Ediff. +Unselects the selected difference, if any, restores the read-only and modified +flags of the compared file buffers, kills Ediff buffers for this session +\(but not file-A and file-B\)." + (interactive) + (if (prog1 + (y-or-n-p "Do you really want to exit Ediff? ") + (message "")) + (ediff-really-quit))) + +;; Perform the quit operations. +(defun ediff-really-quit () + (setq buffer-read-only nil) + (ediff-unselect-and-select-difference -1) + ;; null out the difference overlays so they won't slow down future editing + ;; operations + (mapcar (function (lambda (d) + (ediff-delete-overlay (aref d 0)) + (ediff-delete-overlay (aref d 1)))) + ediff-difference-vector) + ;; allow them to be garbage collected + (setq ediff-difference-vector nil) + (setq ediff-help-message ediff-help-message-long) + (ediff-restore-buffer-characteristics t) ;; restore as they were at setup + (ediff-unhighlight-diffs-totally) + + ;; restore buffer mode line id's in buffer-A/B + (let ((control-buffer ediff-control-buffer)) + (emerge-eval-in-buffer + ediff-A-buffer + (setq before-change-function nil) + (setq ediff-this-buffer-control-sessions + (delq control-buffer ediff-this-buffer-control-sessions)) + (if (null ediff-this-buffer-control-sessions) + (setq local-write-file-hooks + (delq 'ediff-block-write-file local-write-file-hooks))) + (kill-local-variable 'mode-line-buffer-identification)) + (emerge-eval-in-buffer + ediff-B-buffer + (setq ediff-this-buffer-control-sessions + (delq control-buffer ediff-this-buffer-control-sessions)) + (if (null ediff-this-buffer-control-sessions) + (setq local-write-file-hooks + (delq 'ediff-block-write-file local-write-file-hooks))) + (setq before-change-function nil) + (kill-local-variable 'mode-line-buffer-identification))) + + (run-hooks 'ediff-quit-hooks)) + +(defun ediff-kill-buffer-carefully (buf) + "Kill buffer BUF if it exists." + (if (ediff-buffer-live-p buf) + (kill-buffer (get-buffer buf)))) + +;; The default way of quitting Ediff. +;; Kills control buffers and leaves the +;; frame split between the two diff'ed files. +(defun ediff-default-quit-hook () + (let ((buff-A ediff-A-buffer) + (buff-B ediff-B-buffer)) + (ediff-kill-buffer-carefully ediff-diff-buffer) + (ediff-kill-buffer-carefully ediff-diff-error-buffer) + (ediff-kill-buffer-carefully ediff-control-buffer) + (ediff-kill-buffer-carefully ediff-patch-diagnostics) + (delete-other-windows) + (switch-to-buffer buff-B) + (split-window-vertically) + (switch-to-buffer buff-A))) + +;; The default way of suspending Ediff. +;; Buries Ediff buffers, kills all windows. +(defun ediff-default-suspend-hook () + (let ((buf-A ediff-A-buffer) + (buf-B ediff-B-buffer) + (buf-patch ediff-patch-buf) + (buf-patch-diag ediff-patch-diagnostics) + (buf-err ediff-diff-error-buffer) + (buf-diff ediff-diff-buffer)) + (bury-buffer) ;; ediff-control-buffer + (delete-other-windows) + (bury-buffer buf-err) + (bury-buffer buf-diff) + (bury-buffer buf-patch) + (bury-buffer buf-patch-diag) + (bury-buffer buf-A) + (bury-buffer buf-B))) + + +(defun ediff-suspend () + "Suspend Ediff. To resume, switch to the appropriate ``*ediff-control*'' +buffer and then hit ``\\[ediff-recenter]''. Ediff will automatically set +up an appropriate window config." + (interactive) + (run-hooks 'ediff-suspend-hooks) + (message + "To resume, switch to *ediff-control* and hit 'c' (ediff-recenter).")) + + +(defun ediff-file-names () + "Show the names of the buffers or files being operated on by Ediff. +Hit ``\\[ediff-recenter]'' to reset the windows afterward." + (interactive) + (with-output-to-temp-buffer "*Help*" + (emerge-eval-in-buffer ediff-A-buffer + (if buffer-file-name + (progn + (princ "File A is: ") + (princ buffer-file-name)) + (progn + (princ "Buffer A is: ") + (princ (buffer-name)))) + (princ "\n")) + (emerge-eval-in-buffer ediff-B-buffer + (if buffer-file-name + (progn + (princ "File B is: ") + (princ buffer-file-name)) + (progn + (princ "Buffer B is: ") + (princ (buffer-name)))) + (princ "\n")) + )) + + + +(defun ediff-line-numbers () + "Display the current line numbers. +This function displays the line numbers of the points in the A, B." + (interactive) + (let* ((A-line (emerge-eval-in-buffer ediff-A-buffer + (count-lines (point-min) (point)))) + (B-line (emerge-eval-in-buffer ediff-B-buffer + (count-lines (point-min) (point))))) + (message "At lines: A = %d, B = %d" A-line B-line))) + + +;;; Support routines + +;; Select a difference by placing the ASCII flags around the appropriate +;; group of lines in the A, B buffers +(defun ediff-select-difference (n) + (if (and (>= n 0) (< n ediff-number-of-differences)) + (progn + (ediff-remember-buffer-characteristics) + (if (and window-system ediff-want-faces) + (progn + (ediff-highlight-diff n) + (setq ediff-highlighting-style 'face)) + (setq ediff-highlighting-style 'ascii) + (ediff-place-flags-in-buffer 'A ediff-A-buffer + ediff-control-buffer n) + (ediff-place-flags-in-buffer 'B ediff-B-buffer + ediff-control-buffer n)) + + (ediff-restore-buffer-characteristics) + (run-hooks 'ediff-select-hooks)))) + + +;; Unselect a difference by removing the ASCII flags in the buffers. +(defun ediff-unselect-difference (n) + (if (and (>= n 0) (< n ediff-number-of-differences)) + (progn + (ediff-remember-buffer-characteristics) + + (cond ((and window-system ediff-want-faces) + (ediff-unhighlight-diff)) + ((eq ediff-highlighting-style 'ascii) + (ediff-remove-flags-from-buffer + ediff-A-buffer + (ediff-get-diff-posn 'A 'beg n) + (ediff-get-diff-posn 'A 'end n) + ediff-before-flag-A ediff-after-flag-A) + (ediff-remove-flags-from-buffer + ediff-B-buffer + (ediff-get-diff-posn 'B 'beg n) + (ediff-get-diff-posn 'B 'end n) + ediff-before-flag-B ediff-after-flag-B))) + + (ediff-restore-buffer-characteristics) + (setq ediff-highlighting-style nil) + (run-hooks 'ediff-unselect-hooks)))) + + +;; Unselects prev diff and selects a new one, if FLAG has value other than +;; 'select-only or 'unselect-only. If FLAG is 'select-only, the +;; next difference is selected, but the current selection is not +;; unselected. If FLAG is 'unselect-only then the current selection is +;; unselected, but the next one is not selected. If NO-RECENTER is non-nil, +;; don't recenter buffers after selecting/unselecting. +;; +;; Don't use ``ediff-select-difference'' and ``ediff-unselect-difference'' +;; directly,;; since this will screw up the undo info in the presence of +;; ASCII flags. +;; Instead, use ``ediff-unselect-and-select-difference'' with appropriate +;; flags. + +(defun ediff-unselect-and-select-difference (n &optional flag no-recenter) + (let ((wind (selected-window)) + ;; save buf modified info + (buf-A-modified (buffer-modified-p ediff-A-buffer)) + (buf-B-modified (buffer-modified-p ediff-B-buffer)) + ;; temporarily disable undo so highlighting won't confuse the user + buf-A-undo buf-B-undo) + + (emerge-eval-in-buffer + ediff-A-buffer + (setq buf-A-undo buffer-undo-list)) + (emerge-eval-in-buffer + ediff-B-buffer + (setq buf-B-undo buffer-undo-list)) + + (buffer-disable-undo ediff-A-buffer) + (buffer-disable-undo ediff-B-buffer) + + (unwind-protect ;; we don't want to lose undo info due to error + (progn + (or (eq flag 'select-only) + (ediff-unselect-difference ediff-current-difference)) + + ;; Auto-save buffers while Ediff flags are temporarily removed. + (emerge-eval-in-buffer + ediff-A-buffer + (if buf-A-modified + (do-auto-save))) + (emerge-eval-in-buffer + ediff-B-buffer + (if buf-B-modified + (do-auto-save))) + + (or (eq flag 'unselect-only) + (ediff-select-difference n)) + (setq ediff-current-difference n) + ) ;; end protected section + + (select-window wind) ;; must be before recenter! + (ediff-refresh-mode-line) + (or no-recenter + (ediff-recenter 'no-rehighlight)) + + ;; restore undo and buffer-modified info + (emerge-eval-in-buffer + ediff-A-buffer + (set-buffer-modified-p buf-A-modified) + (setq buffer-undo-list buf-A-undo)) + (emerge-eval-in-buffer + ediff-B-buffer + (set-buffer-modified-p buf-B-modified) + (setq buffer-undo-list buf-B-undo)) + ))) + +;; Revise the mode line to display which difference we have selected + +(defun ediff-refresh-mode-line () + (setq mode-line-buffer-identification + (list (format "Ediff: %%b diff %d of %d" + (1+ ediff-current-difference) + ediff-number-of-differences))) + ;; Force mode-line redisplay + (set-buffer-modified-p (buffer-modified-p))) + + + +;; Verify that we have a difference selected. +(defun ediff-validate-difference () + (if (not (and (>= ediff-current-difference 0) + (< ediff-current-difference ediff-number-of-differences))) + (error "No difference selected"))) + +;; The following is added to take care of Lemacs. + + +(defun ediff-read-file-name (prompt default-dir default-file A-file) +; This is a modified version of a similar function in ``emerge.el''. +; PROMPT should not have trailing ': ', so that it can be modified +; according to context. +; If both A-FILE and default-dir are set, the file constructed our of +; default-dir and the non-directory part of A-FILE is used as default and as +; initial input. +; If A-FILE is set (but default-dir is not), it is used as default and +; initial input. +; If default-file is set, it should be used as the default value. +; If default-dir is non-nil, use it as the default directory. +; Otherwise, use the value in Emacs's var default-directory. + (cond + ((and A-file default-dir) + (read-file-name (format "%s (default %s%s): " + prompt + (abbreviate-file-name + (expand-file-name default-dir)) + (file-name-nondirectory A-file)) + (expand-file-name default-dir) + (concat (expand-file-name default-dir) + (file-name-nondirectory A-file)) + 'confirm (file-name-nondirectory A-file))) + (A-file + (read-file-name (format "%s (default %s): " + prompt (file-name-nondirectory A-file)) + (expand-file-name (file-name-directory A-file)) + A-file + 'confirm (file-name-nondirectory A-file))) + ;; If there is a default file, but no A-file, use it. + (default-file + (read-file-name (format "%s (default %s): " prompt default-file) + default-dir ;; if nil then default-directory. + nil 'confirm)) + (t + (read-file-name (concat prompt ": ") + default-dir ;; if nil then default-directory. + nil 'confirm)))) + + +(defun ediff-make-temp-file (prefix) + (let ((f (make-temp-name (concat ediff-temp-file-prefix prefix)))) + ;; create the file + (write-region (point-min) (point-min) f nil 'no-message) + (set-file-modes f ediff-temp-file-mode) + f)) + +(defun ediff-block-write-file () + "Prevent writing files A and B directly." + (if (ediff-check-for-ascii-flags) + (error "Use 'wa' and 'wb' to save buffs A/B (first switch back to *ediff-control*."))) + +(defun ediff-check-for-ascii-flags () + (eval + (cons 'or + (mapcar (function (lambda (buf) + (emerge-eval-in-buffer + buf + (eq ediff-highlighting-style 'ascii)))) + ediff-this-buffer-control-sessions)))) + +(defun ediff-insert-in-front (overl beg end) + "Capture overlays that had insertions in the front. +Called when overlay OVERL gets insertion in front." + (if (ediff-overlay-get overl 'ediff-diff-num) + (setq ediff-disturbed-overlays + (cons overl ediff-disturbed-overlays))) + ) + +(defun ediff-collect-extents-lucid (pos) + "Collects all extents at POS having property `ediff-diff-num'. +Lucid Emacs causes headache by detaching empty extents, so I have to save +them before they disappear." + (let (lis elt) + (while (setq elt (extent-at pos nil 'ediff-diff-num elt)) + (setq lis (cons elt lis))) + (setq ediff-disturbed-overlays lis))) + +(defun ediff-move-disturbed-overlays (posn) + (mapcar (function (lambda (overl) + (ediff-move-overlay overl + posn + (ediff-overlay-end overl)) + )) + ediff-disturbed-overlays) + (setq ediff-disturbed-overlays nil)) + +(defun ediff-adjust-disturbed-extents-lucid (posn &optional posn-type) +;; POSN-TYPE tells if POSN should become a new start of the extents +;; (if 'new-start) or a new end (if 'new-end). If POSN-TYPE is nil, then +;; POSN is both the new start and the new end. + (mapcar (function (lambda (overl) + (cond ((and (null posn-type) + (equal (ediff-overlay-start overl) + (ediff-overlay-end overl))) + (ediff-move-overlay overl posn posn)) + + (posn-type + (ediff-move-overlay + overl + (if (eq posn-type 'new-start) + posn + (ediff-overlay-start overl)) + (if (eq posn-type 'new-end) + posn + (ediff-overlay-end overl))))))) + ediff-disturbed-overlays) + (setq ediff-disturbed-overlays nil)) + +(defun ediff-save-buffer () + "Safe way of saving buffers A and B." + (interactive) + (let ((hooks local-write-file-hooks)) + (ediff-unselect-and-select-difference ediff-current-difference + 'unselect-only) + (unwind-protect + (emerge-eval-in-buffer + (if (eq last-command-char ?a) ediff-A-buffer ediff-B-buffer) + ;; temporarily remove writing block + (setq hooks (delq 'ediff-block-write-file hooks)) + (let ((local-write-file-hooks hooks)) + (save-buffer))) + (ediff-unselect-and-select-difference ediff-current-difference + 'select-only) + ))) + + + +(defun ediff-remove-flags-from-buffer (buffer before-posn after-posn + before-flag after-flag) + "Essentially ``emerge-remove-flags-in-buffer'', modified to allow deletion +of read-only flags." + (emerge-eval-in-buffer + buffer + (let ((buffer-read-only nil) + (before-change-function nil) + (inhibit-read-only t) + (before-flag-length (length before-flag)) + (after-flag-length (length after-flag)) + ) + (goto-char after-posn) + (setq after-posn (point-marker)) ;; after-posn is now a marker + ;; remove the flags, if they're there + (goto-char (- before-posn before-flag-length)) + (if (ediff-if-lucid) + (ediff-collect-extents-lucid (+ (point) before-flag-length))) + (if (looking-at (regexp-quote before-flag)) + (delete-region (point) (+ (point) before-flag-length)) + ;; the flag isn't there + (ding) + (message "Trouble removing ASCII flag")) + (if (ediff-if-lucid) + (ediff-adjust-disturbed-extents-lucid (point))) + + (if (ediff-if-lucid) + (ediff-collect-extents-lucid (point))) + (goto-char after-posn) + (if (looking-at (regexp-quote after-flag)) + (delete-region (point) (+ (point) after-flag-length)) + ;; the flag isn't there + (ding) + (message "Trouble removing ASCII flag")) + (if (ediff-if-lucid) + (ediff-adjust-disturbed-extents-lucid (point))) + (setq after-posn nil) ;; after has become a marker--garbage-collect + ))) + + +(defun ediff-place-flags-in-buffer (buf-type buffer ctl-buffer difference) + "This is a modified ``emerge-place-flags-in-buffer''." + (emerge-eval-in-buffer + buffer + (ediff-place-flags-in-buffer1 buf-type ctl-buffer difference))) + +(defun ediff-place-flags-in-buffer1 (buf-type ctl-buffer difference) + "Modified ``emerge-place-flags-in-buffer1''." + (let ((buffer-read-only nil) + (inhibit-read-only t) + (before-change-function nil) + (before-flag-name (if (eq buf-type 'A) + 'ediff-before-flag-A + 'ediff-before-flag-B)) + (after-flag-name (if (eq buf-type 'A) + 'ediff-after-flag-A + 'ediff-after-flag-B)) + beg-of-line flag) + + ;; insert the flag before the difference + (let ((before (ediff-get-diff-posn buf-type 'beg difference ctl-buffer))) + (goto-char before) + (setq beg-of-line (bolp)) + + (setq flag (emerge-eval-in-buffer + ctl-buffer + (if beg-of-line + (set before-flag-name ediff-before-flag-bol) + (set before-flag-name ediff-before-flag-mol)))) + + ;; insert the flag itself + (if (ediff-if-lucid) + (ediff-collect-extents-lucid (point))) + (insert-before-markers flag) + (if (ediff-if-lucid) + ;; Lucid's extent end-points behave strangely; they won't + ;; respect insert-before-markers + (ediff-adjust-disturbed-extents-lucid (point) 'new-start)) + ) + ;; insert the flag after the difference + (let* ((after (ediff-get-diff-posn buf-type 'end difference ctl-buffer))) + (goto-char after) + (setq beg-of-line (bolp)) + + (setq flag (emerge-eval-in-buffer + ctl-buffer + (if beg-of-line + (set after-flag-name ediff-after-flag-bol) + (set after-flag-name ediff-after-flag-mol)))) + + ;; insert the flag itself + (if (ediff-if-lucid) + (ediff-collect-extents-lucid (point))) + (insert flag) + (if (ediff-if-lucid) + (ediff-adjust-disturbed-extents-lucid after 'new-end)) + ))) + + +(defun ediff-get-diff-posn (buf-type pos &optional n control-buf) + "Returns positions of difference sectors in the buffer denoted BUF-TYPE +\('A or 'B\). +POS is either 'beg or 'end. Specifies whether you want the position at the +beginning of a difference of at the end. Optional N says which difference +\(default: ``ediff-current-difference''\). Optional CONTROL-BUF says which +control buffer is in effect in case it is not the current buffer." + + (let (diff-overlay) + (or control-buf + (setq control-buf (current-buffer))) + + (emerge-eval-in-buffer + control-buf + (or n (setq n ediff-current-difference)) + (if (or (< n 0) (>= n ediff-number-of-differences)) + (error "There is no diff %d in this session. Valid diffs are 1 to %d." + (1+ n) ediff-number-of-differences)) + (setq diff-overlay (aref (aref ediff-difference-vector n) + (if (eq buf-type 'A) 0 1)))) + + (if (ediff-overlay-get diff-overlay 'detached) + (ediff-move-overlay diff-overlay + (ediff-overlay-get diff-overlay 'ediff-marker) + (ediff-overlay-get diff-overlay 'ediff-marker))) + (if (eq pos 'beg) + (ediff-overlay-start diff-overlay) + (ediff-overlay-end diff-overlay)) + )) + + + +;; These would highlight differences under X +(defun ediff-highlight-diff (n) + "Put face on diff N. Invoked for X displays only." + (let* ((last-A (emerge-eval-in-buffer ediff-A-buffer (point-max))) + (last-B (emerge-eval-in-buffer ediff-B-buffer (point-max))) + (begin-A (ediff-get-diff-posn 'A 'beg n)) + (end-A (ediff-get-diff-posn 'A 'end n)) + (xtraA (if (equal begin-A end-A) 1 0)) + (end-A-hilit (min last-A (+ end-A xtraA))) + + (begin-B (ediff-get-diff-posn 'B 'beg n)) + (end-B (ediff-get-diff-posn 'B 'end n)) + (xtraB (if (equal begin-B end-B) 1 0)) + (end-B-hilit (min last-B (+ end-B xtraB)))) + + (if (ediff-if-lucid) + (progn + (ediff-move-overlay + ediff-current-diff-overlay-A begin-A end-A-hilit) + (ediff-move-overlay + ediff-current-diff-overlay-B begin-B end-B-hilit)) + ;; GNU stuff has a bug, which requires that ediff-move-overlay will + ;; have the buffer as a parameter. Will be fixed in 19.23 + (ediff-move-overlay ediff-current-diff-overlay-A + begin-A end-A-hilit ediff-A-buffer) + (ediff-move-overlay ediff-current-diff-overlay-B + begin-B end-B-hilit ediff-B-buffer)) + ;; giving priority of 0 and then changing it may look funny, but + ;; this is intended to overcome an Emacs bug. + (ediff-overlay-put ediff-current-diff-overlay-A 'priority 0) + (ediff-overlay-put ediff-current-diff-overlay-B 'priority 0) + (ediff-overlay-put ediff-current-diff-overlay-A 'priority + (ediff-highest-priority begin-A end-A-hilit ediff-A-buffer)) + (ediff-overlay-put ediff-current-diff-overlay-B 'priority + (ediff-highest-priority begin-B end-B-hilit ediff-B-buffer)) + + (if (and (not (face-differs-from-default-p 'ediff-odd-diff-face-A-var)) + (null ediff-highlight-selected-only)) + (progn + (copy-face ediff-odd-diff-face-A 'ediff-odd-diff-face-A-var) + (copy-face ediff-odd-diff-face-B 'ediff-odd-diff-face-B-var) + (copy-face ediff-even-diff-face-A 'ediff-even-diff-face-A-var) + (copy-face ediff-even-diff-face-B 'ediff-even-diff-face-B-var))) + + ;; unhighlight the background overlay for the diff n so they won't + ;; interfere with the current diff overlay + (ediff-overlay-put (aref (aref ediff-difference-vector n) 0) 'face nil) + (ediff-overlay-put (aref (aref ediff-difference-vector n) 1) 'face nil) + + (sit-for 0) ;; needs to synch for some reason + )) + + +(defun ediff-unhighlight-diff () + "Remove overlays from buffers A and B." + + (ediff-move-overlay ediff-current-diff-overlay-A 1 1) + (ediff-move-overlay ediff-current-diff-overlay-B 1 1) + + ;; rehighlight the overlay in the background of the + ;; current difference region + (ediff-overlay-put (aref (aref ediff-difference-vector + ediff-current-difference) + 0) + 'face (if (ediff-odd-p ediff-current-difference) + 'ediff-odd-diff-face-A-var + 'ediff-even-diff-face-A-var)) + (ediff-overlay-put (aref (aref ediff-difference-vector + ediff-current-difference) + 1) + 'face (if (ediff-odd-p ediff-current-difference) + 'ediff-odd-diff-face-B-var + 'ediff-even-diff-face-B-var)) + ) + + +(defun ediff-unhighlight-diffs-totally () + (if (and window-system ediff-want-faces) + (let ((inhibit-quit t)) + (if (face-differs-from-default-p 'ediff-odd-diff-face-A-var) + (progn + (copy-face 'default 'ediff-odd-diff-face-A-var) + (copy-face 'default 'ediff-odd-diff-face-B-var) + (copy-face 'default 'ediff-even-diff-face-A-var) + (copy-face 'default 'ediff-even-diff-face-B-var))) + (if (ediff-overlayp ediff-current-diff-overlay-A) + (ediff-delete-overlay ediff-current-diff-overlay-A)) + (setq ediff-current-diff-overlay-A nil) + (if (ediff-overlayp ediff-current-diff-overlay-B) + (ediff-delete-overlay ediff-current-diff-overlay-B)) + (setq ediff-current-diff-overlay-B nil)))) + + +(defun ediff-operate-on-flags (action) + "Re/unhighlights buffers A and B with all flags from all active Ediff +sessions that involve these buffers. This is usually needed only when a +buffer is involved in multiple Ediff sessions." + (let* ((A-sessions (emerge-eval-in-buffer + ediff-A-buffer + ediff-this-buffer-control-sessions)) + (B-sessions (emerge-eval-in-buffer + ediff-B-buffer + ediff-this-buffer-control-sessions)) + (sessions (ediff-union A-sessions B-sessions)) + (flag (if (eq action 'remove) 'unselect-only 'select-only))) + + (mapcar (function (lambda (buf) + (emerge-eval-in-buffer + buf + (or (if (eq action 'insert) + (memq ediff-highlighting-style '(ascii off)) + (not (eq ediff-highlighting-style 'ascii))) + (ediff-unselect-and-select-difference + ediff-current-difference + flag 'no-recenter)) + ))) + sessions))) + +(defun ediff-union (list1 list2) + "Combine LIST1 and LIST2 using a set-union operation. +The result list contains all items that appear in either LIST1 or LIST2. +This is a non-destructive function; it makes a copy of the data if necessary +to avoid corrupting the original LIST1 and LIST2. +This is a slightly simplified version from ``cl-seq.el''. Added here to +avoid loading cl-*." + (cond ((null list1) list2) ((null list2) list1) + ((equal list1 list2) list1) + (t + (or (>= (length list1) (length list2)) + (setq list1 (prog1 list2 (setq list2 list1)))) + (while list2 + (or (memq (car list2) list1) + (setq list1 (cons (car list2) list1))) + (setq list2 (cdr list2))) + list1))) + +(defun ediff-debug () + (interactive) + (with-output-to-temp-buffer "*ediff-debug*" + (princ + (format "Ctl buffer: %S\n\nediff-difference-vector:\n" + ediff-control-buffer)) + (mapcar (function + (lambda (overl-vec) + (princ (format "Diff %d: %S %S %S\n\t %S %S %S\n" + (1+ (ediff-overlay-get (aref overl-vec 0) + 'ediff-diff-num)) + (ediff-overlay-get (aref overl-vec 0) + 'ediff-control-buffer) + (ediff-overlay-get (aref overl-vec 0) + 'insert-in-front-hooks) + (aref overl-vec 0) + (ediff-overlay-get (aref overl-vec 1) + 'ediff-control-buffer) + (ediff-overlay-get (aref overl-vec 0) + 'insert-in-front-hooks) + (aref overl-vec 1) + )))) + ediff-difference-vector) + (princ "\nediff-disturbed-overlays:\n") + (mapcar (function + (lambda (overl) + (princ (format "%S %S\n" + (ediff-overlay-get overl 'ediff-control-buffer) + overl + )))) + ediff-disturbed-overlays))) + + +(run-hooks 'ediff-load-hooks) + + +(provide 'ediff) + +;;; ediff.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/ielm.el Mon May 02 05:16:59 1994 +0000 @@ -0,0 +1,366 @@ +;;; ielm.el --- interaction mode for Emacs Lisp +;; Copyright (C) 1994 Free Software Foundation, Inc. + +;; Author: David Smith <maa036@lancaster.ac.uk> +;; Created: 25 Feb 1994 +;; Keywords: lisp + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; Provides a nice interface to evaluating Emacs-Lisp expressions. +;; Input is handled by the comint package, and output is passed +;; through the pretty-printer. + +;; To install: copy this file to a directory in your load-path, and +;; add the line +;; +;; (autoload 'ielm "ielm" "Start an inferior emacs-lisp session" t) +;; +;; For completion to work, the comint.el from FSF Emacs 19.23 is +;; required. If you do not have it, or if you are running Lemacs, +;; also add the following code to your .emacs: +;; +;; (setq ielm-mode-hook +;; '(lambda nil +;; (define-key ielm-map "\t" +;; '(lambda nil (interactive) (or (ielm-tab) +;; (lisp-complete-symbol)))))) + +;; To start: M-x ielm. Type C-h m in the *ielm* buffer for more info. + +;; The latest version is available by WWW from +;; http://mathssun5.lancs.ac.uk:2080/~maa036/elisp/dir.html +;; or by anonymous FTP from +;; /anonymous@wingra.stat.wisc.edu:pub/src/emacs-lisp/ielm.el.gz +;; or from the author: David M. Smith <maa036@lancaster.ac.uk> + +;;; Code: + +(require 'comint) +(require 'pp) + +;;; User variables + +(defvar ielm-noisy t + "*If non-nil, beep on error") + +(defvar ielm-prompt "ELISP> ") + +(defvar ielm-dynamic-return t + "*If non-nil, RET either evaluates input or inserts a newline, +depending on context") + +(defvar ielm-mode-hook nil + "*Hooks to be run when the inferior-emacs-lisp-mode is started") + +;;; System variables + +(defvar ielm-working-buffer nil + "Buffer, if any, to use in ielm. Usually buffer-local") + +(defvar ielm-header + (concat + "*** Welcome to IELM mode version " + (substring "$Revision: 1.15 $" 11 -2) + " *** Type (describe-mode) for help.\n" + "IELM has ABSOLUTELY NO WARRANTY; type (describe-no-warranty) for details\n")) + +(defvar ielm-map nil) +(if ielm-map nil + (if (string-match "Lucid" emacs-version) + ;; Lemacs + (progn + (setq ielm-map (make-sparse-keymap)) + (set-keymap-parent ielm-map comint-mode-map)) + ;; FSF + (setq ielm-map (cons 'keymap comint-mode-map))) + (define-key ielm-map "\t" 'comint-dynamic-complete) + (define-key ielm-map "\C-m" 'ielm-return) + (define-key ielm-map "\C-j" 'ielm-send-input)) + +;;; Completion stuff + +(defun ielm-tab nil + "Possibly indent the current line as lisp code" + (interactive) + (if (or (eq (preceding-char) ?\n) + (eq (char-syntax (preceding-char)) ? )) + (progn + (ielm-indent-line) + t))) + +(defun ielm-complete-symbol nil + "Just like lisp-complete-symbol" + ;; except that it returns non-nil if completion has occurred + (let* ((btick (buffer-modified-tick)) + (cbuffer (get-buffer " *Completions*")) + (ctick (and cbuffer (buffer-modified-tick cbuffer)))) + (lisp-complete-symbol) + ;; completion has occurred if: + (or + ;; the buffer has been modified + (not (= btick (buffer-modified-tick))) + ;; a completions buffer has been modifed or created + (if cbuffer + (not (= ctick (buffer-modified-tick cbuffer))) + (get-buffer " *Completions*"))))) + +(defun ielm-complete-filename nil + ;; Completes filenames if in a string + (if (nth 3 (parse-partial-sexp comint-last-input-start (point))) + (comint-dynamic-complete-filename))) + +(defun ielm-indent-line nil + "Indent the current line as lisp code if it is not a prompt line" + (if (save-excursion + (beginning-of-line) + (looking-at comint-prompt-regexp)) nil + (lisp-indent-line))) + +;;; Other bindings + +(defun ielm-return nil + "Evaluate the sexp at the prompt if it is complete, otherwise newline +and indent. If ielm-dynamic-return is nil, just insert a newline." + (interactive) + (if ielm-dynamic-return + (let ((state + (save-excursion + (end-of-line) + (parse-partial-sexp (ielm-pm) + (point))))) + (if (and (< (car state) 1) (not (nth 3 state))) + (ielm-send-input) + (newline-and-indent))) + (newline))) + +(defun ielm-input-sender (proc input) + (setq ielm-input input)) + +(defun ielm-send-input nil + "Evaluate the Emacs Lisp expression after the prompt" + (interactive) + (let ((buf (current-buffer)) + ielm-input) ; set by ielm-input-sender + (comint-send-input) ; update history, markers etc. + (ielm-eval-input ielm-input))) + +;;; Utility functions + +(defun ielm-is-whitespace (string) + "Return non-nil if STRING is all whitespace" + (or (string= string "") (string-match "\\`[ \t\n]+\\'" string))) + +(defun ielm-format-errors (errlist) + (let ((result "")) + (while errlist + (setq result (concat result (prin1-to-string (car errlist)) ", ")) + (setq errlist (cdr errlist))) + (substring result 0 -2))) + + +(defun ielm-format-error (err) + "Return a string form of the error ERR" + (format "%s%s" + (or (get (car err) 'error-message) "Peculiar error") + (if (cdr err) + (format ": %s" (ielm-format-errors (cdr err))) + ""))) + +;;; Evaluation + +(defun ielm-eval-input (string) + "Evaluate the lisp expression STRING, and pretty-print the result" + ;; This is the function that actually `sends' the input to the + ;; `inferior lisp process'. All comint-send-input does is works out + ;; what that input is. What this function does is evaluates that + ;; input and produces `output' which gets inserted into the buffer, + ;; along with a new prompt. A better way of doing this might have + ;; been to actually send the output to the `cat' process, and write + ;; this as in output filter that converted sexps in the output + ;; stream to their evaluated value. But that would have involved + ;; more process coordination than I was happy to deal with. + (let (form ; form to evaluate + pos ; End posn of parse in string + result ; Result, or error message + error-type ; string, nil if no error + (output "") ; result to display + (wbuf ielm-working-buffer) ; current buffer after evaluation + (pmark (ielm-pm))) + (if (not (ielm-is-whitespace string)) + (progn + (condition-case err + (let (rout) + (setq rout (read-from-string string)) + (setq form (car rout)) + (setq pos (cdr rout))) + (error (setq result (ielm-format-error err)) + (setq error-type "Read error"))) + (if error-type nil + (if (ielm-is-whitespace (substring string pos)) + ;; need this awful let convolution to work around + ;; an Emacs bug involving local vbls and let binding + (let ((:save :) + (::save ::) + (:::save :::)) + (save-excursion + (set-buffer ielm-working-buffer) + (condition-case err + (let ((: :save) + (:: ::save) + (::: :::save)) + (save-excursion + (setq result (eval form)) + (setq wbuf (current-buffer)))) + (error (setq result (ielm-format-error err)) + (setq error-type "Eval error")) + (quit (setq result "Quit during evaluation") + (setq error-type "Eval error"))))) + (setq error-type "IELM error") + (setq result "More than one sexp in input"))) + + ;; If the eval changed the current buffer, mention it here + (if (eq wbuf ielm-working-buffer) nil + (message "current buffer is now: %s" wbuf) + (setq ielm-working-buffer wbuf)) + + (goto-char pmark) + (if (not error-type) + (condition-case err + ;; Self-referential objects cause loops in the printer, so + ;; trap quits here. May as well do errors, too + (setq output (concat output (pp-to-string result))) + (error (setq error-type "IELM Error") + (setq result "Error during pretty-printing (bug in pp)")) + (quit (setq error-type "IELM Error") + (setq result "Quit during pretty-printing")))) + (if error-type + (progn + (if ielm-noisy (ding)) + (setq output (concat output "*** " error-type " *** ")) + (setq output (concat output result))) + ;; There was no error, so shift the ::: values + (setq ::: ::) + (setq :: :) + (setq : result)) + (setq output (concat output "\n")))) + (setq output (concat output ielm-prompt)) + (comint-output-filter (ielm-process) output))) + +;;; Process and marker utilities + +(defun ielm-process nil + "Return the current buffer's process" + (get-buffer-process (current-buffer))) + +(defun ielm-pm nil + "Return the process mark of the current buffer" + (process-mark (get-buffer-process (current-buffer)))) + +(defun ielm-set-pm (pos) + "Set the process mark in the current buffer to POS" + (set-marker (process-mark (get-buffer-process (current-buffer))) pos)) + +;;; Major mode + +(defun inferior-emacs-lisp-mode nil + "Major mode for interactively evaluating Emacs-Lisp expressions +Uses the interface provided by `comint-mode' (q.v.) + +\\[ielm-send-input] evaluates the sexp following the prompt. There must be at most +one top-level sexp per prompt. +\\[ielm-return] inserts a newline and indents. However, if the variable +ielm-dynamic-return is non-nil (the default) then it will also evaluate +a complete expression. +\\[comint-dynamic-complete] completes lisp symbols (or filenames, within strings), +or indents the line if there is nothing to complete. + +During evaluations, the values of the variables `:', `::', and `:::' +are the results of the previous, second previous and third previous +evaluations respectively. + +The current buffer may be changed, and its value is preserved between +successive evaluations. In this way, expressions may be evaluated in +a different buffer than the *ielm* buffer. + +Expressions evaluated by IELM are not subject to debug-on-quit or +debug-on-error. + +The behaviour of IELM may be customised with the following variables: +* To stop beeping on error, set `ielm-noisy' to nil +* If you don't like the prompt, you can change it by setting `ielm-prompt'. +* Set `ielm-dynamic-return' to nil for bindings like `lisp-interaction-mode' +* Entry to this mode runs `comint-mode-hook' and `ielm-mode-hook' + (in that order). + +Customised bindings may be defined in `ielm-map', which currently contains: +\\{ielm-map}" + (interactive) + (comint-mode) + (setq comint-prompt-regexp (concat "^" (regexp-quote ielm-prompt))) + (make-local-variable 'paragraph-start) + (setq paragraph-start comint-prompt-regexp) + (setq comint-input-sender 'ielm-input-sender) + (setq comint-process-echoes nil) + (setq comint-dynamic-complete-functions + '(ielm-tab comint-replace-by-expanded-history ielm-complete-filename ielm-complete-symbol)) + + (setq major-mode 'inferior-emacs-lisp-mode) + (setq mode-name "IELM") + (use-local-map ielm-map) + (set-syntax-table emacs-lisp-mode-syntax-table) + + (make-local-variable 'indent-line-function) + (make-local-variable 'ielm-working-buffer) + (setq ielm-working-buffer (current-buffer)) + (setq indent-line-function 'ielm-indent-line) + + ;;; Value holders + (setq : nil) + (make-local-variable ':) + (setq :: nil) + (make-local-variable '::) + (setq ::: nil) + (make-local-variable ':::) + + ;; A dummy process to keep comint happy. It will never get any input + (if (comint-check-proc (current-buffer)) nil + (start-process "ielm" (current-buffer) "cat") + (process-kill-without-query (ielm-process)) + (goto-char (point-max)) + ;; Add a silly header + (insert ielm-header) + (ielm-set-pm (point-max)) + (comint-output-filter (ielm-process) ielm-prompt) + (set-marker comint-last-input-start (ielm-pm)) + (set-process-filter (get-buffer-process (current-buffer)) 'comint-output-filter)) + (run-hooks 'ielm-mode-hook)) + +;;; User command + +(defun ielm nil + "Switch to or create the buffer *ielm* for evaluating emacs-lisp expressions" + (interactive) + (if (comint-check-proc "*ielm*") nil + (progn + (set-buffer (get-buffer-create "*ielm*")) + (inferior-emacs-lisp-mode))) + (switch-to-buffer "*ielm*")) + +;; ielm.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mail/mail-hist.el Mon May 02 05:16:59 1994 +0000 @@ -0,0 +1,282 @@ +;;; mail-hist.el --- Headers and message body history for outgoing mail. +;; Copyright (C) 1994 Free Software Foundation, Inc. + +;; Author: Karl Fogel <kfogel@cs.oberlin.edu> +;; Created: March, 1994 +;; Version: 1.2.2 +;; Keywords: mail + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;;; Commentary: + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of +;; time. +;; +;; To use this package, put it in a directory in your load-path, and +;; put this in your .emacs file: +;; +;; (load "mail-hist" nil t) +;; +;; Or you could do it with autoloads and hooks in your .emacs: +;; +;; (add-hook 'mail-mode-hook 'mail-hist-define-keys) +;; (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history) +;; (add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) ;or rmail, etc +;; (autoload 'mail-hist-define-keys "mail-hist") +;; (autoload 'mail-hist-put-headers-into-history "mail-hist") +;; +;; Once it's installed, use M-p and M-n from mail headers to recover +;; previous/next contents in the history for that header, or, in the +;; body of the message, to recover previous/next text of the message. +;; This only applies to outgoing mail -- mail-hist ignores received +;; messages. +;; +;; Although repeated history requests do clear out the text from the +;; previous request, an isolated request just inserts its text at +;; point, so that you can mix the histories of different messages +;; easily. This might be confusing at times, but there should be no +;; problems that undo can't handle. + +;;; Code: +(require 'ring) + +;;;###autoload +(defun mail-hist-define-keys () + "Define keys for accessing mail header history. For use in hooks." + (local-set-key "\M-p" 'mail-hist-previous-input) + (local-set-key "\M-n" 'mail-hist-next-input)) + +;;;###autoload +(add-hook 'mail-mode-hook 'mail-hist-define-keys) + +;;;###autoload +(add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) + +;;;###autoload +(add-hook 'mail-send-hook 'mail-hist-put-headers-into-history) + +(defvar mail-hist-header-ring-alist nil + "Alist of form (header-name . history-ring). +Used for knowing which history list to look in when the user asks for +previous/next input.") + +(defvar mail-hist-history-size (or kill-ring-max 1729) + "*The maximum number of elements in a mail field's history. +Oldest elements are dumped first.") + +;;;###autoload +(defvar mail-hist-keep-history t + "*Non-nil means keep a history for headers and text of outgoing mail.") + +;; For handling repeated history requests +(defvar mail-hist-access-count 0) + +(defvar mail-hist-last-bounds nil) +;; (start . end) A pair indicating the buffer positions delimiting the +;; last inserted history, so it can be replaced by a new input if the +;; command is repeated. + +(defvar mail-hist-header-regexp "^[^:]*:" + "Regular expression for matching headers in a mail message.") + +(defsubst mail-hist-current-header-name () + "Get name of mail header point is currently in, without the colon. +Returns nil if not in a header, implying that point is in the body of +the message." + (if (save-excursion + (re-search-backward (concat "^" mail-header-separator) nil t)) + nil ; then we are in the body of the message + (save-excursion + (let* ((body-start ; limit possibility of false headers + (save-excursion + (re-search-forward (concat "^" mail-header-separator) nil t))) + (name-start + (re-search-backward mail-hist-header-regexp nil t)) + (name-end + (prog2 (search-forward ":" body-start t) (1- (point))))) + (and + name-start + name-end + (buffer-substring name-start name-end)))))) + +(defsubst mail-hist-forward-header (count) + "Move forward COUNT headers (backward if COUNT is negative). +If last/first header is encountered first, stop there and returns +nil. + +Places point on the first non-whitespace on the line following the +colon after the header name, or on the second space following that if +the header is empty." + (let ((boundary (save-excursion + (re-search-forward (concat "^" mail-header-separator) nil t)))) + (and + boundary + (let ((unstopped t)) + (setq boundary (save-excursion + (goto-char boundary) + (beginning-of-line) + (1- (point)))) + (if (> count 0) + (while (> count 0) + (setq + unstopped + (re-search-forward mail-hist-header-regexp boundary t)) + (setq count (1- count))) + ;; because the current header will match too. + (setq count (1- count)) + ;; count is negative + (while (< count 0) + (setq + unstopped + (re-search-backward mail-hist-header-regexp nil t)) + (setq count (1+ count))) + ;; we end up behind the header, so must move to the front + (re-search-forward mail-hist-header-regexp boundary t)) + ;; Now we are right after the colon + (and (looking-at "\\s-") (forward-char 1)) + ;; return nil if didn't go as far as asked, otherwise point + unstopped)))) + +(defsubst mail-hist-beginning-of-header () + "Move to the start of the current header. +The start of the current header is defined as one space after the +colon, or just after the colon if it is not followed by whitespace." + ;; this is slick as all heck: + (if (mail-hist-forward-header -1) + (mail-hist-forward-header 1) + (mail-hist-forward-header 1) + (mail-hist-forward-header -1))) + +(defsubst mail-hist-current-header-contents () + "Get the contents of the mail header in which point is located." + (save-excursion + (mail-hist-beginning-of-header) + (let ((start (point))) + (or (mail-hist-forward-header 1) + (re-search-forward (concat "^" mail-header-separator))) + (beginning-of-line) + (buffer-substring start (1- (point)))))) + +(defsubst mail-hist-get-header-ring (header) + "Get HEADER's history ring, or nil if none. +HEADER is a string without the colon." + (cdr (assoc header mail-hist-header-ring-alist))) + +(defsubst mail-hist-add-header-contents-to-ring (header &optional contents) + "Add the contents of HEADER to the header history ring. +Optional argument CONTENTS is a string which will be the contents +(instead of whatever's found in the header)." + (let ((ring (cdr (assoc header mail-hist-header-ring-alist)))) + (or ring + ;; If the ring doesn't exist, we'll have to make it and add it + ;; to the mail-header-ring-alist: + (prog1 + (setq ring (make-ring mail-hist-history-size)) + (setq mail-hist-header-ring-alist + (cons (cons header ring) mail-hist-header-ring-alist)))) + (ring-insert + ring + (or contents (mail-hist-current-header-contents))))) + +;;;###autoload +(defun mail-hist-put-headers-into-history () + "Put headers and contents of this message into mail header history. +Each header has its own independent history, as does the body of the +message. + +This function normally would be called when the message is sent." + (and + mail-hist-keep-history + (progn + (goto-char (point-min)) + (while (mail-hist-forward-header 1) + (mail-hist-add-header-contents-to-ring + (mail-hist-current-header-name))) + (let ((body-contents + (save-excursion + (goto-char (point-min)) + (re-search-forward (concat "^" mail-header-separator) nil) + (forward-line 1) + (buffer-substring (point) (point-max))))) + (mail-hist-add-header-contents-to-ring "body" body-contents))))) + +(defun mail-hist-previous-input (header) + "Insert the previous contents of this mail header or message body. +Moves back through the history of sent mail messages. Each header has +its own independent history, as does the body of the message. + +The history only contains the contents of outgoing messages, not +received mail." + (interactive (list (or (mail-hist-current-header-name) "body"))) + (let* ((ring (cdr (assoc header mail-hist-header-ring-alist))) + (len (ring-length ring)) + (repeat (eq last-command 'mail-hist-input-access))) + (if repeat + (setq mail-hist-access-count + (ring-plus1 mail-hist-access-count len)) + (setq mail-hist-access-count 0)) + (if (null ring) + (progn + (ding) + (message "No history for \"%s\"." header)) + (if (ring-empty-p ring) + (error "\"%s\" ring is empty." header) + (and repeat + (delete-region (car mail-hist-last-bounds) + (cdr mail-hist-last-bounds))) + (let ((start (point))) + (insert (ring-ref ring mail-hist-access-count)) + (setq mail-hist-last-bounds (cons start (point))) + (setq this-command 'mail-hist-input-access)))))) + +(defun mail-hist-next-input (header) + "Insert next contents of this mail header or message body. +Moves back through the history of sent mail messages. Each header has +its own independent history, as does the body of the message. + +Although you can do so, it does not make much sense to call this +without having called `mail-hist-previous-header' first +(\\[mail-hist-previous-header]). + +The history only contains the contents of outgoing messages, not +received mail." + (interactive (list (or (mail-hist-current-header-name) "body"))) + (let* ((ring (cdr (assoc header mail-hist-header-ring-alist))) + (len (ring-length ring)) + (repeat (eq last-command 'mail-hist-input-access))) + (if repeat + (setq mail-hist-access-count + (ring-minus1 mail-hist-access-count len)) + (setq mail-hist-access-count 0)) + (if (null ring) + (progn + (ding) + (message "No history for \"%s\"." header)) + (if (ring-empty-p ring) + (error "\"%s\" ring is empty." header) + (and repeat + (delete-region (car mail-hist-last-bounds) + (cdr mail-hist-last-bounds))) + (let ((start (point))) + (insert (ring-ref ring mail-hist-access-count)) + (setq mail-hist-last-bounds (cons start (point))) + (setq this-command 'mail-hist-input-access)))))) + +(provide 'mail-hist) + +;; mail-hist.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mldrag.el Mon May 02 05:16:59 1994 +0000 @@ -0,0 +1,226 @@ +;;; mldrag.el -- Mode line and vertical line dragging to resize windows. +;;; Copyright (C) 1994 Free Software Foundation, Inc. + +;; Author: Kyle E. Jones <kyle@wonderworks.com> +;; Keywords: mouse + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; This package lets you drag the modeline, vertical bar and +;; scrollbar to resize windows. Suggested bindings are: +;; +;; (global-set-key [mode-line down-mouse-1] 'mldrag-drag-mode-line) +;; (global-set-key [vertical-line down-mouse-1] 'mldrag-drag-vertical-line) +;; (global-set-key [vertical-scroll-bar S-down-mouse-1] +;; 'mldrag-drag-vertical-line) +;; +;; Put the bindings and (require 'mldrag) in your .emacs file. + +;;; Code: + +(provide 'mldrag) + +(defun mldrag-drag-mode-line (start-event) + "Change the height of the current window with the mouse. +This command should be bound to a down-mouse- event, and is most +usefully bound with the `mode-line' prefix. Holding down a mouse +button and moving the mouse up and down will make the clicked-on +window taller or shorter." + (interactive "e") + (let ((done nil) + (echo-keystrokes 0) + (start-event-frame (window-frame (car (car (cdr start-event))))) + (start-event-window (car (car (cdr start-event)))) + (start-nwindows (count-windows t)) + (old-selected-window (selected-window)) + should-enlarge-minibuffer + event mouse minibuffer y top bot edges wconfig params growth) + (setq params (frame-parameters)) + (if (and (not (setq minibuffer (cdr (assq 'minibuffer params)))) + (one-window-p t)) + (error "Attempt to resize sole window")) + (unwind-protect + (track-mouse + (progn + ;; enlarge-window only works on the selected window, so + ;; we must select the window where the start event originated. + ;; unwind-protect will restore the old selected window later. + (select-window start-event-window) + ;; if this is the bottommost ordinary window, then to + ;; move its modeline the minibuffer must be enlarged. + (setq should-enlarge-minibuffer + (and minibuffer + (not (one-window-p t)) + (= (nth 1 (window-edges minibuffer)) + (nth 3 (window-edges))))) + ;; loop reading events and sampling the position of + ;; the mouse. + (while (not done) + (setq event (read-event) + mouse (mouse-position)) + ;; do nothing if + ;; - there is a switch-frame event. + ;; - the mouse isn't in the frame that we started in + ;; - the mouse isn't in any Emacs frame + ;; drag if + ;; - there is a mouse-movement event + ;; - there is a scroll-bar-movement event + ;; (same as mouse movement for our purposes) + ;; quit if + ;; - there is a keyboard event or some other unknown event + ;; unknown event. + (cond ((integerp event) + (setq done t)) + ((eq (car event) 'switch-frame) + nil) + ((not (memq (car event) + '(mouse-movement scroll-bar-movement))) + (setq done t)) + ((not (eq (car mouse) start-event-frame)) + nil) + ((null (car (cdr mouse))) + nil) + (t + (setq y (cdr (cdr mouse)) + edges (window-edges) + top (nth 1 edges) + bot (nth 3 edges)) + ;; scale back a move that would make the + ;; window too short. + (cond ((< (- y top -1) window-min-height) + (setq y (+ top window-min-height -1)))) + ;; compute size change needed + (setq growth (- y bot -1) + wconfig (current-window-configuration)) + ;; grow/shrink minibuffer? + (if should-enlarge-minibuffer + (progn + ;; yes. briefly select minibuffer so + ;; ealarge-window will affect the + ;; correct window. + (select-window minibuffer) + ;; scale back shrinkage if it would + ;; make the minibuffer less than 1 + ;; line tall. + (if (and (> growth 0) + (< (- (window-height minibuffer) + growth) + 1)) + (setq growth (1- (window-height minibuffer)))) + (enlarge-window (- growth)) + (select-window start-event-window)) + ;; no. grow/shrink the selected window + (enlarge-window growth)) + ;; if this window's growth caused another + ;; window to be deleted because it was too + ;; short, rescind the change. + ;; + ;; if size change caused space to be stolen + ;; from a window above this one, rescind the + ;; change, but only if we didn't grow/srhink + ;; the minibuffer. minibuffer size changes + ;; can cause all windows to shrink... no way + ;; around it. + (if (or (/= start-nwindows (count-windows t)) + (and (not should-enlarge-minibuffer) + (/= top (nth 1 (window-edges))))) + (set-window-configuration wconfig))))))) + ;; restore the old selected window + (select-window old-selected-window)))) + +(defun mldrag-drag-vertical-line (start-event) + "Change the width of the current window with the mouse. +This command should be bound to a down-mouse- event, and is most +usefully bound with the `vertical-line' or the `vertical-scroll-bar' +prefix. Holding down a mouse button and moving the mouse left and +right will make the clicked-on window thinner or wider." + (interactive "e") + (let ((done nil) + (echo-keystrokes 0) + (start-event-frame (window-frame (car (car (cdr start-event))))) + (start-event-window (car (car (cdr start-event)))) + (start-nwindows (count-windows t)) + (old-selected-window (selected-window)) + event mouse x left right edges wconfig growth) + (if (one-window-p t) + (error "Attempt to resize sole ordinary window")) + (if (= (nth 2 (window-edges start-event-window)) + (frame-width start-event-frame)) + (error "Attempt to drag rightmost scrollbar")) + (unwind-protect + (track-mouse + (progn + ;; enlarge-window only works on the selected window, so + ;; we must select the window where the start event originated. + ;; unwind-protect will restore the old selected window later. + (select-window start-event-window) + ;; loop reading events and sampling the position of + ;; the mouse. + (while (not done) + (setq event (read-event) + mouse (mouse-position)) + ;; do nothing if + ;; - there is a switch-frame event. + ;; - the mouse isn't in the frame that we started in + ;; - the mouse isn't in any Emacs frame + ;; drag if + ;; - there is a mouse-movement event + ;; - there is a scroll-bar-movement event + ;; (same as mouse movement for our purposes) + ;; quit if + ;; - there is a keyboard event or some other unknown event + ;; unknown event. + (cond ((integerp event) + (setq done t)) + ((eq (car event) 'switch-frame) + nil) + ((not (memq (car event) + '(mouse-movement scroll-bar-movement))) + (setq done t)) + ((not (eq (car mouse) start-event-frame)) + nil) + ((null (car (cdr mouse))) + nil) + (t + (setq x (car (cdr mouse)) + edges (window-edges) + left (nth 0 edges) + right (nth 2 edges)) + ;; scale back a move that would make the + ;; window too thin. + (cond ((< (- x left -1) window-min-width) + (setq x (+ left window-min-width -1)))) + ;; compute size change needed + (setq growth (- x right -1) + wconfig (current-window-configuration)) + (enlarge-window growth t) + ;; if this window's growth caused another + ;; window to be deleted because it was too + ;; thin, rescind the change. + ;; + ;; if size change caused space to be stolen + ;; from a window to the left of this one, + ;; rescind the change. + (if (or (/= start-nwindows (count-windows t)) + (/= left (nth 0 (window-edges)))) + (set-window-configuration wconfig))))))) + ;; restore the old selected window + (select-window old-selected-window)))) + +;; mldrag.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/rsz-mini.el Mon May 02 05:16:59 1994 +0000 @@ -0,0 +1,200 @@ +;;; rsz-mini.el --- dynamically resize minibuffer to display entire contents + +;;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc. + +;;; Author: Noah Friedman <friedman@prep.ai.mit.edu> +;;; Roland McGrath <roland@prep.ai.mit.edu> +;;; Maintainer: friedman@prep.ai.mit.edu +;;; Keywords: minibuffer, window, frame, display +;;; Status: Known to work in FSF GNU Emacs 19.23. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;;; This package allows the entire contents (or as much as possible) of the +;;; minibuffer to be visible at once when typing. As the end of a line is +;;; reached, the minibuffer will resize itself. When the user is done +;;; typing, the minibuffer will return to its original size. + +;;; In window systems where it is possible to have a frame in which the +;;; minibuffer is the only window, the frame itself can be resized. In FSF +;;; GNU Emacs 19.22 and earlier, the frame may not be properly returned to +;;; its original size after it ceases to be active because +;;; `minibuffer-exit-hook' didn't exist until version 19.23. + +;;; Note that the minibuffer and echo area are not the same! They simply +;;; happen to occupy roughly the same place on the frame. Messages put in +;;; the echo area will not cause any resizing by this package. + +;;; This package is considered a minor mode but it doesn't put anything in +;;; minor-mode-alist because this mode is specific to the minibuffer, which +;;; has no mode line. + +;;; To use this package, put the following in your .emacs: +;;; +;;; (autoload 'resize-minibuffer-mode "rsz-mini" nil t) +;;; +;;; Invoking the command `resize-minibuffer-mode' will then enable this mode. + +;;; Code: + + +;;;###autoload +(defvar resize-minibuffer-mode nil + "*If non-`nil', resize the minibuffer so its entire contents are visible.") + +;;;###autoload +(defvar resize-minibuffer-window-max-height nil + "*Maximum size the minibuffer window is allowed to become. +If less than 1 or not a number, the limit is the height of the frame in +which the active minibuffer window resides.") + +;;;###autoload +(defvar resize-minibuffer-window-exactly t + "*If non-`nil', make minibuffer exactly the size needed to display all its contents. +Otherwise, the minibuffer window can temporarily increase in size but +never get smaller while it is active.") + + +;;;###autoload +(defvar resize-minibuffer-frame nil + "*If non-`nil' and the active minibuffer is the sole window in its frame, allow changing the frame height.") + +;;;###autoload +(defvar resize-minibuffer-frame-max-height nil + "*Maximum size the minibuffer frame is allowed to become. +If less than 1 or not a number, there is no limit.") + +;;;###autoload +(defvar resize-minibuffer-frame-exactly nil + "*If non-`nil', make minibuffer frame exactly the size needed to display all its contents. +Otherwise, the minibuffer frame can temporarily increase in size but +never get smaller while it is active.") + + +;;;###autoload +(defun resize-minibuffer-mode (&optional prefix) + "Enable or disable resize-minibuffer mode. +A negative prefix argument disables this mode. A positive argument or +argument of 0 enables it. + +When this minor mode is enabled, the minibuffer is dynamically resized to +contain the entire region of text put in it as you type. + +The variable `resize-minibuffer-mode' is set to t or nil depending on +whether this mode is active or not. + +The maximum height to which the minibuffer can grow is controlled by the +variable `resize-minibuffer-window-max-height'. + +The variable `resize-minibuffer-window-exactly' determines whether the +minibuffer window should ever be shrunk to make it no larger than needed to +display its contents. + +When using a window system, it is possible for a minibuffer to tbe the sole +window in a frame. Since that window is already its maximum size, the only +way to make more text visible at once is to increase the size of the frame. +The variable `resize-minibuffer-frame' controls whether this should be +done. The variables `resize-minibuffer-frame-max-height' and +`resize-minibuffer-frame-exactly' are analogous to their window +counterparts." + (interactive "p") + (or prefix (setq prefix 0)) + (cond + ((>= prefix 0) + (setq resize-minibuffer-mode t)) + (t + (setq resize-minibuffer-mode nil)))) + +(defun resize-minibuffer-setup () + (cond + (resize-minibuffer-mode + (cond + ((and window-system + (eq 'only (cdr (assq 'minibuffer (frame-parameters))))) + (and resize-minibuffer-frame + (progn + (make-local-variable 'minibuffer-exit-hook) + (add-hook 'minibuffer-exit-hook 'resize-minibuffer-frame-restore) + (make-local-variable 'post-command-hook) + (add-hook 'post-command-hook 'resize-minibuffer-frame)))) + (t + (make-local-variable 'post-command-hook) + (add-hook 'post-command-hook 'resize-minibuffer-window)))))) + +(defun resize-minibuffer-count-window-lines (&optional start end) + "Return number of window lines occupied by text in region. +The number of window lines may be greater than the number of actual lines +in the buffer if any wrap on the display due to their length. + +Optional arguments START and END default to point-min and point-max, +respectively." + (or start (setq start (point-min))) + (or end (setq end (point-max))) + (if (= start end) + 0 + (save-excursion + (save-restriction + (widen) + (narrow-to-region start end) + (goto-char start) + (vertical-motion (buffer-size)))))) + + +;; Resize the minibuffer window to contain the minibuffer's contents. +;; The minibuffer must be the current window. +(defun resize-minibuffer-window () + (let ((height (window-height)) + (lines (1+ (resize-minibuffer-count-window-lines)))) + (and (numberp resize-minibuffer-window-max-height) + (> resize-minibuffer-window-max-height 0) + (setq lines (min lines resize-minibuffer-window-max-height))) + (or (if resize-minibuffer-window-exactly + (= lines height) + (<= lines height)) + (enlarge-window (- lines height))))) + + +;; Resize the minibuffer frame to contain the minibuffer's contents. +;; The minibuffer frame must be the current frame. +(defun resize-minibuffer-frame () + (let ((height (frame-height)) + (lines (1+ (resize-minibuffer-count-window-lines)))) + (and (numberp resize-minibuffer-frame-max-height) + (> resize-minibuffer-frame-max-height 0) + (setq lines (min lines resize-minibuffer-frame-max-height))) + (cond + ((> lines height) + (set-frame-size (selected-frame) (frame-width) lines)) + ((and resize-minibuffer-frame-exactly + (> height (cdr (assq 'height minibuffer-frame-alist))) + (< lines height)) + (set-frame-size (selected-frame) (frame-width) lines))))) + +;; Restore the original height of the frame. +(defun resize-minibuffer-frame-restore () + (set-frame-size (selected-frame) + (frame-width) + (cdr (assq 'height minibuffer-frame-alist)))) + + +(provide 'rsz-mini) + +(add-hook 'minibuffer-setup-hook 'resize-minibuffer-setup) + +;; rsz-mini.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/tempo.el Mon May 02 05:16:59 1994 +0000 @@ -0,0 +1,449 @@ +;;; tempo.el --- templates with hotspots +;; Copyright (C) 1994 Free Software Foundation, Inc. + +;; Author: David Kegedal <davidk@lysator.liu.se > +;; Created: 16 Feb 1994 +;; Version: 1.0 +;; Keywords: extensions, languages, tools + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; This file provides a simple way to define powerful templates, or +;; macros, if you wish. It is mainly intended for, but not limited to, +;; other programmers to be used for creating shortcuts for editing +;; certain kind of documents. It was originally written to be used by +;; a HTML editing mode written by Nelson Minar <nelson@reed.edu>, and +;; his html-helper-mode.el is probably the best example of how to use +;; this program. + +;; A template is defined as a list of items to be inserted in the +;; current buffer at point. Some of the items can be simple strings, +;; while other can control formatting or define special points of +;; interest in the inserted text. + +;; If a template defines a "point of interest" that point is inserted +;; in a buffer-local list of "points of interest" that the user can +;; jump between with the commands `tempo-backward-mark' and +;; `tempo-forward-mark'. If the template definer provides a prompt for +;; the point, and the variable `tempo-interactive' is non-nil, the +;; user will be prompted for a string to be inserted in the buffer, +;; using the minibuffer. + +;; The template can also define one point to be replaced with the +;; current region if the template command is called with a prefix (or +;; a non-nil argument). + +;; More flexible templates can be created by including lisp symbols, +;; which will be evaluated as variables, or lists, which will will be +;; evaluated as lisp expressions. + +;; See the documentation for tempo-define-template for the different +;; items that can be used to define a tempo template. + +;; One of the more powerful features of tempo templates are automatic +;; completion. With every template can be assigned a special tag that +;; should be recognized by `tempo-complete-tag' and expanded to the +;; complete template. By default the tags are added to a global list +;; of template tags, and are matched against the last word before +;; point. But if you assign your tags to a specific list, you can also +;; specify another method for matching text in the buffer against the +;; tags. In the HTML mode, for instance, the tags are matched against +;; the text between the last `<' and point. + +;; When defining a template named `foo', a symbol named +;; `tempo-template-foo' will be created whose value as a variable will +;; be the template definition, and its function value will be an +;; interactive function that inserts the template at the point. + +;; Full documentation for tempo.el can be found on the World Wide Web +;; at http://www.lysator.liu.se:7500/~davidk/tempo.html (not yet +;; completed) + +;; The latest tempo.el distribution can be fetched from +;; ftp.lysator.liu.se in the directory /pub/emacs + +;;; Code: + +(provide 'tempo) + +;;; Variables + +(defvar tempo-interactive nil + "*Prompt user for strings in templates. +If this variable is non-nil, `tempo-insert' prompts the +user for text to insert in the templates") + +(defvar tempo-insert-string-functions nil + "List of functions to run when inserting a string. +Each function is called with a single arg, STRING." ) + +(defvar tempo-tags nil + "An association list with tags and corresponding templates") + +(defvar tempo-local-tags '((tempo-tags . nil)) + "A list of locally installed tag completion lists. + +It is a association list where the car of every element is a symbol +whose varable value is a template list. The cdr part, if non-nil, is a +function or a regexp that defines the string to match. See the +documentation for the function `tempo-complete-tag' for more info. + +`tempo-tags' is always in the last position in this list.") + +(defvar tempo-marks nil + "A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.") + +(defvar tempo-default-match-finder "\\b\\([^\\b]*\\)\\=" + "The default regexp used to find the string to match against the tags.") + +;; Make some variables local to every buffer + +(make-variable-buffer-local 'tempo-marks) +(make-variable-buffer-local 'tempo-local-tags) + +;;; Functions + +;; +;; tempo-define-template + +(defun tempo-define-template (name elements &optional tag documentation taglist) + "Define a template. +This function creates a template variable `tempo-template-NAME' and an +interactive function `tempo-template-NAME' that inserts the template +at the point. The created function is returned. + +NAME is a string that contains the name of the template, ELEMENTS is a +list of elements in the template, TAG is the tag used for completion, +DOCUMENTATION is the documentation string for the insertion command +created, and TAGLIST (a symbol) is the tag list that TAG (if provided) +should be added to). If TAGLIST is nil and TAG is non-nil, TAG is +added to `tempo-tags' + +The elements in ELEMENTS can be of several types: + + - A string. It is sent to the hooks in `tempo-insert-string-functions', + and the result is inserted. + - The symbol 'p. This position is saved in `tempo-marks'. + - The symbol 'r. If `tempo-insert' is called with ON-REGION non-nil + the current region is placed here. Otherwise it works like 'p. + - (p . PROMPT) If `tempo-interactive' is non-nil, the user is + prompted in the minbuffer with PROMPT for a string to be inserted. + If `tempo-interactive is nil, it works like 'p. + - (r . PROMPT) like the previou, but if `tempo-interactive' is nil + and `tempo-insert' is called with ON-REGION non-nil, the current + region is placed here. + - '& If there is only whitespace between the line start and point, + nothing happens. Otherwise a newline is inserted. + - '% If there is only whitespace between point and end-of-line + nothing happens. Otherwise a newline is inserted. + - 'n inserts a newline. + - '> The line is indented using `indent-according-to-mode'. Note that + you often should place this item after the text you want on the + line. + - 'n> inserts a newline and indents line. + - nil. It is ignored. + - Anything else. It is evaluated and the result is parsed again." + + (let* ((template-name (intern (concat "tempo-template-" + name))) + (command-name template-name)) + (set template-name elements) + (fset command-name (list 'lambda (list '&optional 'arg) + (or documentation + (concat "Insert a " name ".")) + (list 'interactive "*P") + (list 'tempo-insert-template (list 'quote + template-name) + 'arg))) + (and tag + (tempo-add-tag tag template-name taglist)) + command-name)) + +;;; +;;; tempo-insert-template + +(defun tempo-insert-template (template on-region) + "Insert a template. +TEMPLATE is the template to be inserted. If ON-REGION is non-nil the +`r' elements are replaced with the current region." + (and on-region + (< (mark) (point)) + (exchange-point-and-mark)) + (save-excursion + (tempo-insert-mark (point-marker)) + (mapcar 'tempo-insert + (symbol-value template)) + (tempo-insert-mark (point-marker))) + (tempo-forward-mark)) + +;;; +;;; tempo-insert + +(defun tempo-insert (element) + "Insert a template element. +Insert one element from a template. See documentation for +`tempo-define-template' for the kind of elements possible." + (cond ((stringp element) (tempo-process-and-insert-string element)) + ((and (consp element) (eq (car element) 'p)) + (tempo-insert-prompt (cdr element))) + ((and (consp element) (eq (car element) 'r)) + (if on-region + (exchange-point-and-mark) + (tempo-insert-prompt (cdr element)))) + ((eq element 'p) (tempo-insert-mark (point-marker))) + ((eq element 'r) (if on-region + (exchange-point-and-mark) + (tempo-insert-mark (point-marker)))) + ((eq element '>) (indent-according-to-mode)) + ((eq element '&) (if (not (or (= (current-column) 0) + (save-excursion + (re-search-backward + "^\\s-*\\=" nil t)))) + (insert "\n"))) + ((eq element '%) (if (not (or (eolp) + (save-excursion + (re-search-forward + "\\=\\s-*$" nil t)))) + (insert "\n"))) + ((eq element 'n) (insert "\n")) + ((eq element 'n>) (insert "\n") (indent-according-to-mode)) + ((null element)) + (t (tempo-insert (eval element))))) + +;;; +;;; tempo-insert-prompt + +(defun tempo-insert-prompt (prompt) + "Prompt for a text string and insert it in the current buffer. +If the variable `tempo-interactive' is non-nil the user is prompted +for a string in the minibuffer, which is then inserted in the current +buffer. If `tempo-interactive' is nil, the current point is placed on +`tempo-forward-mark-list'. + +PROMPT is the prompt string." + (if tempo-interactive + (insert (read-string prompt)) + (tempo-insert-mark (point-marker)))) + +;;; +;;; tempo-process-and-insert-string + +(defun tempo-process-and-insert-string (string) + "Insert a string from a template. +Run a string through the preprocessors in `tempo-insert-string-functions' +and insert the results." + + (cond ((null tempo-insert-string-functions) + nil) + ((symbolp tempo-insert-string-functions) + (setq string + (apply tempo-insert-string-functions (list string)))) + ((listp tempo-insert-string-functions) + (mapcar (function (lambda (fn) + (setq string (apply fn string)))) + tempo-insert-string-functions)) + (t + (error "Bogus value in tempo-insert-string-functions: %s" + tempo-insert-string-functions))) + (insert string)) + +;;; +;;; tempo-insert-mark + +(defun tempo-insert-mark (mark) + "Insert a mark `tempo-marks' while keeping it sorted" + (cond ((null tempo-marks) (setq tempo-marks (list mark))) + ((< mark (car tempo-marks)) (setq tempo-marks (cons mark tempo-marks))) + (t (let ((lp tempo-marks)) + (while (and (cdr lp) + (<= (car (cdr lp)) mark)) + (setq lp (cdr lp))) + (if (not (= mark (car lp))) + (setcdr lp (cons mark (cdr lp)))))))) + +;;; +;;; tempo-forward-mark + +(defun tempo-forward-mark () + "Jump to the next mark in `tempo-forward-mark-list'." + (interactive) + (let ((next-mark (catch 'found + (mapcar + (function + (lambda (mark) + (if (< (point) mark) + (throw 'found mark)))) + tempo-marks) + ;; return nil if not found + nil))) + (if next-mark + (goto-char next-mark)))) + +;;; +;;; tempo-backward-mark + +(defun tempo-backward-mark () + "Jump to the previous mark in `tempo-back-mark-list'." + (interactive) + (let ((prev-mark (catch 'found + (let (last) + (mapcar + (function + (lambda (mark) + (if (<= (point) mark) + (throw 'found last)) + (setq last mark))) + tempo-marks) + last)))) + (if prev-mark + (goto-char prev-mark)))) + +;;; +;;; tempo-add-tag + +(defun tempo-add-tag (tag template &optional tag-list) + "Add a template tag. + +Add the TAG, that should complete to TEMPLATE to the list in TAG-LIST, +or to `tempo-tags' if TAG-LIST is nil." + + (interactive "sTag: \nCTemplate: ") + (if (null tag-list) + (setq tag-list 'tempo-tags)) + (if (not (assoc tag (symbol-value tag-list))) + (set tag-list (cons (cons tag template) (symbol-value tag-list))))) + +;;; +;;; tempo-use-tag-list + +(defun tempo-use-tag-list (tag-list &optional completion-function) + "Install TAG-LIST to be used for template completion in the current buffer. + +TAG-LIST is a symbol whose variable value is a tag list created with +`tempo-add-tag' and COMPLETION-FUNCTION is an optional function or +string that is used by `\\[tempo-complete-tag]' to find a string to +match the tag against. + +If COMPLETION-FUNCTION is a string, it should contain a regular +expression with at least one \\( \\) pair. When searching for tags, +`tempo-complete-tag' calls `re-search-backward' with this string, and +the string between the first \\( and \\) is used for matching against +each string in the tag list. If one is found, the whole text between +the first \\( and the point is replaced with the inserted template. + +You will probably want to include \\ \= at the end of the regexp to make +sure that the string is matched only against text adjacent to the +point. + +If COPMLETION-FUNCTION is a symbol, it should be a function that +returns a cons cell of the form (STRING . POS), where STRING is the +string used for matching and POS is the buffer position after which +text should be replaced with a template." + + (let ((old (assq tag-list tempo-local-tags))) + (if old + (setcdr old completion-function) + (setq tempo-local-tags (cons (cons tag-list completion-function) + tempo-local-tags))))) + +;;; +;;; tempo-find-match-string + +(defun tempo-find-match-string (finder) + "Find a string to be matched against a tag list. + +FINDER is a function or a string. Returns (STRING . POS)." + (cond ((stringp finder) + (save-excursion + (re-search-backward finder nil t)) + (cons (buffer-substring (match-beginning 1) (1+ (match-end 1))) + (match-beginning 1))) + (t + (funcall finder)))) + +;;; +;;; tempo-complete-tag + +(defun tempo-complete-tag (&optional silent) + "Look for a tag and expand it.. + +It goes through the tag lists in `tempo-local-tags' (this includes +`tempo-tags') and for each list it uses the corresponding match-finder +function, or `tempo-default-match-finder' if none is given, and tries +to match the match string against the tags in the list using +`try-completion'. If none is found it proceeds to the next list until +one is found. If a partial completion is found, it is replaced by the +template if it can be completed uniquely, or completed as far as +possible. + +When doing partial completion, only tags in the currently examined +list are considered, so if you provide similar tags in different lists +in `tempo-local-tags', the result may not be desirable. + +If no match is found or a partial match is found, and SILENT is +non-nil, the function will give a signal." + + (interactive) + (if (catch 'completed + (mapcar + (function + (lambda (tag-list-a) + (let* ((tag-list (symbol-value(car tag-list-a))) + (match-string-finder (or (cdr tag-list-a) + tempo-default-match-finder)) + (match-info (tempo-find-match-string match-string-finder)) + (match-string (car match-info)) + (match-start (cdr match-info)) + (compl (or (cdr (assoc match-string tag-list)) + (try-completion (car match-info) + tag-list)))) + + (if compl ;any match + (delete-region match-start (point))) + + (cond + ((null compl) + nil) + ((symbolp compl) + (tempo-insert-template compl nil) + (throw 'completed t)) + ((eq compl t) + (tempo-insert-template (cdr (assoc match-string tag-list)) + nil) + (throw 'completed t)) + ((stringp compl) + (let ((compl2 (assoc compl tag-list))) + (if compl2 + (tempo-insert-template (cdr compl2) nil) + (insert compl) + (if (string= match-string compl) + (if (not silent) + (ding))))) + (throw 'completed t)))))) + tempo-local-tags) + ;; No completion found. Return nil + nil) + ;; Do nothing if a completion was found + t + ;; No completion was found + (if (not silent) + (ding)) + nil)) + +;;; tempo.el ends here