annotate lisp/term/apollo.el @ 444:576fb035e263 r21-2-37

Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents 3ecd8885ac67
children 11502791fc1c
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; apollo.el --- Apollo Graphics Primitive Support Functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1998 by Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Copyright (C) 1991 by Lucid, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Author: Leonard N. Zubkoff <lnz@dandelion.com>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Keywords: hardware
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;;; Synched up with: InfoDock 3.6.2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;; GNU Emacs Apollo GPR Support Functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;; Leonard N. Zubkoff
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; lnz@dandelion.com
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;; Lucid, Incorporated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;; 23 January 1991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; This file defines functions that support GNU Emacs using the Apollo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; Graphics Primitives (GPR). See the file "APOLLO.README" for a description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; of the key bindings set up by this file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; Acknowledgements
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; The following people have contributed ideas that have helped make this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;; interface possible: Nathaniel Mishkin, Rob Stanzel, and Mark Weissman of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 ;; Apollo Computer, Dave Holcomb of CAECO, Vincent Broman of NOSC, and J. W.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;; Peterson of the University of Utah.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;;; Change Log:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; Bob Weiner, Motorola, Inc., 2/2/89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;; Added section to 'apollo-clean-help-file()' to remove underlining
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 ;; and overstriking (only by the same letter) from Apollo '.hlp' files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ;; Based on the 'nuke-nroff-bs' function in man.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;; Changed apollo-mouse-{cut,copy,paste} commands so that they work
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;; with the DM paste buffer. This combined with cut,copy,paste
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;; bindings of the mouse keys allows quick and easy copying from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;; Emacs windows to DM windows.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 ;; Added 'unbind-apollo-mouse-button' and 'unbind-apollo-function-key'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ;; commands.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 ;; Added 'apollo-mouse-cut-copy-paste' command which provides a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 ;; second set of mouse key functions that can be set with one key
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;; press and cleared with another key press. Put default mouse key
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 ;; bindings into a command called 'apollo-mouse-defaults' so that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 ;; they can be used to clear any other mouse bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 ;; Both these commands affect the DM mouse key bindings as well.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 ;; Added 'apollo-mouse-cancel-cut-copy-paste' command which resets the mouse
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ;; key defaults within Emacs and the DM. The variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 ;; '*dm-mouse-key-bindings-file*' should be set within an initialization
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 ;; file to the pathname of file that executes a user's default DM mouse
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 ;; key bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 ;; Bob Weiner, Motorola, Inc., 2/23/89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;; Added ':' as valid character within a filename (if not at the end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;; in the command 'extract-file-name-around-point'. For remote UNIX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 ;; operations such as rcp and rsh commands which use the syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 ;; <host>:<path>.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 ;; Bob Weiner, Motorola, Inc., 3/09/89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 ;; Modified 'apollo-mouse-find-file' and 'apollo-find-file' so that they
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 ;; recognize buffer names in addition to directory or file paths. A buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 ;; name is recognized before a path name, if the match buffer names flag is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 ;; enabled. Added the command 'extract-buf-or-file-name-around-point' to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 ; support this functionality. Added find file in other window option to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 ;; these two find-file commands.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 ;; Bob Weiner, Motorola, Inc., 3/20/89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 ;; Changed (funcall *apollo-key-bindings-hook*) to (run-hooks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 ;; '*apollo-key-bindings-hook*) which is what it should be.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 ;; Bob Weiner, Motorola, Inc., 4/20/89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 ;; Rebound M2D button to perform different functions by buffer and location in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 ;; buffer. Executes 'smart-key-mouse' command found in smart-key.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 ;; Meta-M2D executes 'smart-key-mouse-meta'. M2U is unbound.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 ;; Bob Weiner, Motorola, Inc., 8/1/89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 ;; Fixed 'apollo-mouse-move-point' and 'apollo-mouse-move-mark' so they do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 ;; not set the mark gratuitously. They are bound to M1D and M1U respectively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 ;; Bob Weiner, Motorola, Inc., 4/11/90
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 ;; Bound left and right box arrow keys to scroll right and left,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 ;; respectively, which most closely emulates their DM functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 (defvar *dm-mouse-key-bindings-file* "/sys/dm/std_keys3"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 "Path of the DM key binding file which sets up a user's default mouse key
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 bindings. If none exists, this value should be set to one of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 /sys/dm/std_key* files which set up DM key defaults.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 ;;; Set this variable in your ".emacs" to a function to call to set up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 ;;; additional key bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 (defvar *apollo-key-bindings-hook* nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 ;;; Set this variable non-NIL in your ".emacs" to enable preemption of normal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 ;;; Display Manager bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 (defvar *preempt-display-manager-bindings* nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 ;;; Determine whether or not we're running diskless and define
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 ;;; *paste-buffer-directory* to point to the paste buffers directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 (defvar *paste-buffer-directory*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (let ((test-directory (concat "/sys/node_data."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 (downcase (getenv "NODEID"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 "paste_buffers/")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 (if (file-directory-p test-directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 test-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 "/sys/node_data/paste_buffers/")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 ;;; Bind this variable non-NIL to allow apollo-mouse-move-point to leave the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 ;;; minibuffer area.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 (defvar *apollo-mouse-move-point-allow-minibuffer-exit* nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 ;;; Define the Apollo Function Keys.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 (defvar *apollo-function-keys*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 '(("ESC" . 0) ("L1" . 1) ("L2" . 2) ("L3" . 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 ("L1A" . 4) ("L2A" . 5) ("L3A" . 6) ("L4" . 7)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 ("L5" . 8) ("L6" . 9) ("L7" . 10) ("L8" . 11)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 ("L9" . 12) ("LA" . 13) ("LB" . 14) ("LC" . 15)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 ("LD" . 16) ("LE" . 17) ("LF" . 18) ("F0" . 19)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 ("F1" . 20) ("F2" . 21) ("F3" . 22) ("F4" . 23)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 ("F5" . 24) ("F6" . 25) ("F7" . 26) ("F8" . 27)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 ("F9" . 28) ("R1" . 29) ("R2" . 30) ("R3" . 31)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 ("R4" . 32) ("R5" . 33) ("R6" . 34) ("NP0" . 35)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 ("NP1" . 36) ("NP2" . 37) ("NP3" . 38) ("NP4" . 39)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 ("NP5" . 40) ("NP6" . 41) ("NP7" . 42) ("NP8" . 43)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 ("NP9" . 44) ("NPA" . 45) ("NPB" . 46) ("NPC" . 47)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 ("NPD" . 48) ("NPE" . 49) ("NPF" . 50) ("NPG" . 51)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 ("NPP" . 52) ("AL" . 53) ("AR" . 54) ("SHL" . 55)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 ("SHR" . 56) ("LCK" . 57) ("CTL" . 58) ("RPT" . 59)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 ("TAB" . 60) ("RET" . 61) ("BS" . 62) ("DEL" . 63)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 ("ESCS" . 64) ("L1S" . 65) ("L2S" . 66) ("L3S" . 67)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 ("L1AS" . 68) ("L2AS" . 69) ("L3AS" . 70) ("L4S" . 71)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 ("L5S" . 72) ("L6S" . 73) ("L7S" . 74) ("L8S" . 75)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 ("L9S" . 76) ("LAS" . 77) ("LBS" . 78) ("LCS" . 79)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 ("LDS" . 80) ("LES" . 81) ("LFS" . 82) ("F0S" . 83)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 ("F1S" . 84) ("F2S" . 85) ("F3S" . 86) ("F4S" . 87)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 ("F5S" . 88) ("F6S" . 89) ("F7S" . 90) ("F8S" . 91)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 ("F9S" . 92) ("R1S" . 93) ("R2S" . 94) ("R3S" . 95)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 ("R4S" . 96) ("R5S" . 97) ("R6S" . 98) ("NP0S" . 99)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 ("NP1S" . 100) ("NP2S" . 101) ("NP3S" . 102) ("NP4S" . 103)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 ("NP5S" . 104) ("NP6S" . 105) ("NP7S" . 106) ("NP8S" . 107)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 ("NP9S" . 108) ("NPAS" . 109) ("NPBS" . 110) ("NPCS" . 111)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 ("NPDS" . 112) ("NPES" . 113) ("NPFS" . 114) ("NPGS" . 115)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 ("NPPS" . 116) ("ALS" . 117) ("ARS" . 118) ("SHLS" . 119)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 ("SHRS" . 120) ("LCKS" . 121) ("CTLS" . 122) ("RPTS" . 123)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 ("TABS" . 124) ("RETS" . 125) ("BSS" . 126) ("DELS" . 127)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 ("ESCC" . 128) ("L1C" . 129) ("L2C" . 130) ("L3C" . 131)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 ("L1AC" . 132) ("L2AC" . 133) ("L3AC" . 134) ("L4C" . 135)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 ("L5C" . 136) ("L6C" . 137) ("L7C" . 138) ("L8C" . 139)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 ("L9C" . 140) ("LAC" . 141) ("LBC" . 142) ("LCC" . 143)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 ("LDC" . 144) ("LEC" . 145) ("LFC" . 146) ("F0C" . 147)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 ("F1C" . 148) ("F2C" . 149) ("F3C" . 150) ("F4C" . 151)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 ("F5C" . 152) ("F6C" . 153) ("F7C" . 154) ("F8C" . 155)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 ("F9C" . 156) ("R1C" . 157) ("R2C" . 158) ("R3C" . 159)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 ("R4C" . 160) ("R5C" . 161) ("R6C" . 162) ("NP0C" . 163)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 ("NP1C" . 164) ("NP2C" . 165) ("NP3C" . 166) ("NP4C" . 167)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 ("NP5C" . 168) ("NP6C" . 169) ("NP7C" . 170) ("NP8C" . 171)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 ("NP9C" . 172) ("NPAC" . 173) ("NPBC" . 174) ("NPCC" . 175)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 ("NPDC" . 176) ("NPEC" . 177) ("NPFC" . 178) ("NPGC" . 179)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 ("NPPC" . 180) ("ALC" . 181) ("ARC" . 182) ("SHLC" . 183)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 ("SHRC" . 184) ("LCKC" . 185) ("CTLC" . 186) ("RPTC" . 187)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 ("TABC" . 188) ("RETC" . 189) ("BSC" . 190) ("DELC" . 191)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 ("ESCU" . 192) ("L1U" . 193) ("L2U" . 194) ("L3U" . 195)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 ("L1AU" . 196) ("L2AU" . 197) ("L3AU" . 198) ("L4U" . 199)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 ("L5U" . 200) ("L6U" . 201) ("L7U" . 202) ("L8U" . 203)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 ("L9U" . 204) ("LAU" . 205) ("LBU" . 206) ("LCU" . 207)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 ("LDU" . 208) ("LEU" . 209) ("LFU" . 210) ("F0U" . 211)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 ("F1U" . 212) ("F2U" . 213) ("F3U" . 214) ("F4U" . 215)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 ("F5U" . 216) ("F6U" . 217) ("F7U" . 218) ("F8U" . 219)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 ("F9U" . 220) ("R1U" . 221) ("R2U" . 222) ("R3U" . 223)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 ("R4U" . 224) ("R5U" . 225) ("R6U" . 226) ("NP0U" . 227)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 ("NP1U" . 228) ("NP2U" . 229) ("NP3U" . 230) ("NP4U" . 231)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 ("NP5U" . 232) ("NP6U" . 233) ("NP7U" . 234) ("NP8U" . 235)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 ("NP9U" . 236) ("NPAU" . 237) ("NPBU" . 238) ("NPCU" . 239)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 ("NPDU" . 240) ("NPEU" . 241) ("NPFU" . 242) ("NPGU" . 243)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 ("NPPU" . 244) ("ALU" . 245) ("ARU" . 246) ("SHLU" . 247)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 ("SHRU" . 248) ("LCKU" . 249) ("CTLU" . 250) ("RPTU" . 251)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 ("TABU" . 252) ("RETU" . 253) ("BSU" . 254) ("DELU" . 255)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 ("MARK" . "L1") ("LINE_DEL" . "L2") ("CHAR_DEL" . "L3")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 ("L_BAR_ARROW" . "L4") ("CMD" . "L5") ("R_BAR_ARROW" . "L6")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 ("L_BOX_ARROW" . "L7") ("UP_ARROW" . "L8") ("R_BOX_ARROW" . "L9")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 ("LEFT_ARROW" . "LA") ("NEXT_WIN" . "LB") ("RIGHT_ARROW" . "LC")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 ("UP_BOX_ARROW" . "LD") ("DOWN_ARROW" . "LE") ("DOWN_BOX_ARROW" . "LF")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 ("COPY" . "L1A") ("PASTE" . "L2A") ("GROW" . "L3A") ("INS_MODE" . "L1S")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 ("SHELL" . "L5S") ("CUT" . "L1AS") ("UNDO" . "L2AS") ("MOVE" . "L3AS")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 ("POP" . "R1") ("AGAIN" . "R2") ("READ" . "R3") ("EDIT" . "R4")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 ("EXIT" . "R5") ("HOLD" . "R6") ("SAVE" . "R4S") ("ABORT" . "R5S")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 ("UNIXHELP" . "R6S") ("AEGISHELP" . "R6C")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 ;;; Define the Apollo Mouse Buttons.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (defvar *apollo-mouse-buttons*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 '(("M1D" . 97) ("M2D" . 98) ("M3D" . 99) ("M4D" . 100)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 ("M1S" . 33) ("M2S" . 34) ("M3S" . 35) ("M4S" . 36)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 ("M1C" . 1) ("M2C" . 2) ("M3C" . 3) ("M4C" . 4)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 ("M1U" . 65) ("M2U" . 66) ("M3U" . 67) ("M4U" . 68)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 ;;; Define functions to simplify making function key and mouse button bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 (defun bind-apollo-function-key (function-key binding &optional meta-binding)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 "Enable an Apollo Function Key and assign a binding to it."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 (interactive "sFunction Key: \nCCommand: \nCMeta Command: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (let ((numeric-code (cdr (assoc function-key *apollo-function-keys*))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 (if (null numeric-code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (error "%s is not a legal Apollo Function Key name" function-key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 (if (stringp numeric-code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (setq numeric-code
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (cdr (assoc numeric-code *apollo-function-keys*))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 (enable-apollo-function-key numeric-code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 (let ((normal-sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 (concat (char-to-string (logior 72 (lsh numeric-code -6)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (char-to-string (logior 64 (logand numeric-code 63)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 (meta-sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 (concat (char-to-string (logior 76 (lsh numeric-code -6)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 (char-to-string (logior 64 (logand numeric-code 63))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (define-key 'apollo-prefix normal-sequence binding)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 (define-key 'apollo-prefix meta-sequence (or meta-binding binding)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 (defun unbind-apollo-function-key (function-key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 "Disable an Apollo Function Key and return control of it to the DM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 (interactive "sFunction key: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 (let ((numeric-code (cdr (assoc function-key *apollo-function-keys*))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 (if (null numeric-code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 (error "%s is not a legal Apollo Function Key name" function-key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 (if (stringp numeric-code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (setq numeric-code
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 (cdr (assoc numeric-code *apollo-function-keys*))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (disable-apollo-function-key numeric-code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 (defun select-apollo-meta-key (meta-key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 "Select the Function Key used as the Meta Key."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 (interactive "sMeta Key: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 (let ((numeric-code (cdr (assoc meta-key *apollo-function-keys*))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 (if (null numeric-code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 (error "%s is not a legal Apollo Function Key name" meta-key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (if (stringp numeric-code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (setq numeric-code
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (cdr (assoc numeric-code *apollo-function-keys*))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (set-apollo-meta-key numeric-code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (defun bind-apollo-mouse-button (mouse-button binding &optional meta-binding)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 "Enable an Apollo Mouse Button and assign a binding to it."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 (interactive "sMouse Button: \nCCommand: \nCMeta Command: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 (let ((numeric-code (cdr (assoc mouse-button *apollo-mouse-buttons*))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 (if (null numeric-code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 (error "%s is not a legal Apollo Mouse Button name" mouse-button))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 (enable-apollo-mouse-button numeric-code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (let ((normal-sequence (char-to-string numeric-code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (meta-sequence (char-to-string (+ numeric-code 16))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (define-key 'apollo-prefix normal-sequence binding)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (define-key 'apollo-prefix meta-sequence (or meta-binding binding)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (defun unbind-apollo-mouse-button (mouse-button)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 "Disable an Apollo Mouse Button and return control of it to the DM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 (interactive "sMouse Button: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (let ((numeric-code (cdr (assoc mouse-button *apollo-mouse-buttons*))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (if (null numeric-code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (error "%s is not a legal Apollo Mouse Button name" mouse-button))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 (disable-apollo-mouse-button numeric-code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 ;;; Initialize the Apollo Keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (define-prefix-command 'apollo-prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 (global-set-key "\C-^" 'apollo-prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 (define-prefix-command 'apollo-prefix-1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (define-prefix-command 'apollo-prefix-2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (define-prefix-command 'apollo-prefix-3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (define-prefix-command 'apollo-prefix-4)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 (define-prefix-command 'apollo-prefix-5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 (define-prefix-command 'apollo-prefix-6)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (define-prefix-command 'apollo-prefix-7)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (define-prefix-command 'apollo-prefix-8)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (define-key 'apollo-prefix "H" 'apollo-prefix-1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 (define-key 'apollo-prefix "I" 'apollo-prefix-2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (define-key 'apollo-prefix "J" 'apollo-prefix-3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (define-key 'apollo-prefix "K" 'apollo-prefix-4)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (define-key 'apollo-prefix "L" 'apollo-prefix-5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (define-key 'apollo-prefix "M" 'apollo-prefix-6)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (define-key 'apollo-prefix "N" 'apollo-prefix-7)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 (define-key 'apollo-prefix "O" 'apollo-prefix-8)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 ;;; Commands to COPY, CUT, and PASTE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (defun apollo-copy-region ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 "Copy region between point and mark to the default DM paste buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (write-region-to-default-apollo-paste-buffer (mark) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 (message "Region Copied"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 (defun apollo-cut-region ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 "Copy region between point and mark to the default DM paste buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 (write-region-to-default-apollo-paste-buffer (mark) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 (kill-region (mark) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 (message "Region Cut"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (defun apollo-paste ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 "Copy region between point and mark to the default DM paste buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 (let ((x (insert-contents-of-default-apollo-paste-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 (push-mark (+ (point) x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (message "Pasted and Mark set"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 ;;; Miscellaneous Commands.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 (defun minibuffer-prompt-length ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 "Returns the length of the current minibuffer prompt."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (let ((window (selected-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (select-window (minibuffer-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 (let ((point (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (insert-char ?a 200)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 (vertical-motion 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 (setq length (- (frame-width) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 (delete-char 200)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (goto-char point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (select-window window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 length))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (defun extract-file-or-buffer-name-around-point (&optional buffer-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (let ((skip-characters (if buffer-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 "!#-%*-9=?-{}~:<>"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 "!#-%*-9=?-{}~:"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (skip-at-end (if buffer-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 '(?@ ?. ?, ?: ?<)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 '(?* ?@ ?. ?, ?:))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 (skip-chars-backward skip-characters)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 (let ((start (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (skip-chars-forward skip-characters)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (let* ((filename (buffer-substring start (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (last-char (aref filename (- (length filename) 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (if (memq last-char skip-at-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (substring filename 0 -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 filename))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 (fset 'extract-file-name-around-point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 'extract-file-or-buffer-name-around-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (fset 'extract-buf-or-file-name-around-point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 'extract-file-or-buffer-name-around-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (defun apollo-find-file (&optional find-buffer-flag other-window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 "Find the file or buffer whose name the cursor is over. Buffer names are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 matched only if the optional argument FIND-BUFFER-FLAG is non-NIL. If the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 optional argument OTHER-WINDOW is non-NIL, the file is displayed in the other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 window. When matching file names, ignores trailing '*' or '@' as in 'ls -F'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 output."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (let* ((file-or-buffer-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 (extract-file-or-buffer-name-around-point find-buffer-flag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (buffer (and find-buffer-flag (get-buffer file-or-buffer-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 (if (or buffer (file-exists-p file-or-buffer-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 (funcall (if other-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 'switch-to-buffer-other-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 'switch-to-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (or buffer (find-file-noselect file-or-buffer-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (error "Cannot find %s \"%s\""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (if find-buffer-flag "buffer or file" "file")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 file-or-buffer-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (defun apollo-grow-emacs-window ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 "Grow Emacs's Apollo window with rubberbanding."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (execute-dm-command "WGE"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 (defun apollo-move-emacs-window ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 "Move Emacs's Apollo window with rubberbanding."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (execute-dm-command "WME"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (defun apollo-again ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 "Copy the remainder of the current line to the end of the buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 (set-mark-command nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (copy-region-as-kill (mark) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (end-of-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (yank))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (defun apollo-exit ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 "Kill current buffer after saving changes."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 (save-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 (kill-buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 (defun apollo-abort ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 "Kill current buffer without saving changes."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (kill-buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (defun apollo-aegis-help (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 "Prompt for topic and find the Apollo help file."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 (interactive "sHelp on: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 (let ((help-file (concat "/sys/help/" filename ".hlp")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (with-output-to-temp-buffer "*Help File*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 (buffer-disable-undo standard-output)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 (set-buffer standard-output)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (insert-man-file help-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 (if (> (buffer-size) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 (message "Cleaning help file entry...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 (apollo-clean-help-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 (message ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (message "No help found in %s" help-file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 (set-buffer-modified-p nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (fset 'apollo-help 'apollo-aegis-help)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 ;;; Make sure this will be loaded if necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (autoload 'insert-man-file "man")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 (defun apollo-clean-help-file ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 ;; Remove underlining and overstriking by the same letter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (while (search-forward "\b" nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 (let ((preceding (char-after (- (point) 2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 (following (following-char)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 (cond ((= preceding following) ; x\bx
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 (delete-char -2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 ((= preceding ?\_) ; _\b
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 (delete-char -2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 ((= following ?\_) ; \b_
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (delete-region (1- (point)) (1+ (point)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 ;; Remove overstriking and carriage returns before newline.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 (while (re-search-forward "\r$" nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 (replace-match ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 (while (re-search-forward "^.*\r" nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 (replace-match ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 ;; Fit in 79 cols rather than 80.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (indent-rigidly (point-min) (point-max) -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 ;; Delete excess multiple blank lines.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 (while (re-search-forward "\n\n\n\n*" nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 (replace-match "\n\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 ;; Remove blank lines at the beginning.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 (skip-chars-forward "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 (delete-region (point-min) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 ;; Separate the header from the main subject line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 (insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 (goto-char (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 (defun kill-whole-line ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 "Kill the line containing point. Try to retain column cursor is on."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (let ((old-column (current-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 (kill-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 (move-to-column old-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 (defun apollo-key-undefined ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 "Signal that an Apollo Function Key is undefined."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 (error "Apollo Function Key undefined"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 ;;; Define the mouse commands.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (defun apollo-mouse-move-point (&optional no-mark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 "Used so that pressing the left mouse button, moving the cursor, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 releasing the left mouse button leaves the mark set to the initial position
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 and the point set to the final position. Useful for easily marking regions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 of text. If the left mouse button is pressed and released at the same place,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 the mark is left at the original position of the character cursor.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 Returns (x y) frame coordinates of point in columns and lines."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (let* ((opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 (owindow (selected-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 (x (- (read-char) 8))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 (y (- (read-char) 8))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 (edges (window-edges))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 (window nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 (while (and (not (eq window (selected-window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 (or (< y (nth 1 edges))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 (>= y (nth 3 edges))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 (< x (nth 0 edges))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (>= x (nth 2 edges))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (setq window (next-window window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 (setq edges (window-edges window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 (if (and window (not (eq window (selected-window))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 (if (and (not *apollo-mouse-move-point-allow-minibuffer-exit*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 (eq (selected-window) (minibuffer-window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 (error "Cannot use mouse to leave minibuffer!"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 (if (eq window (minibuffer-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 (error "Cannot use mouse to enter minibuffer!"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 (if window (select-window window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 (move-to-window-line (- y (nth 1 edges)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 (let* ((width-1 (1- (window-width window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 (wraps (/ (current-column) width-1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (prompt-length (if (eq (selected-window) (minibuffer-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 (minibuffer-prompt-length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 (move-to-column (+ (- x (nth 0 edges) prompt-length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 (* wraps width-1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (if no-mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (progn (setq window (selected-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 (if (eq owindow window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 (if (equal opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 (pop-mark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 (select-window owindow)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 (pop-mark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 (select-window window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 (set-mark-command nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 ;; Return (x y) coords of point in column and frame line numbers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 (list x y)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 (defun apollo-mouse-move-mark ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 "Used so that pressing the left mouse button, moving the cursor, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 releasing the left mouse button leaves the mark set to the initial position
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 and the point set to the final position. Useful for easily marking regions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 of text. If the left mouse button is pressed and released at the same place,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 the mark is left at the original position of the character cursor."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 (apollo-mouse-move-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 (if (equal (point) (mark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 (pop-mark)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 (defun apollo-mouse-cut ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 "Move point to the location of the mouse cursor and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 cut the region to the default DM paste buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 (apollo-mouse-move-mark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 (apollo-cut-region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 (defun apollo-mouse-copy ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 "Move point to the location of the mouse cursor and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 copy the region to the default DM paste buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 (apollo-mouse-move-mark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 (apollo-copy-region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 (defun apollo-mouse-paste ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 "Move point to the location of the mouse cursor and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 paste in the default DM paste buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 (apollo-mouse-move-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 (apollo-paste))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 (defun apollo-mouse-pop-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 "Used in conjunction with the 'list-buffers' command, moves
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 point to cursor location and displays buffer named on current line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 Similar to a DM pop window by name to top."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 (apollo-mouse-move-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 (Buffer-menu-select))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (defun apollo-mouse-find-file ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 "Find the file or buffer whose name the cursor is over. Buffers are only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 allowed when in the '*Buffer List*' buffer. When matching file names, ignores
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 trailing '*' or '@' as in 'ls -F' output."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 (apollo-mouse-move-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 (let ((find-buffer-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 (equal (buffer-name (current-buffer)) "*Buffer List*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 (apollo-find-file find-buffer-flag nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 (defun apollo-mouse-find-file-other-window ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 "Find the file or buffer whose name the cursor is over. Buffers are only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 allowed when in the '*Buffer List*' buffer. When matching file names, ignores
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 trailing '*' or '@' as in 'ls -F' output. The file or buffer is displayed in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 the other window."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 (apollo-mouse-move-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 (let ((find-buffer-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 (equal (buffer-name (current-buffer)) "*Buffer List*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (apollo-find-file find-buffer-flag t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 (other-window 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 ;;; Define and Enable the Mouse Key Bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 (defun apollo-mouse-defaults ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 "Set up default Apollo mouse key bindings for GNU Emacs."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 (bind-apollo-mouse-button "M1D" 'apollo-mouse-move-point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 'apollo-mouse-move-point) ;MOUSE LEFT DOWN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (bind-apollo-mouse-button "M1U" 'apollo-mouse-move-mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 'apollo-mouse-copy) ;MOUSE LEFT UP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 (bind-apollo-mouse-button "M2D" 'sm-depress
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 'sm-depress-meta) ;MOUSE MIDDLE DOWN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 (bind-apollo-mouse-button "M2U" 'smart-key-mouse
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 'smart-key-mouse-meta) ;MOUSE MIDDLE UP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 (bind-apollo-mouse-button "M3D" 'sm-depress-meta) ;MOUSE RIGHT DOWN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 (bind-apollo-mouse-button "M3U" 'smart-key-mouse-meta) ;MOUSE RIGHT UP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 (apollo-mouse-defaults)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (defun apollo-mouse-cut-copy-paste ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 "Sets Apollo mouse keys to perform DM-style cut, copy, and paste.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 LEFT MOUSE DOWN moves point to cursor location. LEFT MOUSE UP sets
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 mark, moves point to cursor location and cuts region. MID MOUSE works
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 the same way but does a copy. RIGHT MOUSE sets point and pastes at
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 cursor location. These key bindings are also effective in DM windows
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 until \\[apollo-mouse-cancel-cut-copy-paste] is executed in the GNU Emacs DM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 window."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 (bind-apollo-mouse-button "M1D" 'apollo-mouse-move-point) ;MOUSE LEFT DOWN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 (bind-apollo-mouse-button "M1U" 'apollo-mouse-cut) ;MOUSE LEFT UP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 (bind-apollo-mouse-button "M2D" 'apollo-mouse-move-point) ;MOUSE MIDDLE DOWN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 (bind-apollo-mouse-button "M2U" 'apollo-mouse-copy) ;MOUSE MIDDLE UP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 (bind-apollo-mouse-button "M3D" 'apollo-mouse-paste) ;MOUSE RIGHT DOWN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 (unbind-apollo-mouse-button "M3U") ;MOUSE RIGHT UP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 (message "Mouse Edit Mode: left=cut, mid=copy, right=paste")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 (execute-dm-command "msg 'Mouse Edit Mode: left=cut, mid=copy, right=paste';kd m1 dr;echo ke;kd m1u xd ke;kd m2 dr;echo ke;kd m2u xc ke; kd m3 xp ke;kd m3u ke")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 (defun apollo-mouse-cancel-cut-copy-paste ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 "Sets Apollo mouse keys back to defaults with GNU Emacs and personal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 settings within the DM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 (apollo-mouse-defaults)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 (message "Default mouse key bindings set")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 (execute-dm-command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 (concat "msg 'Mouse Edit Mode canceled; personal mouse keys restored';"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 "cmdf " *dm-mouse-key-bindings-file*))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 ;;; Define and Enable the Function Key Bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 (bind-apollo-function-key "TABS" "\C-I") ;Shift TAB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 (bind-apollo-function-key "TABC" "\C-I") ;Control TAB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 (bind-apollo-function-key "RETS" "\C-M") ;Shift RET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 (bind-apollo-function-key "RETC" "\C-M") ;Control RET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 (bind-apollo-function-key "LINE_DEL" 'kill-whole-line) ;LINE DEL
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 (bind-apollo-function-key "CHAR_DEL" "\C-D") ;CHAR DEL
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 (bind-apollo-function-key "L_BAR_ARROW" "\C-A") ;LEFT BAR ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 (bind-apollo-function-key "R_BAR_ARROW" "\C-E") ;RIGHT BAR ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (bind-apollo-function-key "L_BOX_ARROW" "\C-x>") ;LEFT BOX ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (bind-apollo-function-key "UP_ARROW" "\C-P") ;UP ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (bind-apollo-function-key "L8S" "\M-1\M-V") ;Shift UP ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 ;;; RIGHT BOX ARROW is the Default Meta Key. If the Meta Key is changed with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 ;;; SELECT-APOLLO-META-KEY, then RIGHT BOX ARROW signals an error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 (select-apollo-meta-key "R1") ; Make POP the META key instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 (bind-apollo-function-key "R_BOX_ARROW" "\C-x<") ;RIGHT BOX ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 (bind-apollo-function-key "LEFT_ARROW" "\C-B") ;LEFT ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 (bind-apollo-function-key "RIGHT_ARROW" "\C-F") ;RIGHT ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 (bind-apollo-function-key "DOWN_ARROW" "\C-N") ;DOWN ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 (bind-apollo-function-key "LES" "\M-1\C-V") ;Shift DOWN ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 (bind-apollo-function-key "R3S" 'apollo-find-file) ;Shift READ
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 (bind-apollo-function-key "MARK" 'set-mark-command) ;MARK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 (bind-apollo-function-key "INS_MODE" 'overwrite-mode) ;INS MODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 (bind-apollo-function-key "L2S" "\C-Y") ;Shift LINE DEL
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 (bind-apollo-function-key "L3S" "\C-D") ;Shift CHAR DEL
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 (bind-apollo-function-key "COPY" 'apollo-copy-region) ;COPY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 (bind-apollo-function-key "CUT" 'apollo-cut-region) ;CUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (bind-apollo-function-key "PASTE" 'apollo-paste) ;PASTE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 (bind-apollo-function-key "UNDO" 'undo) ;UNDO
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 (bind-apollo-function-key "GROW" 'apollo-grow-emacs-window) ;GROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 (bind-apollo-function-key "MOVE" 'apollo-move-emacs-window) ;MOVE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 (bind-apollo-function-key "LAS" "\M-B") ;Shift LEFT ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 (bind-apollo-function-key "LCS" "\M-F") ;Shift RIGHT ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 (bind-apollo-function-key "UP_BOX_ARROW" "\M-V") ;UP BOX ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 (bind-apollo-function-key "LDS" "\M-<") ;Shift UP BOX ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 (bind-apollo-function-key "DOWN_BOX_ARROW" "\C-V") ;DOWN BOX ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 (bind-apollo-function-key "LFS" "\M->") ;Shift DOWN BOX ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 (bind-apollo-function-key "AGAIN" 'apollo-again) ;AGAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 (bind-apollo-function-key "EXIT" 'apollo-exit) ;EXIT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 (bind-apollo-function-key "ABORT" 'apollo-abort) ;ABORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 (bind-apollo-function-key "SAVE" 'save-buffer) ;SAVE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (bind-apollo-function-key "HOLD" 'apollo-key-undefined) ;HOLD
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 (defun install-apollo-dm-preemptive-key-bindings ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 (bind-apollo-function-key "L4S" "\M-<") ;Shift LEFT BAR ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 (bind-apollo-function-key "L5" 'execute-dm-command) ;CMD
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 (bind-apollo-function-key "L6S" "\M->") ;Shift RIGHT BAR ARROW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 (bind-apollo-function-key "LB" 'other-window) ;NEXT WNDW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 (bind-apollo-function-key "LBS" 'delete-window) ;Shift NEXT WNDW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 (bind-apollo-function-key "READ" 'find-file-read-only) ;READ
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 (bind-apollo-function-key "EDIT" 'find-file) ;EDIT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 (bind-apollo-function-key "SHELL" 'shell) ;SHELL
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 (bind-apollo-function-key "UNIXHELP" 'manual-entry) ;HELP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 (bind-apollo-function-key "AEGISHELP" 'apollo-aegis-help)) ;HELP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 (if *preempt-display-manager-bindings*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 (install-apollo-dm-preemptive-key-bindings))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 (run-hooks '*apollo-key-bindings-hook*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 (provide 'apollo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 ;;; apollo.el ends here