comparison lisp/textmodes/two-column.el @ 809:8a0066235d56

Initial revision
author Eric S. Raymond <esr@snark.thyrsus.com>
date Fri, 17 Jul 1992 06:48:03 +0000
parents
children 113281b361ec
comparison
equal deleted inserted replaced
808:707866b2a190 809:8a0066235d56
1 ;;; two-column.el --- minor mode for editing of two-column text
2
3 ;; Author: Daniel Pfeiffer <pfeiffer@cix.cict.fr>
4 ;; Last-Modified: 14 May 1991
5 ;; Adapted-By: ESR
6
7 ;; Copyright (C) 1992 Free Software Foundation, Inc.
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 1, 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 ;; --8<---- two-column.el ----8<--------8<--------8<--------8<--------8<-------
28 ;; Esperanto: English:
29
30 ;; Minora modalo por samtempa dukolumna Minor mode for simultaneous
31 ;; tajpado two-column editing
32
33 ;; ^Ci dataro estas ero de GNU Emacs. This file is part of GNU Emacs.
34
35 ;; GNU Emacs estas disdonata en la GNU Emacs is distributed in the hope
36 ;; espero ke ^gi estos utila, sed SEN that it will be useful, but WITHOUT
37 ;; IA GARANTIO. Neniu a^utoro a^u ANY WARRANTY. No author or
38 ;; disdonanto akceptas respondecon al distributor accepts responsibility
39 ;; iu ajn por la sekvoj de ^gia uzado, to anyone for the consequences of
40 ;; a^u ^cu ^gi serveblas al iu celo, using it or for whether it serves
41 ;; a^u e^c entute funkcias, se li ni any particular purpose or works at
42 ;; estas skribinta tion. Vidu la GNU all, unless he says so in writing.
43 ;; Emacs ^Generala Publika Licenco por Refer to the GNU Emacs General
44 ;; plenaj detaloj. Public License for full details.
45
46 ;; ^Ciu rajtas kopii, modifi kaj ree Everyone is granted permission to
47 ;; disdoni GNU Emacs, sed nur sub la copy, modify and redistribute GNU
48 ;; condi^coj priskribitaj en la GNU Emacs, but only under the conditions
49 ;; Emacs ^Generala Publika Licenco. described in the GNU Emacs General
50 ;; Kopio de tiu licenso estas supozata Public License. A copy of this
51 ;; donita al vi kune kun GNU Emacs, por license is supposed to have been
52 ;; ke vi sciu viajn rajtojn kaj given to you along with GNU Emacs so
53 ;; respondecojn. ^Gi devus esti en you can know your rights and
54 ;; dataro nomata COPYING. Inter responsibilities. It should be in a
55 ;; alia^joj, la notico pri kopirajto file named COPYING. Among other
56 ;; kaj ^ci notico devas esti gardata things, the copyright notice and
57 ;; sur ^ciuj kopioj. this notice must be preserved on all
58 ;; copies.
59
60
61 ;; Tiu minora modalo ebligas al vi This minor mode allows you to
62 ;; tajpi sendepende en du apudaj independently edit two adjacent
63 ;; bufroj. Vi havas tri eblecojn por buffers. You have three ways to
64 ;; eki ^gin. ^Ciu donas al vi start it up. Each gives you a
65 ;; horizontale disigatan fenestron, horizontally split window similar to
66 ;; simila al fina apareco de via the final outcome of your text:
67 ;; teksto:
68
69 ;; C-x 6 2 asocias novan bufron nomatan associates a new buffer called
70 ;; same, sed kun 2C/ anta^u. the same, but with 2C/
71 ;; prepended.
72
73 ;; C-x 6 b asocias alian bufron. Vi povas associates another buffer.
74 ;; anka^u asocii dataron, se vi This can be used to associate a
75 ;; ^jus anta^ue faris C-x C-f. file if you just did C-x C-f.
76
77 ;; C-x 6 u disigas jam dukolumnan tekston unmerges a two-column text into
78 ;; en du bufroj ekde la nuna two buffers from the current
79 ;; linio, kaj je la nuna kolumno. line and at the current column.
80 ;; La anta^uaj signoj (ofte The preceding characters (often
81 ;; tabeligilo a^u |) estas la tab or |) are the column
82 ;; kolumna disiganto. Linioj kiuj separator. Lines that don't
83 ;; ne enhavas ilin ne estas have them won't be separated.
84 ;; disigitaj. Kiel la kvara kaj Like the fourth and fifth line
85 ;; la kvina linio se vi disigas if you unmerge this file from
86 ;; ^ci dataron ekde la unua angla the first english word.
87 ;; vorto.
88
89 ;; Je ^cia flanko estas bufro, kiu On each side is a buffer that knows
90 ;; konas la alian. Kun la ordonoj C-x about the other. With the commands
91 ;; 6 SPC, C-x 6 DEL kaj C-x 6 RET oni C-x 6 SPC, C-x 6 DEL and C-x 6 RET
92 ;; povas suben- a^u supreniri unu you can simultaneously scroll up or
93 ;; ekranon, kaj subeniri linion, down by a screenfull and by a line
94 ;; samtempe en la du bufroj. Al la alia in both buffers. Empty lines are
95 ;; bufro estas aldonataj linioj se added to the other buffer if
96 ;; necesas, por ke vi vidu la saman necessary, so that you see the same
97 ;; parton. Per C-x 6 C-l vi povas part. With C-x 6 C-l you can
98 ;; recentrigi la linion. Kiam vi nur recenter the line. When you only
99 ;; plu havas unu el la du bufroj have one of the two buffers onscreen
100 ;; surekrane vi revidos la alian per you can get the other back with C-x
101 ;; denove C-x 6 2. 6 2 once more.
102
103 ;; Se vi volas meti longajn liniojn If you include long lines, i.e which
104 ;; (ekz. programerojn) en la kunigotan will span both columns (eg. source
105 ;; tekston, ili devas esti en la code), they should be in what will
106 ;; estonte unua kolumno. La alia devas be the first column, with the
107 ;; havi malplenajn linion apud ili. associated buffer having empty lines
108 ;; next to them.
109
110 ;; Averto: en Emacs kiam vi ^san^gas la Attention: in Emacs when you change
111 ;; ma^joran modalon, la minoraj modaloj the major mode, the minor modes are
112 ;; estas anka^u elmemorigitaj. Tiu- also purged from memory. In that
113 ;; okaze vi devas religi la du bufrojn case you must reassociate the two
114 ;; per iu C-x 6-ordono, ekz. C-x 6 b. buffers with any C-x 6-command, e.g.
115 ;; C-x 6 b.
116
117 ;; Kiam vi estos kontenta de la When you have edited both buffers to
118 ;; rezulto, vi kunmetos la du kolumnojn your content, you merge them with
119 ;; per C-x 6 1. Se vi poste vidas C-x 6 1. If you then see a problem,
120 ;; problemon, vi neniigu la kunmeton you undo the merge with C-x u and
121 ;; per C-x u kaj plue modifu la du continue to edit the two buffers.
122 ;; bufrojn. Kiam vi ne plu volas tajpi When you no longer want to edit in
123 ;; dukolumne, vi eliru el la minora two columns, you turn off the minor
124 ;; modalo per C-x 6 k. mode with C-x 6 k.
125
126
127 ;; An^stata^u tri `autoload' kaj tri | Instead of three `autoload' and
128 ;; `global-set-key' vi povas uzi la | three `global-set-key' you can use
129 ;; jenon en via dataro ~/.emacs, por | the following in your file
130 ;; memstare ^car^gi la modalon: | ~/.emacs, to automatically load
131 ;; | the mode:
132
133 ;; (global-set-key "\C-x6"
134 ;; '(lambda () (interactive)
135 ;; (load-library "two-column")
136 ;; (call-interactively
137 ;; (cdr (assq (read-char) tc-mode-map)))))
138
139 ;; Se vi ^satus havi la dukolumnajn | If you'd like to have the
140 ;; ordonojn je funkciklavo <f2>, vi | two-column commands on function
141 ;; povas uzi la jenon en via dataro | key <f2>, you can use the
142 ;; ~/.emacs: | following in your file ~/.emacs:
143
144 ;; (define-key function-keymap "\^b"
145 ;; '(lambda () (interactive)
146 ;; (load-library "two-column")
147 ;; (define-key function-keymap "\^b" tc-mode-map)
148 ;; (call-interactively
149 ;; (cdr (assq (read-char) tc-mode-map)))))
150
151 ;; In addition to two-column editing of text, for example for writing a
152 ;; bilingual text side-by-side as shown below in the file's prolog, other
153 ;; interesting uses have been found for this minor mode:
154 ;;
155 ;;
156 ;; You can separate the columns with {+} C-x 6 u or <f2> u if you prefer
157 ;; any string that pleases you, by {+} handles these with a prefix argument
158 ;; setting tc-separator. For {+} that enables you to declare the
159 ;; example "{+} " if you like to {+} desired length of such a string.
160 ;; amuse yourself.
161 ;;
162 ;;
163 ;; keyword You can write any text corresponding to a
164 ;; given keyword in a filled paragraph next to
165 ;; it. Note that the width of the first column
166 ;; may be less than window-min-width in the
167 ;; result, but will be displayed at that width.
168 ;;
169 ;; another This is not a three- or multi-column mode.
170 ;; The example in the file's prolog required
171 ;; working on two columns and then treating the
172 ;; result as one column in order to add the
173 ;; third.
174 ;;
175 ;;
176 ;; Programmers might like the ability to split off the comment column of
177 ;; a file that looks like the following. The advantage is that with
178 ;; (setq fill-prefix "-- ") you can run M-q (fill-paragraph) on the
179 ;; comment. The problem is, code quickly gets rather wide, so you need
180 ;; to use a narrower comment column, which is less interesting, unless
181 ;; you have a 132-column screen. Code lines that reach beyond
182 ;; comment-column are no problem, except that you won't always see their
183 ;; end during editing.
184 ;;
185 ;; BEGIN -- This is just some meaningless
186 ;; FOR i IN 1..10 LOOP -- code in Ada, that runs foobar
187 ;; foobar( i ); -- once for each argument from one
188 ;; END LOOP; -- to ten, and then we're already
189 ;; END; -- through with it.
190 ;;
191 ;; Better yet, you can put the point before "This", type M-3 C-x 6 u
192 ;; which makes "-- " the separator between a no-comments Ada buffer, and
193 ;; a plain text comment buffer. When you put them back together, every
194 ;; non-empty line of the 2nd column will again be preceded by "-- ".
195 ;;
196 ;;
197 ;; The <f2> function key hack (which is one of the rare times when
198 ;; function keys are mnemonic) at the end of the file's prolog requires
199 ;; that the lisp/term/*.el for your terminal use the standard
200 ;; conventions. Too bad that some don't (at least not in version 18.55).
201 ;; The Sun one is hopelessly non-standard, and vt2[024]0 somehow forgot
202 ;; to define <f1> thru <f5>. (It defines <pf1> thru <pf4> instead, but
203 ;; that is not what we need on an X terminal.) If you want to use those,
204 ;; you'll need another hack something like:
205 ;;
206 ;; (if (string= (system-name) "cix")
207 ;; (progn
208 ;; (load-library "term/vt200.el")
209 ;; (define-key CSI-map "12~" (cons function-keymap ?\^b)))
210 ;; (global-unset-key "\e[")
211 ;; (define-key esc-map "[225z" (cons function-keymap ?\^b)))
212 ;;
213 ;; where "cix" is the non-sun machine I use. Actually I use the same X
214 ;; terminal to connect to both machines, and I want to keep my ~/.emacs
215 ;; identical on both. Bother, the two Emacses don't recognize the same
216 ;; keys and assign different sequences to those they do! I sure hope all
217 ;; this nonsense will stop with version 19 (or preferably soon) where I'd
218 ;; like to be able to say (define-key some-map '<f2> some-cmd), and see
219 ;; <f2> rather than some unintelligible ESC-sequence in command key
220 ;; sequences.
221
222 ;;; Code:
223
224 ;;;;; variable declarations ;;;;;
225
226 (provide 'two-column)
227
228 (defvar tc-prefix "\C-x6"
229 "Prefix tc-mode-map gets bound to.
230 If you'd like to bind it to function key <f2>, see the prolog of the
231 source file, lisp/two-column.el")
232
233 (defvar tc-mode-map nil
234 "Keymap that contains all commands useful with two-column minor mode.
235 This gets bound globally to `tc-prefix' since minor modes have
236 no local keymap.")
237
238 (if tc-mode-map
239 ()
240 (setq tc-mode-map (make-sparse-keymap))
241 (define-key tc-mode-map "1" 'tc-merge)
242 (define-key tc-mode-map "2" 'tc-split)
243 (define-key tc-mode-map "b" 'tc-associate-buffer)
244 (define-key tc-mode-map "k" 'tc-kill-association)
245 (define-key tc-mode-map "\C-l" 'tc-recenter)
246 (define-key tc-mode-map "o" 'tc-associated-buffer)
247 (define-key tc-mode-map "u" 'tc-unmerge)
248 (define-key tc-mode-map "{" 'shrink-window-horizontally)
249 (define-key tc-mode-map "}" 'enlarge-window-horizontally)
250 (define-key tc-mode-map " " 'tc-scroll-up)
251 (define-key tc-mode-map "\^?" 'tc-scroll-down)
252 (define-key tc-mode-map "\C-m" 'tc-scroll-line))
253
254 (global-set-key tc-prefix tc-mode-map)
255
256
257 ;; markers seem to be the only buffer-id not affected by renaming
258 ;; a buffer. This nevertheless loses when a buffer is killed.
259 (defvar tc-other nil
260 "Marker to the associated buffer, if non-nil.")
261 (make-variable-buffer-local 'tc-other)
262
263
264 (defvar tc-buffer-list ()
265 "An alist of markers to associated buffers. (Backs up `tc-other')")
266
267 (setq minor-mode-alist (cons '(tc-other " 2C") minor-mode-alist))
268
269 ;; rearranged, so that the pertinent info will show in 40 columns
270 (defvar tc-mode-line-format
271 '("-%*- %15b --" (-3 . "%p") "--%[(" mode-name
272 minor-mode-alist "%n" mode-line-process ")%]%-")
273 "*Value of mode-line-format for a buffer in two-column minor mode.")
274
275 (defvar tc-separator ""
276 "*A string inserted between the two columns when merging.
277 This gets set locally by \\[tc-unmerge].")
278
279 (defvar tc-window-width 40
280 "*The width of the first column. (Must be at least `window-min-width')
281 This value is local for every buffer that sets it.")
282 (make-variable-buffer-local 'tc-window-width)
283
284 (defvar tc-beyond-fill-column 4
285 "*Base for calculating `fill-column' for a buffer in two-column minor mode.
286 The value of `fill-column' becomes `tc-window-width' for this buffer
287 minus this value.")
288
289 (defvar tc-mode-hook nil
290 "Function called, if non-nil, whenever turning on two-column minor mode.
291 It can get called by \\[tc-split] (tc-split), \\[tc-unmerge] (tc-unmerge)
292 and \\[tc-associate-buffer] (tc-associate-buffer), on both buffers.")
293
294 ;;;;; base functions ;;;;;
295
296 ;; the access method for the other buffer. this tries to remedy against
297 ;; lost local variables and lost buffers.
298 (defun tc-other ()
299 (if (or tc-other
300 (setq tc-other
301 ; assoc with a different predicate, since we don't know
302 ; which marker points to this buffer
303 (let ((bl tc-buffer-list))
304 (while (and bl (not (eq (current-buffer)
305 (marker-buffer (car (car bl))))))
306 (setq bl (cdr bl)))
307 (cdr (car bl)))))
308 (or (prog1
309 (marker-buffer tc-other)
310 (setq mode-line-format tc-mode-line-format ))
311 ; The associated buffer somehow got killed.
312 (progn
313 ; The other variables may later be useful if the user
314 ; reestablishes the association.
315 (kill-local-variable 'tc-other)
316 (kill-local-variable 'mode-line-format)
317 nil))))
318
319 (defun tc-split (&optional buffer)
320 "Split current window vertically for two-column editing.
321
322 When called the first time, associates a buffer with the current
323 buffer. Both buffers are put in two-column minor mode and
324 tc-mode-hook gets called on both. These buffers remember
325 about one another, even when renamed.
326
327 When called again, restores the screen layout with the current buffer
328 first and the associated buffer to it's right.
329
330 If you include long lines, i.e which will span both columns (eg.
331 source code), they should be in what will be the first column, with
332 the associated buffer having empty lines next to them.
333
334 You have the following commands at your disposal:
335
336 \\[tc-split] Rearrange screen
337 \\[tc-associate-buffer] Reassociate buffer after changing major mode
338 \\[tc-scroll-up] Scroll both buffers up by a screenfull
339 \\[tc-scroll-down] Scroll both buffers down by a screenful
340 \\[tc-scroll-line] Scroll both buffers up by one or more lines
341 \\[tc-recenter] Recenter and realign other buffer
342 \\[shrink-window-horizontally], \\[enlarge-window-horizontally] Shrink, enlarge current column
343 \\[tc-associated-buffer] Switch to associated buffer
344 \\[tc-merge] Merge both buffers
345
346 These keybindings can be customized in your ~/.emacs by `tc-prefix'
347 and `tc-mode-map'.
348
349 The appearance of the screen can be customized by the variables
350 `tc-window-width', `tc-beyond-fill-column',
351 `tc-mode-line-format' and `truncate-partial-width-windows'."
352
353 (interactive "P")
354 ; first go to full width, so that we can certainly split into
355 ; two windows
356 (if (< (window-width) (screen-width))
357 (enlarge-window 99999 t))
358 (split-window-horizontally
359 (max window-min-width (min tc-window-width
360 (- (screen-width) window-min-width))))
361 (if (tc-other)
362 (progn
363 (other-window 1)
364 (switch-to-buffer (tc-other))
365 (other-window -1)
366 ; align buffers if necessary
367 (tc-scroll-line 0))
368
369 ; set up minor mode linking two buffers
370 (setq fill-column (- tc-window-width
371 tc-beyond-fill-column)
372 mode-line-format tc-mode-line-format)
373 (run-hooks tc-mode-hook)
374 (let ((other (point-marker)))
375 (other-window 1)
376 (switch-to-buffer
377 (or buffer
378 (generate-new-buffer
379 (concat "2C/" (buffer-name)))))
380 (or buffer
381 (text-mode))
382 (setq fill-column (- tc-window-width
383 tc-beyond-fill-column)
384 mode-line-format tc-mode-line-format
385 tc-other other
386 other (point-marker))
387 (setq tc-buffer-list (cons (cons tc-other other)
388 tc-buffer-list))
389 (run-hooks tc-mode-hook)
390 (other-window -1)
391 (setq tc-buffer-list
392 (cons (cons other
393 (save-excursion
394 (set-buffer (tc-other))
395 tc-other))
396 tc-buffer-list))
397 (setq tc-other other))))
398
399 (fset 'tc-mode 'tc-split)
400
401 (defun tc-associate-buffer ()
402 "Associate another buffer with this one in two-column minor mode.
403 Can also be used to associate a just previously visited file, by
404 accepting the proposed default buffer.
405
406 See \\[tc-split] and `lisp/two-column.el' for further details."
407 (interactive)
408 (let ((b1 (current-buffer))
409 (b2 (or (tc-other)
410 (read-buffer "Associate buffer: " (other-buffer)))))
411 (save-excursion
412 (setq tc-other nil)
413 (set-buffer b2)
414 (and (tc-other)
415 (not (eq b1 (tc-other)))
416 (error "Buffer already associated with buffer `%s'."
417 (buffer-name (tc-other))))
418 (setq b1 (and (assq 'tc-window-width (buffer-local-variables))
419 tc-window-width)))
420 ; if other buffer has a local width, adjust here too
421 (if b1 (setq tc-window-width (- (screen-width) b1)))
422 (tc-split b2)))
423
424 (defun tc-unmerge (arg)
425 "Unmerge a two-column text into two buffers in two-column minor mode.
426 The text is unmerged at the cursor's column which becomes the local
427 value of tc-window-width. Only lines that have the ARG same
428 preceding characters at that column get split. The ARG preceding
429 characters without any leading whitespace become the local value for
430 `tc-separator'. This way lines that continue across both
431 columns remain untouched in the first buffer.
432
433 This function can be used with a prototype line, to set up things as
434 you like them. You write the first line of each column with the
435 separator you like and then unmerge that line. E.g.:
436
437 First column's text sSs Second columns text
438 \\___/\\
439 / \\
440 5 character Separator You type M-5 \\[tc-unmerge] with the point here
441
442 See \\[tc-split] and `lisp/two-column.el' for further details."
443 (interactive "p")
444 (and (tc-other)
445 (if (y-or-n-p (concat "Overwrite associated buffer `"
446 (buffer-name (tc-other))
447 "'? "))
448 (save-excursion
449 (set-buffer (tc-other))
450 (erase-buffer))
451 (signal 'quit nil)))
452 (let ((point (point))
453 ; make next-line always come back to same column
454 (goal-column (current-column))
455 ; a counter for empty lines in other buffer
456 (n (1- (count-lines (point-min) (point))))
457 chars other)
458 (save-excursion
459 (backward-char arg)
460 (setq chars (buffer-substring (point) point))
461 (skip-chars-forward " \t" point)
462 (make-variable-buffer-local 'tc-separator)
463 (setq tc-separator (buffer-substring (point) point)
464 tc-window-width (current-column)))
465 (tc-split)
466 (setq other (tc-other))
467 ; now we're ready to actually unmerge
468 (save-excursion
469 (while (not (eobp))
470 (if (not (and (= (current-column) goal-column)
471 (string= chars
472 (buffer-substring (point)
473 (save-excursion
474 (backward-char arg)
475 (point))))))
476 (setq n (1+ n))
477 (setq point (point))
478 (backward-char arg)
479 (skip-chars-backward " \t")
480 (delete-region point (point))
481 (setq point (point))
482 (insert-char ?\n n)
483 (append-to-buffer other point (progn (end-of-line)
484 (if (eobp)
485 (point)
486 (1+ (point)))))
487 (delete-region point (point))
488 (setq n 0))
489 (next-line 1)))))
490
491 (defun tc-kill-association ()
492 "Turn off two-column minor mode in current and associated buffer.
493 If the associated buffer is unmodified and empty, it is killed."
494 (interactive)
495 (let ((buffer (current-buffer)))
496 (save-excursion
497 (and (tc-other)
498 (prog2
499 (setq tc-buffer-list
500 (delq (assq tc-other tc-buffer-list)
501 tc-buffer-list))
502 (set-buffer (tc-other))
503 (setq tc-buffer-list
504 (delq (assq tc-other tc-buffer-list)
505 tc-buffer-list)))
506 (or (not (tc-other))
507 (eq buffer (tc-other)))
508 (if (and (not (buffer-modified-p))
509 (eobp) (bobp))
510 (kill-buffer nil)
511 (kill-local-variable 'tc-other)
512 (kill-local-variable 'tc-window-width)
513 (kill-local-variable 'tc-separator)
514 (kill-local-variable 'mode-line-format)
515 (kill-local-variable 'fill-column))))
516 (kill-local-variable 'tc-other)
517 (kill-local-variable 'tc-window-width)
518 (kill-local-variable 'tc-separator)
519 (kill-local-variable 'mode-line-format)
520 (kill-local-variable 'fill-column)))
521
522
523 ;; this doesn't use yank-rectangle, so that the first column can
524 ;; contain long lines
525 (defun tc-merge ()
526 "Merges the associated buffer with the current buffer.
527 They get merged at the column, which is the value of
528 `tc-window-width', i.e. usually at the vertical window
529 separator. This separator gets replaced with white space. Beyond
530 that the value of gets inserted on merged lines. The two columns are
531 thus pasted side by side, in a single text. If the other buffer is
532 not displayed to the left of this one, then this one becomes the left
533 column.
534
535 If you want `tc-separator' on empty lines in the second column,
536 you should put just one space in them. In the final result, you can strip
537 off trailing spaces with \\[beginning-of-buffer] \\[replace-regexp] [ SPC TAB ] + $ RET RET"
538
539 (interactive)
540 (or (tc-other)
541 (error "You must first set two-column minor mode."))
542 (and (> (car (window-edges)) 0) ; not touching left edge of screen
543 (eq (window-buffer (previous-window))
544 (tc-other))
545 (other-window -1))
546 (save-excursion
547 (let ((b1 (current-buffer))
548 (b2 (tc-other))
549 string)
550 (goto-char (point-min))
551 (set-buffer b2)
552 (goto-char (point-min))
553 (while (not (eobp))
554 (setq string (buffer-substring (point)
555 (progn (end-of-line) (point))))
556 (or (eobp)
557 (forward-char)) ; next line
558 (set-buffer b1)
559 (if (string= string "")
560 ()
561 (end-of-line)
562 (indent-to-column tc-window-width)
563 (insert tc-separator string))
564 (next-line 1) ; add one if necessary
565 (set-buffer b2))))
566 (if (< (window-width) (screen-width))
567 (enlarge-window 99999 t)))
568
569 ;;;;; utility functions ;;;;;
570
571 (defun tc-associated-buffer ()
572 "Switch to associated buffer."
573 (interactive)
574 (or (tc-other)
575 (error "You must set two-column minor mode."))
576 (if (get-buffer-window (tc-other))
577 (select-window (get-buffer-window (tc-other)))
578 (switch-to-buffer (tc-other))))
579
580 ;; It would be desirable to intercept anything that causes the current
581 ;; window to scroll. Maybe a `scroll-hook'?
582 (defun tc-scroll-line (arg)
583 "Scroll current window upward by ARG lines.
584 The associated window gets scrolled to the same line."
585 (interactive "p")
586 (or (tc-other)
587 (error "You must set two-column minor mode."))
588 ; scroll-up has a bug on arg 0 at end of buffer
589 (or (zerop arg)
590 (scroll-up arg))
591 (setq arg (count-lines (point-min) (window-start)))
592 ; too bad that pre 18.57 Emacs makes save-window-excursion restore
593 ; the point. When it becomes extinct, we can simplify this.
594 (if (get-buffer-window (tc-other))
595 (let ((window (selected-window)))
596 (select-window (get-buffer-window (tc-other)))
597 (setq arg (- arg (count-lines (point-min) (window-start))))
598 ; make sure that other buffer has enough lines
599 (save-excursion
600 (goto-char (point-max))
601 (insert-char ?\n
602 (- arg (count-lines (window-start) (point-max)) -1)))
603 (or (zerop arg)
604 (scroll-up arg))
605 (select-window window))))
606
607 (defun tc-scroll-up (arg)
608 "Scroll current window upward by ARG screens.
609 The associated window gets scrolled to the same line."
610 (interactive "p")
611 (tc-scroll-line (* arg (- (window-height)
612 next-screen-context-lines 1))))
613
614 (defun tc-scroll-down (arg)
615 "Scroll current window downward by ARG screens.
616 The associated window gets scrolled to the same line."
617 (interactive "p")
618 (tc-scroll-line (* arg (- next-screen-context-lines
619 (window-height) -1))))
620
621 (defun tc-recenter (arg)
622 "Center point in window. With ARG, put point on line ARG.
623 This counts from bottom if ARG is negative. The associated window
624 gets scrolled to the same line."
625 (interactive "P")
626 (setq arg (and arg (prefix-numeric-value arg)))
627 (tc-scroll-line (- (count-lines (window-start) (point))
628 (cond ((null arg) (/ (window-height) 2))
629 ((< arg 0) (+ (window-height) arg))
630 ( arg)))))
631
632 (defun enlarge-window-horizontally (arg)
633 "Make current window ARG columns wider."
634 (interactive "p")
635 (enlarge-window arg t)
636 (and (tc-other)
637 (setq tc-window-width (+ tc-window-width arg))
638 (set-buffer (tc-other))
639 (setq tc-window-width (- tc-window-width arg))))
640
641 (defun shrink-window-horizontally (arg)
642 "Make current window ARG columns narrower."
643 (interactive "p")
644 (enlarge-window-horizontally (- arg)))
645
646 ;;; two-column.el ends here