1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-17 11:20:39 -08:00

Use frame-width instead of screen-width.

This commit is contained in:
Richard M. Stallman 1992-09-28 13:02:35 +00:00
parent 6b18575907
commit 3bcbd523b2

View file

@ -221,48 +221,40 @@
;;; Code: ;;; Code:
;;;;; variable declarations ;;;;; ;;;;; Set up keymap ;;;;;
(provide 'two-column)
(defvar tc-prefix "\C-x6"
"Prefix tc-mode-map gets bound to.
If you'd like to bind it to function key <f2>, see the prolog of the
source file, lisp/two-column.el")
;;;###autoload
(defvar tc-mode-map nil (defvar tc-mode-map nil
"Keymap that contains all commands useful with two-column minor mode. "Keymap for commands for two-column mode.")
This gets bound globally to `tc-prefix' since minor modes have
no local keymap.")
;;;###autoload
(if tc-mode-map (if tc-mode-map
() ()
(setq tc-mode-map (make-sparse-keymap)) (setq tc-mode-map (make-sparse-keymap))
(define-key tc-mode-map "1" 'tc-merge) (define-key tc-mode-map "1" 'tc-merge)
(define-key tc-mode-map "2" 'tc-split) (define-key tc-mode-map "2" 'tc-two-columns)
(define-key tc-mode-map "b" 'tc-associate-buffer) (define-key tc-mode-map "b" 'tc-associate-buffer)
(define-key tc-mode-map "k" 'tc-kill-association) (define-key tc-mode-map "k" 'tc-kill-association)
(define-key tc-mode-map "\C-l" 'tc-recenter) (define-key tc-mode-map "\C-l" 'tc-recenter)
(define-key tc-mode-map "o" 'tc-associated-buffer) (define-key tc-mode-map "o" 'tc-associated-buffer)
(define-key tc-mode-map "u" 'tc-unmerge) (define-key tc-mode-map "s" 'tc-split)
(define-key tc-mode-map "{" 'shrink-window-horizontally) (define-key tc-mode-map "{" 'shrink-window-horizontally)
(define-key tc-mode-map "}" 'enlarge-window-horizontally) (define-key tc-mode-map "}" 'enlarge-window-horizontally)
(define-key tc-mode-map " " 'tc-scroll-up) (define-key tc-mode-map " " 'tc-scroll-up)
(define-key tc-mode-map "\^?" 'tc-scroll-down) (define-key tc-mode-map "\^?" 'tc-scroll-down)
(define-key tc-mode-map "\C-m" 'tc-scroll-line)) (define-key tc-mode-map "\C-m" 'tc-scroll-line))
(global-set-key tc-prefix tc-mode-map) ;;;###autoload
(global-set-key "\C-x6" tc-mode-map)
;;;;; variable declarations ;;;;;
;; markers seem to be the only buffer-id not affected by renaming ;; markers seem to be the only buffer-id not affected by renaming
;; a buffer. This nevertheless loses when a buffer is killed. ;; a buffer. This nevertheless loses when a buffer is killed.
(defvar tc-other nil (defvar tc-other nil
"Marker to the associated buffer, if non-nil.") "Marker to the associated buffer, if non-nil.")
(make-variable-buffer-local 'tc-other) (make-variable-buffer-local 'tc-other)
(put 'tc-other 'permanent-local t)
(defvar tc-buffer-list ()
"An alist of markers to associated buffers. (Backs up `tc-other')")
(setq minor-mode-alist (cons '(tc-other " 2C") minor-mode-alist)) (setq minor-mode-alist (cons '(tc-other " 2C") minor-mode-alist))
@ -274,12 +266,14 @@ no local keymap.")
(defvar tc-separator "" (defvar tc-separator ""
"*A string inserted between the two columns when merging. "*A string inserted between the two columns when merging.
This gets set locally by \\[tc-unmerge].") This gets set locally by \\[tc-split].")
(put 'tc-separator 'permanent-local t)
(defvar tc-window-width 40 (defvar tc-window-width 40
"*The width of the first column. (Must be at least `window-min-width') "*The width of the first column. (Must be at least `window-min-width')
This value is local for every buffer that sets it.") This value is local for every buffer that sets it.")
(make-variable-buffer-local 'tc-window-width) (make-variable-buffer-local 'tc-window-width)
(put 'tc-window-width 'permanent-local t)
(defvar tc-beyond-fill-column 4 (defvar tc-beyond-fill-column 4
"*Base for calculating `fill-column' for a buffer in two-column minor mode. "*Base for calculating `fill-column' for a buffer in two-column minor mode.
@ -288,7 +282,7 @@ minus this value.")
(defvar tc-mode-hook nil (defvar tc-mode-hook nil
"Function called, if non-nil, whenever turning on two-column minor mode. "Function called, if non-nil, whenever turning on two-column minor mode.
It can get called by \\[tc-split] (tc-split), \\[tc-unmerge] (tc-unmerge) It can get called by \\[tc-two-columns] (tc-two-columns), \\[tc-split] (tc-split)
and \\[tc-associate-buffer] (tc-associate-buffer), on both buffers.") and \\[tc-associate-buffer] (tc-associate-buffer), on both buffers.")
;;;;; base functions ;;;;; ;;;;; base functions ;;;;;
@ -296,15 +290,7 @@ and \\[tc-associate-buffer] (tc-associate-buffer), on both buffers.")
;; the access method for the other buffer. this tries to remedy against ;; the access method for the other buffer. this tries to remedy against
;; lost local variables and lost buffers. ;; lost local variables and lost buffers.
(defun tc-other () (defun tc-other ()
(if (or tc-other (if tc-other
(setq tc-other
; assoc with a different predicate, since we don't know
; which marker points to this buffer
(let ((bl tc-buffer-list))
(while (and bl (not (eq (current-buffer)
(marker-buffer (car (car bl))))))
(setq bl (cdr bl)))
(cdr (car bl)))))
(or (prog1 (or (prog1
(marker-buffer tc-other) (marker-buffer tc-other)
(setq mode-line-format tc-mode-line-format )) (setq mode-line-format tc-mode-line-format ))
@ -316,7 +302,7 @@ and \\[tc-associate-buffer] (tc-associate-buffer), on both buffers.")
(kill-local-variable 'mode-line-format) (kill-local-variable 'mode-line-format)
nil)))) nil))))
(defun tc-split (&optional buffer) (defun tc-two-columns (&optional buffer)
"Split current window vertically for two-column editing. "Split current window vertically for two-column editing.
When called the first time, associates a buffer with the current When called the first time, associates a buffer with the current
@ -333,7 +319,7 @@ the associated buffer having empty lines next to them.
You have the following commands at your disposal: You have the following commands at your disposal:
\\[tc-split] Rearrange screen \\[tc-two-columns] Rearrange screen
\\[tc-associate-buffer] Reassociate buffer after changing major mode \\[tc-associate-buffer] Reassociate buffer after changing major mode
\\[tc-scroll-up] Scroll both buffers up by a screenfull \\[tc-scroll-up] Scroll both buffers up by a screenfull
\\[tc-scroll-down] Scroll both buffers down by a screenful \\[tc-scroll-down] Scroll both buffers down by a screenful
@ -353,11 +339,11 @@ The appearance of the screen can be customized by the variables
(interactive "P") (interactive "P")
; first go to full width, so that we can certainly split into ; first go to full width, so that we can certainly split into
; two windows ; two windows
(if (< (window-width) (screen-width)) (if (< (window-width) (frame-width))
(enlarge-window 99999 t)) (enlarge-window 99999 t))
(split-window-horizontally (split-window-horizontally
(max window-min-width (min tc-window-width (max window-min-width (min tc-window-width
(- (screen-width) window-min-width)))) (- (frame-width) window-min-width))))
(if (tc-other) (if (tc-other)
(progn (progn
(other-window 1) (other-window 1)
@ -384,26 +370,18 @@ The appearance of the screen can be customized by the variables
mode-line-format tc-mode-line-format mode-line-format tc-mode-line-format
tc-other other tc-other other
other (point-marker)) other (point-marker))
(setq tc-buffer-list (cons (cons tc-other other)
tc-buffer-list))
(run-hooks tc-mode-hook) (run-hooks tc-mode-hook)
(other-window -1) (other-window -1)
(setq tc-buffer-list
(cons (cons other
(save-excursion
(set-buffer (tc-other))
tc-other))
tc-buffer-list))
(setq tc-other other)))) (setq tc-other other))))
(fset 'tc-mode 'tc-split) (fset 'tc-mode 'tc-two-columns)
(defun tc-associate-buffer () (defun tc-associate-buffer ()
"Associate another buffer with this one in two-column minor mode. "Associate another buffer with this one in two-column minor mode.
Can also be used to associate a just previously visited file, by Can also be used to associate a just previously visited file, by
accepting the proposed default buffer. accepting the proposed default buffer.
See \\[tc-split] and `lisp/two-column.el' for further details." See \\[tc-two-columns] and `lisp/two-column.el' for further details."
(interactive) (interactive)
(let ((b1 (current-buffer)) (let ((b1 (current-buffer))
(b2 (or (tc-other) (b2 (or (tc-other)
@ -418,13 +396,13 @@ See \\[tc-split] and `lisp/two-column.el' for further details."
(setq b1 (and (assq 'tc-window-width (buffer-local-variables)) (setq b1 (and (assq 'tc-window-width (buffer-local-variables))
tc-window-width))) tc-window-width)))
; if other buffer has a local width, adjust here too ; if other buffer has a local width, adjust here too
(if b1 (setq tc-window-width (- (screen-width) b1))) (if b1 (setq tc-window-width (- (frame-width) b1)))
(tc-split b2))) (tc-two-columns b2)))
(defun tc-unmerge (arg) (defun tc-split (arg)
"Unmerge a two-column text into two buffers in two-column minor mode. "Unmerge a two-column text into two buffers in two-column minor mode.
The text is unmerged at the cursor's column which becomes the local The text is unmerged at the cursor's column which becomes the local
value of tc-window-width. Only lines that have the ARG same value of `tc-window-width'. Only lines that have the ARG same
preceding characters at that column get split. The ARG preceding preceding characters at that column get split. The ARG preceding
characters without any leading whitespace become the local value for characters without any leading whitespace become the local value for
`tc-separator'. This way lines that continue across both `tc-separator'. This way lines that continue across both
@ -437,9 +415,9 @@ separator you like and then unmerge that line. E.g.:
First column's text sSs Second columns text First column's text sSs Second columns text
\\___/\\ \\___/\\
/ \\ / \\
5 character Separator You type M-5 \\[tc-unmerge] with the point here 5 character Separator You type M-5 \\[tc-split] with the point here
See \\[tc-split] and `lisp/two-column.el' for further details." See \\[tc-two-columns] and `lisp/two-column.el' for further details."
(interactive "p") (interactive "p")
(and (tc-other) (and (tc-other)
(if (y-or-n-p (concat "Overwrite associated buffer `" (if (y-or-n-p (concat "Overwrite associated buffer `"
@ -459,10 +437,10 @@ See \\[tc-split] and `lisp/two-column.el' for further details."
(backward-char arg) (backward-char arg)
(setq chars (buffer-substring (point) point)) (setq chars (buffer-substring (point) point))
(skip-chars-forward " \t" point) (skip-chars-forward " \t" point)
(make-variable-buffer-local 'tc-separator) (make-local-variable 'tc-separator)
(setq tc-separator (buffer-substring (point) point) (setq tc-separator (buffer-substring (point) point)
tc-window-width (current-column))) tc-window-width (current-column)))
(tc-split) (tc-two-columns)
(setq other (tc-other)) (setq other (tc-other))
; now we're ready to actually unmerge ; now we're ready to actually unmerge
(save-excursion (save-excursion
@ -495,14 +473,7 @@ If the associated buffer is unmodified and empty, it is killed."
(let ((buffer (current-buffer))) (let ((buffer (current-buffer)))
(save-excursion (save-excursion
(and (tc-other) (and (tc-other)
(prog2
(setq tc-buffer-list
(delq (assq tc-other tc-buffer-list)
tc-buffer-list))
(set-buffer (tc-other)) (set-buffer (tc-other))
(setq tc-buffer-list
(delq (assq tc-other tc-buffer-list)
tc-buffer-list)))
(or (not (tc-other)) (or (not (tc-other))
(eq buffer (tc-other))) (eq buffer (tc-other)))
(if (and (not (buffer-modified-p)) (if (and (not (buffer-modified-p))
@ -563,7 +534,7 @@ off trailing spaces with \\[beginning-of-buffer] \\[replace-regexp] [ SPC TAB ]
(insert tc-separator string)) (insert tc-separator string))
(next-line 1) ; add one if necessary (next-line 1) ; add one if necessary
(set-buffer b2)))) (set-buffer b2))))
(if (< (window-width) (screen-width)) (if (< (window-width) (frame-width))
(enlarge-window 99999 t))) (enlarge-window 99999 t)))
;;;;; utility functions ;;;;; ;;;;; utility functions ;;;;;
@ -643,4 +614,6 @@ gets scrolled to the same line."
(interactive "p") (interactive "p")
(enlarge-window-horizontally (- arg))) (enlarge-window-horizontally (- arg)))
(provide 'two-column)
;;; two-column.el ends here ;;; two-column.el ends here