aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1994-05-02 05:16:59 +0000
committerRichard M. Stallman1994-05-02 05:16:59 +0000
commit813f532d2f0d18dcda7d93be2c6cd841815ff8b8 (patch)
tree9532b7d9540d093d97772918eee701de11e54326
parent7ce486180bb65a66b58103891224a563ec4b4d7b (diff)
downloademacs-813f532d2f0d18dcda7d93be2c6cd841815ff8b8.tar.gz
emacs-813f532d2f0d18dcda7d93be2c6cd841815ff8b8.zip
Initial revision
Diffstat
-rw-r--r--lisp/ediff.el3076
-rw-r--r--lisp/ielm.el366
-rw-r--r--lisp/mail/mail-hist.el282
-rw-r--r--lisp/mldrag.el226
-rw-r--r--lisp/rsz-mini.el200
-rw-r--r--lisp/tempo.el449
6 files changed, 4599 insertions, 0 deletions
diff --git a/lisp/ediff.el b/lisp/ediff.el
new file mode 100644
index 00000000000..4ecd56a2ba6
--- /dev/null
+++ b/lisp/ediff.el
@@ -0,0 +1,3076 @@
1;;; ediff.el --- a visual interface to diff & patch
2;;; Copyright (C) 1994 Free Software Foundation, Inc.
3
4;; Author: Michael Kifer <kifer@cs.sunysb.edu>
5;; Created: February 2, 1994
6;; Version: 1.31
7;; Keywords: comparing, merging, patching, version control.
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to
23;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24
25
26;;; Commentary:
27;; ----------
28
29;; Never read those diff(1) outputs again!
30;; Apply patch(1) selectively, like a pro!
31
32;; This package provides a convenient way of simultaneous brousing through
33;; the differences between a pair of files or buffers. The two files being
34;; compared (file-A and file-B) are shown in separate windows (side by
35;; side, one above the another, or in separate frames), and the differences
36;; are highlighted as you step through them. You can also copy difference
37;; regions from one buffer to another (and recover old differences if you
38;; change your mind).
39
40;; In addition, Ediff can apply a patch to a file and then let you step
41;; though both files, the patched and the original one, simultateously,
42;; difference-by-difference. You can even apply a patch right out of a
43;; mail buffer, i.e., patches received by mail don't even have to be saved.
44;; Since Ediff lets you copy differences between buffers, you can, in
45;; effect, apply patches selectively (i.e., you can copy a difference
46;; region from file.orig to file, thereby undoing any particular patch that
47;; you don't like).
48
49;; This package is based on emerge.el. It uses a few utilities and
50;; variables defined there and several other Ediff's functions are
51;; adaptations from emerge.el.
52
53;; Ediff is complimentary to Emerge. While Emerge is better at heavy-duty
54;; tasks that involve merging of files, Ediff is by far superior
55;; for browsing through files compared via diff(1) and for patching files
56;; with patch(1). Furthermore, I feel that Ediff is more convenient for
57;; merging tasks where one of the files is a designated output. This
58;; situation arises while patching files or when comparing an old version
59;; of a file with a newer version (in such cases, it is often desirable to
60;; selectively revert some portions of the new file to its old state).
61
62;; This version of Ediff is much faster than the previous ones and than
63;; Emerge (in Emacs 19.23, Emerge will become much faster as well).
64;; The difference in startup time is dramatic for large files with many
65;; differences.
66
67;; Window configuration:
68;; ----------------------
69
70;; By default, Ediff sets things up in one frame, splitting it between a
71;; small control window and the two windows for file-A and file-B. The
72;; split between these latter windows can be horizontal or vertical, which
73;; can be changed interactively by hitting 's' while the cursor is in the
74;; control window.
75;;
76;; In a multi-frame situation, Ediff would work as follows. When it starts,
77;; it will place the control window in the frame that was selected at the
78;; time of the invocation. If file-A or file-B is seen in one of the
79;; frames, Ediff will leave it there. If a file (A/B) is not visible in any
80;; frame, Ediff will arrange that it will share a frame with the control
81;; window. (If none of the files is visible, then both will share the
82;; control window frame.) The same algorithm works when you hit 'c'
83;; (ediff-recenter), 'p' (ediff-previous-difference), 'n', etc.
84;;
85;; Thus, you can compare files in one frame or in different frames.
86;; The former is done by default, while the latter can be achieved by
87;; arranging files A and B to be seen in different frames. Ediff
88;; respects these arrangements, automatically adapting itself to
89;; the multi-frame mode.
90
91
92;; A note to heavy-duty users:
93
94;; Ediff lets the user run multiple sessions at once, i.e., you can invoke
95;; Ediff on different functions several times in a row, without exiting
96;; the previous Ediff sessions. Different sessions may even operate on the
97;; same pair of files. So, in principle, it is possible to do, say,
98;; pairwise comparison of three (or more) different files. Each session
99;; would have its own *ediff-control* buffer and all the regarding a
100;; particular session is local to the associated *ediff-control* buffer.
101;; You can switch between sessions by suspending one session and then
102;; switching to another *ediff-control* buffer. (Different such buffers
103;; are distinguished by a numerical suffix, e.g., *ediff-control*<3>.)
104;; This, if you would like to compare three files pairwise, you can do
105;; this by preparing three different frames, each with its own control
106;; window. (This would require a very wide screen, and I never claimed
107;; that such 3-way comparison is very easy to do.)
108;;
109;; If you need to conduct multiple Ediff sessions on the same file, one
110;; thing should be kept in mind: each time you invoke Ediff on a buffer that
111;; already participates in another Ediff session, that buffer should not
112;; have any ASCII Ediff flags in it. (Highlighting with faces is OK.) If
113;; flags are not removed, difference overlays won't be set correctly
114;; for the second invocation of Ediff. The simplest way to remove ASCII
115;; flags from an Ediff buffer is to switch to that buffer and try to insert
116;; or delete something. If ASCII flags have been inserted by an Ediff
117;; session, Ediff will ignore this first editing operation, but it will
118;; remove all flags and notify you that this buffer can now be edited.
119;;
120;; To rehighlight Ediff buffers, hit 'c' in ediff-control buffer.
121
122
123;;; Remarks:
124;; -------
125
126;; 1. Ediff is unlikely to run under Emacs 18 without some further work.
127;; 2. If running Lucid Emacs, Ediff requires at least version 19.9.
128;; 3. I didn't test Ediff on FSF versions older than 19.19.
129;; 4. The function vc-ediff requires the vc.el version that comes with
130;; Emacs 19.22.
131
132
133;;; Installation and use:
134;; --------------------
135
136;; You can invoke Ediff interactively using the following functions:
137;;
138;; ediff-buffers - compare buffers
139;; ediff (alias for ediff-files)
140;; ediff-files - compare files
141;; ediff-patch-file - patch file then compare
142;; epatch (alias for ediff-patch-file)
143;; ediff-patch-buffer - patch buffer then compare
144;; vc-ediff - compare buffer & version
145;; using vc.el package
146;; (Emacs 19.22 and up).
147;; rcs-ediff - same using rcs.el; rcs.el
148;; is not part of the
149;; standard Emacs distribution.
150;;
151;; There is also the function ediff-files-remote, which can be invoked only
152;; from within another Emacs Lisp function, i.e., non-interactively.
153;;
154;; To use Ediff, put this in your .emacs file:
155;;
156;; (autoload 'ediff-buffers "ediff" "Visual interface to diff(1)" t)
157;; (autoload 'ediff "ediff" "Visual interface to diff(1)" t)
158;; (autoload 'ediff-files "ediff" "Visual interface to diff(1)" t)
159;; (autoload 'ediff-files-remote "ediff" "Visual interface to diff(1)")
160;; (autoload 'epatch "ediff" "Visual interface to patch(1)" t)
161;; (autoload 'ediff-patch-file "ediff" "Visual interface to patch(1)" t)
162;; (autoload 'ediff-patch-buffer "ediff" "Visual interface to patch(1)" t)
163;; (autoload 'vc-ediff "ediff"
164;; "Interface to diff & version control via vc.el" t)
165;; (autoload 'rcs-ediff "ediff"
166;; "Interface to diff & version control via rcs.el" t)
167;;
168;;
169;; If you want Ediff to be loaded from the very beginning, you should have
170;;
171;; (require 'ediff)
172;;
173;; in your .emacs file. This way it is also easier to figure out changes
174;; to the default Ediff setting, if such changes become necessary --- see
175;; Customization.
176;;
177
178;;; Compilation
179;; -----------
180;;
181;; When you byte-compile Ediff, you will get some warnings about functions
182;; being undefined. These can be safely ignored.
183;;
184;; Warning:
185;; =======
186;;
187;; If you are using advice.el (directly or indirectly, via one of the
188;; other packages), Ediff may not compile properly. In this case, you
189;; should do:
190;;
191;; M-x ad-deactivate-all RET
192;;
193;; M-x byte-compile-file RET ediff.el RET
194;;
195;; M-x ad-activate-all RET
196;;
197;; This precaution will not be needed starting with GNU Emacs 19.23 and
198;; Lucid Emacs 19.10, due to fixing a bug in advice.el.
199
200
201;;; Customization:
202;; -------------
203
204;; If you don't like the default setting, you can change it through the
205;; various variables and hooks. In particular, the following hooks are
206;; available:
207
208;; ediff-load-hooks
209;; ediff-before-setup-windows-hooks
210;; ediff-startup-hooks
211;; ediff-select-hooks
212;; ediff-unselect-hooks
213;; ediff-suspend-hooks
214;; ediff-quit-hooks
215;; ediff-prepare-buffer-hooks
216
217;; The hooks in ediff-load-hooks can be used to change defaults after Ediff
218;; is loaded.
219;; The hooks in ediff-before-setup-windows-hooks, ediff-suspend-hooks, and
220;; ediff-quit-hooks can be used to save and then restore whatever window
221;; configuration you want. However, make sure you understand what you are
222;; doing. Many variables that drive Ediff are local to the different
223;; *ediff-control* buffers. Take a look at ediff-default-suspend-hook and
224;; ediff-default-quit-hook to see what's involved.
225;; The hooks in ediff-prepare-buffer-hooks are executed for each Ediff buffer
226;; (A and B) right after these buffers are arranged.
227;;
228;; The second group of Ediff variables that could be changed, if you so
229;; wish, is:
230;;
231;; ediff-before-flag-eol
232;; ediff-after-flag-eol
233;; ediff-before-flag-mol
234;; ediff-after-flag-mol
235;;
236;; ediff-current-diff-face-A
237;; ediff-current-diff-face-B
238;; ediff-even-diff-face-A
239;; ediff-even-diff-face-B
240;; ediff-odd-diff-face-A
241;; ediff-odd-diff-face-B
242;
243;; The first four are ASCII strings that mark the beginning and the end of
244;; the differences found in file-A and file-B. Ediff uses different flags
245;; to highlight regions that begin/end at the beginning of a line or in a
246;; middle of a line.
247
248;; The rest are the faces used to highlight text on X displays. On X
249;; displays, Ediff uses ediff-current-diff-face-A and
250;; ediff-current-diff-face-B to highlight the current difference regions.
251;; Other (non-current) difference regions are displayed in alternating
252;; faces: ediff-even/odd-diff-face-A/B. (In GNU Emacs, the odd and the even
253;; faces are actually identical on monochrome displays, because it is
254;; rather poor in what you can do on such a display. So, I chose to use
255;; italics to highlight other differences. Any ideas would be welcome. In
256;; Lucid Emacs, the situation is better because it supports pixmaps.)
257;; There are two ways to change the default setting for highlighting faces:
258;; either change the variables, as in
259;;
260;; (setq ediff-current-diff-face-A (internal-get-face 'bold-italic))
261;;
262;; (`internal-get-face' should be `get-face' if you are using Lucid Emacs)
263;; or by selectively modifying the defaults:
264;;
265;; (add-hook 'ediff-load-hooks
266;; (function (lambda ()
267;; (set-face-foreground ediff-current-diff-face-B "blue")
268;; (set-face-background ediff-current-diff-face-B "red")
269;; (make-face-italic ediff-current-diff-face-B))))
270;;
271;; You may also want to take a look at how the above faces are defined in
272;; Ediff.
273;;
274;; The last pair of variables in this group,
275;;
276;; ediff-want-faces
277;; ediff-highlight-selected-only
278;;
279;; indicate whether---on a window system---you want differences to be
280;; marked using ASCII strings (like on a dumb terminal) or using colors and
281;; highlighting. If ediff-want-faces is t, then highlighting with faces is
282;; used. Normally, Ediff highlights all differences, but the selected
283;; difference is highlighted more visibly. If you prefer that unselected
284;; differences won't be highlighted, you can set
285;; ediff-highlight-selected-only to t.
286;;
287;; If you plan on changing these variables, they must be set
288;; BEFORE ediff.el is loaded.
289;;
290;; Note: Ediff lets you switch between the two types of highlighting. That
291;; is you can switch, interactively, from highlighting using faces to
292;; highlighting using ASCII flags, and back. Of course, toggling has
293;; effect only on a window system. On a dumb terminal or in an xterm
294;; window, the only available option is highlighting with ASCII flags.
295;;
296;; The third group of variables controls miscellaneous functions:
297;;
298;; ediff-patch-program
299;; ediff-patch-options
300;; ediff-diff-program
301;; ediff-diff-options
302;;
303;; These specify the functions that produce differences and do patching.
304;; The *-options variables specify which options to pass to these programs.
305;; It is unlikely that you would want to change these. One possible
306;; exception is when you may want to generate differences with context
307;; lines in order to send a patch file through email. Then, you might want
308;; to set ediff-diff-options to '-c'. Sometimes, you may also want to tell
309;; diff(1) to ignore spaces and such. Use the option '-w' for that. Diff(1)
310;; has several other useful options (type 'man diff' to find out).
311;;
312;; The output from diff(1) is found in *ediff-diff* buffer. However, this
313;; makes sense only if you also intend to use Ediff to browse through the
314;; diff'ed files before sending the patch. This is because diff.el is much
315;; faster in yielding the output of diff(1) ;; (Ediff is a big gun, if used
316;; for this simple purpose).
317;;
318;; The last set of variables that can be modified is
319;;
320;; ediff-split-window-function
321;; ediff-use-last-dir
322;; ediff-nix-help-in-control-buffer
323;;
324;; ediff-split-window-function controls the way you want the window be
325;; split between file-A and file-B. It defaults to vertical split, but you
326;; can set it to 'split-window-horizontally, if you want. Ediff lets you
327;; toggle the way windows are split, so you can try different settings
328;; interactively. Note: if file-A and file-B are in different frames,
329;; windows are not split, regardless of the value
330;; ediff-split-window-function. Instead, other windows on these frames are
331;; deleted and Ediff starts displaying file-A and file-B using these two
332;; frames, one file per frame. You can then switch to one-frame mode
333;; simply by hiding the file-A/B buffer that is displayed on a frame other
334;; than the control-window frame.
335;;
336;; Note that if Ediff sees that the two buffers it compares are residing in
337;; separate frames, it assumes that the user wants them to be so displayed
338;; and stops splitting windows. Instead, it will arrange each buffer to
339;; occupy its own frame (possibly shared with Ediff's help window).
340;;
341;; The variable ediff-use-last-dir controls the way Ediff presents the
342;; default directory when it prompts the user for files to compare. If nil,
343;; Ediff will use the default directory of the current buffer when it
344;; prompts the user for file names. Otherwise, it will use the
345;; directories it had previously used for file-A and file-B.
346;;
347;; The ediff-nix-help-in-control-buffer, if set to t, makes C-h behave like
348;; the DEL key, i.e., it will move you back to the previous difference
349;; rather than invoking help. This is useful when, in an xterm window or on
350;; a dumb terminal, the Backspace key is bound to C-h and is positioned
351;; more conveniently than the DEL key.
352
353
354;;; Commands
355;; --------
356
357;; All Ediff commands are displayed in a help window, unless you hit '?' to
358;; shrink it to just one line. You can redisplay the help window by hitting
359;; '?' again.
360;;
361;; Many Ediff commands take numeric prefix arguments. For instance, if you
362;; hit a number, n, and then 'j' (ediff-jump-to-difference), Ediff will
363;; take you to n-th difference. Hitting a number, n, and then 'ab'
364;; (ediff-diff-to-diff) will copy n-th difference from buffer A to buffer B.
365;; Hitting 'ba' does copying in the other direction.
366;; Likewise, a number, n, followed by 'ra' will restore the n-th difference
367;; region in buffer A (if it was previously saved as a result of copying
368;; from B to A).
369;;
370;; Without the prefix argument, all commands operate on the current
371;; difference region.
372;;
373;; The total number of differences and the current difference number are
374;; always displayed in the mode line of the control window.
375
376;;; Display Modes
377;; -------------
378
379;; Ediff can display files in one frame, stacked side-by-side or one on top
380;; of another; or it can display the files in different frames. When you
381;; start Ediff, it assumes a 1-frame mode. You can toggle the side-by-side
382;; and one-on-top-of-another displays by simply hitting 's'.
383;;
384;; Ediff switches to the multi-frame mode when:
385;;
386;; 1. file-A and file-B are in different frames (you have to put them into
387;; different frames manually); or
388;; 2. *ediff-control* buffer is visible in one frame and one other file (A
389;; or B) is visible in another frame. If, say, fileA is visible in a
390;; different frame than *ediff-control*, fileB doesn't have to be
391;; visible. If it is, Ediff will continue displaying fileB in the frame
392;; where it was visible before. If it isn't then Ediff will arrange for
393;; fileB to share a frame with *ediff-control*.
394;;
395;; If all three buffers are in separate frames, Ediff will switch to a
396;; 3-frame mode. If Ediff buffers are currently visible only in two
397;; frames, Ediff will work in a 2-frame mode. In this mode, one of the
398;; frames will be shared by *ediff-control* and file-A or file-B
399;; (whichever is appropriate).
400
401
402;;; Bugs:
403;; ----
404
405;; 1. The undo command doesn't restore deleted regions well. That is, if
406;; you delete all characters in a difference region and then invoke
407;; `undo', the reinserted text will most likely be reinserted outside of
408;; what Ediff thinks is the current difference region. This bug seems to
409;; be present only in GNU Emacs. Lucid Emacs does fine in this respect.
410
411;; 2. You may get an error if your colormap doesn't have the colors requested
412;; by Ediff (on a color display). If this happens, you should create your
413;; own faces using available colors. See `ediff-current-diff-face-A',
414;; ediff-current-diff-face-B, ediff-even-diff-face-A, ediff-even-diff-face-B,
415;; ediff-odd-diff-face-A, and ediff-odd-diff-face-B to get an idea on how
416;; to do this.
417
418
419;;; Change Log:
420;; ----------
421
422;; Thu Feb 3, 1994
423
424;; Added ediff-read-file-name, which is a stub that takes care of Lemacs
425;; versions of Emerge. (Thanks to Alastair Burt <burt@dfki.uni-kl.de>.)
426;;
427;; Fixed a bug in ediff-setup-windows that caused control window to
428;; appear in a wrong place when split-window-keep-point is nil
429;; (Thanks to Kevin Broadey <KevinB@bartley.demon.co.uk>.)
430;;
431;; Added mechanism for using faces instead of before/after flags. This
432;; looks much better on an X display, especially on a color one.
433;; (Thanks to Boris Goldowsky <boris@cs.rochester.edu> for the code
434;; that led to ediff-highlight-diff.
435;; Also, thanks to Kevin Esler <esler@ch.hp.com> for suggestions
436;; regarding highlighting differences on X displays.)
437;;
438;; Added functions to apply patches.
439;; (Thanks to Kevin Broadey <KevinB@bartley.demon.co.uk> for this
440;; suggestion.)
441
442;; Fri Feb 4, 1994
443
444;; Added mechanism for toggling vertical/horizontal window split.
445;; (Inspired by a suggestion from Allan Gottlieb
446;; <gottlieb@allan.ultra.nyu.edu> -- thanks.)
447;;
448;; Added mechanism for toggling between highlighting using faces and
449;; highlighting using ASCII flags.
450;;
451;; Fixed a problem with undo. Now, Ediff has smartened up and doesn't
452;; keep undo info on ASCII flags inserted in buffer-A and buffer-B.
453;; So, if you edit the files while browsing through them, undo behaves
454;; as you would expect, i.e., faces/flags don't get in the way.
455
456;; Sun Feb 6, 1994
457
458;; Added horizontal scrolling. Added ediff-position-region to ensure
459;; that difference regions in buffer-A and buffer-B are aligned with
460;; each other. Disabled ediff-toggle-split when buffers are displayed
461;; in different frames.
462
463;; Mon Feb 7, 1994
464
465;; Added toggle-window help (Suggested by Boris Goldowsky
466;; <boris@cs.rochester.edu>.)
467;; Added functions to copy differences from one buffer to another and to
468;; recover old differences.
469;; Added prefix arguments to ediff-next-difference and
470;; ediff-previous-difference.
471
472;; Tue Feb 8, 1994
473
474;; Replaced text properties with overlays. Fixed ediff-setup-windows.
475;; Added ediff-save-buffer to local-write-file-hooks to prevent user
476;; from saving corrupted states. (Thanks to <boris@cs.rochester.edu>
477;; for suggestion.) Instead, Ediff now has a pair of functions for
478;; safe saving of buffers.
479;; Changed ediff-read-file-name to be more intuitive on ediff-files.
480;; Added ediff-prepare-buffer-hooks. (Thanks to Kevin Esler
481;; <esler@ch.hp.com> for the idea.)
482
483;; Wed Feb 9, 1994
484
485;; Cleanups in ediff-patch-file. Protected ediff-copy-diff against
486;; a bug that Emacs has in kill-region.
487
488;; Thu Feb 10, 1994
489
490;; Added support for Lemacs. (Thanks to Alastair Burt
491;; <burt@dfki.uni-kl.de> for coercing Ediff into working under Lemacs.)
492;; Added ediff-kill-buffer-carefully and other suggestions by Boris
493;; Goldowsky <boris@cs.rochester.edu>.
494;; Refined the protection against interference with highlighting caused
495;; by Hilit19. Added the variable ediff-third-party-highlighting.
496;; Added mechanisn for unhighlighting regions highlighted with Hilit19
497;; before hightlighting them with Ediff's overlays. (And for
498;; rehighlighting them with Hilit19, when the current difference moves on.)
499
500;; Sun Feb 13, 1994
501
502;; Added ediff-place-flags-in-buffer and ediff-remote-exit, which are
503;; modifications of Emerge's similar functions. The difference is that
504;; in Ediff they make ediff-before-flag and ediff-after-flag into
505;; read-only regions, so the user can't change them by mistake.
506;;
507;; Adopted a suggestion by Boris Goldowsky <boris@cs.rochester.edu>
508;; that led to a more elegant treatment of faces.
509;;
510;; Added protection against interference with Font-Lock highlighting
511;; similar to that of Hilit19's protection.
512
513;; Tue Feb 15, 1994
514
515;; Deleted spurious (auto-save-mode 1) in ediff-control-buffer, which
516;; was causing this buffer to be auto-saved for no good reason.
517;; Added read-only protection to ediff-before/after-flags in Lemacs.
518;; (Thanks to Alastair Burt <burt@dfki.uni-kl.de> for help in testing.)
519
520;; Wed Feb 16, 1994
521
522;; Further fixes in the Lemacs part. Changed highlighted region in
523;; ediff-highlight-diff so that an extra character will be highlighted
524;; only if a difference is empty (thereby allowing the user to see where an
525;; insertion or a deletion has taken place).
526;;
527;; Simplified interaction with other highlighting packages by giving
528;; Ediff overlays the highest priority. (Taking a cue from
529;; ediff-highlight-diff-lemacs written by Alastair Burt
530;; <burt@dfki.uni-kl.de>.) Zapped ediff-third-party-highlighting
531;; variable and hooks that were previously used to
532;; unhighlight/rehighlight buffers when hilit19/font-lock are on.
533
534;; Fri Feb 18, 1994
535
536;; Added a bit more sophistication to ediff-read-file-name. Now,
537;; ediff-files remembers both, the file-A and the file-B directories.
538;; They are offered as defaults when ediff-use-last-dir is set to t.
539
540;; Fri Feb 22, 1994
541
542;; Added ediff-before-change-guard to remove ASCII highlighting when
543;; the user attempts to change buffer-A/B. This is needed because
544;; otherwise the undo info may become screwed up in those buffers.
545;; Hitting 'h' (ediff-toggle-hilit) on a dumb terminal will toggle
546;; between ASCII highlighting and no highlighting.
547
548;; Fri Feb 24, 1994
549
550;; Fixed problems with multiple Ediff sessions running simultaneously.
551
552;; Tue Mar 1, 1994
553
554;; Added vc-ediff, the Ediff interface to vc.el. (Thanks to Eric
555;; Freudenthal <freudent@jan.ultra.nyu.edu> for contributing this
556;; function.)
557
558;; Sun Mar 6, 1994
559
560;; Added rcs-ediff, an Ediff interface to RCS via rcs.el. (Thanks to
561;; Alastair Burt <burt@dfki.uni-kl.de>.)
562;; Some minor improvements.
563
564;; Tue March 15, 1994
565
566;; Fixed a buglet in defining ediff-current-diff-face-A/B.
567;; (Thanks to Job Ganzevoort <Job.Ganzevoort@cwi.nl>.)
568
569;; Tue March 22, 1994
570
571;; Fixed a bug with ediffing narrowed buffers, reported by Kevin
572;; Broadey <KevinB@bartley.demon.co.uk>.
573;; Made Ediff to work with files that have incomplete last line.
574;; Made Ediff execute diff(1) and patch(1) using Bourne Shell, which
575;; should eliminate problems with $prompt that some people had.
576
577;; Thu March 24, 1994
578
579;; Achieved quadratic speedup in the size of the file by replacing the
580;; slow goto-line by forward-line. Ediff is now *much* faster than
581;; Emerge on large files. Converted demarkation of difference regions
582;; from markers to overlays. This will later allow us to highlight all
583;; diffs, not just the current one.
584
585;; Wed March 30, 1994
586
587;; Under X, Ediff now highlights all differences in dim colors and the
588;; current difference in bright colors. Improved Lucid Emacs support.
589
590;; Thu March 31, 1994
591
592;; Changed toggle hilit to cycle through 3 states: highlighting all
593;; diffs, highlighting only the current diff, and highlighting using
594;; ASCII flags.
595;; Added support for difference regions that are not full lines.
596
597;; Fri April 1, 1994
598
599;; Fixed bugs related to writing buffers A and B.
600;; Added commands 'ga', 'gb' to jump directly to the closest diff in
601;; buffer A and B, respectively.
602
603
604;;; Code:
605
606(require 'emerge) ;; Ediff is based on emerge
607
608
609;;; Macros
610(defmacro ediff-if-lucid ()
611 (` (string-match "Lucid" emacs-version)))
612(defmacro ediff-odd-p (arg)
613 (` (eq (logand (, arg) 1) 1)))
614(defmacro ediff-buffer-live-p (buf)
615 (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf))))))
616
617
618(defun ediff-mode ()
619 "Ediff mode is used by the Ediff file-difference package.
620It is entered only through one of the following commands:
621 ``ediff''
622 ``ediff-files''
623 ``ediff-buffers''
624 ``epatch''
625 ``ediff-patch-file''
626 ``ediff-patch-buffer''
627 ``vc-ediff''
628 ``rcs-ediff''
629or through a non-interactive Emacs Lisp function
630 ``ediff-files-remote''
631
632Commands:
633\\{ediff-mode-map}"
634 (interactive)
635 (kill-all-local-variables)
636 (setq major-mode 'ediff-mode)
637 (setq mode-name "Ediff"))
638
639(defvar ediff-version "1.31"
640 "The current version of Ediff.")
641
642(defun ediff-version ()
643 "Return string describing the version of Ediff.
644When called interactively, displays the version."
645 (interactive)
646 (if (interactive-p)
647 (message "Ediff version %s" (ediff-version))
648 ediff-version))
649
650
651;; Hook variables
652
653(defvar ediff-before-setup-windows-hooks nil
654 "* Hooks to run before Ediff sets its own window config. This can be used
655to save the previous window config, which can be restored on ediff-quit or
656ediff-suspend.")
657(defvar ediff-startup-hooks nil
658 "*Hooks to run in the control buffer after Ediff has been set up.")
659(defvar ediff-select-hooks nil
660 "*Hooks to run after a difference has been selected.")
661(defvar ediff-unselect-hooks nil
662 "*Hooks to run after a difference has been unselected.")
663(defvar ediff-prepare-buffer-hooks nil
664 "*Hooks called after buffers A and B are set up.")
665(defvar ediff-load-hooks nil
666 "* Hook run after Ediff is loaded. Can be used to change defaults.")
667
668(defvar ediff-suspend-hooks 'ediff-default-suspend-hook
669 "* Hooks to run in the Ediff control buffer each time Ediff is
670suspended.")
671(defvar ediff-quit-hooks 'ediff-default-quit-hook
672 "* Hooks to run in the Ediff control buffer after the ediff has been
673finished.")
674
675(make-variable-buffer-local 'local-write-file-hooks)
676(make-variable-buffer-local 'before-change-function)
677
678;; Help messages
679
680(defconst ediff-help-message-long
681"p,DEL - prev diff c - recenter ab - diff A to B l - line numbers
682n,SPC - next diff v/V - scroll up/dn ba - diff B to A f - file names
683 j - jump to diff </> - scroll lt/rt ra - restore A z - suspend Ediff
684 ga - goto pt in A s - toggle split rb - restore B q - quit Ediff
685 gb - goto pt in B h - toggle hilit
686wa/wb - save buf A/B A/B - toggle read-only buf A/B ? - toggle help")
687
688(defconst ediff-help-message-short
689" ? - toggle help window")
690
691(defvar ediff-help-message ediff-help-message-long
692 "* The actual help message.")
693
694
695(defvar ediff-diff-program "diff"
696 "* Name of the program that compares two files.")
697(defvar ediff-diff-options ""
698 "* Options to pass to ``ediff-diff-program''.")
699
700
701;; Support for patches
702
703(defvar ediff-patch-program "patch"
704 "* Name of the program that applies patches.")
705(defvar ediff-patch-options ""
706 "* Options to pass to ediff-patch-program.")
707
708(defvar ediff-shell "sh"
709 "* The shell used to run diff(1) and patch(1). If user's .profile or
710.cshrc files are set up correctly, any shell will do. However, some people
711set $prompt or other things incorrectly, which leads to undesirable output
712messages. These may cause Ediff to fail. In such a case, set ediff-shell
713to a shell that you are not using or, better, fix your shell's startup file.")
714
715(defvar ediff-diff-ok-lines-regexp
716 "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\|Warning:\\)"
717 "*Regexp that matches normal output lines from ``ediff-diff-program''.
718This is mostly lifted from Emerge, except that Ediff also considers the
719'Missing newline' message to be 'normal output.'
720Lines that do not match are assumed to be error messages.")
721
722(defvar ediff-match-diff-line (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)"))
723 (concat "^" x "\\([acd]\\)" x "$"))
724 "*Pattern to match lines produced by diff that describe differences.")
725
726(defvar ediff-patch-buf nil
727 "The buffer of the patch file.")
728(defvar ediff-patch-diagnostics nil
729 "The buffer where patch(1) would display its diagnostics.")
730
731
732;; Copying diffs betw buffers.
733
734(emerge-defvar-local ediff-killed-diffs-alist nil
735 "A list of killed diffs. A diff is saved here if it is replaced by a diff
736from another buffer. This alist has the form:
737((num (A . diff) (B . diff)) ...), where A or B parts may be missing.")
738
739
740;; Highlighting
741(defvar ediff-before-flag-bol
742 ;"vvvvvvvvvvvvvvvv---- ediff ----vvvvvvvvvvvvvvv\n"
743 ">>--->>>\n"
744 "*Flag placed above the highlighted block of differences. Must end with
745newline. Must be set before Ediff is loaded. If set to nil, the flags from
746emerge.el are used.")
747(defvar ediff-after-flag-bol
748 ;"^^^^^^^^^^^^^^^^---- ediff ----^^^^^^^^^^^^^^^\n"
749 "<<<---<<\n"
750 "*Flag placed below the highlighted block of differences. Must end with
751newline. Must be set before Ediff is loaded. If set to nil, the flags from
752emerge.el are used.")
753
754(defvar ediff-before-flag-mol ">>--->>>"
755 "*This is like ediff-before-flag, except it is used when a difference
756region starts in the middle of a line.")
757(defvar ediff-after-flag-mol "<<<---<<"
758 "*This is like ediff-after-flag, except it is used when a difference
759region starts in the middle of a line.")
760
761(emerge-defvar-local ediff-before-flag-A nil
762 "This is the actual ASCII before-flag in effect in buffer A.
763It is either `ediff-before-flag-mol' or `ediff-before-flag-bol' depending
764on whether the selected difference region starts in the middle of a line
765or at the beginning of a line.")
766(emerge-defvar-local ediff-after-flag-A nil
767 "This is the actual ASCII after-flag in effect in buffer A.
768It is either `ediff-before-flag-mol' or `ediff-before-flag-bol' depending
769on whether the selected difference region starts in the middle of a line
770or at the beginning of a line.")
771(emerge-defvar-local ediff-before-flag-B nil
772 "This is the actual ASCII before-flag in effect in buffer B.
773It is either `ediff-before-flag-mol' or `ediff-before-flag-bol' depending
774on whether the selected difference region starts in the middle of a line
775or at the beginning of a line.")
776(emerge-defvar-local ediff-after-flag-B nil
777 "This is the actual ASCII after-flag in effect in buffer B.
778It is either `ediff-before-flag-mol' or `ediff-before-flag-bol' depending
779on whether the selected difference region starts in the middle of a line
780or at the beginning of a line.")
781
782
783(emerge-defvar-local ediff-want-faces t
784 "If t, differences will be highlighted using faces on a window
785system. If nil, they will be highlighted using ASCII flags, ediff-before-flag
786and ediff-after-flag. On a non-window system, differences are always
787highlighted using ASCII flags.
788
789This is not a user option. Can be set either in .emacs or toggled
790interactively, using ediff-toggle-hilit.")
791
792(emerge-defvar-local ediff-highlight-selected-only nil
793 "If t, only the selected differences are highlighted.
794
795This is not a user option. Can be set either in .emacs or toggled
796interactively, using ediff-toggle-hilit.")
797
798(emerge-defvar-local ediff-highlighting-style nil
799 "A var local to each ediff-control buffer. Indicates highlighting style
800in effect for this buffer: 'face, 'ascii, nil -- temporarily unhighlighted,
801'off -- turned off \(on a dumb terminal only\).")
802
803
804
805;; Variables that control each Ediff session. They are local to the
806;; control buffer.
807
808;; Mode variables
809(emerge-defvar-local ediff-A-buffer nil
810 "The buffer in which the A variant is stored.")
811(emerge-defvar-local ediff-B-buffer nil
812 "The buffer in which the B variant is stored.")
813(emerge-defvar-local ediff-control-buffer nil
814 "The control buffer of ediff. ")
815
816(emerge-defvar-local ediff-control-buffer-suffix nil
817 "The suffix of the control buffer name. ")
818
819(defvar ediff-control-window nil
820 "The control window.")
821
822
823(emerge-defvar-local ediff-A-buffer-values nil
824 "Keeps working values of ediff-saved-variables for ediff-A-buffer.")
825(emerge-defvar-local ediff-B-buffer-values nil
826 "Keeps working values of ediff-saved-variables for ediff-B-buffer.")
827
828(emerge-defvar-local ediff-A-buffer-values-setup nil
829 "Remembers ediff-saved-variables for ediff-A-buffer as they were at setup.")
830(emerge-defvar-local ediff-B-buffer-values-setup nil
831 "Remembers ediff-saved-variables for ediff-B-buffer as they were at setup.")
832
833(emerge-defvar-local ediff-difference-vector nil
834 "Vector of differences between the variants. Each difference is
835represented by a vector of two overlays. The first overlays the difference
836section in the A buffer and the second overlays the diff in the B buffer.
837If a difference section is empty, the corresponding overlay's endpoints
838councide. ")
839
840(emerge-defvar-local ediff-current-difference -1
841 "The difference that is currently selected.")
842(emerge-defvar-local ediff-number-of-differences nil
843 "Number of differences found.")
844
845(emerge-defvar-local ediff-diff-buffer nil
846 "Buffer containing the output of diff(1), which is used by Ediff to step
847through files.")
848(emerge-defvar-local ediff-diff-error-buffer nil
849 "Buffer containing the output of diff(1) when diff returns errors.")
850
851(emerge-defvar-local ediff-this-buffer-control-sessions nil
852 "Keeps the list of ediff-control buffers associated with each buffer A/B
853involved in an ediff session.")
854
855(defvar ediff-disturbed-overlays nil
856 "A list of difference overlays that were disturbed by copying or recovery
857of the current diff.")
858
859(defvar ediff-shaded-overlay-priority
860 (if (ediff-if-lucid)
861 (1+ mouse-highlight-priority)
862 100) ;; 100 is a kludge. There is a bug in insert-in-front-hooks
863 ;; in Emacs < 19.23. When this is fixed, I will get rid of
864 ;; this kludge.
865 "Priority of non-selected overlays.")
866
867
868(if (ediff-if-lucid)
869 (progn
870 (fset 'ediff-overlayp (symbol-function 'extentp))
871 (fset 'ediff-make-overlay (symbol-function 'make-extent))
872 (fset 'ediff-delete-overlay (symbol-function 'delete-extent))
873 (fset 'ediff-overlay-put (symbol-function 'set-extent-property))
874 (fset 'ediff-move-overlay (symbol-function 'set-extent-endpoints))
875 (fset 'ediff-overlay-start (symbol-function 'extent-start-position))
876 (fset 'ediff-overlay-end (symbol-function 'extent-end-position))
877 (fset 'ediff-overlay-get (symbol-function 'extent-property)))
878 ;; GNU definitions
879 (fset 'ediff-overlayp (symbol-function 'overlayp))
880 (fset 'ediff-make-overlay (symbol-function 'make-overlay))
881 (fset 'ediff-delete-overlay (symbol-function 'delete-overlay))
882 (fset 'ediff-overlay-put (symbol-function 'overlay-put))
883 (fset 'ediff-move-overlay (symbol-function 'move-overlay))
884 (fset 'ediff-overlay-start (symbol-function 'overlay-start))
885 (fset 'ediff-overlay-end (symbol-function 'overlay-end))
886 (fset 'ediff-overlay-get (symbol-function 'overlay-get)))
887
888(if window-system
889 (if (ediff-if-lucid)
890 (progn
891 (fset 'ediff-select-frame (symbol-function 'select-screen))
892 (fset 'ediff-window-frame (symbol-function 'window-screen))
893 (fset 'ediff-display-color-p (symbol-function 'x-color-display-p))
894 (fset 'ediff-get-face (symbol-function 'get-face)))
895 (fset 'ediff-window-frame (symbol-function 'window-frame))
896 (fset 'ediff-select-frame (symbol-function 'select-frame))
897 (fset 'ediff-display-color-p (symbol-function 'x-display-color-p))
898 (fset 'ediff-get-face (symbol-function 'internal-get-face)))
899 ;; not a window system
900 (fset 'ediff-window-frame (function (lambda (wind) (if wind 1 nil)) ))
901 (fset 'ediff-select-frame (symbol-function 'identity))
902 (fset 'ediff-make-current-diff-overlay (function (lambda (type) nil)))
903 (fset 'ediff-unhighlight-diffs-totally (function (lambda () nil))))
904
905
906(if (not window-system)
907 ()
908 (defvar ediff-current-diff-face-A
909 (progn
910 (make-face 'ediff-current-diff-face-A)
911 (cond ((ediff-display-color-p)
912 (set-face-foreground 'ediff-current-diff-face-A "firebrick")
913 (set-face-background 'ediff-current-diff-face-A "pale green"))
914 (t
915 (if (ediff-if-lucid)
916 (copy-face 'modeline 'ediff-current-diff-face-A)
917 (copy-face 'highlight 'ediff-current-diff-face-A))
918 ))
919 (ediff-get-face 'ediff-current-diff-face-A))
920 "Face for highlighting the currently selected difference in buffer A of
921the Ediff display")
922
923 (defvar ediff-current-diff-face-B
924 (progn
925 (make-face 'ediff-current-diff-face-B)
926 (cond ((ediff-display-color-p)
927 (set-face-foreground 'ediff-current-diff-face-B "DarkOrchid")
928 (set-face-background 'ediff-current-diff-face-B "Yellow"))
929 (t
930 (if (ediff-if-lucid)
931 (copy-face 'modeline 'ediff-current-diff-face-B)
932 (copy-face 'highlight 'ediff-current-diff-face-B))
933 ))
934 (ediff-get-face 'ediff-current-diff-face-B))
935 "Face for highlighting the currently selected difference in buffer B of
936the Ediff display")
937
938 (defvar ediff-even-diff-face-A
939 (progn
940 (make-face 'ediff-even-diff-face-A)
941 (cond ((ediff-display-color-p)
942 (set-face-background 'ediff-even-diff-face-A "light grey"))
943 (t
944 (if (ediff-if-lucid)
945 (progn
946 (copy-face 'highlight 'ediff-even-diff-face-A)
947 (invert-face 'ediff-even-diff-face-A))
948 (make-face-italic 'ediff-even-diff-face-A))))
949 (ediff-get-face 'ediff-even-diff-face-A))
950 "Face used to highlight even-numbered differences in buffer A.")
951
952 (defvar ediff-even-diff-face-B
953 (progn
954 (make-face 'ediff-even-diff-face-B)
955 (cond ((ediff-display-color-p)
956 (set-face-foreground 'ediff-even-diff-face-B "White")
957 (set-face-background 'ediff-even-diff-face-B "Gray"))
958 (t
959 (if (ediff-if-lucid)
960 (copy-face 'highlight 'ediff-even-diff-face-B)
961 (make-face-italic 'ediff-even-diff-face-B))))
962 (ediff-get-face 'ediff-even-diff-face-B))
963 "Face used to highlight even-numbered differences in buffer B.")
964
965 (defvar ediff-odd-diff-face-A
966 (progn
967 (make-face 'ediff-odd-diff-face-A)
968 (cond ((ediff-display-color-p)
969 (set-face-foreground 'ediff-odd-diff-face-A "White")
970 (set-face-background 'ediff-odd-diff-face-A "Gray"))
971 (t
972 (if (ediff-if-lucid)
973 (copy-face 'highlight 'ediff-odd-diff-face-A)
974 (make-face-italic 'ediff-odd-diff-face-A))))
975 (ediff-get-face 'ediff-odd-diff-face-A))
976 "Face used to highlight odd-numbered differences in buffer A.")
977
978 (defvar ediff-odd-diff-face-B
979 (progn
980 (make-face 'ediff-odd-diff-face-B)
981 (cond ((ediff-display-color-p)
982 (set-face-foreground 'ediff-odd-diff-face-B "Black")
983 (set-face-background 'ediff-odd-diff-face-B "light grey"))
984 (t
985 (if (ediff-if-lucid)
986 (progn
987 (copy-face 'highlight 'ediff-odd-diff-face-B)
988 (invert-face 'ediff-odd-diff-face-B))
989 (make-face-italic 'ediff-odd-diff-face-B))))
990 (ediff-get-face 'ediff-odd-diff-face-B))
991 "Face used to highlight odd-numbered differences in buffer B.")
992
993
994 ;; Create *-var faces. These are the actual faces used to highlight
995 ;; odd-numbered difference regions.
996 ;; They are used as follows: when highlighting is turned on,
997 ;; ediff-odd/even-diff-face-A/B are copied
998 ;; into ediff-odd/even-diff-face-A/B-var, and all odd/even overlays become
999 ;; highlighted. When highlighting is turned off, then the face 'default is
1000 ;; copied into ediff-odd/even-diff-face-A/B-var, thereby unhighlighting all
1001 ;; difference regions.
1002 (make-face 'ediff-even-diff-face-A-var)
1003 (make-face 'ediff-even-diff-face-B-var)
1004 (make-face 'ediff-odd-diff-face-A-var)
1005 (make-face 'ediff-odd-diff-face-B-var)
1006
1007 ;; initialize *-var faces
1008 (defun ediff-init-var-faces ()
1009 (copy-face (if (and ediff-want-faces (null ediff-highlight-selected-only))
1010 ediff-even-diff-face-A 'default)
1011 'ediff-even-diff-face-A-var)
1012 (copy-face (if (and ediff-want-faces (null ediff-highlight-selected-only))
1013 ediff-even-diff-face-B 'default)
1014 'ediff-even-diff-face-B-var)
1015 (copy-face (if (and ediff-want-faces (null ediff-highlight-selected-only))
1016 ediff-odd-diff-face-A 'default)
1017 'ediff-odd-diff-face-A-var)
1018 (copy-face (if (and ediff-want-faces (null ediff-highlight-selected-only))
1019 ediff-odd-diff-face-B 'default)
1020 'ediff-odd-diff-face-B-var))
1021
1022
1023 ;;; Overlays
1024
1025 (emerge-defvar-local ediff-current-diff-overlay-A nil
1026 "Overlay in buffer A.")
1027 (emerge-defvar-local ediff-current-diff-overlay-B nil
1028 "Overlay in buffer B.")
1029
1030 (defun ediff-make-current-diff-overlay (type)
1031 (let ((overlay (if (eq type 'A)
1032 'ediff-current-diff-overlay-A
1033 'ediff-current-diff-overlay-B))
1034 (buffer (if (eq type 'A) ediff-A-buffer ediff-B-buffer))
1035 (face (if (eq type 'A)
1036 (face-name ediff-current-diff-face-A)
1037 (face-name ediff-current-diff-face-B))))
1038 (set overlay (ediff-make-overlay (point-max) (point-max) buffer))
1039 (ediff-overlay-put (eval overlay) 'face face)
1040 (ediff-overlay-put (eval overlay) 'ediff ediff-control-buffer)
1041 ))
1042
1043 ;; Computes priority of ediff overlay.
1044 (defun ediff-highest-priority (start end buffer)
1045 (let ((pos (max 1 (1- start)))
1046 ovr-list)
1047 (if (ediff-if-lucid)
1048 (+ 2 mouse-highlight-priority)
1049 (emerge-eval-in-buffer
1050 buffer
1051 (while (< pos (min (point-max) (1+ end)))
1052 (setq ovr-list (append (overlays-at pos) ovr-list))
1053 (setq pos (next-overlay-change pos)))
1054 (1+ (eval
1055 (cons '+
1056 (mapcar (function
1057 (lambda (ovr)
1058 (if ovr
1059 (or (ediff-overlay-get ovr 'priority) 0)
1060 0)))
1061 ovr-list)
1062 )))
1063 ))))
1064
1065) ; end of window-system-only code.
1066
1067
1068
1069;;; Misc
1070
1071(defvar ediff-split-window-function 'split-window-vertically
1072 "* The function to be called to divide the main window between buffer-A
1073and buffer-B. You can set it to be split horizontally instead of the
1074default verstical split by setting this variable to
1075'split-window-horizontally. You can also have your own function for fancy
1076splits. This variable has no effect when buffer-A and buffer-B are shown in
1077different frames. In this case, Ediff will use those frames to display
1078these buffers.")
1079
1080(defconst ediff-saved-variables
1081 '(buffer-read-only
1082 buffer-auto-save-file-name)
1083 "Variables and properties of a buffer which are saved, modified and restored
1084during an Ediff session.")
1085
1086(defconst ediff-working-values '(nil nil)
1087 "Values to be assigned to ediff-saved-variables during diff.")
1088
1089(defvar ediff-use-last-dir nil
1090 "* If t, Ediff will use last directory it had seen as a default
1091directory when prompting for file names.")
1092
1093(defvar ediff-nix-help-in-control-buffer nil
1094 "*Don't want C-h to invoke Emacs help. Instead, C-h will jump to previous
1095difference.")
1096
1097(defvar ediff-temp-file-prefix
1098 (let ((env (getenv "TMPDIR"))
1099 d)
1100 (setq d (if (and env (> (length env) 0))
1101 env
1102 "/tmp"))
1103 (if (= (aref d (1- (length d))) ?/)
1104 (setq d (substring d 0 -1)))
1105 (concat d "/ediff"))
1106 "*Prefix to put on Ediff temporary file names.
1107Do not start with `~/' or `~user-name/'.")
1108
1109(defvar ediff-temp-file-mode 384 ; u=rw only
1110 "*Mode for Ediff temporary files.")
1111
1112(defvar ediff-last-dir-A nil
1113 "Last directory used by an Ediff command for file-A.")
1114(defvar ediff-last-dir-B nil
1115 "Last directory used by an Ediff command for file-B.")
1116
1117;; Build keymaps
1118
1119(defvar ediff-mode-map nil
1120 "Local keymap used in Ediff mode.")
1121
1122
1123(defun ediff-setup-keymap ()
1124 "Set up the keymap used in the control buffer of Ediff."
1125 (setq ediff-mode-map (make-sparse-keymap))
1126 (suppress-keymap ediff-mode-map)
1127
1128 (define-key ediff-mode-map "p" 'ediff-previous-difference)
1129 (define-key ediff-mode-map "\C-?" 'ediff-previous-difference)
1130 (define-key ediff-mode-map "\C-h" (if ediff-nix-help-in-control-buffer
1131 'ediff-previous-difference nil))
1132 (define-key ediff-mode-map "n" 'ediff-next-difference)
1133 (define-key ediff-mode-map " " 'ediff-next-difference)
1134 (define-key ediff-mode-map "j" 'ediff-jump-to-difference)
1135 (define-key ediff-mode-map "g" nil)
1136 (define-key ediff-mode-map "ga" 'ediff-jump-to-difference-at-point)
1137 (define-key ediff-mode-map "gb" 'ediff-jump-to-difference-at-point)
1138 (define-key ediff-mode-map "q" 'ediff-quit)
1139 (define-key ediff-mode-map "z" 'ediff-suspend)
1140 (define-key ediff-mode-map "c" 'ediff-recenter)
1141 (define-key ediff-mode-map "s" 'ediff-toggle-split)
1142 (define-key ediff-mode-map "h" 'ediff-toggle-hilit)
1143 (define-key ediff-mode-map "v" 'ediff-scroll-up)
1144 (define-key ediff-mode-map "\C-v" 'ediff-scroll-up)
1145 (define-key ediff-mode-map "^" 'ediff-scroll-down)
1146 (define-key ediff-mode-map "\M-v" 'ediff-scroll-down)
1147 (define-key ediff-mode-map "V" 'ediff-scroll-down)
1148 (define-key ediff-mode-map "<" 'ediff-scroll-left)
1149 (define-key ediff-mode-map ">" 'ediff-scroll-right)
1150 (define-key ediff-mode-map "f" 'ediff-file-names)
1151 (define-key ediff-mode-map "l" 'ediff-line-numbers)
1152 (define-key ediff-mode-map "?" 'ediff-toggle-help)
1153 (define-key ediff-mode-map "a" nil)
1154 (define-key ediff-mode-map "ab" 'ediff-diff-to-diff)
1155 (define-key ediff-mode-map "b" nil)
1156 (define-key ediff-mode-map "ba" 'ediff-diff-to-diff)
1157 (define-key ediff-mode-map "r" nil)
1158 (define-key ediff-mode-map "ra" 'ediff-restore-diff)
1159 (define-key ediff-mode-map "rb" 'ediff-restore-diff)
1160 (define-key ediff-mode-map "o" nil)
1161 (define-key ediff-mode-map "A" 'ediff-toggle-read-only)
1162 (define-key ediff-mode-map "B" 'ediff-toggle-read-only)
1163 (define-key ediff-mode-map "w" nil)
1164 (define-key ediff-mode-map "wa" 'ediff-save-buffer)
1165 (define-key ediff-mode-map "wb" 'ediff-save-buffer)
1166 (define-key ediff-mode-map "k" nil)
1167 (define-key ediff-mode-map "kkk" 'ediff-reload-keymap) ;; for debug
1168 ;; Allow ediff-mode-map to be referenced indirectly
1169 (fset 'ediff-mode-map ediff-mode-map))
1170
1171
1172;;; Setup functions
1173
1174(defun ediff-find-file (file buffer &optional last-dir)
1175 "Visits FILE for ediff.
1176BUFFER is a variable symbol that is supposed to
1177get the buffer into which FILE is read. LAST-DIR is the directory variable
1178symbol where FILE's dir name should be returned.
1179Arguments: (file 'buffer &optional 'last-dir)"
1180 (if (not (file-readable-p file))
1181 (error "File `%s' does not exist or is not readable" file))
1182
1183 ;; Record the buffer
1184 (set buffer (find-file-noselect file))
1185 ;; Record the directory of the file
1186 (if last-dir
1187 (set last-dir (expand-file-name (file-name-directory file))))
1188
1189 ;; Make sure the entire file is seen, and it reflects what is on disk
1190 (emerge-eval-in-buffer
1191 (eval buffer)
1192 (widen)
1193 (let ((temp (file-local-copy file))
1194 startup-hooks)
1195 (if temp
1196 (setq file temp
1197 startup-hooks
1198 (cons (` (lambda () (delete-file (, file))))
1199 startup-hooks))
1200 ;; Verify that the file matches the buffer
1201 (emerge-verify-file-buffer)))))
1202
1203(defun ediff-files-internal (file-A file-B &optional startup-hooks)
1204 (let (buffer-A buffer-B)
1205 (message "Ediff: Reading file %s ... " file-A)(sit-for .5)
1206 (ediff-find-file file-A 'buffer-A 'ediff-last-dir-A)
1207 (message "Ediff: Reading file %s ... " file-B)(sit-for .5)
1208 (ediff-find-file file-B 'buffer-B 'ediff-last-dir-B)
1209 (ediff-setup buffer-A file-A buffer-B file-B startup-hooks)))
1210
1211(defun ediff-get-patch-buffer (dir)
1212 "Obtain patch buffer. If patch is already in a buffer---use it.
1213Else, read patch file into a new buffer."
1214 (if (y-or-n-p "Is the patch file already in a buffer? ")
1215 (setq ediff-patch-buf
1216 (get-buffer (read-buffer "Patch buffer name: " nil t))) ;must match
1217 (setq ediff-patch-buf
1218 (find-file-noselect (read-file-name "Patch file name: "
1219 dir))))
1220 (emerge-eval-in-buffer
1221 ediff-patch-buf
1222 (toggle-read-only 1))
1223 (setq ediff-patch-diagnostics
1224 (get-buffer-create "*ediff patch diagnostics*"))
1225 (emerge-eval-in-buffer
1226 ediff-patch-diagnostics
1227 (insert-buffer ediff-patch-buf))
1228 )
1229
1230;; Start up Ediff on two files
1231(defun ediff-setup (buffer-A file-A buffer-B file-B startup-hooks)
1232 (setq file-A (expand-file-name file-A))
1233 (setq file-B (expand-file-name file-B))
1234 (let* ((control-buffer-name (emerge-unique-buffer-name "*ediff-control" "*"))
1235 (control-buffer (emerge-eval-in-buffer
1236 buffer-A
1237 (get-buffer-create control-buffer-name))))
1238 (emerge-eval-in-buffer
1239 control-buffer
1240 (ediff-mode) ;; in control buffer only
1241 (setq buffer-read-only nil)
1242 (setq ediff-A-buffer buffer-A)
1243 (setq ediff-B-buffer buffer-B)
1244 (setq ediff-control-buffer control-buffer)
1245 (setq ediff-control-buffer-suffix
1246 (if (string-match "<[0-9]*>" control-buffer-name)
1247 (substring control-buffer-name
1248 (match-beginning 0) (match-end 0))
1249 "<1>"))
1250 (ediff-remember-buffer-characteristics t) ;; remember at setup
1251
1252 (ediff-set-keys)
1253 (setq ediff-difference-vector (ediff-make-diff-list file-A file-B))
1254 (setq ediff-number-of-differences (length ediff-difference-vector))
1255 (setq ediff-current-difference -1)
1256 (ediff-make-current-diff-overlay 'A)
1257 (ediff-make-current-diff-overlay 'B)
1258 (if window-system
1259 (ediff-init-var-faces))
1260 (run-hooks 'ediff-before-setup-windows-hooks)
1261 (ediff-setup-windows buffer-A buffer-B control-buffer t)
1262
1263 ;; all these must be inside emerge-eval-in-buffer control-buffer,
1264 ;; since these vars are local to control-buffer
1265 ;; These won't run if there are errors in diff
1266 (emerge-eval-in-buffer
1267 ediff-A-buffer
1268 (run-hooks 'ediff-prepare-buffer-hooks)
1269 (add-hook 'local-write-file-hooks 'ediff-block-write-file)
1270 (setq before-change-function 'ediff-before-change-guard)
1271 ;; add control-buffer to the list of sessions
1272 (or (memq control-buffer ediff-this-buffer-control-sessions)
1273 (setq ediff-this-buffer-control-sessions
1274 (cons control-buffer ediff-this-buffer-control-sessions)))
1275 (setq mode-line-buffer-identification '("A: %b")))
1276 (emerge-eval-in-buffer
1277 ediff-B-buffer
1278 (run-hooks 'ediff-prepare-buffer-hooks)
1279 (add-hook 'local-write-file-hooks 'ediff-block-write-file)
1280 (setq before-change-function 'ediff-before-change-guard)
1281 ;; add control-buffer to the list of sessions
1282 (or (memq control-buffer ediff-this-buffer-control-sessions)
1283 (setq ediff-this-buffer-control-sessions
1284 (cons control-buffer ediff-this-buffer-control-sessions)))
1285 (setq mode-line-buffer-identification '("B: %b")))
1286
1287 (emerge-eval-in-buffer control-buffer
1288 (run-hooks 'startup-hooks 'ediff-startup-hooks)
1289 (setq buffer-read-only t)))))
1290
1291;; Generate the Ediff difference list between two files
1292(defun ediff-make-diff-list (file-A file-B)
1293 (setq ediff-diff-buffer
1294 (get-buffer-create (emerge-unique-buffer-name "*ediff-diff" "*")))
1295 (emerge-eval-in-buffer
1296 ediff-diff-buffer
1297 (erase-buffer)
1298 ;; shell-command tends to display old shell command buffers even when it
1299 ;; puts output in another buffer---probably an Emacs bug.
1300 (ediff-kill-buffer-carefully "*Shell Command Output*")
1301 (let ((shell-file-name ediff-shell))
1302 (message "Ediff: Computing differences ...")(sit-for .5)
1303 (shell-command
1304 (format "%s %s %s %s"
1305 ediff-diff-program ediff-diff-options
1306 (emerge-protect-metachars file-A)
1307 (emerge-protect-metachars file-B))
1308 t)
1309 ))
1310 (ediff-prepare-error-list ediff-diff-ok-lines-regexp)
1311 (message "Ediff: Computing differences ... Done.")(sit-for .5)
1312 (ediff-convert-diffs-to-overlays
1313 ediff-A-buffer ediff-B-buffer
1314 (ediff-extract-diffs ediff-diff-buffer ediff-A-buffer ediff-B-buffer)))
1315
1316(defun ediff-prepare-error-list (ok-regexp)
1317 (let ((diff-buff ediff-diff-buffer))
1318 (setq ediff-diff-error-buffer
1319 (get-buffer-create (emerge-unique-buffer-name
1320 "*ediff-diff-errors" "*")))
1321 (emerge-eval-in-buffer
1322 ediff-diff-error-buffer
1323 (erase-buffer)
1324 (insert-buffer diff-buff)
1325 (delete-matching-lines ok-regexp))))
1326
1327;;; Function to start Ediff by patching a file
1328
1329;;;###autoload
1330(defun ediff-patch-file (file-to-patch &optional startup-hooks)
1331 "Run Ediff by patching FILE-TP-PATCH."
1332 (interactive "fFile to patch: ")
1333
1334 (ediff-get-patch-buffer (file-name-directory file-to-patch))
1335 (let ((buf (get-file-buffer file-to-patch)))
1336 (if buf
1337 (progn
1338 (emerge-eval-in-buffer
1339 buf
1340 (if (buffer-modified-p buf)
1341 (if (y-or-n-p
1342 (format
1343 "File '%s' is already in buffer %s. Save before killing? "
1344 file-to-patch (buffer-name buf)))
1345 (save-buffer buf)))
1346 (set-buffer-modified-p nil))
1347 (ediff-kill-buffer-carefully buf))))
1348 (emerge-eval-in-buffer
1349 ediff-patch-diagnostics
1350 (let ((shell-file-name ediff-shell))
1351 (message "Ediff: Applying patch ... ")(sit-for .5)
1352 (shell-command-on-region
1353 (point-min) (point-max)
1354 (format "%s %s %s"
1355 ediff-patch-program ediff-patch-options
1356 (expand-file-name file-to-patch))
1357 t)
1358 (message "Ediff: Applying patch ... Done.")(sit-for .5)
1359 ))
1360 (switch-to-buffer ediff-patch-diagnostics)
1361 (sit-for 0) ;; synchronize
1362
1363 (setq startup-hooks (cons 'ediff-toggle-read-only-A startup-hooks))
1364 (ediff-files (format "%s.orig" file-to-patch) file-to-patch startup-hooks)
1365
1366 (bury-buffer ediff-patch-diagnostics)
1367 (message "Patch diagnostics available in buffer %s."
1368 (buffer-name ediff-patch-diagnostics)))
1369
1370(defalias 'epatch 'ediff-patch-file)
1371
1372;;; Function to start Ediff on files
1373
1374;;;###autoload
1375(defun ediff-files (file-A file-B &optional startup-hooks)
1376 "Run Ediff on a pair files, FILE-A and FILE-B."
1377 (interactive
1378 (let (f)
1379 (list (setq f (ediff-read-file-name "File A to compare"
1380 (if ediff-use-last-dir
1381 ediff-last-dir-A
1382 default-directory)
1383 nil nil))
1384 (ediff-read-file-name "File B to compare"
1385 (if ediff-use-last-dir
1386 ediff-last-dir-B nil)
1387 f f)
1388 )))
1389 (ediff-files-internal file-A file-B startup-hooks))
1390
1391
1392(defalias 'ediff 'ediff-files)
1393
1394
1395;;; Function to start Ediff on buffers
1396
1397;;;###autoload
1398(defun ediff-buffers (buffer-A buffer-B &optional startup-hooks)
1399 "Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B."
1400 (interactive "bBuffer A to compare: \nbBuffer B to compare: ")
1401 (let (ediff-file-A ediff-file-B)
1402 (emerge-eval-in-buffer
1403 buffer-A
1404 (setq ediff-file-A
1405 (ediff-make-temp-file
1406 (format ".%s." (file-name-nondirectory (buffer-name)))))
1407 (write-region (point-min) (point-max) ediff-file-A nil 'no-message))
1408 (emerge-eval-in-buffer
1409 buffer-B
1410 (setq ediff-file-B
1411 (ediff-make-temp-file
1412 (format ".%s." (file-name-nondirectory (buffer-name)))))
1413 (write-region (point-min) (point-max) ediff-file-B nil 'no-message))
1414 (ediff-setup (get-buffer buffer-A) ediff-file-A
1415 (get-buffer buffer-B) ediff-file-B
1416 (cons (` (lambda ()
1417 (delete-file (, ediff-file-A))
1418 (delete-file (, ediff-file-B))))
1419 startup-hooks)
1420 )))
1421
1422;;;###autoload
1423(defun ediff-patch-buffer (buffer-name &optional startup-hooks)
1424 "Run Ediff by patching BUFFER-NAME."
1425 (interactive "bBuffer to patch: ")
1426
1427 (let* ((file-buffer (get-buffer buffer-name))
1428 (file-name (if file-buffer (buffer-file-name file-buffer))))
1429 (if (not file-name)
1430 (error "Buffer %s doesn't exist or doesn't visit any file. Why patch?"
1431 file-name))
1432
1433 (ediff-patch-file file-name startup-hooks)))
1434
1435
1436;;; Versions Control functions
1437
1438;;;###autoload
1439(defun vc-ediff (rev)
1440 "Run ediff on version REV of the current buffer in another window.
1441If the current buffer is named `F', the version is named `F.~REV~'.
1442If `F.~REV~' already exists, it is used instead of being re-created.
1443Note: this function will work starting with GNU Emacs 19.22."
1444 (interactive "sVersion to ediff with (default is the latest version): ")
1445 (or (featurep 'vc)
1446 (if (locate-library "vc") ;; if vc.el is available
1447 (progn
1448 (require 'vc-hooks)
1449 (define-key vc-prefix-map "=" 'vc-ediff))
1450 (error "The VC package is apparently not installed.")))
1451 (let ((newvers (current-buffer))
1452 (oldvers (vc-version-other-window rev)))
1453 (ediff-buffers newvers oldvers)
1454 ))
1455
1456(defun rcs-ediff-view-revision (&optional rev)
1457 "View previous RCS revison of current file.
1458With prefix argument, prompts for a revision name."
1459 (interactive (list (if current-prefix-arg
1460 (read-string "Revision: "))))
1461 (let* ((filename (buffer-file-name (current-buffer)))
1462 (switches (append '("-p")
1463 (if rev (list (concat "-r" rev)) nil)))
1464 (buff (concat (file-name-nondirectory filename) ".~" rev "~")))
1465 (message "Working...")
1466 (setq filename (expand-file-name filename))
1467 (with-output-to-temp-buffer
1468 buff
1469 (let ((output-buffer (rcs-get-output-buffer filename buff)))
1470 (delete-windows-on output-buffer)
1471 (save-excursion
1472 (set-buffer output-buffer)
1473 (apply 'call-process "co" nil t nil
1474 ;; -q: quiet (no diagnostics)
1475 (append switches rcs-default-co-switches
1476 (list "-q" filename)))))
1477 (message "")
1478 buff)))
1479
1480;;;###autoload
1481(defun rcs-ediff (&optional rev)
1482 "Run Ediff on the current buffer, comparing it with previous RCS revison.
1483With prefix argument, prompts for revision name."
1484 (interactive (list (if current-prefix-arg
1485 (read-string "Revision: "))))
1486 (or (featurep 'rcs)
1487 (if (locate-library "rcs")
1488 (progn
1489 (require 'rcs)
1490 (global-set-key "\C-cD" 'rcs-ediff))
1491 (error "The RCS package is apparently not installed.")))
1492 (let ((newvers (current-buffer))
1493 (oldvers (rcs-ediff-view-revision rev)))
1494 (ediff-buffers newvers oldvers)
1495 ))
1496
1497
1498;;; Functions to start Ediff via remote request
1499
1500;;;###autoload
1501(defun ediff-files-remote (file-a file-b)
1502 "Run Ediff on remote files, FILE-A and FILE-B."
1503 (ediff-files-internal file-a file-b nil)
1504 (throw 'client-wait nil))
1505
1506
1507(defun ediff-remote-exit (exit-func)
1508 "Exit remote Ediff session."
1509 (ediff-really-quit)
1510 (funcall exit-func))
1511
1512
1513
1514;; Select the lowest window on the frame.
1515(defun ediff-select-lowest-window ()
1516 (let* ((lowest-window (selected-window))
1517 (bottom-edge (car (cdr (cdr (cdr (window-edges))))))
1518 (last-window (previous-window))
1519 (window-search t))
1520 (while window-search
1521 (let* ((this-window (next-window))
1522 (next-bottom-edge (car (cdr (cdr (cdr
1523 (window-edges this-window)))))))
1524 (if (< bottom-edge next-bottom-edge)
1525 (progn
1526 (setq bottom-edge next-bottom-edge)
1527 (setq lowest-window this-window)))
1528
1529 (select-window this-window)
1530 (if (eq last-window this-window)
1531 (progn
1532 (select-window lowest-window)
1533 (setq window-search nil)))))))
1534
1535;;; Common setup routines
1536
1537;; Set up the window configuration. If POS is given, set the points to
1538;; the beginnings of the buffers.
1539(defun ediff-setup-windows (buffer-A buffer-B control-buffer &optional pos)
1540 ;; Make sure we are not in the minibuffer window when we try to delete
1541 ;; all other windows.
1542 (if (eq (selected-window) (minibuffer-window))
1543 (other-window 1))
1544 (delete-other-windows)
1545 (switch-to-buffer control-buffer)
1546 (ediff-refresh-mode-line)
1547
1548 (ediff-arrange-buffer buffer-A buffer-B (current-buffer) pos)
1549 (ediff-arrange-buffer buffer-B buffer-A (current-buffer) pos)
1550 ;; ediff-arrange-buffer always leaves in ctl buffer
1551 ;; setup ctl wind if it is not set.
1552 (ediff-setup-control-window)
1553
1554 ;; If diff reports errors, display them rather than then compare buffers.
1555 (if (/= 0 (emerge-eval-in-buffer ediff-diff-error-buffer (buffer-size)))
1556 (let ((diff-output-buf ediff-diff-buffer))
1557 (switch-to-buffer ediff-diff-error-buffer)
1558 (ediff-kill-buffer-carefully control-buffer)
1559 (error "Errors found in diff output. Diff output buffer is %s"
1560 diff-output-buf))))
1561
1562
1563;; Arranges goal-buf on the screen.
1564(defun ediff-arrange-buffer (goal-buf other-buf ctl-buf &optional pos)
1565 (let* ((ctl-wind (get-buffer-window ctl-buf t))
1566 (goal-wind (get-buffer-window goal-buf t))
1567 (other-wind (get-buffer-window other-buf t))
1568 (ctl-frame (ediff-window-frame ctl-wind))
1569 (goal-frame (if goal-wind (ediff-window-frame goal-wind)))
1570 (other-frame (if other-wind (ediff-window-frame other-wind)))
1571 (ctl-frame-shared (or (eq ctl-frame goal-frame)
1572 (eq ctl-frame other-frame))))
1573
1574 (cond ((and goal-frame (not (eq goal-wind other-wind)))
1575 ;; goal buffer is visible and we are not comparing file
1576 ;; against itself (by mistake).
1577 ;; Note: goal-frame != ctl-frame, as we deleted other
1578 ;; windows on ctl-frame.
1579 (ediff-select-frame goal-frame)
1580 (select-window goal-wind)
1581 (delete-other-windows))
1582
1583 ;; goal-buf invisible, ctl-frame has only ctl-buf
1584 ;; then put goal-buf on ctl-frame
1585 ((null ctl-frame-shared)
1586 (ediff-select-frame ctl-frame)
1587 (split-window-vertically)
1588 (ediff-select-lowest-window)
1589 (setq ctl-wind (selected-window))
1590 (switch-to-buffer ctl-buf)
1591 (ediff-setup-control-window)
1592 (other-window 1)
1593 (switch-to-buffer goal-buf)) ; goal-buf set
1594 ;; goal-buf invisible, ctl-frame has ctl-buf and other-buf
1595 ;; So, put everything in one frame
1596 (other-frame ;; share with the other buf
1597 (ediff-select-frame ctl-frame)
1598 (select-window other-wind)
1599 (funcall ediff-split-window-function)
1600 (other-window 1)
1601 (switch-to-buffer goal-buf))
1602 (t ;; debug
1603 (error "Funny window combination (Ediff bug?)")))
1604
1605 (if pos
1606 (goto-char (point-min)))
1607
1608 (ediff-select-frame ctl-frame)
1609 (select-window ctl-wind)
1610 (switch-to-buffer ctl-buf)))
1611
1612;; This function assumes that we are in the window where control buffer is
1613;; to reside.
1614(defun ediff-setup-control-window ()
1615 "Set up window for control buffer."
1616 (erase-buffer)
1617 (insert ediff-help-message)
1618 (shrink-window-if-larger-than-buffer)
1619 (setq ediff-control-window (selected-window))
1620 (goto-char (point-min))
1621 (skip-chars-forward " \t\n"))
1622
1623
1624;; Set up the keymap in the control buffer
1625(defun ediff-set-keys ()
1626 "Set up Ediff keymap, if necessary."
1627 (if (null ediff-mode-map)
1628 (ediff-setup-keymap))
1629 (use-local-map ediff-mode-map))
1630
1631;; Reload Ediff keymap. For debugging only.
1632(defun ediff-reload-keymap ()
1633 (interactive)
1634 (setq ediff-mode-map nil)
1635 (ediff-set-keys))
1636
1637(defun ediff-before-change-guard (start end)
1638 "If buffer is highlighted with ASCII flags, remove highlighting before
1639changing buf. Arguments, START and END are not used, but are provided
1640because this is required by ``before-change-function''."
1641 (let (notify)
1642 (save-window-excursion
1643 (mapcar
1644 (function
1645 (lambda (buf)
1646 (if (ediff-buffer-live-p buf)
1647 (emerge-eval-in-buffer
1648 buf
1649 (if (eq ediff-highlighting-style 'ascii)
1650 (progn
1651 (ediff-unselect-and-select-difference
1652 ediff-current-difference
1653 'unselect-only 'no-recenter)
1654 (setq notify t)
1655 ))))))
1656 ediff-this-buffer-control-sessions)
1657 (if notify
1658 (error "ASCII flags removed. You can edit now. Hit 'c' to rehighlight."))
1659 )))
1660
1661
1662(defun ediff-remember-buffer-characteristics (&optional arg)
1663 "Record certain properties of the buffers being compared.
1664Must be called in the control buffer. Saves ``read-only'', ``modified'',
1665and ``auto-save'' properties in buffer local variables. Turns off
1666``auto-save-mode''. These properties are restored via a call to
1667``ediff-restore-buffer-characteristics''."
1668
1669 ;; remember and alter buffer characteristics
1670 (set (if arg 'ediff-A-buffer-values-setup 'ediff-A-buffer-values)
1671 (emerge-eval-in-buffer
1672 ediff-A-buffer
1673 (prog1
1674 (emerge-save-variables ediff-saved-variables)
1675 (emerge-restore-variables ediff-saved-variables
1676 ediff-working-values))))
1677 (set (if arg 'ediff-B-buffer-values-setup 'ediff-B-buffer-values)
1678 (emerge-eval-in-buffer
1679 ediff-B-buffer
1680 (prog1
1681 (emerge-save-variables ediff-saved-variables)
1682 (emerge-restore-variables ediff-saved-variables
1683 ediff-working-values)))))
1684
1685(defun ediff-restore-buffer-characteristics (&optional arg)
1686 "Restores properties saved by ``ediff-remember-buffer-characteristics''."
1687 (let ((A-values (if arg ediff-A-buffer-values-setup ediff-A-buffer-values))
1688 (B-values (if arg ediff-B-buffer-values-setup ediff-B-buffer-values)))
1689 (emerge-eval-in-buffer ediff-A-buffer
1690 (emerge-restore-variables ediff-saved-variables
1691 A-values))
1692 (emerge-eval-in-buffer ediff-B-buffer
1693 (emerge-restore-variables ediff-saved-variables
1694 B-values))))
1695
1696
1697(defun ediff-extract-diffs (diff-buffer A-buffer B-buffer)
1698 (let (diff-list
1699 (a-prev 1) ;; this is needed to set the first diff line correctly
1700 (b-prev 1))
1701 (emerge-eval-in-buffer
1702 A-buffer
1703 (goto-char (point-min)))
1704 (emerge-eval-in-buffer
1705 B-buffer
1706 (goto-char (point-min)))
1707 (emerge-eval-in-buffer
1708 diff-buffer
1709 (goto-char (point-min))
1710 (while (re-search-forward ediff-match-diff-line nil t)
1711 (let* ((a-begin (string-to-int (buffer-substring (match-beginning 1)
1712 (match-end 1))))
1713 (a-end (let ((b (match-beginning 3))
1714 (e (match-end 3)))
1715 (if b
1716 (string-to-int (buffer-substring b e))
1717 a-begin)))
1718 (diff-type (buffer-substring (match-beginning 4) (match-end 4)))
1719 (b-begin (string-to-int (buffer-substring (match-beginning 5)
1720 (match-end 5))))
1721 (b-end (let ((b (match-beginning 7))
1722 (e (match-end 7)))
1723 (if b
1724 (string-to-int (buffer-substring b e))
1725 b-begin)))
1726 a-begin-pt a-end-pt b-begin-pt b-end-pt)
1727 ;; fix the beginning and end numbers, because diff is somewhat
1728 ;; strange about how it numbers lines
1729 (if (string-equal diff-type "a")
1730 (setq b-end (1+ b-end)
1731 a-begin (1+ a-begin)
1732 a-end a-begin)
1733 (if (string-equal diff-type "d")
1734 (setq a-end (1+ a-end)
1735 b-begin (1+ b-begin)
1736 b-end b-begin)
1737 ;; (string-equal diff-type "c")
1738 (setq a-end (1+ a-end)
1739 b-end (1+ b-end))))
1740 ;; convert to relative line numbers
1741 (emerge-eval-in-buffer
1742 A-buffer
1743 (forward-line (- a-begin a-prev))
1744 (setq a-begin-pt (point))
1745 (forward-line (- a-end a-begin))
1746 (setq a-end-pt (point)
1747 a-prev a-end))
1748 (emerge-eval-in-buffer
1749 B-buffer
1750 (forward-line (- b-begin b-prev))
1751 (setq b-begin-pt (point))
1752 (forward-line (- b-end b-begin))
1753 (setq b-end-pt (point)
1754 b-prev b-end))
1755 (setq diff-list (nconc diff-list (list (vector a-begin-pt a-end-pt
1756 b-begin-pt b-end-pt))))
1757 )))
1758 diff-list
1759 ))
1760
1761(defun ediff-convert-diffs-to-overlays (A-buffer B-buffer diff-list)
1762 (let* ((current-diff -1)
1763 (total-diffs (length diff-list))
1764 (control-buffer-suffix ediff-control-buffer-suffix)
1765 diff-overlay-list list-element
1766 a-begin a-end b-begin b-end
1767 a-overlay b-overlay)
1768
1769 (while diff-list
1770 (setq current-diff (1+ current-diff)
1771 list-element (car diff-list)
1772 a-begin (aref list-element 0)
1773 a-end (aref list-element 1)
1774 b-begin (aref list-element 2)
1775 b-end (aref list-element 3))
1776
1777 ;; place overlays at the appropriate places in the buffers
1778 (setq a-overlay (ediff-make-overlay a-begin a-end A-buffer))
1779 ;; priority of a-overlay and b-overlay should be equal. otherwise it
1780 ;; won't work due to Emacs bug---insert-in-front-hooks will be called
1781 ;; only on behalf of the buffer with higher priority.
1782 (ediff-overlay-put a-overlay 'priority ediff-shaded-overlay-priority)
1783 (ediff-overlay-put a-overlay 'ediff-diff-num current-diff)
1784 (ediff-overlay-put a-overlay
1785 'insert-in-front-hooks '(ediff-insert-in-front))
1786 (ediff-overlay-put a-overlay
1787 'ediff-control-buffer control-buffer-suffix)
1788 (ediff-overlay-put a-overlay
1789 'face (if (ediff-odd-p current-diff) ;; odd diff
1790 'ediff-odd-diff-face-A-var
1791 'ediff-even-diff-face-A-var))
1792
1793 (setq b-overlay (ediff-make-overlay b-begin b-end B-buffer))
1794 (ediff-overlay-put b-overlay 'priority ediff-shaded-overlay-priority)
1795 (ediff-overlay-put b-overlay 'ediff-diff-num current-diff)
1796 (ediff-overlay-put b-overlay
1797 'insert-in-front-hooks '(ediff-insert-in-front))
1798 (ediff-overlay-put b-overlay
1799 'ediff-control-buffer control-buffer-suffix)
1800 (ediff-overlay-put b-overlay
1801 'face (if (ediff-odd-p current-diff) ;; odd diff
1802 'ediff-odd-diff-face-B-var
1803 'ediff-even-diff-face-B-var))
1804
1805 (if (ediff-if-lucid) ;; chars inserted at end will be inside extent
1806 (progn
1807 (ediff-overlay-put a-overlay
1808 'ediff-marker
1809 (move-marker (make-marker) a-begin A-buffer))
1810 (ediff-overlay-put b-overlay
1811 'ediff-marker
1812 (move-marker (make-marker) b-begin B-buffer))
1813 (ediff-overlay-put a-overlay 'end-open nil)
1814 (ediff-overlay-put b-overlay 'end-open nil)))
1815
1816 ;; record all overlays for this difference
1817 (setq diff-overlay-list
1818 (nconc diff-overlay-list (list (vector a-overlay b-overlay)))
1819 diff-list (cdr diff-list))
1820 (message "Ediff: Processing diff region %d of %d"
1821 current-diff total-diffs)
1822 ) ;; while
1823 ;; this is just to avoid confusing the user with diff num < total-diffs
1824 (message "Ediff: Processing diff region %d of %d"
1825 (1+ current-diff) total-diffs)
1826 ;; convert the list of difference information into a vector for
1827 ;; fast access
1828 (setq ediff-difference-vector
1829 (apply 'vector diff-overlay-list))))
1830
1831
1832
1833;;; Commands
1834
1835(defun ediff-recenter (&optional no-rehighlight)
1836 "Bring the highlighted region of all buffers A and B into view.
1837Reestablish the default three-window display."
1838 (interactive)
1839 (setq ediff-disturbed-overlays nil) ;; clear after use
1840 (let (buffer-read-only)
1841 (ediff-setup-windows ediff-A-buffer ediff-B-buffer ediff-control-buffer))
1842 ;; Redisplay whatever buffers are showing, if there is a selected difference
1843 (if (and (>= ediff-current-difference 0)
1844 (< ediff-current-difference ediff-number-of-differences))
1845 (let* ( ;; context must be saved before switching to windows A/B
1846 (buffer-A ediff-A-buffer)
1847 (buffer-B ediff-B-buffer)
1848 (wind (selected-window))
1849 (control-buf ediff-control-buffer)
1850 (before-flag-shift-A (if (eq ediff-highlighting-style 'ascii)
1851 (1- (length ediff-before-flag-A))
1852 0))
1853 (after-flag-shift-A (if (eq ediff-highlighting-style 'ascii)
1854 (1- (length ediff-after-flag-A))
1855 0))
1856 (before-flag-shift-B (if (eq ediff-highlighting-style 'ascii)
1857 (1- (length ediff-before-flag-B))
1858 0))
1859 (after-flag-shift-B (if (eq ediff-highlighting-style 'ascii)
1860 (1- (length ediff-after-flag-B))
1861 0))
1862 (window-A (get-buffer-window buffer-A t))
1863 (window-B (get-buffer-window buffer-B t)))
1864
1865 (or no-rehighlight
1866 (ediff-operate-on-flags 'insert))
1867
1868 (if window-A (progn
1869 (select-window window-A)
1870 (ediff-position-region
1871 (- (ediff-get-diff-posn 'A 'beg nil control-buf)
1872 before-flag-shift-A)
1873 (+ (ediff-get-diff-posn 'A 'end nil control-buf)
1874 after-flag-shift-A)
1875 (ediff-get-diff-posn 'A 'beg nil control-buf))))
1876 (if window-B (progn
1877 (select-window window-B)
1878 (ediff-position-region
1879 (- (ediff-get-diff-posn 'B 'beg nil control-buf)
1880 before-flag-shift-B)
1881 (+ (ediff-get-diff-posn 'B 'end nil control-buf)
1882 after-flag-shift-B)
1883 (ediff-get-diff-posn 'B 'beg nil control-buf))))
1884 (select-window wind))))
1885
1886(defun ediff-toggle-split ()
1887 "Toggle vertical/horizontal window split.
1888Does nothing if file-A and file-B are in different frames."
1889 (interactive)
1890 (let* ((wind-A (get-buffer-window ediff-A-buffer t))
1891 (wind-B (get-buffer-window ediff-B-buffer t))
1892 (frame-A (if wind-A (ediff-window-frame wind-A)))
1893 (frame-B (if wind-B (ediff-window-frame wind-B))))
1894 (if (eq frame-A frame-B)
1895 (setq ediff-split-window-function
1896 (if (eq ediff-split-window-function 'split-window-vertically)
1897 'split-window-horizontally
1898 'split-window-vertically))
1899 (message "Buffers A and B are residing in different frames. Why split?"))
1900 (ediff-recenter 'no-rehighlight)))
1901
1902(defun ediff-toggle-hilit ()
1903 "Switch between highlighting using ASCII flags and highlighting using faces.
1904On a dumb terminal, switches between ASCII highlighting and no highlighting."
1905 (interactive)
1906 (if (not window-system)
1907 (if (eq ediff-highlighting-style 'ascii)
1908 (progn
1909 (message "ASCII highlighting flags removed.")
1910 (ediff-unselect-and-select-difference ediff-current-difference
1911 'unselect-only)
1912 (setq ediff-highlighting-style 'off))
1913 (ediff-unselect-and-select-difference ediff-current-difference
1914 'select-only))
1915 (ediff-unselect-and-select-difference ediff-current-difference
1916 'unselect-only)
1917 ;; cycle through highlighting
1918 (cond ((and ediff-want-faces (null ediff-highlight-selected-only))
1919 (message "Ediff: Unhighlighted unselected difference regions.")
1920 (setq ediff-highlight-selected-only t))
1921 (ediff-want-faces
1922 (message "Ediff: Now using ASCII flags only.")
1923 (setq ediff-want-faces nil))
1924 (t
1925 (message "Ediff: Re-highlighted all difference regions.")
1926 (setq ediff-want-faces t
1927 ediff-highlight-selected-only nil)))
1928
1929 (if (and ediff-want-faces (null ediff-highlight-selected-only))
1930 (if (not (face-differs-from-default-p 'ediff-odd-diff-face-A-var))
1931 (progn
1932 (copy-face ediff-odd-diff-face-A 'ediff-odd-diff-face-A-var)
1933 (copy-face ediff-odd-diff-face-B 'ediff-odd-diff-face-B-var)
1934 (copy-face ediff-even-diff-face-A 'ediff-even-diff-face-A-var)
1935 (copy-face ediff-even-diff-face-B 'ediff-even-diff-face-B-var)))
1936 (copy-face 'default 'ediff-odd-diff-face-A-var)
1937 (copy-face 'default 'ediff-odd-diff-face-B-var)
1938 (copy-face 'default 'ediff-even-diff-face-A-var)
1939 (copy-face 'default 'ediff-even-diff-face-B-var))
1940
1941 (ediff-unselect-and-select-difference
1942 ediff-current-difference 'select-only))
1943 (ediff-operate-on-flags 'insert)
1944 )
1945
1946(defun ediff-toggle-help ()
1947 "Toggle short/long help message."
1948 (interactive)
1949 (let (buffer-read-only)
1950 (erase-buffer)
1951 (if (string= ediff-help-message ediff-help-message-long)
1952 (setq ediff-help-message ediff-help-message-short)
1953 (setq ediff-help-message ediff-help-message-long)))
1954 (ediff-recenter 'no-rehighlight))
1955
1956
1957(defun ediff-toggle-read-only-A ()
1958 "Used as a startup hook to set `.orig' patch file read-only."
1959 (let ((last-command-char ?A))
1960 (ediff-toggle-read-only)))
1961
1962(defun ediff-toggle-read-only ()
1963 "Toggles buffer-read-only for buffer buffers A and B."
1964 (interactive)
1965 (emerge-eval-in-buffer
1966 (if (eq last-command-char ?A) ediff-A-buffer ediff-B-buffer)
1967 (setq buffer-read-only (null buffer-read-only))))
1968
1969;;; Window scrolling operations
1970;; These operations are designed to scroll all three windows the same amount,
1971;; so as to keep the text in them aligned.
1972
1973;; Perform some operation on two file windows (if they are showing).
1974;; Catches all errors on the operation in the A and B windows.
1975;; Usually, errors come from scrolling off the
1976;; beginning or end of the buffer, and this gives nice nice error messages.
1977(defun ediff-operate-on-windows (operation arg)
1978 (let* ((buffer-A ediff-A-buffer)
1979 (buffer-B ediff-B-buffer)
1980 (wind (selected-window))
1981 (window-A (get-buffer-window buffer-A t))
1982 (window-B (get-buffer-window buffer-B t)))
1983 (if window-A (progn
1984 (select-window window-A)
1985 (condition-case nil
1986 (funcall operation arg)
1987 (error))))
1988 (if window-B (progn
1989 (select-window window-B)
1990 (condition-case nil
1991 (funcall operation arg)
1992 (error))))
1993 (select-window wind)
1994 ))
1995
1996(defun ediff-scroll-up (&optional arg)
1997 "Scroll up buffers A and B, if they are in windows.
1998With optional argument ARG, scroll ARG lines; otherwise scroll by nearly
1999the height of window-A."
2000 (interactive "P")
2001 (ediff-operate-on-windows
2002 'scroll-up
2003 ;; calculate argument to scroll-up
2004 ;; if there is an explicit argument
2005 (if (and arg (not (equal arg '-)))
2006 ;; use it
2007 (prefix-numeric-value arg)
2008 ;; if not, see if we can determine a default amount (the window height)
2009 (let* ((window-A (get-buffer-window ediff-A-buffer t))
2010 (window-B (get-buffer-window ediff-B-buffer t))
2011 default-amount)
2012 (if (or (null window-A) (null window-B))
2013 (setq default-amount 0)
2014 (setq default-amount
2015 (- (min (window-height window-A) (window-height window-B))
2016 1 next-screen-context-lines)))
2017 ;; the window was found
2018 (if arg
2019 ;; C-u as argument means half of default amount
2020 (/ default-amount 2)
2021 ;; no argument means default amount
2022 default-amount)))))
2023
2024(defun ediff-scroll-down (&optional arg)
2025 "Scroll down buffers A and B, if they are in windows.
2026With optional argument ARG, scroll ARG lines; otherwise scroll by nearly
2027the height of window-A."
2028 (interactive "P")
2029 (ediff-operate-on-windows
2030 'scroll-down
2031 ;; calculate argument to scroll-down
2032 ;; if there is an explicit argument
2033 (if (and arg (not (equal arg '-)))
2034 ;; use it
2035 (prefix-numeric-value arg)
2036 ;; if not, see if we can determine a default amount (the window height)
2037 (let* ((window-A (get-buffer-window ediff-A-buffer t))
2038 (window-B (get-buffer-window ediff-B-buffer t))
2039 default-amount)
2040 (if (or (null window-A) (null window-B))
2041 (setq default-amount 0)
2042 (setq default-amount
2043 (- (min (window-height window-A) (window-height window-B))
2044 1 next-screen-context-lines)))
2045 ;; the window was found
2046 (if arg
2047 ;; C-u as argument means half of default amount
2048 (/ default-amount 2)
2049 ;; no argument means default amount
2050 default-amount)))))
2051
2052(defun ediff-scroll-left (&optional arg)
2053 "Scroll left buffer-A and buffer-B, if they are in windows.
2054If an argument is given, that is how many columns are scrolled, else nearly
2055the width of the A and B windows."
2056 (interactive "P")
2057 (ediff-operate-on-windows
2058 'scroll-left
2059 ;; calculate argument to scroll-left
2060 ;; if there is an explicit argument
2061 (if (and arg (not (equal arg '-)))
2062 ;; use it
2063 (prefix-numeric-value arg)
2064 ;; if not, see if we can determine a default amount
2065 ;; (half the window width)
2066 (if (null ediff-control-window)
2067 ;; no control window, use nil
2068 nil
2069 (let ((default-amount
2070 (- (/ (window-width ediff-control-window) 2) 3)))
2071 ;; the window was found
2072 (if arg
2073 ;; C-u as argument means half of default amount
2074 (/ default-amount 2)
2075 ;; no argument means default amount
2076 default-amount))))))
2077
2078(defun ediff-scroll-right (&optional arg)
2079 "Scroll right buffer-A and buffer-B, if they are in windows.
2080If an argument is given, that is how many columns are scrolled, else nearly
2081the width of the A and B windows."
2082 (interactive "P")
2083 (ediff-operate-on-windows
2084 'scroll-right
2085 ;; calculate argument to scroll-right
2086 ;; if there is an explicit argument
2087 (if (and arg (not (equal arg '-)))
2088 ;; use it
2089 (prefix-numeric-value arg)
2090 ;; if not, see if we can determine a default amount
2091 ;; (half the window width)
2092 (if (null ediff-control-window)
2093 ;; no control window, use nil
2094 nil
2095 (let ((default-amount
2096 (- (/ (window-width ediff-control-window) 2) 3)))
2097 ;; the window was found
2098 (if arg
2099 ;; C-u as argument means half of default amount
2100 (/ default-amount 2)
2101 ;; no argument means default amount
2102 default-amount))))))
2103
2104(defun ediff-position-region (beg end pos)
2105 "This is a variation on ``emerge-position-region''.
2106The difference is that it always tries to align difference regions in
2107buffer-A and buffer-B, so that it will be easier to compare them."
2108 (set-window-start (selected-window) beg)
2109 (if (pos-visible-in-window-p end)
2110 ;; Determine the number of lines that the region occupies
2111 (let ((lines 0))
2112 (while (> end (progn
2113 (move-to-window-line lines)
2114 (point)))
2115 (setq lines (1+ lines)))
2116 ;; And position the beginning on the right line
2117 (goto-char beg)
2118 (recenter (/ (1+ (max (- (1- (window-height (selected-window)))
2119 lines)
2120 1)
2121 )
2122 2))))
2123 (goto-char pos)
2124 )
2125
2126
2127(defun ediff-next-difference (arg)
2128 "Advance to the next difference.
2129With a prefix argument, go back that many differences."
2130 (interactive "P")
2131 (if (< ediff-current-difference ediff-number-of-differences)
2132 (let ((n (min ediff-number-of-differences
2133 (+ ediff-current-difference (if arg arg 1))))
2134 (buffer-read-only nil))
2135 (ediff-unselect-and-select-difference n))
2136 (error "At end of the difference list.")))
2137
2138(defun ediff-previous-difference (arg)
2139 "Go to the previous difference.
2140With a prefix argument, go back that many differences."
2141 (interactive "P")
2142 (if (> ediff-current-difference -1)
2143 (let ((n (max -1 (- ediff-current-difference (if arg arg 1))))
2144 (buffer-read-only nil))
2145 (ediff-unselect-and-select-difference n))
2146 (error "At beginning of the difference list.")))
2147
2148(defun ediff-jump-to-difference (difference-number)
2149 "Go to the difference specified as a prefix argument."
2150 (interactive "p")
2151 (let ((buffer-read-only nil))
2152 (setq difference-number (1- difference-number))
2153 (if (and (>= difference-number -1)
2154 (< difference-number (1+ ediff-number-of-differences)))
2155 (ediff-unselect-and-select-difference difference-number)
2156 (error "Bad difference number"))))
2157
2158(defun ediff-jump-to-difference-at-point ()
2159 "Go to the difference closest to the point in buffer A or B.
2160If this command is invoked via `ja' or `ga' then the point in buffer A is
2161used. Otherwise, buffer B is used."
2162 (interactive)
2163 (let ((buffer-read-only nil)
2164 (buf-type (if (eq last-command-char ?a) 'A 'B)))
2165
2166 (ediff-jump-to-difference (ediff-diff-at-point buf-type))))
2167
2168
2169;; find region "most related to the current point position
2170
2171(defun ediff-diff-at-point (buf-type)
2172 (let ((buffer (if (eq buf-type 'A) ediff-A-buffer ediff-B-buffer))
2173 (ctl-buffer ediff-control-buffer)
2174 (diff-no -1)
2175 (prev-beg 0)
2176 (beg 0))
2177
2178 (emerge-eval-in-buffer
2179 buffer
2180 (while (or (< (point) prev-beg) (> (point) beg))
2181 (setq diff-no (1+ diff-no))
2182 (setq prev-beg beg)
2183 (setq beg (ediff-get-diff-posn buf-type 'beg diff-no ctl-buffer)))
2184
2185 (if (< (abs (- (point) prev-beg))
2186 (abs (- (point) beg)))
2187 diff-no
2188 (1+ diff-no)) ;; jump-to-diff works with diff nums higher by 1
2189 )))
2190
2191;;; Copying diffs.
2192
2193(defun ediff-diff-to-diff (arg)
2194 "Copy buffer-A'th diff to buffer B.
2195If numerical prefix argument, copy this diff specified in the arg.
2196Otherwise, copy the difference given by ``ediff-current-difference''."
2197 (interactive "P")
2198 (if arg
2199 (ediff-jump-to-difference arg))
2200 (ediff-copy-diff ediff-current-difference
2201 (if (eq last-command-char ?a) 'B 'A))
2202 (ediff-recenter 'no-rehighlight))
2203
2204
2205(defun ediff-copy-diff (n buf-type)
2206 "Copy diff N from BUF-TYPE \(given as 'A or 'B\)."
2207 (let* ((other-buf (if (eq buf-type 'A)
2208 ediff-B-buffer ediff-A-buffer))
2209 (buf (if (eq buf-type 'A)
2210 ediff-A-buffer ediff-B-buffer))
2211 (other-buf-type (if (eq buf-type 'A) 'B 'A))
2212 (ctrl-buf ediff-control-buffer)
2213 reg-to-copy reg-to-delete
2214 reg-to-delete-beg reg-to-delete-end)
2215
2216 (ediff-operate-on-flags 'remove)
2217 (setq reg-to-delete-beg
2218 (ediff-get-diff-posn other-buf-type 'beg n ctrl-buf))
2219 (setq reg-to-delete-end
2220 (ediff-get-diff-posn other-buf-type 'end n ctrl-buf))
2221 (setq reg-to-copy (emerge-eval-in-buffer
2222 buf
2223 (buffer-substring (ediff-get-diff-posn
2224 buf-type 'beg n ctrl-buf)
2225 (ediff-get-diff-posn
2226 buf-type 'end n ctrl-buf))))
2227 (setq reg-to-delete (emerge-eval-in-buffer
2228 other-buf
2229 (buffer-substring reg-to-delete-beg
2230 reg-to-delete-end)))
2231 (setq ediff-disturbed-overlays nil) ;; clear before use
2232
2233 (if (string= reg-to-delete reg-to-copy)
2234 (progn
2235 (ding)
2236 (message
2237 "Diff regions %d are identical in buffers A and B. Nothing copied."
2238 (1+ n)))
2239
2240 ;; seems ok to copy
2241 (if (ediff-test-save-region n other-buf-type)
2242 (condition-case conds
2243 (let (inhibit-read-only)
2244 (emerge-eval-in-buffer
2245 other-buf
2246 ;; to prevent flags from interfering if buffer is writable
2247 (setq inhibit-read-only (null buffer-read-only))
2248 (let ((before-change-function nil))
2249 (goto-char reg-to-delete-end)
2250 (insert-before-markers reg-to-copy)
2251 (if (ediff-if-lucid)
2252 (progn
2253 (ediff-collect-extents-lucid reg-to-delete-beg)
2254 (if (> reg-to-delete-end reg-to-delete-beg)
2255 (progn
2256 (kill-region reg-to-delete-beg
2257 reg-to-delete-end)
2258 (if (string= reg-to-copy "")
2259 (ediff-adjust-disturbed-extents-lucid
2260 reg-to-delete-beg)))))
2261 (if (> reg-to-delete-end reg-to-delete-beg)
2262 (kill-region reg-to-delete-beg reg-to-delete-end)
2263 (ediff-move-disturbed-overlays reg-to-delete-beg)))
2264 ))
2265 (ediff-save-diff-region n other-buf-type reg-to-delete))
2266 (error (message "%s %s"
2267 (car conds)
2268 (mapconcat 'prin1-to-string (cdr conds) " "))
2269 (beep 1))))
2270 )
2271 (ediff-operate-on-flags 'insert)
2272 ))
2273
2274(defun ediff-save-diff-region (n buf-type reg)
2275 "Save N-th diff of buffer BUF-TYPE \('A or 'B\) on the
2276``ediff-killed-diffs-alist''. REG is the region to save.
2277It is redundant here,but is passed anyway, for convenience."
2278
2279 (let* ((n-th-diff-saved (assoc n ediff-killed-diffs-alist))
2280 (this-buf-n-th-diff-saved (assoc buf-type (cdr n-th-diff-saved))))
2281
2282 (if this-buf-n-th-diff-saved
2283 ;; either nothing saved for n-th diff and buffer or we OK'ed
2284 ;; overriding
2285 (setcdr this-buf-n-th-diff-saved reg)
2286 (if n-th-diff-saved ;; n-th diff saved, but for another buffer
2287 (nconc n-th-diff-saved (list (cons buf-type reg)))
2288 (setq ediff-killed-diffs-alist ;; create record for n-th diff
2289 (cons (list n (cons buf-type reg))
2290 ediff-killed-diffs-alist))))
2291 (message "Saved diff region #%d for buffer %S. To recover hit '%s'."
2292 (1+ n) buf-type (if (eq buf-type 'A) "ra" "rb"))))
2293
2294(defun ediff-test-save-region (n buf-type)
2295 "Test if saving N-th difference region of buffer BUF-TYPE is possible."
2296 (let* ((n-th-diff-saved (assoc n ediff-killed-diffs-alist))
2297 (this-buf-n-th-diff-saved (assoc buf-type (cdr n-th-diff-saved))))
2298
2299 (if this-buf-n-th-diff-saved
2300 (if (yes-or-no-p
2301 (format
2302 "You've previously copied diff %d from %S to %S. Confirm. "
2303 (1+ n) (if (eq buf-type 'A) 'B 'A) buf-type))
2304 t
2305 (error "Quit."))
2306 t)))
2307
2308(defun ediff-pop-diff (n buf-type)
2309 "Pop last killed N-th diff region from buffer BUF-TYPE."
2310 (let* ((n-th-record (assoc n ediff-killed-diffs-alist))
2311 (saved-rec (assoc buf-type (cdr n-th-record)))
2312 (buf (if (eq buf-type 'A) ediff-A-buffer ediff-B-buffer))
2313 saved-diff reg-beg reg-end recovered)
2314
2315 (if (cdr saved-rec)
2316 (setq saved-diff (cdr saved-rec))
2317 (error "Nothing saved for diff %d in buffer %S." (1+ n) buf-type))
2318
2319 (ediff-operate-on-flags 'remove)
2320
2321 (setq reg-beg (ediff-get-diff-posn buf-type 'beg n ediff-control-buffer))
2322 (setq reg-end (ediff-get-diff-posn buf-type 'end n ediff-control-buffer))
2323 (setq ediff-disturbed-overlays nil) ;; clear before use
2324
2325 (condition-case conds
2326 (emerge-eval-in-buffer
2327 buf
2328 (let ((inhibit-read-only (null buffer-read-only))
2329 (before-change-function nil))
2330 (goto-char reg-end)
2331 (insert-before-markers saved-diff)
2332
2333 (if (ediff-if-lucid)
2334 (progn
2335 (ediff-collect-extents-lucid reg-beg)
2336 (if (> reg-end reg-beg)
2337 (progn
2338 (kill-region reg-beg reg-end)
2339 (if (string= saved-diff "")
2340 (ediff-adjust-disturbed-extents-lucid reg-beg)))))
2341 (if (> reg-end reg-beg)
2342 (kill-region reg-beg reg-end)
2343 (ediff-move-disturbed-overlays reg-beg)))
2344
2345 (setq recovered t)
2346 ))
2347 (error (message "%s %s"
2348 (car conds)
2349 (mapconcat 'prin1-to-string (cdr conds) " "))
2350 (beep 1)))
2351
2352 (ediff-operate-on-flags 'insert)
2353 (if recovered
2354 (progn
2355 (setq n-th-record (delq saved-rec n-th-record))
2356 (message "Diff region %d restored for buffer %S." (1+ n) buf-type)))
2357 ))
2358
2359(defun ediff-restore-diff (arg)
2360 "Restore ARG-th diff from ediff-killed-diffs-alist.
2361ARG is a prefix argument. If ARG is `nil', restore current-difference."
2362 (interactive "P")
2363 (if arg
2364 (ediff-jump-to-difference arg))
2365 (ediff-pop-diff ediff-current-difference
2366 (if (eq last-command-char ?a) 'A 'B))
2367 (ediff-recenter 'no-rehighlight))
2368
2369
2370;;; Quitting, suspending, etc.
2371(defun ediff-quit ()
2372 "Finish an Ediff session and exit Ediff.
2373Unselects the selected difference, if any, restores the read-only and modified
2374flags of the compared file buffers, kills Ediff buffers for this session
2375\(but not file-A and file-B\)."
2376 (interactive)
2377 (if (prog1
2378 (y-or-n-p "Do you really want to exit Ediff? ")
2379 (message ""))
2380 (ediff-really-quit)))
2381
2382;; Perform the quit operations.
2383(defun ediff-really-quit ()
2384 (setq buffer-read-only nil)
2385 (ediff-unselect-and-select-difference -1)
2386 ;; null out the difference overlays so they won't slow down future editing
2387 ;; operations
2388 (mapcar (function (lambda (d)
2389 (ediff-delete-overlay (aref d 0))
2390 (ediff-delete-overlay (aref d 1))))
2391 ediff-difference-vector)
2392 ;; allow them to be garbage collected
2393 (setq ediff-difference-vector nil)
2394 (setq ediff-help-message ediff-help-message-long)
2395 (ediff-restore-buffer-characteristics t) ;; restore as they were at setup
2396 (ediff-unhighlight-diffs-totally)
2397
2398 ;; restore buffer mode line id's in buffer-A/B
2399 (let ((control-buffer ediff-control-buffer))
2400 (emerge-eval-in-buffer
2401 ediff-A-buffer
2402 (setq before-change-function nil)
2403 (setq ediff-this-buffer-control-sessions
2404 (delq control-buffer ediff-this-buffer-control-sessions))
2405 (if (null ediff-this-buffer-control-sessions)
2406 (setq local-write-file-hooks
2407 (delq 'ediff-block-write-file local-write-file-hooks)))
2408 (kill-local-variable 'mode-line-buffer-identification))
2409 (emerge-eval-in-buffer
2410 ediff-B-buffer
2411 (setq ediff-this-buffer-control-sessions
2412 (delq control-buffer ediff-this-buffer-control-sessions))
2413 (if (null ediff-this-buffer-control-sessions)
2414 (setq local-write-file-hooks
2415 (delq 'ediff-block-write-file local-write-file-hooks)))
2416 (setq before-change-function nil)
2417 (kill-local-variable 'mode-line-buffer-identification)))
2418
2419 (run-hooks 'ediff-quit-hooks))
2420
2421(defun ediff-kill-buffer-carefully (buf)
2422 "Kill buffer BUF if it exists."
2423 (if (ediff-buffer-live-p buf)
2424 (kill-buffer (get-buffer buf))))
2425
2426;; The default way of quitting Ediff.
2427;; Kills control buffers and leaves the
2428;; frame split between the two diff'ed files.
2429(defun ediff-default-quit-hook ()
2430 (let ((buff-A ediff-A-buffer)
2431 (buff-B ediff-B-buffer))
2432 (ediff-kill-buffer-carefully ediff-diff-buffer)
2433 (ediff-kill-buffer-carefully ediff-diff-error-buffer)
2434 (ediff-kill-buffer-carefully ediff-control-buffer)
2435 (ediff-kill-buffer-carefully ediff-patch-diagnostics)
2436 (delete-other-windows)
2437 (switch-to-buffer buff-B)
2438 (split-window-vertically)
2439 (switch-to-buffer buff-A)))
2440
2441;; The default way of suspending Ediff.
2442;; Buries Ediff buffers, kills all windows.
2443(defun ediff-default-suspend-hook ()
2444 (let ((buf-A ediff-A-buffer)
2445 (buf-B ediff-B-buffer)
2446 (buf-patch ediff-patch-buf)
2447 (buf-patch-diag ediff-patch-diagnostics)
2448 (buf-err ediff-diff-error-buffer)
2449 (buf-diff ediff-diff-buffer))
2450 (bury-buffer) ;; ediff-control-buffer
2451 (delete-other-windows)
2452 (bury-buffer buf-err)
2453 (bury-buffer buf-diff)
2454 (bury-buffer buf-patch)
2455 (bury-buffer buf-patch-diag)
2456 (bury-buffer buf-A)
2457 (bury-buffer buf-B)))
2458
2459
2460(defun ediff-suspend ()
2461 "Suspend Ediff. To resume, switch to the appropriate ``*ediff-control*''
2462buffer and then hit ``\\[ediff-recenter]''. Ediff will automatically set
2463up an appropriate window config."
2464 (interactive)
2465 (run-hooks 'ediff-suspend-hooks)
2466 (message
2467 "To resume, switch to *ediff-control* and hit 'c' (ediff-recenter)."))
2468
2469
2470(defun ediff-file-names ()
2471 "Show the names of the buffers or files being operated on by Ediff.
2472Hit ``\\[ediff-recenter]'' to reset the windows afterward."
2473 (interactive)
2474 (with-output-to-temp-buffer "*Help*"
2475 (emerge-eval-in-buffer ediff-A-buffer
2476 (if buffer-file-name
2477 (progn
2478 (princ "File A is: ")
2479 (princ buffer-file-name))
2480 (progn
2481 (princ "Buffer A is: ")
2482 (princ (buffer-name))))
2483 (princ "\n"))
2484 (emerge-eval-in-buffer ediff-B-buffer
2485 (if buffer-file-name
2486 (progn
2487 (princ "File B is: ")
2488 (princ buffer-file-name))
2489 (progn
2490 (princ "Buffer B is: ")
2491 (princ (buffer-name))))
2492 (princ "\n"))
2493 ))
2494
2495
2496
2497(defun ediff-line-numbers ()
2498 "Display the current line numbers.
2499This function displays the line numbers of the points in the A, B."
2500 (interactive)
2501 (let* ((A-line (emerge-eval-in-buffer ediff-A-buffer
2502 (count-lines (point-min) (point))))
2503 (B-line (emerge-eval-in-buffer ediff-B-buffer
2504 (count-lines (point-min) (point)))))
2505 (message "At lines: A = %d, B = %d" A-line B-line)))
2506
2507
2508;;; Support routines
2509
2510;; Select a difference by placing the ASCII flags around the appropriate
2511;; group of lines in the A, B buffers
2512(defun ediff-select-difference (n)
2513 (if (and (>= n 0) (< n ediff-number-of-differences))
2514 (progn
2515 (ediff-remember-buffer-characteristics)
2516 (if (and window-system ediff-want-faces)
2517 (progn
2518 (ediff-highlight-diff n)
2519 (setq ediff-highlighting-style 'face))
2520 (setq ediff-highlighting-style 'ascii)
2521 (ediff-place-flags-in-buffer 'A ediff-A-buffer
2522 ediff-control-buffer n)
2523 (ediff-place-flags-in-buffer 'B ediff-B-buffer
2524 ediff-control-buffer n))
2525
2526 (ediff-restore-buffer-characteristics)
2527 (run-hooks 'ediff-select-hooks))))
2528
2529
2530;; Unselect a difference by removing the ASCII flags in the buffers.
2531(defun ediff-unselect-difference (n)
2532 (if (and (>= n 0) (< n ediff-number-of-differences))
2533 (progn
2534 (ediff-remember-buffer-characteristics)
2535
2536 (cond ((and window-system ediff-want-faces)
2537 (ediff-unhighlight-diff))
2538 ((eq ediff-highlighting-style 'ascii)
2539 (ediff-remove-flags-from-buffer
2540 ediff-A-buffer
2541 (ediff-get-diff-posn 'A 'beg n)
2542 (ediff-get-diff-posn 'A 'end n)
2543 ediff-before-flag-A ediff-after-flag-A)
2544 (ediff-remove-flags-from-buffer
2545 ediff-B-buffer
2546 (ediff-get-diff-posn 'B 'beg n)
2547 (ediff-get-diff-posn 'B 'end n)
2548 ediff-before-flag-B ediff-after-flag-B)))
2549
2550 (ediff-restore-buffer-characteristics)
2551 (setq ediff-highlighting-style nil)
2552 (run-hooks 'ediff-unselect-hooks))))
2553
2554
2555;; Unselects prev diff and selects a new one, if FLAG has value other than
2556;; 'select-only or 'unselect-only. If FLAG is 'select-only, the
2557;; next difference is selected, but the current selection is not
2558;; unselected. If FLAG is 'unselect-only then the current selection is
2559;; unselected, but the next one is not selected. If NO-RECENTER is non-nil,
2560;; don't recenter buffers after selecting/unselecting.
2561;;
2562;; Don't use ``ediff-select-difference'' and ``ediff-unselect-difference''
2563;; directly,;; since this will screw up the undo info in the presence of
2564;; ASCII flags.
2565;; Instead, use ``ediff-unselect-and-select-difference'' with appropriate
2566;; flags.
2567
2568(defun ediff-unselect-and-select-difference (n &optional flag no-recenter)
2569 (let ((wind (selected-window))
2570 ;; save buf modified info
2571 (buf-A-modified (buffer-modified-p ediff-A-buffer))
2572 (buf-B-modified (buffer-modified-p ediff-B-buffer))
2573 ;; temporarily disable undo so highlighting won't confuse the user
2574 buf-A-undo buf-B-undo)
2575
2576 (emerge-eval-in-buffer
2577 ediff-A-buffer
2578 (setq buf-A-undo buffer-undo-list))
2579 (emerge-eval-in-buffer
2580 ediff-B-buffer
2581 (setq buf-B-undo buffer-undo-list))
2582
2583 (buffer-disable-undo ediff-A-buffer)
2584 (buffer-disable-undo ediff-B-buffer)
2585
2586 (unwind-protect ;; we don't want to lose undo info due to error
2587 (progn
2588 (or (eq flag 'select-only)
2589 (ediff-unselect-difference ediff-current-difference))
2590
2591 ;; Auto-save buffers while Ediff flags are temporarily removed.
2592 (emerge-eval-in-buffer
2593 ediff-A-buffer
2594 (if buf-A-modified
2595 (do-auto-save)))
2596 (emerge-eval-in-buffer
2597 ediff-B-buffer
2598 (if buf-B-modified
2599 (do-auto-save)))
2600
2601 (or (eq flag 'unselect-only)
2602 (ediff-select-difference n))
2603 (setq ediff-current-difference n)
2604 ) ;; end protected section
2605
2606 (select-window wind) ;; must be before recenter!
2607 (ediff-refresh-mode-line)
2608 (or no-recenter
2609 (ediff-recenter 'no-rehighlight))
2610
2611 ;; restore undo and buffer-modified info
2612 (emerge-eval-in-buffer
2613 ediff-A-buffer
2614 (set-buffer-modified-p buf-A-modified)
2615 (setq buffer-undo-list buf-A-undo))
2616 (emerge-eval-in-buffer
2617 ediff-B-buffer
2618 (set-buffer-modified-p buf-B-modified)
2619 (setq buffer-undo-list buf-B-undo))
2620 )))
2621
2622;; Revise the mode line to display which difference we have selected
2623
2624(defun ediff-refresh-mode-line ()
2625 (setq mode-line-buffer-identification
2626 (list (format "Ediff: %%b diff %d of %d"
2627 (1+ ediff-current-difference)
2628 ediff-number-of-differences)))
2629 ;; Force mode-line redisplay
2630 (set-buffer-modified-p (buffer-modified-p)))
2631
2632
2633
2634;; Verify that we have a difference selected.
2635(defun ediff-validate-difference ()
2636 (if (not (and (>= ediff-current-difference 0)
2637 (< ediff-current-difference ediff-number-of-differences)))
2638 (error "No difference selected")))
2639
2640;; The following is added to take care of Lemacs.
2641
2642
2643(defun ediff-read-file-name (prompt default-dir default-file A-file)
2644; This is a modified version of a similar function in ``emerge.el''.
2645; PROMPT should not have trailing ': ', so that it can be modified
2646; according to context.
2647; If both A-FILE and default-dir are set, the file constructed our of
2648; default-dir and the non-directory part of A-FILE is used as default and as
2649; initial input.
2650; If A-FILE is set (but default-dir is not), it is used as default and
2651; initial input.
2652; If default-file is set, it should be used as the default value.
2653; If default-dir is non-nil, use it as the default directory.
2654; Otherwise, use the value in Emacs's var default-directory.
2655 (cond
2656 ((and A-file default-dir)
2657 (read-file-name (format "%s (default %s%s): "
2658 prompt
2659 (abbreviate-file-name
2660 (expand-file-name default-dir))
2661 (file-name-nondirectory A-file))
2662 (expand-file-name default-dir)
2663 (concat (expand-file-name default-dir)
2664 (file-name-nondirectory A-file))
2665 'confirm (file-name-nondirectory A-file)))
2666 (A-file
2667 (read-file-name (format "%s (default %s): "
2668 prompt (file-name-nondirectory A-file))
2669 (expand-file-name (file-name-directory A-file))
2670 A-file
2671 'confirm (file-name-nondirectory A-file)))
2672 ;; If there is a default file, but no A-file, use it.
2673 (default-file
2674 (read-file-name (format "%s (default %s): " prompt default-file)
2675 default-dir ;; if nil then default-directory.
2676 nil 'confirm))
2677 (t
2678 (read-file-name (concat prompt ": ")
2679 default-dir ;; if nil then default-directory.
2680 nil 'confirm))))
2681
2682
2683(defun ediff-make-temp-file (prefix)
2684 (let ((f (make-temp-name (concat ediff-temp-file-prefix prefix))))
2685 ;; create the file
2686 (write-region (point-min) (point-min) f nil 'no-message)
2687 (set-file-modes f ediff-temp-file-mode)
2688 f))
2689
2690(defun ediff-block-write-file ()
2691 "Prevent writing files A and B directly."
2692 (if (ediff-check-for-ascii-flags)
2693 (error "Use 'wa' and 'wb' to save buffs A/B (first switch back to *ediff-control*.")))
2694
2695(defun ediff-check-for-ascii-flags ()
2696 (eval
2697 (cons 'or
2698 (mapcar (function (lambda (buf)
2699 (emerge-eval-in-buffer
2700 buf
2701 (eq ediff-highlighting-style 'ascii))))
2702 ediff-this-buffer-control-sessions))))
2703
2704(defun ediff-insert-in-front (overl beg end)
2705 "Capture overlays that had insertions in the front.
2706Called when overlay OVERL gets insertion in front."
2707 (if (ediff-overlay-get overl 'ediff-diff-num)
2708 (setq ediff-disturbed-overlays
2709 (cons overl ediff-disturbed-overlays)))
2710 )
2711
2712(defun ediff-collect-extents-lucid (pos)
2713 "Collects all extents at POS having property `ediff-diff-num'.
2714Lucid Emacs causes headache by detaching empty extents, so I have to save
2715them before they disappear."
2716 (let (lis elt)
2717 (while (setq elt (extent-at pos nil 'ediff-diff-num elt))
2718 (setq lis (cons elt lis)))
2719 (setq ediff-disturbed-overlays lis)))
2720
2721(defun ediff-move-disturbed-overlays (posn)
2722 (mapcar (function (lambda (overl)
2723 (ediff-move-overlay overl
2724 posn
2725 (ediff-overlay-end overl))
2726 ))
2727 ediff-disturbed-overlays)
2728 (setq ediff-disturbed-overlays nil))
2729
2730(defun ediff-adjust-disturbed-extents-lucid (posn &optional posn-type)
2731;; POSN-TYPE tells if POSN should become a new start of the extents
2732;; (if 'new-start) or a new end (if 'new-end). If POSN-TYPE is nil, then
2733;; POSN is both the new start and the new end.
2734 (mapcar (function (lambda (overl)
2735 (cond ((and (null posn-type)
2736 (equal (ediff-overlay-start overl)
2737 (ediff-overlay-end overl)))
2738 (ediff-move-overlay overl posn posn))
2739
2740 (posn-type
2741 (ediff-move-overlay
2742 overl
2743 (if (eq posn-type 'new-start)
2744 posn
2745 (ediff-overlay-start overl))
2746 (if (eq posn-type 'new-end)
2747 posn
2748 (ediff-overlay-end overl)))))))
2749 ediff-disturbed-overlays)
2750 (setq ediff-disturbed-overlays nil))
2751
2752(defun ediff-save-buffer ()
2753 "Safe way of saving buffers A and B."
2754 (interactive)
2755 (let ((hooks local-write-file-hooks))
2756 (ediff-unselect-and-select-difference ediff-current-difference
2757 'unselect-only)
2758 (unwind-protect
2759 (emerge-eval-in-buffer
2760 (if (eq last-command-char ?a) ediff-A-buffer ediff-B-buffer)
2761 ;; temporarily remove writing block
2762 (setq hooks (delq 'ediff-block-write-file hooks))
2763 (let ((local-write-file-hooks hooks))
2764 (save-buffer)))
2765 (ediff-unselect-and-select-difference ediff-current-difference
2766 'select-only)
2767 )))
2768
2769
2770
2771(defun ediff-remove-flags-from-buffer (buffer before-posn after-posn
2772 before-flag after-flag)
2773 "Essentially ``emerge-remove-flags-in-buffer'', modified to allow deletion
2774of read-only flags."
2775 (emerge-eval-in-buffer
2776 buffer
2777 (let ((buffer-read-only nil)
2778 (before-change-function nil)
2779 (inhibit-read-only t)
2780 (before-flag-length (length before-flag))
2781 (after-flag-length (length after-flag))
2782 )
2783 (goto-char after-posn)
2784 (setq after-posn (point-marker)) ;; after-posn is now a marker
2785 ;; remove the flags, if they're there
2786 (goto-char (- before-posn before-flag-length))
2787 (if (ediff-if-lucid)
2788 (ediff-collect-extents-lucid (+ (point) before-flag-length)))
2789 (if (looking-at (regexp-quote before-flag))
2790 (delete-region (point) (+ (point) before-flag-length))
2791 ;; the flag isn't there
2792 (ding)
2793 (message "Trouble removing ASCII flag"))
2794 (if (ediff-if-lucid)
2795 (ediff-adjust-disturbed-extents-lucid (point)))
2796
2797 (if (ediff-if-lucid)
2798 (ediff-collect-extents-lucid (point)))
2799 (goto-char after-posn)
2800 (if (looking-at (regexp-quote after-flag))
2801 (delete-region (point) (+ (point) after-flag-length))
2802 ;; the flag isn't there
2803 (ding)
2804 (message "Trouble removing ASCII flag"))
2805 (if (ediff-if-lucid)
2806 (ediff-adjust-disturbed-extents-lucid (point)))
2807 (setq after-posn nil) ;; after has become a marker--garbage-collect
2808 )))
2809
2810
2811(defun ediff-place-flags-in-buffer (buf-type buffer ctl-buffer difference)
2812 "This is a modified ``emerge-place-flags-in-buffer''."
2813 (emerge-eval-in-buffer
2814 buffer
2815 (ediff-place-flags-in-buffer1 buf-type ctl-buffer difference)))
2816
2817(defun ediff-place-flags-in-buffer1 (buf-type ctl-buffer difference)
2818 "Modified ``emerge-place-flags-in-buffer1''."
2819 (let ((buffer-read-only nil)
2820 (inhibit-read-only t)
2821 (before-change-function nil)
2822 (before-flag-name (if (eq buf-type 'A)
2823 'ediff-before-flag-A
2824 'ediff-before-flag-B))
2825 (after-flag-name (if (eq buf-type 'A)
2826 'ediff-after-flag-A
2827 'ediff-after-flag-B))
2828 beg-of-line flag)
2829
2830 ;; insert the flag before the difference
2831 (let ((before (ediff-get-diff-posn buf-type 'beg difference ctl-buffer)))
2832 (goto-char before)
2833 (setq beg-of-line (bolp))
2834
2835 (setq flag (emerge-eval-in-buffer
2836 ctl-buffer
2837 (if beg-of-line
2838 (set before-flag-name ediff-before-flag-bol)
2839 (set before-flag-name ediff-before-flag-mol))))
2840
2841 ;; insert the flag itself
2842 (if (ediff-if-lucid)
2843 (ediff-collect-extents-lucid (point)))
2844 (insert-before-markers flag)
2845 (if (ediff-if-lucid)
2846 ;; Lucid's extent end-points behave strangely; they won't
2847 ;; respect insert-before-markers
2848 (ediff-adjust-disturbed-extents-lucid (point) 'new-start))
2849 )
2850 ;; insert the flag after the difference
2851 (let* ((after (ediff-get-diff-posn buf-type 'end difference ctl-buffer)))
2852 (goto-char after)
2853 (setq beg-of-line (bolp))
2854
2855 (setq flag (emerge-eval-in-buffer
2856 ctl-buffer
2857 (if beg-of-line
2858 (set after-flag-name ediff-after-flag-bol)
2859 (set after-flag-name ediff-after-flag-mol))))
2860
2861 ;; insert the flag itself
2862 (if (ediff-if-lucid)
2863 (ediff-collect-extents-lucid (point)))
2864 (insert flag)
2865 (if (ediff-if-lucid)
2866 (ediff-adjust-disturbed-extents-lucid after 'new-end))
2867 )))
2868
2869
2870(defun ediff-get-diff-posn (buf-type pos &optional n control-buf)
2871 "Returns positions of difference sectors in the buffer denoted BUF-TYPE
2872\('A or 'B\).
2873POS is either 'beg or 'end. Specifies whether you want the position at the
2874beginning of a difference of at the end. Optional N says which difference
2875\(default: ``ediff-current-difference''\). Optional CONTROL-BUF says which
2876control buffer is in effect in case it is not the current buffer."
2877
2878 (let (diff-overlay)
2879 (or control-buf
2880 (setq control-buf (current-buffer)))
2881
2882 (emerge-eval-in-buffer
2883 control-buf
2884 (or n (setq n ediff-current-difference))
2885 (if (or (< n 0) (>= n ediff-number-of-differences))
2886 (error "There is no diff %d in this session. Valid diffs are 1 to %d."
2887 (1+ n) ediff-number-of-differences))
2888 (setq diff-overlay (aref (aref ediff-difference-vector n)
2889 (if (eq buf-type 'A) 0 1))))
2890
2891 (if (ediff-overlay-get diff-overlay 'detached)
2892 (ediff-move-overlay diff-overlay
2893 (ediff-overlay-get diff-overlay 'ediff-marker)
2894 (ediff-overlay-get diff-overlay 'ediff-marker)))
2895 (if (eq pos 'beg)
2896 (ediff-overlay-start diff-overlay)
2897 (ediff-overlay-end diff-overlay))
2898 ))
2899
2900
2901
2902;; These would highlight differences under X
2903(defun ediff-highlight-diff (n)
2904 "Put face on diff N. Invoked for X displays only."
2905 (let* ((last-A (emerge-eval-in-buffer ediff-A-buffer (point-max)))
2906 (last-B (emerge-eval-in-buffer ediff-B-buffer (point-max)))
2907 (begin-A (ediff-get-diff-posn 'A 'beg n))
2908 (end-A (ediff-get-diff-posn 'A 'end n))
2909 (xtraA (if (equal begin-A end-A) 1 0))
2910 (end-A-hilit (min last-A (+ end-A xtraA)))
2911
2912 (begin-B (ediff-get-diff-posn 'B 'beg n))
2913 (end-B (ediff-get-diff-posn 'B 'end n))
2914 (xtraB (if (equal begin-B end-B) 1 0))
2915 (end-B-hilit (min last-B (+ end-B xtraB))))
2916
2917 (if (ediff-if-lucid)
2918 (progn
2919 (ediff-move-overlay
2920 ediff-current-diff-overlay-A begin-A end-A-hilit)
2921 (ediff-move-overlay
2922 ediff-current-diff-overlay-B begin-B end-B-hilit))
2923 ;; GNU stuff has a bug, which requires that ediff-move-overlay will
2924 ;; have the buffer as a parameter. Will be fixed in 19.23
2925 (ediff-move-overlay ediff-current-diff-overlay-A
2926 begin-A end-A-hilit ediff-A-buffer)
2927 (ediff-move-overlay ediff-current-diff-overlay-B
2928 begin-B end-B-hilit ediff-B-buffer))
2929 ;; giving priority of 0 and then changing it may look funny, but
2930 ;; this is intended to overcome an Emacs bug.
2931 (ediff-overlay-put ediff-current-diff-overlay-A 'priority 0)
2932 (ediff-overlay-put ediff-current-diff-overlay-B 'priority 0)
2933 (ediff-overlay-put ediff-current-diff-overlay-A 'priority
2934 (ediff-highest-priority begin-A end-A-hilit ediff-A-buffer))
2935 (ediff-overlay-put ediff-current-diff-overlay-B 'priority
2936 (ediff-highest-priority begin-B end-B-hilit ediff-B-buffer))
2937
2938 (if (and (not (face-differs-from-default-p 'ediff-odd-diff-face-A-var))
2939 (null ediff-highlight-selected-only))
2940 (progn
2941 (copy-face ediff-odd-diff-face-A 'ediff-odd-diff-face-A-var)
2942 (copy-face ediff-odd-diff-face-B 'ediff-odd-diff-face-B-var)
2943 (copy-face ediff-even-diff-face-A 'ediff-even-diff-face-A-var)
2944 (copy-face ediff-even-diff-face-B 'ediff-even-diff-face-B-var)))
2945
2946 ;; unhighlight the background overlay for the diff n so they won't
2947 ;; interfere with the current diff overlay
2948 (ediff-overlay-put (aref (aref ediff-difference-vector n) 0) 'face nil)
2949 (ediff-overlay-put (aref (aref ediff-difference-vector n) 1) 'face nil)
2950
2951 (sit-for 0) ;; needs to synch for some reason
2952 ))
2953
2954
2955(defun ediff-unhighlight-diff ()
2956 "Remove overlays from buffers A and B."
2957
2958 (ediff-move-overlay ediff-current-diff-overlay-A 1 1)
2959 (ediff-move-overlay ediff-current-diff-overlay-B 1 1)
2960
2961 ;; rehighlight the overlay in the background of the
2962 ;; current difference region
2963 (ediff-overlay-put (aref (aref ediff-difference-vector
2964 ediff-current-difference)
2965 0)
2966 'face (if (ediff-odd-p ediff-current-difference)
2967 'ediff-odd-diff-face-A-var
2968 'ediff-even-diff-face-A-var))
2969 (ediff-overlay-put (aref (aref ediff-difference-vector
2970 ediff-current-difference)
2971 1)
2972 'face (if (ediff-odd-p ediff-current-difference)
2973 'ediff-odd-diff-face-B-var
2974 'ediff-even-diff-face-B-var))
2975 )
2976
2977
2978(defun ediff-unhighlight-diffs-totally ()
2979 (if (and window-system ediff-want-faces)
2980 (let ((inhibit-quit t))
2981 (if (face-differs-from-default-p 'ediff-odd-diff-face-A-var)
2982 (progn
2983 (copy-face 'default 'ediff-odd-diff-face-A-var)
2984 (copy-face 'default 'ediff-odd-diff-face-B-var)
2985 (copy-face 'default 'ediff-even-diff-face-A-var)
2986 (copy-face 'default 'ediff-even-diff-face-B-var)))
2987 (if (ediff-overlayp ediff-current-diff-overlay-A)
2988 (ediff-delete-overlay ediff-current-diff-overlay-A))
2989 (setq ediff-current-diff-overlay-A nil)
2990 (if (ediff-overlayp ediff-current-diff-overlay-B)
2991 (ediff-delete-overlay ediff-current-diff-overlay-B))
2992 (setq ediff-current-diff-overlay-B nil))))
2993
2994
2995(defun ediff-operate-on-flags (action)
2996 "Re/unhighlights buffers A and B with all flags from all active Ediff
2997sessions that involve these buffers. This is usually needed only when a
2998buffer is involved in multiple Ediff sessions."
2999 (let* ((A-sessions (emerge-eval-in-buffer
3000 ediff-A-buffer
3001 ediff-this-buffer-control-sessions))
3002 (B-sessions (emerge-eval-in-buffer
3003 ediff-B-buffer
3004 ediff-this-buffer-control-sessions))
3005 (sessions (ediff-union A-sessions B-sessions))
3006 (flag (if (eq action 'remove) 'unselect-only 'select-only)))
3007
3008 (mapcar (function (lambda (buf)
3009 (emerge-eval-in-buffer
3010 buf
3011 (or (if (eq action 'insert)
3012 (memq ediff-highlighting-style '(ascii off))
3013 (not (eq ediff-highlighting-style 'ascii)))
3014 (ediff-unselect-and-select-difference
3015 ediff-current-difference
3016 flag 'no-recenter))
3017 )))
3018 sessions)))
3019
3020(defun ediff-union (list1 list2)
3021 "Combine LIST1 and LIST2 using a set-union operation.
3022The result list contains all items that appear in either LIST1 or LIST2.
3023This is a non-destructive function; it makes a copy of the data if necessary
3024to avoid corrupting the original LIST1 and LIST2.
3025This is a slightly simplified version from ``cl-seq.el''. Added here to
3026avoid loading cl-*."
3027 (cond ((null list1) list2) ((null list2) list1)
3028 ((equal list1 list2) list1)
3029 (t
3030 (or (>= (length list1) (length list2))
3031 (setq list1 (prog1 list2 (setq list2 list1))))
3032 (while list2
3033 (or (memq (car list2) list1)
3034 (setq list1 (cons (car list2) list1)))
3035 (setq list2 (cdr list2)))
3036 list1)))
3037
3038(defun ediff-debug ()
3039 (interactive)
3040 (with-output-to-temp-buffer "*ediff-debug*"
3041 (princ
3042 (format "Ctl buffer: %S\n\nediff-difference-vector:\n"
3043 ediff-control-buffer))
3044 (mapcar (function
3045 (lambda (overl-vec)
3046 (princ (format "Diff %d: %S %S %S\n\t %S %S %S\n"
3047 (1+ (ediff-overlay-get (aref overl-vec 0)
3048 'ediff-diff-num))
3049 (ediff-overlay-get (aref overl-vec 0)
3050 'ediff-control-buffer)
3051 (ediff-overlay-get (aref overl-vec 0)
3052 'insert-in-front-hooks)
3053 (aref overl-vec 0)
3054 (ediff-overlay-get (aref overl-vec 1)
3055 'ediff-control-buffer)
3056 (ediff-overlay-get (aref overl-vec 0)
3057 'insert-in-front-hooks)
3058 (aref overl-vec 1)
3059 ))))
3060 ediff-difference-vector)
3061 (princ "\nediff-disturbed-overlays:\n")
3062 (mapcar (function
3063 (lambda (overl)
3064 (princ (format "%S %S\n"
3065 (ediff-overlay-get overl 'ediff-control-buffer)
3066 overl
3067 ))))
3068 ediff-disturbed-overlays)))
3069
3070
3071(run-hooks 'ediff-load-hooks)
3072
3073
3074(provide 'ediff)
3075
3076;;; ediff.el ends here
diff --git a/lisp/ielm.el b/lisp/ielm.el
new file mode 100644
index 00000000000..3b5b1242140
--- /dev/null
+++ b/lisp/ielm.el
@@ -0,0 +1,366 @@
1;;; ielm.el --- interaction mode for Emacs Lisp
2;; Copyright (C) 1994 Free Software Foundation, Inc.
3
4;; Author: David Smith <maa036@lancaster.ac.uk>
5;; Created: 25 Feb 1994
6;; Keywords: lisp
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to
22;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24;;; Commentary:
25
26;; Provides a nice interface to evaluating Emacs-Lisp expressions.
27;; Input is handled by the comint package, and output is passed
28;; through the pretty-printer.
29
30;; To install: copy this file to a directory in your load-path, and
31;; add the line
32;;
33;; (autoload 'ielm "ielm" "Start an inferior emacs-lisp session" t)
34;;
35;; For completion to work, the comint.el from FSF Emacs 19.23 is
36;; required. If you do not have it, or if you are running Lemacs,
37;; also add the following code to your .emacs:
38;;
39;; (setq ielm-mode-hook
40;; '(lambda nil
41;; (define-key ielm-map "\t"
42;; '(lambda nil (interactive) (or (ielm-tab)
43;; (lisp-complete-symbol))))))
44
45;; To start: M-x ielm. Type C-h m in the *ielm* buffer for more info.
46
47;; The latest version is available by WWW from
48;; http://mathssun5.lancs.ac.uk:2080/~maa036/elisp/dir.html
49;; or by anonymous FTP from
50;; /anonymous@wingra.stat.wisc.edu:pub/src/emacs-lisp/ielm.el.gz
51;; or from the author: David M. Smith <maa036@lancaster.ac.uk>
52
53;;; Code:
54
55(require 'comint)
56(require 'pp)
57
58;;; User variables
59
60(defvar ielm-noisy t
61 "*If non-nil, beep on error")
62
63(defvar ielm-prompt "ELISP> ")
64
65(defvar ielm-dynamic-return t
66 "*If non-nil, RET either evaluates input or inserts a newline,
67depending on context")
68
69(defvar ielm-mode-hook nil
70 "*Hooks to be run when the inferior-emacs-lisp-mode is started")
71
72;;; System variables
73
74(defvar ielm-working-buffer nil
75 "Buffer, if any, to use in ielm. Usually buffer-local")
76
77(defvar ielm-header
78 (concat
79 "*** Welcome to IELM mode version "
80 (substring "$Revision: 1.15 $" 11 -2)
81 " *** Type (describe-mode) for help.\n"
82 "IELM has ABSOLUTELY NO WARRANTY; type (describe-no-warranty) for details\n"))
83
84(defvar ielm-map nil)
85(if ielm-map nil
86 (if (string-match "Lucid" emacs-version)
87 ;; Lemacs
88 (progn
89 (setq ielm-map (make-sparse-keymap))
90 (set-keymap-parent ielm-map comint-mode-map))
91 ;; FSF
92 (setq ielm-map (cons 'keymap comint-mode-map)))
93 (define-key ielm-map "\t" 'comint-dynamic-complete)
94 (define-key ielm-map "\C-m" 'ielm-return)
95 (define-key ielm-map "\C-j" 'ielm-send-input))
96
97;;; Completion stuff
98
99(defun ielm-tab nil
100 "Possibly indent the current line as lisp code"
101 (interactive)
102 (if (or (eq (preceding-char) ?\n)
103 (eq (char-syntax (preceding-char)) ? ))
104 (progn
105 (ielm-indent-line)
106 t)))
107
108(defun ielm-complete-symbol nil
109 "Just like lisp-complete-symbol"
110 ;; except that it returns non-nil if completion has occurred
111 (let* ((btick (buffer-modified-tick))
112 (cbuffer (get-buffer " *Completions*"))
113 (ctick (and cbuffer (buffer-modified-tick cbuffer))))
114 (lisp-complete-symbol)
115 ;; completion has occurred if:
116 (or
117 ;; the buffer has been modified
118 (not (= btick (buffer-modified-tick)))
119 ;; a completions buffer has been modifed or created
120 (if cbuffer
121 (not (= ctick (buffer-modified-tick cbuffer)))
122 (get-buffer " *Completions*")))))
123
124(defun ielm-complete-filename nil
125 ;; Completes filenames if in a string
126 (if (nth 3 (parse-partial-sexp comint-last-input-start (point)))
127 (comint-dynamic-complete-filename)))
128
129(defun ielm-indent-line nil
130 "Indent the current line as lisp code if it is not a prompt line"
131 (if (save-excursion
132 (beginning-of-line)
133 (looking-at comint-prompt-regexp)) nil
134 (lisp-indent-line)))
135
136;;; Other bindings
137
138(defun ielm-return nil
139 "Evaluate the sexp at the prompt if it is complete, otherwise newline
140and indent. If ielm-dynamic-return is nil, just insert a newline."
141 (interactive)
142 (if ielm-dynamic-return
143 (let ((state
144 (save-excursion
145 (end-of-line)
146 (parse-partial-sexp (ielm-pm)
147 (point)))))
148 (if (and (< (car state) 1) (not (nth 3 state)))
149 (ielm-send-input)
150 (newline-and-indent)))
151 (newline)))
152
153(defun ielm-input-sender (proc input)
154 (setq ielm-input input))
155
156(defun ielm-send-input nil
157 "Evaluate the Emacs Lisp expression after the prompt"
158 (interactive)
159 (let ((buf (current-buffer))
160 ielm-input) ; set by ielm-input-sender
161 (comint-send-input) ; update history, markers etc.
162 (ielm-eval-input ielm-input)))
163
164;;; Utility functions
165
166(defun ielm-is-whitespace (string)
167 "Return non-nil if STRING is all whitespace"
168 (or (string= string "") (string-match "\\`[ \t\n]+\\'" string)))
169
170(defun ielm-format-errors (errlist)
171 (let ((result ""))
172 (while errlist
173 (setq result (concat result (prin1-to-string (car errlist)) ", "))
174 (setq errlist (cdr errlist)))
175 (substring result 0 -2)))
176
177
178(defun ielm-format-error (err)
179 "Return a string form of the error ERR"
180 (format "%s%s"
181 (or (get (car err) 'error-message) "Peculiar error")
182 (if (cdr err)
183 (format ": %s" (ielm-format-errors (cdr err)))
184 "")))
185
186;;; Evaluation
187
188(defun ielm-eval-input (string)
189 "Evaluate the lisp expression STRING, and pretty-print the result"
190 ;; This is the function that actually `sends' the input to the
191 ;; `inferior lisp process'. All comint-send-input does is works out
192 ;; what that input is. What this function does is evaluates that
193 ;; input and produces `output' which gets inserted into the buffer,
194 ;; along with a new prompt. A better way of doing this might have
195 ;; been to actually send the output to the `cat' process, and write
196 ;; this as in output filter that converted sexps in the output
197 ;; stream to their evaluated value. But that would have involved
198 ;; more process coordination than I was happy to deal with.
199 (let (form ; form to evaluate
200 pos ; End posn of parse in string
201 result ; Result, or error message
202 error-type ; string, nil if no error
203 (output "") ; result to display
204 (wbuf ielm-working-buffer) ; current buffer after evaluation
205 (pmark (ielm-pm)))
206 (if (not (ielm-is-whitespace string))
207 (progn
208 (condition-case err
209 (let (rout)
210 (setq rout (read-from-string string))
211 (setq form (car rout))
212 (setq pos (cdr rout)))
213 (error (setq result (ielm-format-error err))
214 (setq error-type "Read error")))
215 (if error-type nil
216 (if (ielm-is-whitespace (substring string pos))
217 ;; need this awful let convolution to work around
218 ;; an Emacs bug involving local vbls and let binding
219 (let ((:save :)
220 (::save ::)
221 (:::save :::))
222 (save-excursion
223 (set-buffer ielm-working-buffer)
224 (condition-case err
225 (let ((: :save)
226 (:: ::save)
227 (::: :::save))
228 (save-excursion
229 (setq result (eval form))
230 (setq wbuf (current-buffer))))
231 (error (setq result (ielm-format-error err))
232 (setq error-type "Eval error"))
233 (quit (setq result "Quit during evaluation")
234 (setq error-type "Eval error")))))
235 (setq error-type "IELM error")
236 (setq result "More than one sexp in input")))
237
238 ;; If the eval changed the current buffer, mention it here
239 (if (eq wbuf ielm-working-buffer) nil
240 (message "current buffer is now: %s" wbuf)
241 (setq ielm-working-buffer wbuf))
242
243 (goto-char pmark)
244 (if (not error-type)
245 (condition-case err
246 ;; Self-referential objects cause loops in the printer, so
247 ;; trap quits here. May as well do errors, too
248 (setq output (concat output (pp-to-string result)))
249 (error (setq error-type "IELM Error")
250 (setq result "Error during pretty-printing (bug in pp)"))
251 (quit (setq error-type "IELM Error")
252 (setq result "Quit during pretty-printing"))))
253 (if error-type
254 (progn
255 (if ielm-noisy (ding))
256 (setq output (concat output "*** " error-type " *** "))
257 (setq output (concat output result)))
258 ;; There was no error, so shift the ::: values
259 (setq ::: ::)
260 (setq :: :)
261 (setq : result))
262 (setq output (concat output "\n"))))
263 (setq output (concat output ielm-prompt))
264 (comint-output-filter (ielm-process) output)))
265
266;;; Process and marker utilities
267
268(defun ielm-process nil
269 "Return the current buffer's process"
270 (get-buffer-process (current-buffer)))
271
272(defun ielm-pm nil
273 "Return the process mark of the current buffer"
274 (process-mark (get-buffer-process (current-buffer))))
275
276(defun ielm-set-pm (pos)
277 "Set the process mark in the current buffer to POS"
278 (set-marker (process-mark (get-buffer-process (current-buffer))) pos))
279
280;;; Major mode
281
282(defun inferior-emacs-lisp-mode nil
283 "Major mode for interactively evaluating Emacs-Lisp expressions
284Uses the interface provided by `comint-mode' (q.v.)
285
286\\[ielm-send-input] evaluates the sexp following the prompt. There must be at most
287one top-level sexp per prompt.
288\\[ielm-return] inserts a newline and indents. However, if the variable
289ielm-dynamic-return is non-nil (the default) then it will also evaluate
290a complete expression.
291\\[comint-dynamic-complete] completes lisp symbols (or filenames, within strings),
292or indents the line if there is nothing to complete.
293
294During evaluations, the values of the variables `:', `::', and `:::'
295are the results of the previous, second previous and third previous
296evaluations respectively.
297
298The current buffer may be changed, and its value is preserved between
299successive evaluations. In this way, expressions may be evaluated in
300a different buffer than the *ielm* buffer.
301
302Expressions evaluated by IELM are not subject to debug-on-quit or
303debug-on-error.
304
305The behaviour of IELM may be customised with the following variables:
306* To stop beeping on error, set `ielm-noisy' to nil
307* If you don't like the prompt, you can change it by setting `ielm-prompt'.
308* Set `ielm-dynamic-return' to nil for bindings like `lisp-interaction-mode'
309* Entry to this mode runs `comint-mode-hook' and `ielm-mode-hook'
310 (in that order).
311
312Customised bindings may be defined in `ielm-map', which currently contains:
313\\{ielm-map}"
314 (interactive)
315 (comint-mode)
316 (setq comint-prompt-regexp (concat "^" (regexp-quote ielm-prompt)))
317 (make-local-variable 'paragraph-start)
318 (setq paragraph-start comint-prompt-regexp)
319 (setq comint-input-sender 'ielm-input-sender)
320 (setq comint-process-echoes nil)
321 (setq comint-dynamic-complete-functions
322 '(ielm-tab comint-replace-by-expanded-history ielm-complete-filename ielm-complete-symbol))
323
324 (setq major-mode 'inferior-emacs-lisp-mode)
325 (setq mode-name "IELM")
326 (use-local-map ielm-map)
327 (set-syntax-table emacs-lisp-mode-syntax-table)
328
329 (make-local-variable 'indent-line-function)
330 (make-local-variable 'ielm-working-buffer)
331 (setq ielm-working-buffer (current-buffer))
332 (setq indent-line-function 'ielm-indent-line)
333
334 ;;; Value holders
335 (setq : nil)
336 (make-local-variable ':)
337 (setq :: nil)
338 (make-local-variable '::)
339 (setq ::: nil)
340 (make-local-variable ':::)
341
342 ;; A dummy process to keep comint happy. It will never get any input
343 (if (comint-check-proc (current-buffer)) nil
344 (start-process "ielm" (current-buffer) "cat")
345 (process-kill-without-query (ielm-process))
346 (goto-char (point-max))
347 ;; Add a silly header
348 (insert ielm-header)
349 (ielm-set-pm (point-max))
350 (comint-output-filter (ielm-process) ielm-prompt)
351 (set-marker comint-last-input-start (ielm-pm))
352 (set-process-filter (get-buffer-process (current-buffer)) 'comint-output-filter))
353 (run-hooks 'ielm-mode-hook))
354
355;;; User command
356
357(defun ielm nil
358 "Switch to or create the buffer *ielm* for evaluating emacs-lisp expressions"
359 (interactive)
360 (if (comint-check-proc "*ielm*") nil
361 (progn
362 (set-buffer (get-buffer-create "*ielm*"))
363 (inferior-emacs-lisp-mode)))
364 (switch-to-buffer "*ielm*"))
365
366;; ielm.el ends here
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
new file mode 100644
index 00000000000..ffa3003a45c
--- /dev/null
+++ b/lisp/mail/mail-hist.el
@@ -0,0 +1,282 @@
1;;; mail-hist.el --- Headers and message body history for outgoing mail.
2;; Copyright (C) 1994 Free Software Foundation, Inc.
3
4;; Author: Karl Fogel <kfogel@cs.oberlin.edu>
5;; Created: March, 1994
6;; Version: 1.2.2
7;; Keywords: mail
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;;; Commentary:
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs; see the file COPYING. If not, write to
25;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26
27;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of
28;; time.
29;;
30;; To use this package, put it in a directory in your load-path, and
31;; put this in your .emacs file:
32;;
33;; (load "mail-hist" nil t)
34;;
35;; Or you could do it with autoloads and hooks in your .emacs:
36;;
37;; (add-hook 'mail-mode-hook 'mail-hist-define-keys)
38;; (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)
39;; (add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) ;or rmail, etc
40;; (autoload 'mail-hist-define-keys "mail-hist")
41;; (autoload 'mail-hist-put-headers-into-history "mail-hist")
42;;
43;; Once it's installed, use M-p and M-n from mail headers to recover
44;; previous/next contents in the history for that header, or, in the
45;; body of the message, to recover previous/next text of the message.
46;; This only applies to outgoing mail -- mail-hist ignores received
47;; messages.
48;;
49;; Although repeated history requests do clear out the text from the
50;; previous request, an isolated request just inserts its text at
51;; point, so that you can mix the histories of different messages
52;; easily. This might be confusing at times, but there should be no
53;; problems that undo can't handle.
54
55;;; Code:
56(require 'ring)
57
58;;;###autoload
59(defun mail-hist-define-keys ()
60 "Define keys for accessing mail header history. For use in hooks."
61 (local-set-key "\M-p" 'mail-hist-previous-input)
62 (local-set-key "\M-n" 'mail-hist-next-input))
63
64;;;###autoload
65(add-hook 'mail-mode-hook 'mail-hist-define-keys)
66
67;;;###autoload
68(add-hook 'vm-mail-mode-hook 'mail-hist-define-keys)
69
70;;;###autoload
71(add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)
72
73(defvar mail-hist-header-ring-alist nil
74 "Alist of form (header-name . history-ring).
75Used for knowing which history list to look in when the user asks for
76previous/next input.")
77
78(defvar mail-hist-history-size (or kill-ring-max 1729)
79 "*The maximum number of elements in a mail field's history.
80Oldest elements are dumped first.")
81
82;;;###autoload
83(defvar mail-hist-keep-history t
84 "*Non-nil means keep a history for headers and text of outgoing mail.")
85
86;; For handling repeated history requests
87(defvar mail-hist-access-count 0)
88
89(defvar mail-hist-last-bounds nil)
90;; (start . end) A pair indicating the buffer positions delimiting the
91;; last inserted history, so it can be replaced by a new input if the
92;; command is repeated.
93
94(defvar mail-hist-header-regexp "^[^:]*:"
95 "Regular expression for matching headers in a mail message.")
96
97(defsubst mail-hist-current-header-name ()
98 "Get name of mail header point is currently in, without the colon.
99Returns nil if not in a header, implying that point is in the body of
100the message."
101 (if (save-excursion
102 (re-search-backward (concat "^" mail-header-separator) nil t))
103 nil ; then we are in the body of the message
104 (save-excursion
105 (let* ((body-start ; limit possibility of false headers
106 (save-excursion
107 (re-search-forward (concat "^" mail-header-separator) nil t)))
108 (name-start
109 (re-search-backward mail-hist-header-regexp nil t))
110 (name-end
111 (prog2 (search-forward ":" body-start t) (1- (point)))))
112 (and
113 name-start
114 name-end
115 (buffer-substring name-start name-end))))))
116
117(defsubst mail-hist-forward-header (count)
118 "Move forward COUNT headers (backward if COUNT is negative).
119If last/first header is encountered first, stop there and returns
120nil.
121
122Places point on the first non-whitespace on the line following the
123colon after the header name, or on the second space following that if
124the header is empty."
125 (let ((boundary (save-excursion
126 (re-search-forward (concat "^" mail-header-separator) nil t))))
127 (and
128 boundary
129 (let ((unstopped t))
130 (setq boundary (save-excursion
131 (goto-char boundary)
132 (beginning-of-line)
133 (1- (point))))
134 (if (> count 0)
135 (while (> count 0)
136 (setq
137 unstopped
138 (re-search-forward mail-hist-header-regexp boundary t))
139 (setq count (1- count)))
140 ;; because the current header will match too.
141 (setq count (1- count))
142 ;; count is negative
143 (while (< count 0)
144 (setq
145 unstopped
146 (re-search-backward mail-hist-header-regexp nil t))
147 (setq count (1+ count)))
148 ;; we end up behind the header, so must move to the front
149 (re-search-forward mail-hist-header-regexp boundary t))
150 ;; Now we are right after the colon
151 (and (looking-at "\\s-") (forward-char 1))
152 ;; return nil if didn't go as far as asked, otherwise point
153 unstopped))))
154
155(defsubst mail-hist-beginning-of-header ()
156 "Move to the start of the current header.
157The start of the current header is defined as one space after the
158colon, or just after the colon if it is not followed by whitespace."
159 ;; this is slick as all heck:
160 (if (mail-hist-forward-header -1)
161 (mail-hist-forward-header 1)
162 (mail-hist-forward-header 1)
163 (mail-hist-forward-header -1)))
164
165(defsubst mail-hist-current-header-contents ()
166 "Get the contents of the mail header in which point is located."
167 (save-excursion
168 (mail-hist-beginning-of-header)
169 (let ((start (point)))
170 (or (mail-hist-forward-header 1)
171 (re-search-forward (concat "^" mail-header-separator)))
172 (beginning-of-line)
173 (buffer-substring start (1- (point))))))
174
175(defsubst mail-hist-get-header-ring (header)
176 "Get HEADER's history ring, or nil if none.
177HEADER is a string without the colon."
178 (cdr (assoc header mail-hist-header-ring-alist)))
179
180(defsubst mail-hist-add-header-contents-to-ring (header &optional contents)
181 "Add the contents of HEADER to the header history ring.
182Optional argument CONTENTS is a string which will be the contents
183(instead of whatever's found in the header)."
184 (let ((ring (cdr (assoc header mail-hist-header-ring-alist))))
185 (or ring
186 ;; If the ring doesn't exist, we'll have to make it and add it
187 ;; to the mail-header-ring-alist:
188 (prog1
189 (setq ring (make-ring mail-hist-history-size))
190 (setq mail-hist-header-ring-alist
191 (cons (cons header ring) mail-hist-header-ring-alist))))
192 (ring-insert
193 ring
194 (or contents (mail-hist-current-header-contents)))))
195
196;;;###autoload
197(defun mail-hist-put-headers-into-history ()
198 "Put headers and contents of this message into mail header history.
199Each header has its own independent history, as does the body of the
200message.
201
202This function normally would be called when the message is sent."
203 (and
204 mail-hist-keep-history
205 (progn
206 (goto-char (point-min))
207 (while (mail-hist-forward-header 1)
208 (mail-hist-add-header-contents-to-ring
209 (mail-hist-current-header-name)))
210 (let ((body-contents
211 (save-excursion
212 (goto-char (point-min))
213 (re-search-forward (concat "^" mail-header-separator) nil)
214 (forward-line 1)
215 (buffer-substring (point) (point-max)))))
216 (mail-hist-add-header-contents-to-ring "body" body-contents)))))
217
218(defun mail-hist-previous-input (header)
219 "Insert the previous contents of this mail header or message body.
220Moves back through the history of sent mail messages. Each header has
221its own independent history, as does the body of the message.
222
223The history only contains the contents of outgoing messages, not
224received mail."
225 (interactive (list (or (mail-hist-current-header-name) "body")))
226 (let* ((ring (cdr (assoc header mail-hist-header-ring-alist)))
227 (len (ring-length ring))
228 (repeat (eq last-command 'mail-hist-input-access)))
229 (if repeat
230 (setq mail-hist-access-count
231 (ring-plus1 mail-hist-access-count len))
232 (setq mail-hist-access-count 0))
233 (if (null ring)
234 (progn
235 (ding)
236 (message "No history for \"%s\"." header))
237 (if (ring-empty-p ring)
238 (error "\"%s\" ring is empty." header)
239 (and repeat
240 (delete-region (car mail-hist-last-bounds)
241 (cdr mail-hist-last-bounds)))
242 (let ((start (point)))
243 (insert (ring-ref ring mail-hist-access-count))
244 (setq mail-hist-last-bounds (cons start (point)))
245 (setq this-command 'mail-hist-input-access))))))
246
247(defun mail-hist-next-input (header)
248 "Insert next contents of this mail header or message body.
249Moves back through the history of sent mail messages. Each header has
250its own independent history, as does the body of the message.
251
252Although you can do so, it does not make much sense to call this
253without having called `mail-hist-previous-header' first
254(\\[mail-hist-previous-header]).
255
256The history only contains the contents of outgoing messages, not
257received mail."
258 (interactive (list (or (mail-hist-current-header-name) "body")))
259 (let* ((ring (cdr (assoc header mail-hist-header-ring-alist)))
260 (len (ring-length ring))
261 (repeat (eq last-command 'mail-hist-input-access)))
262 (if repeat
263 (setq mail-hist-access-count
264 (ring-minus1 mail-hist-access-count len))
265 (setq mail-hist-access-count 0))
266 (if (null ring)
267 (progn
268 (ding)
269 (message "No history for \"%s\"." header))
270 (if (ring-empty-p ring)
271 (error "\"%s\" ring is empty." header)
272 (and repeat
273 (delete-region (car mail-hist-last-bounds)
274 (cdr mail-hist-last-bounds)))
275 (let ((start (point)))
276 (insert (ring-ref ring mail-hist-access-count))
277 (setq mail-hist-last-bounds (cons start (point)))
278 (setq this-command 'mail-hist-input-access))))))
279
280(provide 'mail-hist)
281
282;; mail-hist.el ends here
diff --git a/lisp/mldrag.el b/lisp/mldrag.el
new file mode 100644
index 00000000000..419e0e556e0
--- /dev/null
+++ b/lisp/mldrag.el
@@ -0,0 +1,226 @@
1;;; mldrag.el -- Mode line and vertical line dragging to resize windows.
2;;; Copyright (C) 1994 Free Software Foundation, Inc.
3
4;; Author: Kyle E. Jones <kyle@wonderworks.com>
5;; Keywords: mouse
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 2, or (at your option)
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to
21;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
23;;; Commentary:
24
25;; This package lets you drag the modeline, vertical bar and
26;; scrollbar to resize windows. Suggested bindings are:
27;;
28;; (global-set-key [mode-line down-mouse-1] 'mldrag-drag-mode-line)
29;; (global-set-key [vertical-line down-mouse-1] 'mldrag-drag-vertical-line)
30;; (global-set-key [vertical-scroll-bar S-down-mouse-1]
31;; 'mldrag-drag-vertical-line)
32;;
33;; Put the bindings and (require 'mldrag) in your .emacs file.
34
35;;; Code:
36
37(provide 'mldrag)
38
39(defun mldrag-drag-mode-line (start-event)
40 "Change the height of the current window with the mouse.
41This command should be bound to a down-mouse- event, and is most
42usefully bound with the `mode-line' prefix. Holding down a mouse
43button and moving the mouse up and down will make the clicked-on
44window taller or shorter."
45 (interactive "e")
46 (let ((done nil)
47 (echo-keystrokes 0)
48 (start-event-frame (window-frame (car (car (cdr start-event)))))
49 (start-event-window (car (car (cdr start-event))))
50 (start-nwindows (count-windows t))
51 (old-selected-window (selected-window))
52 should-enlarge-minibuffer
53 event mouse minibuffer y top bot edges wconfig params growth)
54 (setq params (frame-parameters))
55 (if (and (not (setq minibuffer (cdr (assq 'minibuffer params))))
56 (one-window-p t))
57 (error "Attempt to resize sole window"))
58 (unwind-protect
59 (track-mouse
60 (progn
61 ;; enlarge-window only works on the selected window, so
62 ;; we must select the window where the start event originated.
63 ;; unwind-protect will restore the old selected window later.
64 (select-window start-event-window)
65 ;; if this is the bottommost ordinary window, then to
66 ;; move its modeline the minibuffer must be enlarged.
67 (setq should-enlarge-minibuffer
68 (and minibuffer
69 (not (one-window-p t))
70 (= (nth 1 (window-edges minibuffer))
71 (nth 3 (window-edges)))))
72 ;; loop reading events and sampling the position of
73 ;; the mouse.
74 (while (not done)
75 (setq event (read-event)
76 mouse (mouse-position))
77 ;; do nothing if
78 ;; - there is a switch-frame event.
79 ;; - the mouse isn't in the frame that we started in
80 ;; - the mouse isn't in any Emacs frame
81 ;; drag if
82 ;; - there is a mouse-movement event
83 ;; - there is a scroll-bar-movement event
84 ;; (same as mouse movement for our purposes)
85 ;; quit if
86 ;; - there is a keyboard event or some other unknown event
87 ;; unknown event.
88 (cond ((integerp event)
89 (setq done t))
90 ((eq (car event) 'switch-frame)
91 nil)
92 ((not (memq (car event)
93 '(mouse-movement scroll-bar-movement)))
94 (setq done t))
95 ((not (eq (car mouse) start-event-frame))
96 nil)
97 ((null (car (cdr mouse)))
98 nil)
99 (t
100 (setq y (cdr (cdr mouse))
101 edges (window-edges)
102 top (nth 1 edges)
103 bot (nth 3 edges))
104 ;; scale back a move that would make the
105 ;; window too short.
106 (cond ((< (- y top -1) window-min-height)
107 (setq y (+ top window-min-height -1))))
108 ;; compute size change needed
109 (setq growth (- y bot -1)
110 wconfig (current-window-configuration))
111 ;; grow/shrink minibuffer?
112 (if should-enlarge-minibuffer
113 (progn
114 ;; yes. briefly select minibuffer so
115 ;; ealarge-window will affect the
116 ;; correct window.
117 (select-window minibuffer)
118 ;; scale back shrinkage if it would
119 ;; make the minibuffer less than 1
120 ;; line tall.
121 (if (and (> growth 0)
122 (< (- (window-height minibuffer)
123 growth)
124 1))
125 (setq growth (1- (window-height minibuffer))))
126 (enlarge-window (- growth))
127 (select-window start-event-window))
128 ;; no. grow/shrink the selected window
129 (enlarge-window growth))
130 ;; if this window's growth caused another
131 ;; window to be deleted because it was too
132 ;; short, rescind the change.
133 ;;
134 ;; if size change caused space to be stolen
135 ;; from a window above this one, rescind the
136 ;; change, but only if we didn't grow/srhink
137 ;; the minibuffer. minibuffer size changes
138 ;; can cause all windows to shrink... no way
139 ;; around it.
140 (if (or (/= start-nwindows (count-windows t))
141 (and (not should-enlarge-minibuffer)
142 (/= top (nth 1 (window-edges)))))
143 (set-window-configuration wconfig)))))))
144 ;; restore the old selected window
145 (select-window old-selected-window))))
146
147(defun mldrag-drag-vertical-line (start-event)
148 "Change the width of the current window with the mouse.
149This command should be bound to a down-mouse- event, and is most
150usefully bound with the `vertical-line' or the `vertical-scroll-bar'
151prefix. Holding down a mouse button and moving the mouse left and
152right will make the clicked-on window thinner or wider."
153 (interactive "e")
154 (let ((done nil)
155 (echo-keystrokes 0)
156 (start-event-frame (window-frame (car (car (cdr start-event)))))
157 (start-event-window (car (car (cdr start-event))))
158 (start-nwindows (count-windows t))
159 (old-selected-window (selected-window))
160 event mouse x left right edges wconfig growth)
161 (if (one-window-p t)
162 (error "Attempt to resize sole ordinary window"))
163 (if (= (nth 2 (window-edges start-event-window))
164 (frame-width start-event-frame))
165 (error "Attempt to drag rightmost scrollbar"))
166 (unwind-protect
167 (track-mouse
168 (progn
169 ;; enlarge-window only works on the selected window, so
170 ;; we must select the window where the start event originated.
171 ;; unwind-protect will restore the old selected window later.
172 (select-window start-event-window)
173 ;; loop reading events and sampling the position of
174 ;; the mouse.
175 (while (not done)
176 (setq event (read-event)
177 mouse (mouse-position))
178 ;; do nothing if
179 ;; - there is a switch-frame event.
180 ;; - the mouse isn't in the frame that we started in
181 ;; - the mouse isn't in any Emacs frame
182 ;; drag if
183 ;; - there is a mouse-movement event
184 ;; - there is a scroll-bar-movement event
185 ;; (same as mouse movement for our purposes)
186 ;; quit if
187 ;; - there is a keyboard event or some other unknown event
188 ;; unknown event.
189 (cond ((integerp event)
190 (setq done t))
191 ((eq (car event) 'switch-frame)
192 nil)
193 ((not (memq (car event)
194 '(mouse-movement scroll-bar-movement)))
195 (setq done t))
196 ((not (eq (car mouse) start-event-frame))
197 nil)
198 ((null (car (cdr mouse)))
199 nil)
200 (t
201 (setq x (car (cdr mouse))
202 edges (window-edges)
203 left (nth 0 edges)
204 right (nth 2 edges))
205 ;; scale back a move that would make the
206 ;; window too thin.
207 (cond ((< (- x left -1) window-min-width)
208 (setq x (+ left window-min-width -1))))
209 ;; compute size change needed
210 (setq growth (- x right -1)
211 wconfig (current-window-configuration))
212 (enlarge-window growth t)
213 ;; if this window's growth caused another
214 ;; window to be deleted because it was too
215 ;; thin, rescind the change.
216 ;;
217 ;; if size change caused space to be stolen
218 ;; from a window to the left of this one,
219 ;; rescind the change.
220 (if (or (/= start-nwindows (count-windows t))
221 (/= left (nth 0 (window-edges))))
222 (set-window-configuration wconfig)))))))
223 ;; restore the old selected window
224 (select-window old-selected-window))))
225
226;; mldrag.el ends here
diff --git a/lisp/rsz-mini.el b/lisp/rsz-mini.el
new file mode 100644
index 00000000000..3801b023681
--- /dev/null
+++ b/lisp/rsz-mini.el
@@ -0,0 +1,200 @@
1;;; rsz-mini.el --- dynamically resize minibuffer to display entire contents
2
3;;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc.
4
5;;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
6;;; Roland McGrath <roland@prep.ai.mit.edu>
7;;; Maintainer: friedman@prep.ai.mit.edu
8;;; Keywords: minibuffer, window, frame, display
9;;; Status: Known to work in FSF GNU Emacs 19.23.
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation; either version 2, or (at your option)
16;; any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs; see the file COPYING. If not, write to
25;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26
27;;; Commentary:
28
29;;; This package allows the entire contents (or as much as possible) of the
30;;; minibuffer to be visible at once when typing. As the end of a line is
31;;; reached, the minibuffer will resize itself. When the user is done
32;;; typing, the minibuffer will return to its original size.
33
34;;; In window systems where it is possible to have a frame in which the
35;;; minibuffer is the only window, the frame itself can be resized. In FSF
36;;; GNU Emacs 19.22 and earlier, the frame may not be properly returned to
37;;; its original size after it ceases to be active because
38;;; `minibuffer-exit-hook' didn't exist until version 19.23.
39
40;;; Note that the minibuffer and echo area are not the same! They simply
41;;; happen to occupy roughly the same place on the frame. Messages put in
42;;; the echo area will not cause any resizing by this package.
43
44;;; This package is considered a minor mode but it doesn't put anything in
45;;; minor-mode-alist because this mode is specific to the minibuffer, which
46;;; has no mode line.
47
48;;; To use this package, put the following in your .emacs:
49;;;
50;;; (autoload 'resize-minibuffer-mode "rsz-mini" nil t)
51;;;
52;;; Invoking the command `resize-minibuffer-mode' will then enable this mode.
53
54;;; Code:
55
56
57;;;###autoload
58(defvar resize-minibuffer-mode nil
59 "*If non-`nil', resize the minibuffer so its entire contents are visible.")
60
61;;;###autoload
62(defvar resize-minibuffer-window-max-height nil
63 "*Maximum size the minibuffer window is allowed to become.
64If less than 1 or not a number, the limit is the height of the frame in
65which the active minibuffer window resides.")
66
67;;;###autoload
68(defvar resize-minibuffer-window-exactly t
69 "*If non-`nil', make minibuffer exactly the size needed to display all its contents.
70Otherwise, the minibuffer window can temporarily increase in size but
71never get smaller while it is active.")
72
73
74;;;###autoload
75(defvar resize-minibuffer-frame nil
76 "*If non-`nil' and the active minibuffer is the sole window in its frame, allow changing the frame height.")
77
78;;;###autoload
79(defvar resize-minibuffer-frame-max-height nil
80 "*Maximum size the minibuffer frame is allowed to become.
81If less than 1 or not a number, there is no limit.")
82
83;;;###autoload
84(defvar resize-minibuffer-frame-exactly nil
85 "*If non-`nil', make minibuffer frame exactly the size needed to display all its contents.
86Otherwise, the minibuffer frame can temporarily increase in size but
87never get smaller while it is active.")
88
89
90;;;###autoload
91(defun resize-minibuffer-mode (&optional prefix)
92 "Enable or disable resize-minibuffer mode.
93A negative prefix argument disables this mode. A positive argument or
94argument of 0 enables it.
95
96When this minor mode is enabled, the minibuffer is dynamically resized to
97contain the entire region of text put in it as you type.
98
99The variable `resize-minibuffer-mode' is set to t or nil depending on
100whether this mode is active or not.
101
102The maximum height to which the minibuffer can grow is controlled by the
103variable `resize-minibuffer-window-max-height'.
104
105The variable `resize-minibuffer-window-exactly' determines whether the
106minibuffer window should ever be shrunk to make it no larger than needed to
107display its contents.
108
109When using a window system, it is possible for a minibuffer to tbe the sole
110window in a frame. Since that window is already its maximum size, the only
111way to make more text visible at once is to increase the size of the frame.
112The variable `resize-minibuffer-frame' controls whether this should be
113done. The variables `resize-minibuffer-frame-max-height' and
114`resize-minibuffer-frame-exactly' are analogous to their window
115counterparts."
116 (interactive "p")
117 (or prefix (setq prefix 0))
118 (cond
119 ((>= prefix 0)
120 (setq resize-minibuffer-mode t))
121 (t
122 (setq resize-minibuffer-mode nil))))
123
124(defun resize-minibuffer-setup ()
125 (cond
126 (resize-minibuffer-mode
127 (cond
128 ((and window-system
129 (eq 'only (cdr (assq 'minibuffer (frame-parameters)))))
130 (and resize-minibuffer-frame
131 (progn
132 (make-local-variable 'minibuffer-exit-hook)
133 (add-hook 'minibuffer-exit-hook 'resize-minibuffer-frame-restore)
134 (make-local-variable 'post-command-hook)
135 (add-hook 'post-command-hook 'resize-minibuffer-frame))))
136 (t
137 (make-local-variable 'post-command-hook)
138 (add-hook 'post-command-hook 'resize-minibuffer-window))))))
139
140(defun resize-minibuffer-count-window-lines (&optional start end)
141 "Return number of window lines occupied by text in region.
142The number of window lines may be greater than the number of actual lines
143in the buffer if any wrap on the display due to their length.
144
145Optional arguments START and END default to point-min and point-max,
146respectively."
147 (or start (setq start (point-min)))
148 (or end (setq end (point-max)))
149 (if (= start end)
150 0
151 (save-excursion
152 (save-restriction
153 (widen)
154 (narrow-to-region start end)
155 (goto-char start)
156 (vertical-motion (buffer-size))))))
157
158
159;; Resize the minibuffer window to contain the minibuffer's contents.
160;; The minibuffer must be the current window.
161(defun resize-minibuffer-window ()
162 (let ((height (window-height))
163 (lines (1+ (resize-minibuffer-count-window-lines))))
164 (and (numberp resize-minibuffer-window-max-height)
165 (> resize-minibuffer-window-max-height 0)
166 (setq lines (min lines resize-minibuffer-window-max-height)))
167 (or (if resize-minibuffer-window-exactly
168 (= lines height)
169 (<= lines height))
170 (enlarge-window (- lines height)))))
171
172
173;; Resize the minibuffer frame to contain the minibuffer's contents.
174;; The minibuffer frame must be the current frame.
175(defun resize-minibuffer-frame ()
176 (let ((height (frame-height))
177 (lines (1+ (resize-minibuffer-count-window-lines))))
178 (and (numberp resize-minibuffer-frame-max-height)
179 (> resize-minibuffer-frame-max-height 0)
180 (setq lines (min lines resize-minibuffer-frame-max-height)))
181 (cond
182 ((> lines height)
183 (set-frame-size (selected-frame) (frame-width) lines))
184 ((and resize-minibuffer-frame-exactly
185 (> height (cdr (assq 'height minibuffer-frame-alist)))
186 (< lines height))
187 (set-frame-size (selected-frame) (frame-width) lines)))))
188
189;; Restore the original height of the frame.
190(defun resize-minibuffer-frame-restore ()
191 (set-frame-size (selected-frame)
192 (frame-width)
193 (cdr (assq 'height minibuffer-frame-alist))))
194
195
196(provide 'rsz-mini)
197
198(add-hook 'minibuffer-setup-hook 'resize-minibuffer-setup)
199
200;; rsz-mini.el ends here
diff --git a/lisp/tempo.el b/lisp/tempo.el
new file mode 100644
index 00000000000..f6c6676ce40
--- /dev/null
+++ b/lisp/tempo.el
@@ -0,0 +1,449 @@
1;;; tempo.el --- templates with hotspots
2;; Copyright (C) 1994 Free Software Foundation, Inc.
3
4;; Author: David Kegedal <davidk@lysator.liu.se >
5;; Created: 16 Feb 1994
6;; Version: 1.0
7;; Keywords: extensions, languages, tools
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to
23;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24
25;;; Commentary:
26
27;; This file provides a simple way to define powerful templates, or
28;; macros, if you wish. It is mainly intended for, but not limited to,
29;; other programmers to be used for creating shortcuts for editing
30;; certain kind of documents. It was originally written to be used by
31;; a HTML editing mode written by Nelson Minar <nelson@reed.edu>, and
32;; his html-helper-mode.el is probably the best example of how to use
33;; this program.
34
35;; A template is defined as a list of items to be inserted in the
36;; current buffer at point. Some of the items can be simple strings,
37;; while other can control formatting or define special points of
38;; interest in the inserted text.
39
40;; If a template defines a "point of interest" that point is inserted
41;; in a buffer-local list of "points of interest" that the user can
42;; jump between with the commands `tempo-backward-mark' and
43;; `tempo-forward-mark'. If the template definer provides a prompt for
44;; the point, and the variable `tempo-interactive' is non-nil, the
45;; user will be prompted for a string to be inserted in the buffer,
46;; using the minibuffer.
47
48;; The template can also define one point to be replaced with the
49;; current region if the template command is called with a prefix (or
50;; a non-nil argument).
51
52;; More flexible templates can be created by including lisp symbols,
53;; which will be evaluated as variables, or lists, which will will be
54;; evaluated as lisp expressions.
55
56;; See the documentation for tempo-define-template for the different
57;; items that can be used to define a tempo template.
58
59;; One of the more powerful features of tempo templates are automatic
60;; completion. With every template can be assigned a special tag that
61;; should be recognized by `tempo-complete-tag' and expanded to the
62;; complete template. By default the tags are added to a global list
63;; of template tags, and are matched against the last word before
64;; point. But if you assign your tags to a specific list, you can also
65;; specify another method for matching text in the buffer against the
66;; tags. In the HTML mode, for instance, the tags are matched against
67;; the text between the last `<' and point.
68
69;; When defining a template named `foo', a symbol named
70;; `tempo-template-foo' will be created whose value as a variable will
71;; be the template definition, and its function value will be an
72;; interactive function that inserts the template at the point.
73
74;; Full documentation for tempo.el can be found on the World Wide Web
75;; at http://www.lysator.liu.se:7500/~davidk/tempo.html (not yet
76;; completed)
77
78;; The latest tempo.el distribution can be fetched from
79;; ftp.lysator.liu.se in the directory /pub/emacs
80
81;;; Code:
82
83(provide 'tempo)
84
85;;; Variables
86
87(defvar tempo-interactive nil
88 "*Prompt user for strings in templates.
89If this variable is non-nil, `tempo-insert' prompts the
90user for text to insert in the templates")
91
92(defvar tempo-insert-string-functions nil
93 "List of functions to run when inserting a string.
94Each function is called with a single arg, STRING." )
95
96(defvar tempo-tags nil
97 "An association list with tags and corresponding templates")
98
99(defvar tempo-local-tags '((tempo-tags . nil))
100 "A list of locally installed tag completion lists.
101
102It is a association list where the car of every element is a symbol
103whose varable value is a template list. The cdr part, if non-nil, is a
104function or a regexp that defines the string to match. See the
105documentation for the function `tempo-complete-tag' for more info.
106
107`tempo-tags' is always in the last position in this list.")
108
109(defvar tempo-marks nil
110 "A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.")
111
112(defvar tempo-default-match-finder "\\b\\([^\\b]*\\)\\="
113 "The default regexp used to find the string to match against the tags.")
114
115;; Make some variables local to every buffer
116
117(make-variable-buffer-local 'tempo-marks)
118(make-variable-buffer-local 'tempo-local-tags)
119
120;;; Functions
121
122;;
123;; tempo-define-template
124
125(defun tempo-define-template (name elements &optional tag documentation taglist)
126 "Define a template.
127This function creates a template variable `tempo-template-NAME' and an
128interactive function `tempo-template-NAME' that inserts the template
129at the point. The created function is returned.
130
131NAME is a string that contains the name of the template, ELEMENTS is a
132list of elements in the template, TAG is the tag used for completion,
133DOCUMENTATION is the documentation string for the insertion command
134created, and TAGLIST (a symbol) is the tag list that TAG (if provided)
135should be added to). If TAGLIST is nil and TAG is non-nil, TAG is
136added to `tempo-tags'
137
138The elements in ELEMENTS can be of several types:
139
140 - A string. It is sent to the hooks in `tempo-insert-string-functions',
141 and the result is inserted.
142 - The symbol 'p. This position is saved in `tempo-marks'.
143 - The symbol 'r. If `tempo-insert' is called with ON-REGION non-nil
144 the current region is placed here. Otherwise it works like 'p.
145 - (p . PROMPT) If `tempo-interactive' is non-nil, the user is
146 prompted in the minbuffer with PROMPT for a string to be inserted.
147 If `tempo-interactive is nil, it works like 'p.
148 - (r . PROMPT) like the previou, but if `tempo-interactive' is nil
149 and `tempo-insert' is called with ON-REGION non-nil, the current
150 region is placed here.
151 - '& If there is only whitespace between the line start and point,
152 nothing happens. Otherwise a newline is inserted.
153 - '% If there is only whitespace between point and end-of-line
154 nothing happens. Otherwise a newline is inserted.
155 - 'n inserts a newline.
156 - '> The line is indented using `indent-according-to-mode'. Note that
157 you often should place this item after the text you want on the
158 line.
159 - 'n> inserts a newline and indents line.
160 - nil. It is ignored.
161 - Anything else. It is evaluated and the result is parsed again."
162
163 (let* ((template-name (intern (concat "tempo-template-"
164 name)))
165 (command-name template-name))
166 (set template-name elements)
167 (fset command-name (list 'lambda (list '&optional 'arg)
168 (or documentation
169 (concat "Insert a " name "."))
170 (list 'interactive "*P")
171 (list 'tempo-insert-template (list 'quote
172 template-name)
173 'arg)))
174 (and tag
175 (tempo-add-tag tag template-name taglist))
176 command-name))
177
178;;;
179;;; tempo-insert-template
180
181(defun tempo-insert-template (template on-region)
182 "Insert a template.
183TEMPLATE is the template to be inserted. If ON-REGION is non-nil the
184`r' elements are replaced with the current region."
185 (and on-region
186 (< (mark) (point))
187 (exchange-point-and-mark))
188 (save-excursion
189 (tempo-insert-mark (point-marker))
190 (mapcar 'tempo-insert
191 (symbol-value template))
192 (tempo-insert-mark (point-marker)))
193 (tempo-forward-mark))
194
195;;;
196;;; tempo-insert
197
198(defun tempo-insert (element)
199 "Insert a template element.
200Insert one element from a template. See documentation for
201`tempo-define-template' for the kind of elements possible."
202 (cond ((stringp element) (tempo-process-and-insert-string element))
203 ((and (consp element) (eq (car element) 'p))
204 (tempo-insert-prompt (cdr element)))
205 ((and (consp element) (eq (car element) 'r))
206 (if on-region
207 (exchange-point-and-mark)
208 (tempo-insert-prompt (cdr element))))
209 ((eq element 'p) (tempo-insert-mark (point-marker)))
210 ((eq element 'r) (if on-region
211 (exchange-point-and-mark)
212 (tempo-insert-mark (point-marker))))
213 ((eq element '>) (indent-according-to-mode))
214 ((eq element '&) (if (not (or (= (current-column) 0)
215 (save-excursion
216 (re-search-backward
217 "^\\s-*\\=" nil t))))
218 (insert "\n")))
219 ((eq element '%) (if (not (or (eolp)
220 (save-excursion
221 (re-search-forward
222 "\\=\\s-*$" nil t))))
223 (insert "\n")))
224 ((eq element 'n) (insert "\n"))
225 ((eq element 'n>) (insert "\n") (indent-according-to-mode))
226 ((null element))
227 (t (tempo-insert (eval element)))))
228
229;;;
230;;; tempo-insert-prompt
231
232(defun tempo-insert-prompt (prompt)
233 "Prompt for a text string and insert it in the current buffer.
234If the variable `tempo-interactive' is non-nil the user is prompted
235for a string in the minibuffer, which is then inserted in the current
236buffer. If `tempo-interactive' is nil, the current point is placed on
237`tempo-forward-mark-list'.
238
239PROMPT is the prompt string."
240 (if tempo-interactive
241 (insert (read-string prompt))
242 (tempo-insert-mark (point-marker))))
243
244;;;
245;;; tempo-process-and-insert-string
246
247(defun tempo-process-and-insert-string (string)
248 "Insert a string from a template.
249Run a string through the preprocessors in `tempo-insert-string-functions'
250and insert the results."
251
252 (cond ((null tempo-insert-string-functions)
253 nil)
254 ((symbolp tempo-insert-string-functions)
255 (setq string
256 (apply tempo-insert-string-functions (list string))))
257 ((listp tempo-insert-string-functions)
258 (mapcar (function (lambda (fn)
259 (setq string (apply fn string))))
260 tempo-insert-string-functions))
261 (t
262 (error "Bogus value in tempo-insert-string-functions: %s"
263 tempo-insert-string-functions)))
264 (insert string))
265
266;;;
267;;; tempo-insert-mark
268
269(defun tempo-insert-mark (mark)
270 "Insert a mark `tempo-marks' while keeping it sorted"
271 (cond ((null tempo-marks) (setq tempo-marks (list mark)))
272 ((< mark (car tempo-marks)) (setq tempo-marks (cons mark tempo-marks)))
273 (t (let ((lp tempo-marks))
274 (while (and (cdr lp)
275 (<= (car (cdr lp)) mark))
276 (setq lp (cdr lp)))
277 (if (not (= mark (car lp)))
278 (setcdr lp (cons mark (cdr lp))))))))
279
280;;;
281;;; tempo-forward-mark
282
283(defun tempo-forward-mark ()
284 "Jump to the next mark in `tempo-forward-mark-list'."
285 (interactive)
286 (let ((next-mark (catch 'found
287 (mapcar
288 (function
289 (lambda (mark)
290 (if (< (point) mark)
291 (throw 'found mark))))
292 tempo-marks)
293 ;; return nil if not found
294 nil)))
295 (if next-mark
296 (goto-char next-mark))))
297
298;;;
299;;; tempo-backward-mark
300
301(defun tempo-backward-mark ()
302 "Jump to the previous mark in `tempo-back-mark-list'."
303 (interactive)
304 (let ((prev-mark (catch 'found
305 (let (last)
306 (mapcar
307 (function
308 (lambda (mark)
309 (if (<= (point) mark)
310 (throw 'found last))
311 (setq last mark)))
312 tempo-marks)
313 last))))
314 (if prev-mark
315 (goto-char prev-mark))))
316
317;;;
318;;; tempo-add-tag
319
320(defun tempo-add-tag (tag template &optional tag-list)
321 "Add a template tag.
322
323Add the TAG, that should complete to TEMPLATE to the list in TAG-LIST,
324or to `tempo-tags' if TAG-LIST is nil."
325
326 (interactive "sTag: \nCTemplate: ")
327 (if (null tag-list)
328 (setq tag-list 'tempo-tags))
329 (if (not (assoc tag (symbol-value tag-list)))
330 (set tag-list (cons (cons tag template) (symbol-value tag-list)))))
331
332;;;
333;;; tempo-use-tag-list
334
335(defun tempo-use-tag-list (tag-list &optional completion-function)
336 "Install TAG-LIST to be used for template completion in the current buffer.
337
338TAG-LIST is a symbol whose variable value is a tag list created with
339`tempo-add-tag' and COMPLETION-FUNCTION is an optional function or
340string that is used by `\\[tempo-complete-tag]' to find a string to
341match the tag against.
342
343If COMPLETION-FUNCTION is a string, it should contain a regular
344expression with at least one \\( \\) pair. When searching for tags,
345`tempo-complete-tag' calls `re-search-backward' with this string, and
346the string between the first \\( and \\) is used for matching against
347each string in the tag list. If one is found, the whole text between
348the first \\( and the point is replaced with the inserted template.
349
350You will probably want to include \\ \= at the end of the regexp to make
351sure that the string is matched only against text adjacent to the
352point.
353
354If COPMLETION-FUNCTION is a symbol, it should be a function that
355returns a cons cell of the form (STRING . POS), where STRING is the
356string used for matching and POS is the buffer position after which
357text should be replaced with a template."
358
359 (let ((old (assq tag-list tempo-local-tags)))
360 (if old
361 (setcdr old completion-function)
362 (setq tempo-local-tags (cons (cons tag-list completion-function)
363 tempo-local-tags)))))
364
365;;;
366;;; tempo-find-match-string
367
368(defun tempo-find-match-string (finder)
369 "Find a string to be matched against a tag list.
370
371FINDER is a function or a string. Returns (STRING . POS)."
372 (cond ((stringp finder)
373 (save-excursion
374 (re-search-backward finder nil t))
375 (cons (buffer-substring (match-beginning 1) (1+ (match-end 1)))
376 (match-beginning 1)))
377 (t
378 (funcall finder))))
379
380;;;
381;;; tempo-complete-tag
382
383(defun tempo-complete-tag (&optional silent)
384 "Look for a tag and expand it..
385
386It goes through the tag lists in `tempo-local-tags' (this includes
387`tempo-tags') and for each list it uses the corresponding match-finder
388function, or `tempo-default-match-finder' if none is given, and tries
389to match the match string against the tags in the list using
390`try-completion'. If none is found it proceeds to the next list until
391one is found. If a partial completion is found, it is replaced by the
392template if it can be completed uniquely, or completed as far as
393possible.
394
395When doing partial completion, only tags in the currently examined
396list are considered, so if you provide similar tags in different lists
397in `tempo-local-tags', the result may not be desirable.
398
399If no match is found or a partial match is found, and SILENT is
400non-nil, the function will give a signal."
401
402 (interactive)
403 (if (catch 'completed
404 (mapcar
405 (function
406 (lambda (tag-list-a)
407 (let* ((tag-list (symbol-value(car tag-list-a)))
408 (match-string-finder (or (cdr tag-list-a)
409 tempo-default-match-finder))
410 (match-info (tempo-find-match-string match-string-finder))
411 (match-string (car match-info))
412 (match-start (cdr match-info))
413 (compl (or (cdr (assoc match-string tag-list))
414 (try-completion (car match-info)
415 tag-list))))
416
417 (if compl ;any match
418 (delete-region match-start (point)))
419
420 (cond
421 ((null compl)
422 nil)
423 ((symbolp compl)
424 (tempo-insert-template compl nil)
425 (throw 'completed t))
426 ((eq compl t)
427 (tempo-insert-template (cdr (assoc match-string tag-list))
428 nil)
429 (throw 'completed t))
430 ((stringp compl)
431 (let ((compl2 (assoc compl tag-list)))
432 (if compl2
433 (tempo-insert-template (cdr compl2) nil)
434 (insert compl)
435 (if (string= match-string compl)
436 (if (not silent)
437 (ding)))))
438 (throw 'completed t))))))
439 tempo-local-tags)
440 ;; No completion found. Return nil
441 nil)
442 ;; Do nothing if a completion was found
443 t
444 ;; No completion was found
445 (if (not silent)
446 (ding))
447 nil))
448
449;;; tempo.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-19 16:36:33 +0000