Article View: comp.editors
Article #3943Re: "Brief" keymap emulation
From: Dan Schmidt
Date: Wed, 24 May 2000 00:00
Date: Wed, 24 May 2000 00:00
200 lines
7401 bytes
7401 bytes
Here's the code I wrote a while ago to make F1, F3, and F4 work like
in Brief. I never bothered to get F2 (resize) working.
;; Brief-like window manipulation
;; Dan Schmidt, 5/6/96
;;
;; F1 plus a direction goes to that window
;; F3 plus a direction creates a window over there
;; F4 plus a direction deletes that window
(defun find-nearby-window (dx dy)
"Return the nearest window in the direction of DX DY,
or nil if there is none."
(let* ((this-window (selected-window)) ; current window
(we (window-edges)) ; its coordinates
(x0 (nth 0 we))
(y0 (nth 1 we))
(x1 (nth 2 we))
(y1 (nth 3 we))
(x x0) (y y0) ; I think UL of window works best
(new-window))
(catch 'look
(while t
(setq x (+ x dx)) ; keep moving
(setq y (+ y dy))
(setq new-window (window-at x y))
;; Don't go off-screen, or into the minibuffer unless it's active.
(if (or (null new-window)
(and (window-minibuffer-p new-window)
(not (eq new-window (active-minibuffer-window)))))
(throw 'look nil)) ; off screen
(if (not (equal new-window this-window))
(throw 'look new-window)))))) ; found a new one
(defun move-to-nearby-window (dx dy)
"Move to the nearest window in the direction of DX DY if possible."
(let ((new-window (find-nearby-window dx dy)))
(if new-window
(select-window new-window))))
(defun delete-nearby-window (dx dy)
"Delete the nearest window in the direction of DX DY if possible."
(let ((new-window (find-nearby-window dx dy)))
(if new-window
(delete-window new-window))))
(defun create-new-window-up ()
"Create a new window above the current one."
(interactive)
(let ((this-window (selected-window))
(new-window (split-window-vertically)))
;; We've split the window vertically, now make sure that
;; the new window is above the current one.
(if (< (nth 1 (window-edges new-window))
(nth 1 (window-edges this-window)))
(select-window new-window))))
(defun create-new-window-down ()
"Create a new window below the current one."
(interactive)
(let ((this-window (selected-window))
(new-window (split-window-vertically)))
(if (> (nth 1 (window-edges new-window))
(nth 1 (window-edges this-window)))
(select-window new-window))))
(defun create-new-window-left ()
"Create a new window to the left of the current one."
(interactive)
(let ((this-window (selected-window))
(new-window (split-window-horizontally)))
(if (< (nth 0 (window-edges new-window))
(nth 0 (window-edges this-window)))
(select-window new-window))))
(defun create-new-window-right ()
"Create a new window to the right of the current one."
(interactive)
(let ((this-window (selected-window))
(new-window (split-window-horizontally)))
(if (> (nth 0 (window-edges new-window))
(nth 0 (window-edges this-window)))
(select-window new-window))))
(defun move-up-to-window ()
"Move up to the next window."
(interactive)
(move-to-nearby-window 0 -1))
(defun move-down-to-window ()
"Move down to the next window."
(interactive)
(move-to-nearby-window 0 1))
(defun move-left-to-window ()
"Move left to the next window."
(interactive)
(move-to-nearby-window -1 0))
(defun move-right-to-window ()
"Move right to the next window."
(interactive)
(move-to-nearby-window 1 0))
(defun delete-up-window ()
"Delete the window above this one."
(interactive)
(delete-nearby-window 0 -1))
(defun delete-down-window ()
"Delete the window below this one."
(interactive)
(delete-nearby-window 0 1))
(defun delete-left-window ()
"Delete the window to the left of this one."
(interactive)
(delete-nearby-window -1 0))
(defun delete-right-window ()
"Delete the window to the right of this one."
(interactive)
(delete-nearby-window 1 0))
(defvar f1-map (make-sparse-keymap) "Keymap for F1.")
(define-key global-map [f1] f1-map)
(define-key f1-map [up] 'move-up-to-window)
(define-key f1-map [down] 'move-down-to-window)
(define-key f1-map [left] 'move-left-to-window)
(define-key f1-map [right] 'move-right-to-window)
(defvar f3-map (make-sparse-keymap) "Keymap for F3.")
(define-key global-map [f3] f3-map)
(define-key f3-map [up] 'create-new-window-up)
(define-key f3-map [down] 'create-new-window-down)
(define-key f3-map [left] 'create-new-window-left)
(define-key f3-map [right] 'create-new-window-right)
(defvar f4-map (make-sparse-keymap) "Keymap for F4.")
(define-key global-map [f4] f4-map)
(define-key f4-map [up] 'delete-up-window)
(define-key f4-map [down] 'delete-down-window)
(define-key f4-map [left] 'delete-left-window)
(define-key f4-map [right] 'delete-right-window)
;; Home and End
(defvar home-times 0
"The number of times in a row that [Home] has been pressed.")
(defvar end-times 0
"The number of times in a row that [End] has been pressed.")
(defun home-command ()
"React to the [Home] key like in Brief.
Pressing it once goes to the beginning of the line.
Pressing it twice goes to the top of the window.
Pressing it three times goes to the beginning of the buffer."
(interactive)
(if (eq last-command 'home-command)
(setq home-times (1+ home-times))
(setq home-times 0))
(cond ((eq home-times 0)
(beginning-of-line))
((eq home-times 1)
(goto-char (window-start)))
((>= home-times 2)
(beginning-of-buffer))))
(defun end-command ()
"React to the [End] key like in Brief.
Pressing it once goes to the end of the line.
Pressing it twice goes to the end of the window.
Pressing it three times goes to the end of the buffer."
(interactive)
(if (eq last-command 'end-command)
(setq end-times (1+ end-times))
(setq end-times 0))
(cond ((eq end-times 0)
(end-of-line))
((eq end-times 1)
(goto-char (1- (window-end))))
((>= end-times 2)
(end-of-buffer))))
(define-key global-map [home] 'home-command)
(define-key global-map [end] 'end-command)
--
Dan Schmidt | http://www.dfan.org
Honest Bob CD now available! | http://www.dfan.org/honestbob/cd.html
Technical Details
Message-ID:
<wkg0r7sn56.fsf@turangalila.harmonixmusic.com>Path:
arc1-ca.pugleaf.net!unknown!not-for-mailReferences:
<39232D56.F480D8E8@attws.com>Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 102b9a,aa9c8647e2f0a005 X-Google-Attributes: gid102b9a,public X-Google-Thread: 103b8b,aa9c8647e2f0a005 X-Google-Attributes: gid103b8b,public X-Google-Thread: 107393,aa9c8647e2f0a005 X-Google-Attributes: gid107393,public From: Dan Schmidt <dfan@harmonixmusic.com> Subject: Re: "Brief" keymap emulation Date: 2000/05/24 Message-ID: <wkg0r7sn56.fsf@turangalila.harmonixmusic.com> X-Deja-AN: 626885464 Sender: dfan@turangalila.harmonixmusic.com References: <39232D56.F480D8E8@attws.com> Organization: Harmonix Musick Systems Content-Type: text/plain; charset=us-ascii User-Agent: Gnus/5.0806 (Gnus v5.8.6) Emacs/20.6 Mime-Version: 1.0 Newsgroups: comp.editors,gnu.emacs.help,comp.emacs