diff options
Diffstat (limited to 'lisp/term')
| -rw-r--r-- | lisp/term/COPYING | 249 | ||||
| -rw-r--r-- | lisp/term/apollo.el | 1 | ||||
| -rw-r--r-- | lisp/term/at386.el | 101 | ||||
| -rw-r--r-- | lisp/term/bbn.el | 1 | ||||
| -rw-r--r-- | lisp/term/bg-mouse.el | 304 | ||||
| -rw-r--r-- | lisp/term/bg.el | 6 | ||||
| -rw-r--r-- | lisp/term/bgnv.el | 1 | ||||
| -rw-r--r-- | lisp/term/bgrv.el | 1 | ||||
| -rw-r--r-- | lisp/term/bobcat.el | 11 | ||||
| -rw-r--r-- | lisp/term/news.el | 85 | ||||
| -rw-r--r-- | lisp/term/s4.el | 142 | ||||
| -rw-r--r-- | lisp/term/sun-mouse.el | 668 | ||||
| -rw-r--r-- | lisp/term/sun.el | 333 | ||||
| -rw-r--r-- | lisp/term/sup-mouse.el | 207 | ||||
| -rw-r--r-- | lisp/term/supdup.el | 81 | ||||
| -rw-r--r-- | lisp/term/unixpc.el | 148 | ||||
| -rw-r--r-- | lisp/term/vt100.el | 66 | ||||
| -rw-r--r-- | lisp/term/vt101.el | 1 | ||||
| -rw-r--r-- | lisp/term/vt102.el | 1 | ||||
| -rw-r--r-- | lisp/term/vt125.el | 1 | ||||
| -rw-r--r-- | lisp/term/vt131.el | 1 | ||||
| -rw-r--r-- | lisp/term/vt200.el | 90 | ||||
| -rw-r--r-- | lisp/term/vt220.el | 1 | ||||
| -rw-r--r-- | lisp/term/vt240.el | 1 | ||||
| -rw-r--r-- | lisp/term/vt300.el | 1 | ||||
| -rw-r--r-- | lisp/term/wyse50.el | 235 | ||||
| -rw-r--r-- | lisp/term/x-win.el | 817 | ||||
| -rw-r--r-- | lisp/term/xterm.el | 2 |
28 files changed, 1445 insertions, 2111 deletions
diff --git a/lisp/term/COPYING b/lisp/term/COPYING new file mode 100644 index 00000000000..9a170375811 --- /dev/null +++ b/lisp/term/COPYING @@ -0,0 +1,249 @@ + + GNU GENERAL PUBLIC LICENSE + Version 1, February 1989 + + Copyright (C) 1989 Free Software Foundation, Inc. + 675 Mass Ave, Cambridge, MA 02139, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The license agreements of most software companies try to keep users +at the mercy of those companies. By contrast, our General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. The +General Public License applies to the Free Software Foundation's +software and to any other program whose authors commit to using it. +You can use it for your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Specifically, the General Public License is designed to make +sure that you have the freedom to give away or sell copies of free +software, that you receive source code or can get it if you want it, +that you can change the software or use pieces of it in new free +programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of a such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must tell them their rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work based +on the Program" means either the Program or any work containing the +Program or a portion of it, either verbatim or with modifications. Each +licensee is addressed as "you". + + 1. You may copy and distribute verbatim copies of the Program's source +code as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice and +disclaimer of warranty; keep intact all the notices that refer to this +General Public License and to the absence of any warranty; and give any +other recipients of the Program a copy of this General Public License +along with the Program. You may charge a fee for the physical act of +transferring a copy. + + 2. You may modify your copy or copies of the Program or any portion of +it, and copy and distribute such modifications under the terms of Paragraph +1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating that + you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, that + in whole or in part contains the Program or any part thereof, either + with or without modifications, to be licensed at no charge to all + third parties under the terms of this General Public License (except + that you may choose to grant warranty protection to some or all + third parties, at your option). + + c) If the modified program normally reads commands interactively when + run, you must cause it, when started running for such interactive use + in the simplest and most usual way, to print or display an + announcement including an appropriate copyright notice and a notice + that there is no warranty (or else, saying that you provide a + warranty) and that users may redistribute the program under these + conditions, and telling the user how to view a copy of this General + Public License. + + d) You may charge a fee for the physical act of transferring a + copy, and you may at your option offer warranty protection in + exchange for a fee. + +Mere aggregation of another independent work with the Program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other work under the scope of these terms. + + 3. You may copy and distribute the Program (or a portion or derivative of +it, under Paragraph 2) in object code or executable form under the terms of +Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal charge + for the cost of distribution) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +Source code for a work means the preferred form of the work for making +modifications to it. For an executable file, complete source code means +all the source code for all modules it contains; but, as a special +exception, it need not include source code for modules which are standard +libraries that accompany the operating system on which the executable +file runs, or for standard header files or definitions files that +accompany that operating system. + + 4. You may not copy, modify, sublicense, distribute or transfer the +Program except as expressly provided under this General Public License. +Any attempt otherwise to copy, modify, sublicense, distribute or transfer +the Program is void, and will automatically terminate your rights to use +the Program under this License. However, parties who have received +copies, or rights to use copies, from you under this General Public +License will not have their licenses terminated so long as such parties +remain in full compliance. + + 5. By copying, distributing or modifying the Program (or any work based +on the Program) you indicate your acceptance of this license to do so, +and all its terms and conditions. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the original +licensor to copy, distribute or modify the Program subject to these +terms and conditions. You may not impose any further restrictions on the +recipients' exercise of the rights granted herein. + + 7. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of the license which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +the license, you may choose any version ever published by the Free Software +Foundation. + + 8. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to humanity, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively convey +the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) 19yy <name of author> + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19xx name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than `show w' and `show +c'; they could even be mouse-clicks or menu items--whatever suits your +program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + program `Gnomovision' (a program to direct compilers to make passes + at assemblers) written by James Hacker. + + <signature of Ty Coon>, 1 April 1989 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/lisp/term/apollo.el b/lisp/term/apollo.el new file mode 100644 index 00000000000..3b75d654c50 --- /dev/null +++ b/lisp/term/apollo.el @@ -0,0 +1 @@ +(load "term/vt100") diff --git a/lisp/term/at386.el b/lisp/term/at386.el new file mode 100644 index 00000000000..65848affb74 --- /dev/null +++ b/lisp/term/at386.el @@ -0,0 +1,101 @@ +;;; Dell 325D (UNIX SVR4) as AT386 UNIX PC keyboard definitions +;;; Based on Brant Cheikes (brant@linc.cis.upenn.edu, manta!brant) +;;; unixpc.el. +;;; +;;; Mark J. Hewitt (mjh@uk.co.kernel) +;;; 8-apr-91 +;;; +;;; The AT386 keyboard mapping has three types of prefix keys: +;;; +;;; <esc> [ for cursor positioning and keypad +;;; <esc> O for function keys +;;; <esc> N for ALT keys +;;; +;;; *NOTE* Care is required when using ALT bound as a simple META key. +;;; It works for most normal key sequences, but some ALT-CTRL +;;; (aka M-C-x) are intercepted locally. F'rinstance M-C-d would +;;; break to the kernel debugger, kdb (!). +;;; + +(require 'keypad) ; for keypad-defaults + +(defvar Dell-map-1 nil + "The <esc>O keys (Function) on the Dell Unix PC.") +(defvar Dell-map-3 nil + "The <esc>[ keys (Right-hand keypads) on the Dell Unix PC.") + +(defun enable-function-keys () + "Enable the use of the keypad and function keys. +Because of the nature of the PC keyboard under Unix, +this unavoidably breaks a standard Emacs command (M-[); +therefore, it is not done by default, but only if you give this command." + (interactive) + (global-set-key "\eO" Dell-map-1) + (global-set-key "\eN" 'ESC-prefix) + (global-set-key "\e[" Dell-map-3) +) + +;;; Create a few new keypad defaults. + +(keypad-default "5" 'set-mark-command) +(keypad-default "I" 'yank) +(keypad-default "x" 'call-last-kbd-macro) +(keypad-default "\C-f" 'info) +(keypad-default "\C-g" 'overwrite-mode) +(keypad-default "\C-h" 'auto-fill-mode) +(keypad-default "\C-i" 'abbrev-mode) +(keypad-default "\C-j" 'browse-yank) +; There are no definitions for these functions. +;(keypad-default "\C-l" 'Dell-132) +;(keypad-default "\C-m" 'Dell-80) +(keypad-default "\C-n" 'scroll-other-window) +(keypad-default "\C-o" 'other-window) +(keypad-default "\C-p" 'repeat-complex-command) + +;; Now populate the maps, if they are enabled. + +(if Dell-map-1 + nil + (setq Dell-map-1 (make-keymap)) ; <ESC>O (function key) commands + (setup-terminal-keymap Dell-map-1 + '(("P" . ??) ; F1 (help) + ("p" . ?\^f) ; Shift F1 (info) + ("Q" . ?\^g) ; F2 (overwrite-mode) + ("q" . ?\^g) ; Shift F2 (overwrite-mode) + ("R" . ?\^h) ; F3 (auto-fill-mode) + ("r" . ?\^h) ; Shift F3 (auto-fill-mode) + ("S" . ?\^i) ; F4 (abbrev-mode) + ("s" . ?\^i) ; Shift F4 (abbrev-mode) + ("T" . ?\^j) ; F5 (browse-yank) + ("t" . ?\^j) ; Shift F5 (browse-yank) + ("U" . ?\^l) ; F6 (Dell-132) + ("u" . ?\^m) ; Shift F6 (Dell-80) + ("V" . nil) ; F7 + ("v" . nil) ; Shift F7 + ("W" . ?\^n) ; F8 (scroll-other-window) + ("w" . ?\^o) ; Shift F8 (other-window) + ("X" . nil) ; F9 + ("x" . nil) ; Shift F9 + ("Y" . nil) ; F10 + ("y" . nil) ; Shift F10 + ("Z" . ?\^p) ; F11 (repeat-complex-command) + ("z" . ?\^p) ; Shift F11 (repeat-complex-command) + ("A" . ?x) ; F12 (call-last-kbd-macro) + ("a" . ?x) ; Shift F12 (call-last-kbd-macro) + ))) + +(if Dell-map-3 + nil + (setq Dell-map-3 (make-sparse-keymap)) ; <ESC>[ commands + (setup-terminal-keymap Dell-map-3 + '(("A" . ?u) ; Up Arrow (previous-line) + ("B" . ?d) ; Down Arrow (next-line) + ("C" . ?r) ; Right Arrow (forward-char) + ("D" . ?l) ; Left Arrow (backward-char) + ("H" . ?\^a) ; Home (beginning-of-line) + ("Y" . ?\^b) ; End (end-of-line) + ("@" . ?I) ; Insert (yank) + ("U" . ?N) ; Page Up (scroll-up) + ("V" . ?P) ; Shift-Page (scroll-down) + ("G" . ?5) ; pad 5 (set-mark-command) + ))) diff --git a/lisp/term/bbn.el b/lisp/term/bbn.el new file mode 100644 index 00000000000..9affcc21281 --- /dev/null +++ b/lisp/term/bbn.el @@ -0,0 +1 @@ +(load (concat term-file-prefix "bg") nil t) diff --git a/lisp/term/bg-mouse.el b/lisp/term/bg-mouse.el deleted file mode 100644 index 9b83f5f6c2a..00000000000 --- a/lisp/term/bg-mouse.el +++ /dev/null @@ -1,304 +0,0 @@ -;; GNU Emacs code for BBN Bitgraph mouse. -;; Copyright (C) Free Software Foundation, Inc. Oct 1985. -;; Time stamp <89/03/21 14:27:08 gildea> - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 1, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - - -;;; Original version by John Robinson (jr@bbn-unix.arpa, bbncca!jr), Oct 1985 -;;; Modularized and enhanced by gildea@bbn.com Nov 1987 - -(provide 'bg-mouse) - -;;; User customization option: - -(defvar bg-mouse-fast-select-window nil - "*Non-nil for mouse hits to select new window, then execute; else just select.") - -;;; These numbers are summed to make the index into the mouse-map. -;;; The low three bits correspond to what the mouse actually sends. -(defconst bg-button-r 1) -(defconst bg-button-m 2) -(defconst bg-button-c 2) -(defconst bg-button-l 4) -(defconst bg-in-modeline 8) -(defconst bg-in-scrollbar 16) -(defconst bg-in-minibuf 24) - -;;; semicolon screws up indenting, so use this instead -(defconst semicolon ?\;) - -;;; Defuns: - -(defun bg-mouse-report (prefix-arg) - "Read, parse, and execute a BBN BitGraph mouse click. - -L-- move point | These apply for mouse click in a window. ---R set mark | If bg-mouse-fast-select-window is nil, -L-R kill region | these commands on a nonselected window --C- move point and yank | just select that window. -LC- yank-pop | --CR or LCR undo | \"Scroll bar\" is right-hand window column. - -on modeline: on \"scroll bar\": in minibuffer: -L-- scroll-up line to top execute-extended-command ---R scroll-down line to bottom eval-expression --C- proportional goto-char line to middle suspend-emacs - -To reinitialize the mouse if the terminal is reset, type ESC : RET" - (interactive "P") - (bg-get-tty-num semicolon) - (let* - ((screen-mouse-x (min (1- (screen-width)) ;don't hit column 86! - (/ (bg-get-tty-num semicolon) 9))) - (screen-mouse-y (- (1- (screen-height)) ;assume default font size. - (/ (bg-get-tty-num semicolon) 16))) - (bg-mouse-buttons (% (bg-get-tty-num ?c) 8)) - (bg-mouse-window (bg-window-from-x-y screen-mouse-x screen-mouse-y)) - (bg-cursor-window (selected-window)) - (edges (window-edges bg-mouse-window)) - (minibuf-p (= screen-mouse-y (1- (screen-height)))) - (in-modeline-p (and (not minibuf-p) - (= screen-mouse-y (1- (nth 3 edges))))) - (in-scrollbar-p (and (not minibuf-p) (not in-modeline-p) - (>= screen-mouse-x (1- (nth 2 edges))))) - (same-window-p (eq bg-mouse-window bg-cursor-window)) - (in-minibuf-p (and minibuf-p - (not bg-mouse-window))) ;minibuf must be inactive - (bg-mode-bits (+ (if in-minibuf-p bg-in-minibuf 0) - (if in-modeline-p bg-in-modeline 0) - (if in-scrollbar-p bg-in-scrollbar 0))) - (bg-command - (lookup-key mouse-map - (char-to-string (+ bg-mode-bits bg-mouse-buttons)))) - (bg-mouse-x (- screen-mouse-x (nth 0 edges))) - (bg-mouse-y (- screen-mouse-y (nth 1 edges)))) - (cond ((or in-modeline-p in-scrollbar-p) - (select-window bg-mouse-window) - (bg-command-execute bg-command) - (select-window bg-cursor-window)) - ((or same-window-p in-minibuf-p) - (bg-command-execute bg-command)) - (t ;in another window - (select-window bg-mouse-window) - (if bg-mouse-fast-select-window - (bg-command-execute bg-command))) - ))) - - -;;; Library of commands: - -(defun bg-set-point () - "Move point to location of BitGraph mouse." - (interactive) - (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) - (setq this-command 'next-line) ;make subsequent line moves work - (setq temporary-goal-column bg-mouse-x)) - -(defun bg-set-mark () - "Set mark at location of BitGraph mouse." - (interactive) - (push-mark) - (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) - (exchange-point-and-mark)) - -(defun bg-yank () - "Move point to location of BitGraph mouse and yank." - (interactive "*") - (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) - (setq this-command 'yank) - (yank)) - -(defun yank-pop-1 () - (interactive "*") - (yank-pop 1)) - -(defun bg-yank-or-pop () - "Move point to location of BitGraph mouse and yank. If last command -was a yank, do a yank-pop." - (interactive "*") - (if (eql last-command 'yank) - (yank-pop 1) - (bg-yank))) - -;;; In 18.51, Emacs Lisp doesn't provide most-positive-fixnum -(defconst bg-most-positive-fixnum 8388607) - -(defun bg-move-by-percentage () - "Go to location in buffer that is the same percentage of the way -through the buffer as the BitGraph mouse's X position in the window." - (interactive) - ;; check carefully for overflow in intermediate calculations - (goto-char - (cond ((zerop bg-mouse-x) - 0) - ((< (buffer-size) (/ bg-most-positive-fixnum bg-mouse-x)) - ;; no danger of overflow: compute it exactly - (/ (* bg-mouse-x (buffer-size)) - (1- (window-width)))) - (t - ;; overflow possible: approximate - (* (/ (buffer-size) (1- (window-width))) - bg-mouse-x)))) - (beginning-of-line) - (what-cursor-position)) - -(defun bg-mouse-line-to-top () - "Scroll the line pointed to by the BitGraph mouse to the top of the window." - (interactive) - (scroll-up bg-mouse-y)) - -(defun bg-mouse-line-to-center () - "Scroll the line pointed to by the BitGraph mouse to the center -of the window" - (interactive) - (scroll-up (/ (+ 2 bg-mouse-y bg-mouse-y (- (window-height))) 2))) - -(defun bg-mouse-line-to-bottom () - "Scroll the line pointed to by the mouse to the bottom of the window." - (interactive) - (scroll-up (+ bg-mouse-y (- 2 (window-height))))) - -(defun bg-kill-region () - (interactive "*") - (kill-region (region-beginning) (region-end))) - -(defun bg-insert-moused-sexp () - "Insert a copy of the word (actually sexp) that the mouse is pointing at. -Sexp is inserted into the buffer at point (where the text cursor is)." - (interactive) - (let ((moused-text - (save-excursion - (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) - (if (looking-at "\\s)") - (forward-char 1) - (forward-sexp 1)) - (buffer-substring (save-excursion (backward-sexp 1) (point)) - (point))))) - (select-window bg-cursor-window) - (delete-horizontal-space) - (cond - ((bolp) - (indent-according-to-mode)) - ;; In Lisp assume double-quote is closing; in Text assume opening. - ;; Why? Because it does the right thing most often. - ((save-excursion (forward-char -1) - (and (not (looking-at "\\s\"")) - (looking-at "[`'\"\\]\\|\\s("))) - nil) - (t - (insert-string " "))) - (insert-string moused-text) - (or (eolp) - (looking-at "\\s.\\|\\s)") - (and (looking-at "'") (looking-at "\\sw")) ;hack for text mode - (save-excursion (insert-string " "))))) - -;;; Utility functions: - -(defun bg-get-tty-num (term-char) - "Read from terminal until TERM-CHAR is read, and return intervening number. -If non-numeric not matching TERM-CHAR, reprogram the mouse and signal an error." - (let - ((num 0) - (char (- (read-char) 48))) - (while (and (>= char 0) - (<= char 9)) - (setq num (+ (* num 10) char)) - (setq char (- (read-char) 48))) - (or (eq term-char (+ char 48)) - (progn - (bg-program-mouse) - (error - "Invalid data format in bg-mouse command: mouse reinitialized."))) - num)) - -;;; Note that this fails in the minibuf because move-to-column doesn't -;;; allow for the width of the prompt. -(defun bg-move-point-to-x-y (x y) - "Position cursor in window coordinates. -X and Y are 0-based character positions in the window." - (move-to-window-line y) - ;; if not on a wrapped line, zero-column will be 0 - (let ((zero-column (current-column)) - (scroll-offset (window-hscroll))) - ;; scrolling takes up column 0 to display the $ - (if (> scroll-offset 0) - (setq scroll-offset (1- scroll-offset))) - (move-to-column (+ zero-column scroll-offset x)) - )) - -;;; Returns the window that screen position (x, y) is in or nil if none, -;;; meaning we are in the echo area with a non-active minibuffer. -;;; If coordinates-in-window-p were not in an X-windows-specific file -;;; we could use that. In Emacs 19 can even use locate-window-from-coordinates -(defun bg-window-from-x-y (x y) - "Find window corresponding to screen coordinates. -X and Y are 0-based character positions on the screen." - (let ((edges (window-edges)) - (window nil)) - (while (and (not (eq window (selected-window))) - (or (< y (nth 1 edges)) - (>= y (nth 3 edges)) - (< x (nth 0 edges)) - (>= x (nth 2 edges)))) - (setq window (next-window window)) - (setq edges (window-edges window))) - (cond ((eq window (selected-window)) - nil) ;we've looped: not found - ((not window) - (selected-window)) ;just starting: current window - (t - window)) - )) - -(defun bg-command-execute (bg-command) - (if (commandp bg-command) - (command-execute bg-command) - (ding))) - -(defun bg-program-mouse () - (send-string-to-terminal "\e:0;7;;;360;512;9;16;9;16c")) - -;;; Note that the doc string for mouse-map (as defined in subr.el) -;;; says it is for the X-window mouse. This is wrong; that keymap -;;; should be used for your mouse no matter what terminal you have. - -(or (keymapp mouse-map) - (setq mouse-map (make-keymap))) - -(defun bind-bg-mouse-click (click-code function) - "Bind bg-mouse CLICK-CODE to run FUNCTION." - (define-key mouse-map (char-to-string click-code) function)) - -(bind-bg-mouse-click bg-button-l 'bg-set-point) -(bind-bg-mouse-click bg-button-m 'bg-yank) -(bind-bg-mouse-click bg-button-r 'bg-set-mark) -(bind-bg-mouse-click (+ bg-button-l bg-button-m) 'yank-pop-1) -(bind-bg-mouse-click (+ bg-button-l bg-button-r) 'bg-kill-region) -(bind-bg-mouse-click (+ bg-button-m bg-button-r) 'undo) -(bind-bg-mouse-click (+ bg-button-l bg-button-m bg-button-r) 'undo) -(bind-bg-mouse-click (+ bg-in-modeline bg-button-l) 'scroll-up) -(bind-bg-mouse-click (+ bg-in-modeline bg-button-m) 'bg-move-by-percentage) -(bind-bg-mouse-click (+ bg-in-modeline bg-button-r) 'scroll-down) -(bind-bg-mouse-click (+ bg-in-scrollbar bg-button-l) 'bg-mouse-line-to-top) -(bind-bg-mouse-click (+ bg-in-scrollbar bg-button-m) 'bg-mouse-line-to-center) -(bind-bg-mouse-click (+ bg-in-scrollbar bg-button-r) 'bg-mouse-line-to-bottom) -(bind-bg-mouse-click (+ bg-in-minibuf bg-button-l) 'execute-extended-command) -(bind-bg-mouse-click (+ bg-in-minibuf bg-button-m) 'suspend-emacs) -(bind-bg-mouse-click (+ bg-in-minibuf bg-button-r) 'eval-expression) - diff --git a/lisp/term/bg.el b/lisp/term/bg.el new file mode 100644 index 00000000000..c1b98910861 --- /dev/null +++ b/lisp/term/bg.el @@ -0,0 +1,6 @@ +;; BBN bitgraph terminal. + +(load (concat term-file-prefix "vt100") nil t) ;BG keyboard is VT100 clone +(autoload 'bg-mouse-report "bg-mouse") +(global-set-key "\e:" 'bg-mouse-report) +(send-string-to-terminal "\e:0;7;;;360;512;9;16;9;16c") diff --git a/lisp/term/bgnv.el b/lisp/term/bgnv.el new file mode 100644 index 00000000000..9affcc21281 --- /dev/null +++ b/lisp/term/bgnv.el @@ -0,0 +1 @@ +(load (concat term-file-prefix "bg") nil t) diff --git a/lisp/term/bgrv.el b/lisp/term/bgrv.el new file mode 100644 index 00000000000..9affcc21281 --- /dev/null +++ b/lisp/term/bgrv.el @@ -0,0 +1 @@ +(load (concat term-file-prefix "bg") nil t) diff --git a/lisp/term/bobcat.el b/lisp/term/bobcat.el new file mode 100644 index 00000000000..7abe538ef77 --- /dev/null +++ b/lisp/term/bobcat.el @@ -0,0 +1,11 @@ +;;; HP terminals usually encourage using ^H as the rubout character + +(let ((the-table (make-string 128 0))) + (let ((i 0)) + (while (< i 128) + (aset the-table i i) + (setq i (1+ i)))) + ;; Swap ^H and DEL + (aset the-table ?\177 ?\^h) + (aset the-table ?\^h ?\177) + (setq keyboard-translate-table the-table)) diff --git a/lisp/term/news.el b/lisp/term/news.el deleted file mode 100644 index 16b79e291c9..00000000000 --- a/lisp/term/news.el +++ /dev/null @@ -1,85 +0,0 @@ -;; keypad and function key bindings for the Sony NEWS keyboard. -;; Copyright (C) 1989 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY. No author or distributor -;; accepts responsibility to anyone for the consequences of using it -;; or for whether it serves any particular purpose or works at all, -;; unless he says so in writing. Refer to the GNU Emacs General Public -;; License for full details. - -;; Everyone is granted permission to copy, modify and redistribute -;; GNU Emacs, but only under the conditions described in the -;; GNU Emacs General Public License. A copy of this license is -;; supposed to have been given to you along with GNU Emacs so you -;; can know your rights and responsibilities. It should be in a -;; file named COPYING. Among other things, the copyright notice -;; and this notice must be preserved on all copies. - -;; This file effects a mapping from the raw escape sequences of various -;; keypad and function keys to the symbols used by emacs to represent -;; those keys. The mapping from key symbol to the function performed -;; when that key is pressed is handled keyboard-independently by the file -;; ../keypad.el. - -;; Note that his file is also used under X11. For this to work, the variable -;; names must not change from keyboard file to keyboard file, nor can the -;; structure of keypad-maps change. - -(require 'keypad) - -(defvar keypads nil - "Keypad and function keys keymap for Sony News machine.") - -(defvar keypad-maps nil - "A list of strings sent by the keypad and function keys on the Sony News. -There is an element for each unique prefix. Each element is of the form -(PREFIX map map ...), each map being (string . symbol).") - -(setq keypad-maps '(("\eO" - ("P" . function-1) - ("Q" . function-2) - ("R" . function-3) - ("S" . function-4) - ("T" . function-5) - ("U" . function-6) - ("V" . function-7) - ("W" . function-8) - ("X" . function-9) - ("Y" . function-10) - - ("m" . keypad-subtract) - ("k" . keypad-add) - ("l" . keypad-comma) - ("n" . keypad-period) - ("M" . keypad-enter) - - ("p" . keypad-0) - ("q" . keypad-1) - ("r" . keypad-2) - ("s" . keypad-3) - ("t" . keypad-4) - ("u" . keypad-5) - ("v" . keypad-6) - ("w" . keypad-7) - ("x" . keypad-8) - ("y" . keypad-9) - - ; These three strings are just made up. - ("a" . execute) ; enter - ("b" . select) ; nfer - ("c" . cancel)))) ; xfer - -(let ((pads keypad-maps)) - (while pads - (unwind-protect - (let* ((prefix (car (car pads))) - (stringmap (cdr (car pads))) - (padmap (if (lookup-key global-map prefix) - (error "Keymap entry for keypad prefix already exisists") - (make-sparse-keymap)))) - (define-key global-map prefix padmap) - (setup-terminal-keymap padmap stringmap)) - (setq pads (cdr pads))))) diff --git a/lisp/term/s4.el b/lisp/term/s4.el new file mode 100644 index 00000000000..ab81a3bd7c9 --- /dev/null +++ b/lisp/term/s4.el @@ -0,0 +1,142 @@ +;; Map s4 function key escape sequences +;; into the standard slots in function-keymap where we can; +;; set up terminal-specific bindings where we must +;; +;; by: Eric S. Raymond, eric@snark.thyrsus.com + +(require 'keypad) + +;; First, map as many keys as possible to terminal-independent keycaps + +(defvar META-RB-map nil + "The META-RB-map maps the ESC-[ function keys on the s4 keyboard.") + +(if (not META-RB-map) + (progn + (setq META-RB-map (lookup-key global-map "\e[")) + (if (not (keymapp META-RB-map)) + (setq META-RB-map (make-sparse-keymap))) ;; <ESC>[ commands + + (setup-terminal-keymap META-RB-map + '(("A" . ?u) ; up arrow + ("B" . ?d) ; down-arrow + ("C" . ?r) ; right-arrow + ("D" . ?l) ; left-arrow + ("U" . ?N) ; 'Page' -> next page + ("V" . ?P) ; 'Shift-Page' -> prev page + ("H" . ?h) ; 'Home' -> home-key + ;; ("J" . ??) ; 'Clear' -> unmapped + )))) + +(defun enable-arrow-keys () + "Enable the use of the s4 arrow keys for cursor motion. +Because of the nature of the s4, this unavoidably breaks +the standard Emacs command ESC [; therefore, it is not done by default, +but only if you give this command in your .emacs." + (global-set-key "\e[" META-RB-map)) + +(defvar META-N-map nil + "META-N-map maps the ESC-N function keys on the s4 keyboard.") + +(if (not META-N-map) + (progn + + (setq META-N-map (lookup-key global-map "\eN")) + (if (not (keymapp META-N-map)) + (setq META-N-map (make-sparse-keymap))) ;; <ESC>N commands + (setup-terminal-keymap META-N-map '( + ("a" . ?C) ; 'Rfrsh' -> redraw screen + ;; ("A" . ??) ; 'Clear' -> unmapped + ;; ("c" . ??) ; 'Move' -> unmapped + ;; ("d" . ??) ; 'Copy' -> unmapped + ;; ("B" . ??) ; 'Shift-Beg' -> unmapped + ;; ("M" . ??) ; 'Shift-Home' -> unmapped + ;; ("N" . ??) ; 'Shift-End' -> unmapped + ("e" . ?k) ; 'Dlete' -> generic delete (kill-region) + ("f" . ?.) ; 'Dlete Char' -> keypad . + ("g" . ?1) ; 'Prev' -> keypad 1 (backward-word) + ("h" . ?3) ; 'Next' -> keypad 3 (forward-word) + ("i" . ?s) ; 'Mark' -> select + ;; ("I" . ??) ; 'Select' -> MAPPED BELOW + ;; ("j" . ??) ; 'Input Mode' -> unmapped + )) + + (define-key global-map "\eN" META-N-map))) + +(defvar META-O-map nil + "META-O-map maps the META-O function keys on the s4 keyboard.") + +(if (not META-O-map) + (progn + + (setq META-O-map (lookup-key global-map "\eO")) + (if (not (keymapp META-O-map)) + (setq META-O-map (make-sparse-keymap))) ;; <ESC>O commands + (setup-terminal-keymap META-O-map '( + ("a" . ?E) ; 'Clear-Line' -> Clear to EOL + ("A" . ?S) ; 'Shift-Clear-Line' -> Clear to EOS + ("b" . ?\C-@) ; 'Ref' -> function key 0 + ("c" . ?\C-a) ; 'F1' -> function key 1 + ("d" . ?\C-b) ; 'F2' -> function key 2 + ("e" . ?\C-c) ; 'F3' -> function key 3 + ("f" . ?\C-d) ; 'F4' -> function key 4 + ("g" . ?\C-e) ; 'F5' -> function key 5 + ("h" . ?\C-f) ; 'F6' -> function key 6 + ("i" . ?\C-g) ; 'F7' -> function key 7 + ("j" . ?\C-h) ; 'F8' -> function key 8 + ;; ("k" . ??) ; 'Exit' -> MAPPED BELOW + ("m" . ??) ; 'Help' -> help-command + ;; ("n" . ??) ; 'Creat' -> unmapped + ;; ("o" . ??) ; 'Save' -> MAPPED BELOW + ;; ("r" . ??) ; 'Opts' -> unmapped + ;; ("s" . ??) ; 'Undo' -> MAPPED BELOW + ("t" . ?x) ; 'Redo' -> 'do' key + ;; ("u" . ??) ; 'Cmd' -> MAPPED BELOW + ;; ("v" . ??) ; 'Open' -> MAPPED BELOW + ;; ("V" . ??) ; 'Close' -> unmapped + ;; ("w" . ??) ; 'Cancel' -> MAPPED BELOW + ("x" . ?f) ; 'Find' -> find/replace + ;; ("y" . ??) ; 'Rplac' -> MAPPED BELOW + ;; ("z" . ??) ; 'Print' -> MAPPED BELOW + )) + + (define-key global-map "\eO" META-O-map))) + +(defvar META-P-map nil + "META-P-map maps the META-P function keys on the s4 keyboard.") + +(if (not META-P-map) + (progn + + (setq META-P-map (lookup-key global-map "\eP")) + (if (not (keymapp META-P-map)) + (setq META-P-map (make-sparse-keymap))) ;; <ESC>P commands + (setup-terminal-keymap META-P-map '( + ("a" . ?1) ; Ctrl-1 -> keypad 1 + ("b" . ?2) ; Ctrl-2 -> keypad 2 + ("c" . ?3) ; Ctrl-3 -> keypad 3 + ("d" . ?4) ; Ctrl-4 -> keypad 4 + ("e" . ?5) ; Ctrl-5 -> keypad 5 + ("f" . ?6) ; Ctrl-6 -> keypad 6 + ("g" . ?7) ; Ctrl-7 -> keypad 7 + ("h" . ?8) ; Ctrl-8 -> keypad 8 + ("i" . ?9) ; Ctrl-9 -> keypad 9 + ("j" . ?0) ; Ctrl-0 -> keypad 0 + ("k" . ?-) ; Ctrl-- -> keypad - + )) + + (define-key global-map "\eP" META-P-map))) + +;; Now do terminal-specific mappings of keys with no standard-keycap equivalent + +;;;(define-key esc-map "9" 'beginning-of-buffer) ;'Begin' +;;;(define-key esc-map "0" 'end-of-buffer) ;'End' +(define-key META-N-map "I" 'narrow-to-region) ;'Select' +(define-key META-O-map "k" 'save-buffers-kill-emacs) ;'Exit' +(define-key META-O-map "o" 'save-buffer) ;'Save' +(define-key META-O-map "s" 'undo) ;'Undo' +(define-key META-O-map "u" 'execute-extended-command) ;'Cmd' +(define-key META-O-map "v" 'find-file) ;'Open' +(define-key META-O-map "w" 'keyboard-quit) ;'Cancl' +(define-key META-O-map "y" 'replace-regexp) ;'Rplac' +(define-key META-O-map "z" 'lpr-buffer) ;'Print' diff --git a/lisp/term/sun-mouse.el b/lisp/term/sun-mouse.el deleted file mode 100644 index bed2b416c1f..00000000000 --- a/lisp/term/sun-mouse.el +++ /dev/null @@ -1,668 +0,0 @@ -;; Mouse handling for Sun windows -;; Copyright (C) 1987 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 1, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Jeff Peck, Sun Microsystems, Jan 1987. -;;; Original idea by Stan Jefferson - -(provide 'sun-mouse) - -;;; -;;; Modelled after the GNUEMACS keymap interface. -;;; -;;; User Functions: -;;; make-mousemap, copy-mousemap, -;;; define-mouse, global-set-mouse, local-set-mouse, -;;; use-global-mousemap, use-local-mousemap, -;;; mouse-lookup, describe-mouse-bindings -;;; -;;; Options: -;;; extra-click-wait, scrollbar-width -;;; - -(defvar extra-click-wait 150 - "*Number of milliseconds to wait for an extra click. -Set this to zero if you don't want chords or double clicks.") - -(defvar scrollbar-width 5 - "*The character width of the scrollbar. -The cursor is deemed to be in the right edge scrollbar if it is this near the -right edge, and more than two chars past the end of the indicated line. -Setting to nil limits the scrollbar to the edge or vertical dividing bar.") - -;;; -;;; Mousemaps -;;; -(defun make-mousemap () - "Returns a new mousemap." - (cons 'mousemap nil)) - -(defun copy-mousemap (mousemap) - "Return a copy of mousemap." - (copy-alist mousemap)) - -(defun define-mouse (mousemap mouse-list def) - "Args MOUSEMAP, MOUSE-LIST, DEF. Define MOUSE-LIST in MOUSEMAP as DEF. -MOUSE-LIST is a list of atoms specifing a mouse hit according to these rules: - * One of these atoms specifies the active region of the definition. - text, scrollbar, modeline, minibuffer - * One or two or these atoms specify the button or button combination. - left, middle, right, double - * Any combination of these atoms specify the active shift keys. - control, shift, meta - * With a single unshifted button, you can add - up - to indicate an up-click. -The atom `double' is used with a button designator to denote a double click. -Two button chords are denoted by listing the two buttons. -See sun-mouse-handler for the treatment of the form DEF." - (mousemap-set (mouse-list-to-mouse-code mouse-list) mousemap def)) - -(defun global-set-mouse (mouse-list def) - "Give MOUSE-EVENT-LIST a local definition of DEF. -See define-mouse for a description of MOUSE-EVENT-LIST and DEF. -Note that if MOUSE-EVENT-LIST has a local definition in the current buffer, -that local definition will continue to shadow any global definition." - (interactive "xMouse event: \nxDefinition: ") - (define-mouse current-global-mousemap mouse-list def)) - -(defun local-set-mouse (mouse-list def) - "Give MOUSE-EVENT-LIST a local definition of DEF. -See define-mouse for a description of the arguments. -The definition goes in the current buffer's local mousemap. -Normally buffers in the same major mode share a local mousemap." - (interactive "xMouse event: \nxDefinition: ") - (if (null current-local-mousemap) - (setq current-local-mousemap (make-mousemap))) - (define-mouse current-local-mousemap mouse-list def)) - -(defun use-global-mousemap (mousemap) - "Selects MOUSEMAP as the global mousemap." - (setq current-global-mousemap mousemap)) - -(defun use-local-mousemap (mousemap) - "Selects MOUSEMAP as the local mousemap. -nil for MOUSEMAP means no local mousemap." - (setq current-local-mousemap mousemap)) - - -;;; -;;; Interface to the Mouse encoding defined in Emacstool.c -;;; -;;; Called when mouse-prefix is sent to emacs, additional -;;; information is read in as a list (button x y time-delta) -;;; -;;; First, some generally useful functions: -;;; - -(defun logtest (x y) - "True if any bits set in X are also set in Y. -Just like the Common Lisp function of the same name." - (not (zerop (logand x y)))) - - -;;; -;;; Hit accessors. -;;; - -(defconst sm::ButtonBits 7) ; Lowest 3 bits. -(defconst sm::ShiftmaskBits 56) ; Second lowest 3 bits (56 = 63 - 7). -(defconst sm::DoubleBits 64) ; Bit 7. -(defconst sm::UpBits 128) ; Bit 8. - -;;; All the useful code bits -(defmacro sm::hit-code (hit) - (` (nth 0 (, hit)))) -;;; The button, or buttons if a chord. -(defmacro sm::hit-button (hit) - (` (logand sm::ButtonBits (nth 0 (, hit))))) -;;; The shift, control, and meta flags. -(defmacro sm::hit-shiftmask (hit) - (` (logand sm::ShiftmaskBits (nth 0 (, hit))))) -;;; Set if a double click (but not a chord). -(defmacro sm::hit-double (hit) - (` (logand sm::DoubleBits (nth 0 (, hit))))) -;;; Set on button release (as opposed to button press). -(defmacro sm::hit-up (hit) - (` (logand sm::UpBits (nth 0 (, hit))))) -;;; Screen x position. -(defmacro sm::hit-x (hit) (list 'nth 1 hit)) -;;; Screen y position. -(defmacro sm::hit-y (hit) (list 'nth 2 hit)) -;;; Millisconds since last hit. -(defmacro sm::hit-delta (hit) (list 'nth 3 hit)) - -(defmacro sm::hit-up-p (hit) ; A predicate. - (` (not (zerop (sm::hit-up (, hit)))))) - -;;; -;;; Loc accessors. for sm::window-xy -;;; -(defmacro sm::loc-w (loc) (list 'nth 0 loc)) -(defmacro sm::loc-x (loc) (list 'nth 1 loc)) -(defmacro sm::loc-y (loc) (list 'nth 2 loc)) - -(defmacro eval-in-buffer (buffer &rest forms) - "Macro to switches to BUFFER, evaluates FORMS, returns to original buffer." - ;; When you don't need the complete window context of eval-in-window - (` (let ((StartBuffer (current-buffer))) - (unwind-protect - (progn - (set-buffer (, buffer)) - (,@ forms)) - (set-buffer StartBuffer))))) - -(put 'eval-in-buffer 'lisp-indent-function 1) - -;;; this is used extensively by sun-fns.el -;;; -(defmacro eval-in-window (window &rest forms) - "Switch to WINDOW, evaluate FORMS, return to original window." - (` (let ((OriginallySelectedWindow (selected-window))) - (unwind-protect - (progn - (select-window (, window)) - (,@ forms)) - (select-window OriginallySelectedWindow))))) -(put 'eval-in-window 'lisp-indent-function 1) - -;;; -;;; handy utility, generalizes window_loop -;;; - -;;; It's a macro (and does not evaluate its arguments). -(defmacro eval-in-windows (form &optional yesmini) - "Switches to each window and evaluates FORM. Optional argument -YESMINI says to include the minibuffer as a window. -This is a macro, and does not evaluate its arguments." - (` (let ((OriginallySelectedWindow (selected-window))) - (unwind-protect - (while (progn - (, form) - (not (eq OriginallySelectedWindow - (select-window - (next-window nil (, yesmini))))))) - (select-window OriginallySelectedWindow))))) -(put 'eval-in-window 'lisp-indent-function 0) - -(defun move-to-loc (x y) - "Move cursor to window location X, Y. -Handles wrapped and horizontally scrolled lines correctly." - (move-to-window-line y) - ;; window-line-end expects this to return the window column it moved to. - (let ((cc (current-column)) - (nc (move-to-column - (if (zerop (window-hscroll)) - (+ (current-column) - (min (- (window-width) 2) ; To stay on the line. - x)) - (+ (window-hscroll) -1 - (min (1- (window-width)) ; To stay on the line. - x)))))) - (- nc cc))) - - -(defun minibuffer-window-p (window) - "True iff this WINDOW is minibuffer." - (= (screen-height) - (nth 3 (window-edges window)) ; The bottom edge. - )) - - -(defun sun-mouse-handler (&optional hit) - "Evaluates the function or list associated with a mouse hit. -Expecting to read a hit, which is a list: (button x y delta). -A form bound to button by define-mouse is found by mouse-lookup. -The variables: *mouse-window*, *mouse-x*, *mouse-y* are bound. -If the form is a symbol (symbolp), it is funcall'ed with *mouse-window*, -*mouse-x*, and *mouse-y* as arguments; if the form is a list (listp), -the form is eval'ed; if the form is neither of these, it is an error. -Returns nil." - (interactive) - (if (null hit) (setq hit (sm::combined-hits))) - (let ((loc (sm::window-xy (sm::hit-x hit) (sm::hit-y hit)))) - (let ((*mouse-window* (sm::loc-w loc)) - (*mouse-x* (sm::loc-x loc)) - (*mouse-y* (sm::loc-y loc)) - (mouse-code (mouse-event-code hit loc))) - (let ((form (eval-in-buffer (window-buffer *mouse-window*) - (mouse-lookup mouse-code)))) - (cond ((null form) - (if (not (sm::hit-up-p hit)) ; undefined up hits are ok. - (error "Undefined mouse event: %s" - (prin1-to-string - (mouse-code-to-mouse-list mouse-code))))) - ((symbolp form) - (setq this-command form) - (funcall form *mouse-window* *mouse-x* *mouse-y*)) - ((listp form) - (setq this-command (car form)) - (eval form)) - (t - (error "Mouse action must be symbol or list, but was: %s" - form)))))) - ;; Don't let 'sun-mouse-handler get on last-command, - ;; since this function should be transparent. - (if (eq this-command 'sun-mouse-handler) - (setq this-command last-command)) - ;; (message (prin1-to-string this-command)) ; to see what your buttons did - nil) - -(defun sm::combined-hits () - "Read and return next mouse-hit, include possible double click" - (let ((hit1 (mouse-hit-read))) - (if (not (sm::hit-up-p hit1)) ; Up hits dont start doubles or chords. - (let ((hit2 (mouse-second-hit extra-click-wait))) - (if hit2 ; we cons'd it, we can smash it. - ; (setf (sm::hit-code hit1) (logior (sm::hit-code hit1) ...)) - (setcar hit1 (logior (sm::hit-code hit1) - (sm::hit-code hit2) - (if (= (sm::hit-button hit1) - (sm::hit-button hit2)) - sm::DoubleBits 0)))))) - hit1)) - -(defun mouse-hit-read () - "Read mouse-hit list from keyboard. Like (read 'read-char), -but that uses minibuffer, and mucks up last-command." - (let ((char-list nil) (char nil)) - (while (not (equal 13 ; Carriage return. - (prog1 (setq char (read-char)) - (setq char-list (cons char char-list)))))) - (read (mapconcat 'char-to-string (nreverse char-list) "")) - )) - -;;; Second Click Hackery.... -;;; if prefix is not mouse-prefix, need a way to unread the char... -;;; or else have mouse flush input queue, or else need a peek at next char. - -;;; There is no peek, but since one character can be unread, we only -;;; have to flush the queue when the command after a mouse click -;;; starts with mouse-prefix1 (see below). -;;; Something to do later: We could buffer the read commands and -;;; execute them ourselves after doing the mouse command (using -;;; lookup-key ??). - -(defvar mouse-prefix1 24 ; C-x - "First char of mouse-prefix. Used to detect double clicks and chords.") - -(defvar mouse-prefix2 0 ; C-@ - "Second char of mouse-prefix. Used to detect double clicks and chords.") - - -(defun mouse-second-hit (hit-wait) - "Returns the next mouse hit occurring within HIT-WAIT milliseconds." - (if (sit-for-millisecs hit-wait) nil ; No input within hit-wait millisecs. - (let ((pc1 (read-char))) - (if (or (not (equal pc1 mouse-prefix1)) - (sit-for-millisecs 3)) ; a mouse prefix will have second char - (progn (setq unread-command-char pc1) ; Can get away with one unread. - nil) ; Next input not mouse event. - (let ((pc2 (read-char))) - (if (not (equal pc2 mouse-prefix2)) - (progn (setq unread-command-char pc1) ; put back the ^X -;;; Too bad can't do two: (setq unread-command-char (list pc1 pc2)) - (ding) ; user will have to retype that pc2. - nil) ; This input is not a mouse event. - ;; Next input has mouse prefix and is within time limit. - (let ((new-hit (mouse-hit-read))) ; Read the new hit. - (if (sm::hit-up-p new-hit) ; Ignore up events when timing. - (mouse-second-hit (- hit-wait (sm::hit-delta new-hit))) - new-hit ; New down hit within limit, return it. - )))))))) - -(defun sm::window-xy (x y) - "Find window containing screen coordinates X and Y. -Returns list (window x y) where x and y are relative to window." - (or - (catch 'found - (eval-in-windows - (let ((we (window-edges (selected-window)))) - (let ((le (nth 0 we)) - (te (nth 1 we)) - (re (nth 2 we)) - (be (nth 3 we))) - (if (= re (screen-width)) - ;; include the continuation column with this window - (setq re (1+ re))) - (if (= be (screen-height)) - ;; include partial line at bottom of screen with this window - ;; id est, if window is not multple of char size. - (setq be (1+ be))) - - (if (and (>= x le) (< x re) - (>= y te) (< y be)) - (throw 'found - (list (selected-window) (- x le) (- y te)))))) - t)) ; include minibuffer in eval-in-windows - ;;If x,y from a real mouse click, we shouldn't get here. - (list nil x y) - )) - -(defun sm::window-region (loc) - "Parse LOC into a region symbol. -Returns one of (text scrollbar modeline minibuffer)" - (let ((w (sm::loc-w loc)) - (x (sm::loc-x loc)) - (y (sm::loc-y loc))) - (let ((right (1- (window-width w))) - (bottom (1- (window-height w)))) - (cond ((minibuffer-window-p w) 'minibuffer) - ((>= y bottom) 'modeline) - ((>= x right) 'scrollbar) - ;; far right column (window seperator) is always a scrollbar - ((and scrollbar-width - ;; mouse within scrollbar-width of edge. - (>= x (- right scrollbar-width)) - ;; mouse a few chars past the end of line. - (>= x (+ 2 (window-line-end w x y)))) - 'scrollbar) - (t 'text))))) - -(defun window-line-end (w x y) - "Return WINDOW column (ignore X) containing end of line Y" - (eval-in-window w (save-excursion (move-to-loc (screen-width) y)))) - -;;; -;;; The encoding of mouse events into a mousemap. -;;; These values must agree with coding in emacstool: -;;; -(defconst sm::keyword-alist - '((left . 1) (middle . 2) (right . 4) - (shift . 8) (control . 16) (meta . 32) (double . 64) (up . 128) - (text . 256) (scrollbar . 512) (modeline . 1024) (minibuffer . 2048) - )) - -(defun mouse-event-code (hit loc) - "Maps MOUSE-HIT and LOC into a mouse-code." -;;;Region is a code for one of text, modeline, scrollbar, or minibuffer. - (logior (sm::hit-code hit) - (mouse-region-to-code (sm::window-region loc)))) - -(defun mouse-region-to-code (region) - "Returns partial mouse-code for specified REGION." - (cdr (assq region sm::keyword-alist))) - -(defun mouse-list-to-mouse-code (mouse-list) - "Map a MOUSE-LIST to a mouse-code." - (apply 'logior - (mapcar (function (lambda (x) - (cdr (assq x sm::keyword-alist)))) - mouse-list))) - -(defun mouse-code-to-mouse-list (mouse-code) - "Map a MOUSE-CODE to a mouse-list." - (apply 'nconc (mapcar - (function (lambda (x) - (if (logtest mouse-code (cdr x)) - (list (car x))))) - sm::keyword-alist))) - -(defun mousemap-set (code mousemap value) - (let* ((alist (cdr mousemap)) - (assq-result (assq code alist))) - (if assq-result - (setcdr assq-result value) - (setcdr mousemap (cons (cons code value) alist))))) - -(defun mousemap-get (code mousemap) - (cdr (assq code (cdr mousemap)))) - -(defun mouse-lookup (mouse-code) - "Look up MOUSE-EVENT and return the definition. nil means undefined." - (or (mousemap-get mouse-code current-local-mousemap) - (mousemap-get mouse-code current-global-mousemap))) - -;;; -;;; I (jpeck) don't understand the utility of the next four functions -;;; ask Steven Greenbaum <froud@kestrel> -;;; -(defun mouse-mask-lookup (mask list) - "Args MASK (a bit mask) and LIST (a list of (code . form) pairs). -Returns a list of elements of LIST whose code or'ed with MASK is non-zero." - (let ((result nil)) - (while list - (if (logtest mask (car (car list))) - (setq result (cons (car list) result))) - (setq list (cdr list))) - result)) - -(defun mouse-union (l l-unique) - "Return the union of list of mouse (code . form) pairs L and L-UNIQUE, -where L-UNIQUE is considered to be union'ized already." - (let ((result l-unique)) - (while l - (let ((code-form-pair (car l))) - (if (not (assq (car code-form-pair) result)) - (setq result (cons code-form-pair result)))) - (setq l (cdr l))) - result)) - -(defun mouse-union-first-prefered (l1 l2) - "Return the union of lists of mouse (code . form) pairs L1 and L2, -based on the code's, with preference going to elements in L1." - (mouse-union l2 (mouse-union l1 nil))) - -(defun mouse-code-function-pairs-of-region (region) - "Return a list of (code . function) pairs, where each code is -currently set in the REGION." - (let ((mask (mouse-region-to-code region))) - (mouse-union-first-prefered - (mouse-mask-lookup mask (cdr current-local-mousemap)) - (mouse-mask-lookup mask (cdr current-global-mousemap)) - ))) - -;;; -;;; Functions for DESCRIBE-MOUSE-BINDINGS -;;; And other mouse documentation functions -;;; Still need a good procedure to print out a help sheet in readable format. -;;; - -(defun one-line-doc-string (function) - "Returns first line of documentation string for FUNCTION. -If there is no documentation string, then the string -\"No documentation\" is returned." - (while (consp function) (setq function (car function))) - (let ((doc (documentation function))) - (if (null doc) - "No documentation." - (string-match "^.*$" doc) - (substring doc 0 (match-end 0))))) - -(defun print-mouse-format (binding) - (princ (car binding)) - (princ ": ") - (mapcar (function - (lambda (mouse-list) - (princ mouse-list) - (princ " "))) - (cdr binding)) - (terpri) - (princ " ") - (princ (one-line-doc-string (car binding))) - (terpri) - ) - -(defun print-mouse-bindings (region) - "Prints mouse-event bindings for REGION." - (mapcar 'print-mouse-format (sm::event-bindings region))) - -(defun sm::event-bindings (region) - "Returns an alist of (function . (mouse-list1 ... mouse-listN)) for REGION, -where each mouse-list is bound to the function in REGION." - (let ((mouse-bindings (mouse-code-function-pairs-of-region region)) - (result nil)) - (while mouse-bindings - (let* ((code-function-pair (car mouse-bindings)) - (current-entry (assoc (cdr code-function-pair) result))) - (if current-entry - (setcdr current-entry - (cons (mouse-code-to-mouse-list (car code-function-pair)) - (cdr current-entry))) - (setq result (cons (cons (cdr code-function-pair) - (list (mouse-code-to-mouse-list - (car code-function-pair)))) - result)))) - (setq mouse-bindings (cdr mouse-bindings)) - ) - result)) - -(defun describe-mouse-bindings () - "Lists all current mouse-event bindings." - (interactive) - (with-output-to-temp-buffer "*Help*" - (princ "Text Region") (terpri) - (princ "---- ------") (terpri) - (print-mouse-bindings 'text) (terpri) - (princ "Modeline Region") (terpri) - (princ "-------- ------") (terpri) - (print-mouse-bindings 'modeline) (terpri) - (princ "Scrollbar Region") (terpri) - (princ "--------- ------") (terpri) - (print-mouse-bindings 'scrollbar))) - -(defun describe-mouse-briefly (mouse-list) - "Print a short description of the function bound to MOUSE-LIST." - (interactive "xDescibe mouse list briefly: ") - (let ((function (mouse-lookup (mouse-list-to-mouse-code mouse-list)))) - (if function - (message "%s runs the command %s" mouse-list function) - (message "%s is undefined" mouse-list)))) - -(defun mouse-help-menu (function-and-binding) - (cons (prin1-to-string (car function-and-binding)) - (menu-create ; Two sub-menu items of form ("String" . nil) - (list (list (one-line-doc-string (car function-and-binding))) - (list (prin1-to-string (cdr function-and-binding))))))) - -(defun mouse-help-region (w x y &optional region) - "Displays a menu of mouse functions callable in this region." - (let* ((region (or region (sm::window-region (list w x y)))) - (mlist (mapcar (function mouse-help-menu) - (sm::event-bindings region))) - (menu (menu-create (cons (list (symbol-name region)) mlist))) - (item (sun-menu-evaluate w 0 y menu)) - ))) - -;;; -;;; Menu interface functions -;;; -;;; use defmenu, because this interface is subject to change -;;; really need a menu-p, but we use vectorp and the context... -;;; -(defun menu-create (items) - "Functional form for defmenu, given a list of ITEMS returns a menu. -Each ITEM is a (STRING . VALUE) pair." - (apply 'vector items) - ) - -(defmacro defmenu (menu &rest itemlist) - "Defines MENU to be a menu, the ITEMS are (STRING . VALUE) pairs. -See sun-menu-evaluate for interpretation of ITEMS." - (list 'defconst menu (funcall 'menu-create itemlist)) - ) - -(defun sun-menu-evaluate (*menu-window* *menu-x* *menu-y* menu) - "Display a pop-up menu in WINDOW at X Y and evaluate selected item -of MENU. MENU (or its symbol-value) should be a menu defined by defmenu. - A menu ITEM is a (STRING . FORM) pair; -the FORM associated with the selected STRING is evaluated, -and the resulting value is returned. Generally these FORMs are -evaluated for their side-effects rather than their values. - If the selected form is a menu or a symbol whose value is a menu, -then it is displayed and evaluated as a pullright menu item. - If the the FORM of the first ITEM is nil, the STRING of the item -is used as a label for the menu, i.e. it's inverted and not selectible." - - (if (symbolp menu) (setq menu (symbol-value menu))) - (eval (sun-menu-internal *menu-window* *menu-x* *menu-y* 4 menu))) - -(defun sun-get-frame-data (code) - "Sends the tty-sub-window escape sequence CODE to terminal, -and returns a cons of the two numbers in returned escape sequence. -That is it returns (cons <car> <cdr>) from \"\\E[n;<car>;<cdr>t\". -CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars." - (send-string-to-terminal (concat "\033[" (int-to-string code) "t")) - (let (char str x y) - (while (not (equal 116 (setq char (read-char)))) ; #\t = 116 - (setq str (cons char str))) - (setq str (mapconcat 'char-to-string (nreverse str) "")) - (string-match ";[0-9]*" str) - (setq y (substring str (1+ (match-beginning 0)) (match-end 0))) - (setq str (substring str (match-end 0))) - (string-match ";[0-9]*" str) - (setq x (substring str (1+ (match-beginning 0)) (match-end 0))) - (cons (string-to-int y) (string-to-int x)))) - -(defun sm::font-size () - "Returns font size in pixels: (cons Ysize Xsize)" - (let ((pix (sun-get-frame-data 14)) ; returns size in pixels - (chr (sun-get-frame-data 18))) ; returns size in chars - (cons (/ (car pix) (car chr)) (/ (cdr pix) (cdr chr))))) - -(defvar sm::menu-kludge-x nil - "Cached frame-to-window X-Offset for sm::menu-kludge") -(defvar sm::menu-kludge-y nil - "Cached frame-to-window Y-Offset for sm::menu-kludge") - -(defun sm::menu-kludge () - "If sunfns.c uses <Menu_Base_Kludge> this function must be here!" - (or sm::menu-kludge-y - (let ((fs (sm::font-size))) - (setq sm::menu-kludge-y (+ 8 (car fs)) ; a title line and borders - sm::menu-kludge-x 4))) ; best values depend on .defaults/Menu - (let ((wl (sun-get-frame-data 13))) ; returns frame location - (cons (+ (car wl) sm::menu-kludge-y) - (+ (cdr wl) sm::menu-kludge-x)))) - -;;; -;;; Function interface to selection/region -;;; primative functions are defined in sunfns.c -;;; -(defun sun-yank-selection () - "Set mark and yank the contents of the current sunwindows selection -into the current buffer at point." - (interactive "*") - (set-mark-command nil) - (insert-string (sun-get-selection))) - -(defun sun-select-region (beg end) - "Set the sunwindows selection to the region in the current buffer." - (interactive "r") - (sun-set-selection (buffer-substring beg end))) - -;;; -;;; Support for emacstool -;;; This closes the window instead of stopping emacs. -;;; -(defun suspend-emacstool (&optional stuffstring) - "If running under as a detached process emacstool, -you don't want to suspend (there is no way to resume), -just close the window, and wait for reopening." - (interactive) - (run-hooks 'suspend-hook) - (if stuffstring (send-string-to-terminal stuffstring)) - (send-string-to-terminal "\033[2t") ; To close EmacsTool window. - (run-hooks 'suspend-resume-hook)) -;;; -;;; initialize mouse maps -;;; - -(make-variable-buffer-local 'current-local-mousemap) -(setq-default current-local-mousemap nil) -(defvar current-global-mousemap (make-mousemap)) diff --git a/lisp/term/sun.el b/lisp/term/sun.el new file mode 100644 index 00000000000..171bc1c4488 --- /dev/null +++ b/lisp/term/sun.el @@ -0,0 +1,333 @@ +;; keybinding for standard default sunterm keys +;; Copyright (C) 1987 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Jeff Peck, Sun Microsystems Inc <peck@sun.com> +;; Mar, 91 better integration with X windows + +(defun ignore-key () + "interactive version of ignore" + (interactive) + (ignore)) + +(defun unbound-key () + "filler for compound keymaps" + (interactive) + (error "unbound-key")) + +(defun on-window-line-p (n) + (save-excursion + (beginning-of-line 1) + (let ((p (point))) + (move-to-window-line n) + (equal (point) p)))) + +(defun scroll-down-in-place (n) + (interactive "p") + (if (on-window-line-p 0) + (progn (scroll-down n) (previous-line n)) + (previous-line n) (scroll-down n))) + +(defun scroll-up-in-place (n) + (interactive "p") + (if (on-window-line-p -1) + (progn (scroll-up n) (next-line n)) + (next-line n) (scroll-up n))) + +(defun kill-region-and-unmark (beg end) + "Like kill-region, but pops the mark [which equals point, anyway.]" + (interactive "r") + (kill-region beg end) + (setq this-command 'kill-region-and-unmark) + (set-mark-command t)) + +(defun rerun-prev-command () + "Repeat Previous-complex-command." + (interactive) + (eval (nth 0 command-history))) + +(defvar grep-arg nil "Default arg for RE-search") + +;; not sure this all works... or works at all... +(defun search-command-arg () + ;; if previous minibuf command specified a search string, return it. + ;; this way, a call to M-x re-search-forward can pass its arg. + (let* ((command (car command-history)) + (command-name (symbol-name (car command))) + (search-arg (car (cdr command))) + (search-command + (and command-name (string-match "search" command-name)))) + (and search-command (stringp search-arg) search-arg))) + +(defun grep-arg (&optional prompt) + "helper function used by research-{backward,forward}" + (if (memq last-command '(research-forward research-backward)) grep-arg + (let ((this-command this-command) ; save this binding from read-string + (default (or (search-command-arg) + search-last-regexp + grep-arg))) + (read-string (or prompt "Regexp arg: ") default)))) + +(defun research-forward () + "Repeat regexp search forward, using previous search arg if available." + (interactive) ; + (if (re-search-forward (grep-arg "Regexp search: ")) + (setq search-last-regexp grep-arg))) + +(defun research-backward () + "Repeat regexp search backward, using previous search arg if available." + (interactive) ; + (if (re-search-backward (grep-arg "Regexp search backward: ")) + (setq search-last-regexp grep-arg))) + +(defun help-for-dummies () + (interactive) + (let ((char ?\C-h)) + (if (or (= char ?\C-h) (= char ??)) + (save-window-excursion + (switch-to-buffer "*Help*") + (erase-buffer) + (insert (documentation 'help-for-help)) + (goto-char (point-min)) + (while (memq char '(?\C-h ?? ?\C-v ?\ ?\177 ?\M-v)) + (if (memq char '(?\C-v ?\ )) + (scroll-up)) + (if (memq char '(?\177 ?\M-v)) + (scroll-down)) + (message "A B C F I K L M N S T V W C-c C-d C-n C-w%s: " + (if (pos-visible-in-window-p (point-max)) + "" " or Space to scroll")) + (let ((cursor-in-echo-area t)) + (setq char (read-char)))))) + (let ((defn (cdr (assq (downcase char) (cdr help-map))))) + (if defn (call-interactively defn) (ding))))) + +;;; +;;; handle sun's extra function keys +;;; this version for those who run with standard .ttyswrc and no emacstool +;;; +;;; sunview picks up expose and open on the way UP, +;;; so we ignore them on the way down +;;; + +;;; Since .emacs gets loaded before this file, a hook is supplied +;;; for you to put your own bindings in. Example: +;(setq sun-esc-bracket t) +;(setq sun-raw-map-hooks '( ; not your usual hook list +; (define-key sun-raw-map "211z" 'goto-line) ; R4 +; (define-key sun-raw-map "212z" 'other-window) ; R5 +; (define-key sun-raw-map "213z" 'scroll-other-window) ; R6 +; )) + +(defvar sun-esc-bracket nil + "*If non-nil, rebind ESC [ as prefix for Sun function keys.") + +(defvar sun-raw-map (make-sparse-keymap) "*Keymap for ESC-[ encoded keyboard") + +(define-key sun-raw-map "208z" 'unbound-key) ; R1 +(define-key sun-raw-map "209z" 'unbound-key) ; R2 +(define-key sun-raw-map "210z" 'backward-page) ; R3 +(define-key sun-raw-map "213z" 'forward-page) ; R6 +(define-key sun-raw-map "214z" 'beginning-of-buffer) ; R7 +(define-key sun-raw-map "216z" 'scroll-down) ; R9 +(define-key sun-raw-map "215z" 'previous-line) ; R8 (up-arrow) +(define-key sun-raw-map "217z" 'backward-char) ; R10 (rt-arrow) +(define-key sun-raw-map "219z" 'forward-char) ; R12 (dn-arrow) +(define-key sun-raw-map "221z" 'next-line) ; R14 (lf-arrow) +(define-key sun-raw-map "218z" 'recenter) ; R11 +(define-key sun-raw-map "220z" 'end-of-buffer) ; R13 +(define-key sun-raw-map "222z" 'scroll-up) ; R15 +(define-key sun-raw-map "193z" 'redraw-display) ; Again L1 +(define-key sun-raw-map "194z" 'list-buffers) ; Props L2 +(define-key sun-raw-map "195z" 'undo) ; Undo L3 +(define-key sun-raw-map "196z" 'ignore-key) ; Expose-down L4 +(define-key sun-raw-map "197z" 'sun-select-region) ; Put L5 +(define-key sun-raw-map "198z" 'ignore-key) ; Open-down L6 +(define-key sun-raw-map "199z" 'sun-yank-selection) ; Get L7 +(define-key sun-raw-map "200z" 'exchange-point-and-mark); Find L8 +(define-key sun-raw-map "201z" 'kill-region-and-unmark) ; Delete L9 +(define-key sun-raw-map "207z" 'help-for-help) ; Help Key on Type-4 KBD +(define-key sun-raw-map "225z" 'toggle-selective-display); T2 +(define-key sun-raw-map "226z" 'scroll-down-in-place) ; T3 +(define-key sun-raw-map "227z" 'scroll-up-in-place) ; T4 +(define-key sun-raw-map "228z" 'shell) ; T5 +(define-key sun-raw-map "229z" 'shrink-window) ; T6 +(define-key sun-raw-map "230z" 'enlarge-window) ; T7 + +(if sun-esc-bracket + (progn + (define-key esc-map "[" sun-raw-map) ; Install sun-raw-map + (define-key esc-map "[A" 'previous-line ) ; R8 + (define-key esc-map "[B" 'next-line) ; R14 + (define-key esc-map "[C" 'forward-char) ; R12 + (define-key esc-map "[D" 'backward-char) ; R10 + (define-key esc-map "[[" 'backward-paragraph) ; the original esc-[ + )) + +;;; Since .emacs gets loaded before this file, a hook is supplied +;;; for you to put your own bindings in. + +(defvar sun-raw-map-hooks nil + "List of forms to evaluate after setting sun-raw-map. +This list is processed by: (mapcar 'eval sun-raw-map-hooks)") + +(mapcar 'eval sun-raw-map-hooks) + +;;; This section adds defintions for the emacstool users +;;; emacstool event filter converts function keys to C-x*{c}{lrt} +;;; +;;; for example the Open key (L7) would be encoded as "\C-x*gl" +;;; the control, meta, and shift keys modify the character {lrt} +;;; note that (unshifted) C-l is ",", C-r is "2", and C-t is "4" +;;; +;;; {c} is [a-j] for LEFT, [a-i] for TOP, [a-o] for RIGHT. +;;; A higher level insists on encoding {h,j,l,n}{r} (the arrow keys) +;;; as ANSI escape sequences. Use the shell command +;;; % setkeys noarrows +;;; if you want these to come through for emacstool. +;;; +;;; If you are not using EmacsTool, +;;; you can also use this by creating a .ttyswrc file to do the conversion. +;;; but it won't include the CONTROL, META, or SHIFT keys! +;;; + +;;; Note: al (STOP), el (EXPOSE) and gl (OPEN) are trapped by EmacsTool, +;;; so they never make it here. + +(defvar meta-flag t) + +(defvar suntool-map (make-sparse-keymap) + "*Keymap for Emacstool bindings.") + +(define-key suntool-map "ar" 'unbound-key) ; R1 +(define-key suntool-map "br" 'unbound-key) ; R2 +(define-key suntool-map "hr" 'previous-line) ; R8 (up-arrow) +(define-key suntool-map "jr" 'backward-char) ; R10 (rt-arrow) +(define-key suntool-map "lr" 'forward-char) ; R12 (dn-arrow) +(define-key suntool-map "nr" 'next-line) ; R14 (lf-arrow) +(define-key suntool-map "gr" 'beginning-of-buffer) ; r7 +(define-key suntool-map "iR" 'backward-page) ; R9 +(define-key suntool-map "ir" 'scroll-down) ; r9 +(define-key suntool-map "kr" 'recenter) ; r11 +(define-key suntool-map "mr" 'end-of-buffer) ; r13 +(define-key suntool-map "oR" 'forward-page) ; R15 +(define-key suntool-map "or" 'scroll-up) ; r15 +(define-key suntool-map "b\M-L" 'rerun-prev-command) ; M-AGAIN +(define-key suntool-map "b\M-l" 'repeat-complex-command); M-Again +(define-key repeat-complex-command-map "\C-x*b\M-l" 'previous-complex-command) +(define-key suntool-map "bl" 'redraw-display) ; Again L1 +(define-key suntool-map "cl" 'list-buffers) ; Props L2 +(define-key suntool-map "dl" 'undo) ; Undo L3 +(define-key suntool-map "el" 'ignore-key) ; Expose-Top L4 +(define-key suntool-map "fl" 'sun-select-region) ; Put L5 +(define-key suntool-map "f," 'copy-region-as-kill) ; C-Put L5 +(define-key suntool-map "gl" 'ignore-key) ; Open-Open L6 +(define-key suntool-map "hl" 'sun-yank-selection) ; Get L7 +(define-key suntool-map "h\M-l" 'sunview-yank-any-selection) ; M-Get L7 +(define-key suntool-map "h," 'yank) ; C-Get +;; interactive regexp search ; Find L8 +(define-key suntool-map "iL" 're-isearch-forward) ; FIND (shift-Find) +(define-key suntool-map "i\M-L" 're-isearch-backward) ; M-FIND (M-shift-Find) +;; non-interactive versions: +;; search again, using previous search arg as regexp. +(define-key suntool-map "il" 'research-forward) ; Find +(define-key suntool-map "i\M-l" 'research-backward) ; M-Find +;; supply new arg +(define-key suntool-map "i," 're-search-forward) ; C-Find +(define-key suntool-map "i\M-," 're-search-backward) ; C-M-Find + +(define-key suntool-map "jL" 'yank) ; DELETE L9 +(define-key suntool-map "jl" 'kill-region-and-unmark) ; Delete +(define-key suntool-map "j\M-l" 'exchange-point-and-mark); M-Delete +(define-key suntool-map "j," + '(lambda () (interactive) (pop-mark 1))) ; C-Delete +(define-key suntool-map "pl" 'describe-mode) ; Help +(define-key suntool-map "p\M-l" 'command-apropos) ; M-Help +(define-key suntool-map "pL" 'describe-bindings) ; HELP +;; Oops, Help is preempted by Xview, may need to modify xvetool +(define-key suntool-map "p," 'help-for-help) ; C-Help +(define-key suntool-map "p," 'help-for-dummies) ; C-Help + +(define-key suntool-map "bt" 'toggle-selective-display) ; t2 +(define-key suntool-map "cT" '(lambda(n) (interactive "p") (scroll-down n))) +(define-key suntool-map "dT" '(lambda(n) (interactive "p") (scroll-up n))) +(define-key suntool-map "ct" 'scroll-down-in-place) ; t3 +(define-key suntool-map "dt" 'scroll-up-in-place) ; t4 +(define-key suntool-map "et" 'shell) ; t5 +(define-key suntool-map "fT" 'shrink-window-horizontally) ; T6 +(define-key suntool-map "gT" 'enlarge-window-horizontally) ; T7 +(define-key suntool-map "ft" 'shrink-window) ; t6 +(define-key suntool-map "gt" 'enlarge-window) ; t7 +(define-key ctl-x-map "*" suntool-map) + +;;; Since .emacs gets loaded before this file, a hook is supplied +;;; for you to put your own bindings in. + +;;; Example: +;(setq suntool-map-hooks '( ; not your usual hook list +; (define-key suntool-map "c\M-l" 'browse) ; Meta-Props +; (define-key suntool-map "dr" 'goto-line) ; R4 +; (define-key suntool-map "d2" 'what-line) ; Control-R4 +; )) + +(defvar suntool-map-hooks nil + "List of forms to evaluate after setting suntool-map. +This variable is processed by: (mapcar 'eval suntool-map-hooks)") + +(mapcar 'eval suntool-map-hooks) + +;;; +;;; If running under emacstool, arrange to call suspend-emacstool +;;; instead of suspend-emacs. +;;; +;;; First mouse blip is a clue that we are in emacstool. +;;; +;;; C-x C-@ is the mouse command prefix. + +(autoload 'sun-mouse-handler "sun-mouse" + "Sun Emacstool handler for mouse blips (not loaded)." t) + +(defun sun-mouse-once () + "Converts to emacstool and sun-mouse-handler on first mouse hit." + (interactive) + (emacstool-init) + (sun-mouse-handler) ; Now, execute this mouse blip. + ) +(if (not window-system) ; don't do this for X! + (define-key ctl-x-map "\C-@" 'sun-mouse-once)) + +(defun emacstool-init () + "Set up Emacstool window, if you know you are in an emacstool." + ;; Make sure sun-mouse and sun-fns are loaded. + (require 'sun-fns) + (define-key ctl-x-map "\C-@" 'sun-mouse-handler) + + (if (fboundp 'sun-window-init) () + (error "SunWindows support not compiled in: #define HAVE_SUN_WINDOWS in config.h")) + (if (and (not (getenv "DISPLAY")) (< (sun-window-init) 0)) + (message "Not a SunView Window")) + (progn + (substitute-key-definition 'suspend-emacs 'suspend-emacstool global-map) + (substitute-key-definition 'suspend-emacs 'suspend-emacstool esc-map) + (substitute-key-definition 'suspend-emacs 'suspend-emacstool ctl-x-map) + (send-string-to-terminal + (concat "\033]lEmacstool - GNU Emacs " emacs-version "\033\\"))) + ) + +;;; If Emacstool is being nice, and informs us of its presence: +(if (getenv "IN_EMACSTOOL") (emacstool-init)) diff --git a/lisp/term/sup-mouse.el b/lisp/term/sup-mouse.el deleted file mode 100644 index d03b009136d..00000000000 --- a/lisp/term/sup-mouse.el +++ /dev/null @@ -1,207 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; ;; -;; File: sup-mouse.el ;; -;; Author: Wolfgang Rupprecht ;; -;; Created: Fri Nov 21 19:22:22 1986 ;; -;; Contents: supdup mouse support for lisp machines ;; -;; ;; -;; (from code originally written by John Robinson@bbn for the bitgraph) ;; -;; ;; -;; $Log$ ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; GNU Emacs code for lambda/supdup mouse -;; Copyright (C) Free Software Foundation 1985, 1986 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 1, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; User customization option: - -(defvar sup-mouse-fast-select-window nil - "*Non-nil for mouse hits to select new window, then execute; else just select.") - -(defconst mouse-left 0) -(defconst mouse-center 1) -(defconst mouse-right 2) - -(defconst mouse-2left 4) -(defconst mouse-2center 5) -(defconst mouse-2right 6) - -(defconst mouse-3left 8) -(defconst mouse-3center 9) -(defconst mouse-3right 10) - -;;; Defuns: - -(defun sup-mouse-report () - "This function is called directly by the mouse, it parses and -executes the mouse commands. - - L move point * |---- These apply for mouse click in a window. -2L delete word | -3L copy word | If sup-mouse-fast-select-window is nil, - C move point and yank * | just selects that window. -2C yank pop | - R set mark * | -2R delete region | -3R copy region | - -on modeline on \"scroll bar\" in minibuffer - L scroll-up line to top execute-extended-command - C proportional goto-char line to middle mouse-help - R scroll-down line to bottom eval-expression" - - (interactive) - (let* -;; expect a string of <esc>:<buttons>;<x-pos>;<y-pos>c - ((buttons (sup-get-tty-num ?\;)) - (x (sup-get-tty-num ?\;)) - (y (sup-get-tty-num ?c)) - (window (sup-pos-to-window x y)) - (edges (window-edges window)) - (old-window (selected-window)) - (in-minibuf-p (eq y (1- (screen-height)))) - (same-window-p (and (not in-minibuf-p) (eq window old-window))) - (in-modeline-p (eq y (1- (nth 3 edges)))) - (in-scrollbar-p (>= x (1- (nth 2 edges))))) - (setq x (- x (nth 0 edges))) - (setq y (- y (nth 1 edges))) - -; (error "mouse-hit %d %d %d" buttons x y) ;;;; debug - - (cond (in-modeline-p - (select-window window) - (cond ((= buttons mouse-left) - (scroll-up)) - ((= buttons mouse-right) - (scroll-down)) - ((= buttons mouse-center) - (goto-char (/ (* x - (- (point-max) (point-min))) - (1- (window-width)))) - (beginning-of-line) - (what-cursor-position))) - (select-window old-window)) - (in-scrollbar-p - (select-window window) - (scroll-up - (cond ((= buttons mouse-left) - y) - ((= buttons mouse-right) - (+ y (- 2 (window-height)))) - ((= buttons mouse-center) - (/ (+ 2 y y (- (window-height))) 2)) - (t - 0))) - (select-window old-window)) - (same-window-p - (cond ((= buttons mouse-left) - (sup-move-point-to-x-y x y)) - ((= buttons mouse-2left) - (sup-move-point-to-x-y x y) - (kill-word 1)) - ((= buttons mouse-3left) - (sup-move-point-to-x-y x y) - (save-excursion - (copy-region-as-kill - (point) (progn (forward-word 1) (point)))) - (setq this-command 'yank) - ) - ((= buttons mouse-right) - (push-mark) - (sup-move-point-to-x-y x y) - (exchange-point-and-mark)) - ((= buttons mouse-2right) - (push-mark) - (sup-move-point-to-x-y x y) - (kill-region (mark) (point))) - ((= buttons mouse-3right) - (push-mark) - (sup-move-point-to-x-y x y) - (copy-region-as-kill (mark) (point)) - (setq this-command 'yank)) - ((= buttons mouse-center) - (sup-move-point-to-x-y x y) - (setq this-command 'yank) - (yank)) - ((= buttons mouse-2center) - (yank-pop 1)) - ) - ) - (in-minibuf-p - (cond ((= buttons mouse-right) - (call-interactively 'eval-expression)) - ((= buttons mouse-left) - (call-interactively 'execute-extended-command)) - ((= buttons mouse-center) - (describe-function 'sup-mouse-report)); silly self help - )) - (t ;in another window - (select-window window) - (cond ((not sup-mouse-fast-select-window)) - ((= buttons mouse-left) - (sup-move-point-to-x-y x y)) - ((= buttons mouse-right) - (push-mark) - (sup-move-point-to-x-y x y) - (exchange-point-and-mark)) - ((= buttons mouse-center) - (sup-move-point-to-x-y x y) - (setq this-command 'yank) - (yank)) - )) - ))) - - -(defun sup-get-tty-num (term-char) - "Read from terminal until TERM-CHAR is read, and return intervening number. -Upon non-numeric not matching TERM-CHAR signal an error." - (let - ((num 0) - (char (read-char))) - (while (and (>= char ?0) - (<= char ?9)) - (setq num (+ (* num 10) (- char ?0))) - (setq char (read-char))) - (or (eq term-char char) - (error "Invalid data format in mouse command")) - num)) - -(defun sup-move-point-to-x-y (x y) - "Position cursor in window coordinates. -X and Y are 0-based character positions in the window." - (move-to-window-line y) - (move-to-column x) - ) - -(defun sup-pos-to-window (x y) - "Find window corresponding to screen coordinates. -X and Y are 0-based character positions on the screen." - (let ((edges (window-edges)) - (window nil)) - (while (and (not (eq window (selected-window))) - (or (< y (nth 1 edges)) - (>= y (nth 3 edges)) - (< x (nth 0 edges)) - (>= x (nth 2 edges)))) - (setq window (next-window window)) - (setq edges (window-edges window)) - ) - (or window (selected-window)) - ) - ) diff --git a/lisp/term/supdup.el b/lisp/term/supdup.el new file mode 100644 index 00000000000..4e7ac2ab602 --- /dev/null +++ b/lisp/term/supdup.el @@ -0,0 +1,81 @@ +;; Losing unix doesn't know about the -real- control bit + +;; there should be some way to conditionalize this on the basis +;; of %TOFCI -- except that the existing supdup server loses this information! +;; It isn't clear-cut what to do in the server, as %tofci means that the user +;; can generate full 9-bit MIT characters, which isn't what the `km' termcap +;; flag means. On the other hand, being able to generate 8-bit characters +;; (which is sort of what `km' is) isn't the same as %tofci. +;; I think the problem is fundamental and cultural and irresolvable. + +;; unix supdup server uses 0237 as a control escape. +;; c-a 001 +;; m-a 341 +;; c-m-a 201 +;; c-1 237 061 +;; m-1 261 +;; c-m-1 237 261 +;; c-m-_ 237 237 + +(defvar supdup-control-map (make-keymap)) +(fillarray supdup-control-map 'ascii-loses) +(defvar supdup-control-meta-map (make-keymap)) +(fillarray supdup-control-meta-map 'ascii-loses) +(define-key supdup-control-meta-map "\C-_" nil) ; this is c-m-_ +(define-key supdup-control-map "\e" supdup-control-meta-map) +(define-key global-map "\e\C-_" supdup-control-map) +(let ((n ?0)) + (while (<= n ?9) + (define-key supdup-control-map (char-to-string n) 'supdup-digit-argument) + (define-key supdup-control-meta-map (char-to-string n) 'supdup-digit-argument) + (setq n (1+ n))) + (define-key supdup-control-map "-" 'supdup-digit-argument) + (define-key supdup-control-meta-map "-" 'supdup-digit-argument)) + +(defun ascii-loses () + (interactive) + (if (= (aref (this-command-keys) 0) meta-prefix-char) + ;; loser typed <esc> c-_ <char> + (error "Undefined command: %s" + (mapconcat 'text-char-description (this-command-keys) " ")) + ;; Get here from m-c-_ <char> for c-<char> or m-c-_ m-<char> + (error "Ascii loses: c-%s%c" + (if (> last-input-char ?\200) "m-" "") + (logand last-input-char ?\177)))) + + +(defun supdup-digit-argument (p) + (interactive "P") + (let ((n last-input-char)) + (if (and (<= (+ ?\200 ?0) n) (<= n (+ ?\200 ?9))) + (setq n (- n ?\200))) + (cond ((or (= n ?-) (= n ?\M--)) + (message "Arg: %s" (setq prefix-arg '-))) + ((or (< n ?0) (> n ?9)) + (error "Lossage: %s" (this-command-keys))) + (t + (setq n (- n ?0)) + (message "Arg: %d" + (setq prefix-arg + (cond ((listp p) + n) + ((eq p '-) + (- n)) + ((>= p 0) + (+ (* p 10) n)) + (t + (- (* p 10) n))))))))) + +;; Attempt to detect slimebollix machine serving as terminal. +(if (let ((termcap (getenv "TERMCAP"))) + (and termcap + (string-match ":co#131:li#52:\\|:co#135:li#50:" termcap))) + (message "In doing business with Symbolics, you are rewarding a wrong.")) + + +;; Mouse support works with Lambdas. +;(autoload 'sup-mouse-report "sup-mouse" +; "This command is sent by a special version of Supdup on the LMI Lambda +;when the mouse is clicked." t) +;(global-set-key "\C-x\C-@" 'sup-mouse-report) + diff --git a/lisp/term/unixpc.el b/lisp/term/unixpc.el new file mode 100644 index 00000000000..3ebf4d25566 --- /dev/null +++ b/lisp/term/unixpc.el @@ -0,0 +1,148 @@ +;;; AT&T UnixPC keyboard definitions +;;; Brant Cheikes (brant@linc.cis.upenn.edu, manta!brant) +;;; 4 August 1987 +;;; +;;; Tested on: GNU Emacs 18.47.1 of Fri Jul 24 1987 on manta (usg-unix-v) +;;; +;;; The AT&T Unix PC (aka PC7300, 3B1) has a bizarre keyboard with +;;; lots of interestingly labeled function keys. This file tries to +;;; assign useful actions to the function keys. Note that the Shift +;;; and Ctrl keys have the same effect on function keys, so Shift-F1 +;;; is the same as Ctrl-F1. +;;; +;;; Most of the information needed to create this file was taken from +;;; documentation found in lisp/keypad.el +;;; +;;; Bug: The "Beg" and "End" (unshifted) keys are not supported because +;;; they generate <esc>9 and <esc>0 respectively, and I know not how to +;;; deal with them. + +(require 'keypad) + +;;; There seem to be three prefixes for AT&T UnixPC function keys: +;;; "<esc>O", "<esc>N", and "<esc>[". There seem to be a couple +;;; keys that just generate "<esc><digit>". +;;; +;;; Note: for each mapping, I indicate the key on the Unix PC followed +;;; by the Emacs command it is bound to (if any). Note that when I +;;; couldn't figure out anything useful to do with a key, I simply bound +;;; it to 'previous-line, arbitrarily. My goal was to get keys to do +;;; "mnemonic" things. + +(defvar ATT-map-1 nil + "The bulk of the function keys on the AT&T Unix PC.") +(defvar ATT-map-2 nil + "A few other random function keys on the AT&T Unix PC.") +(defvar ATT-map-3 nil + "Some really random function keys on the AT&T Unix PC.") + +(defun enable-unixpc-keys () + "Enable the use of the AT&T Unix PC function keys. Because of the +nature of the Unix PC, this unavoidably breaks several standard Emacs +prefixes; therefore, it is not done by default, but only if you give +this command." + (interactive) + (global-set-key "\eO" ATT-map-1) + (global-set-key "\eN" ATT-map-2) + (global-set-key "\e[" ATT-map-3)) + +;;; Create a few new keypad defaults. Here's what I think I'm doing here: +;;; I look through "keypad.el" to find any unused entries in function-keymap +;;; and then create my own bindings for them here. Then I use the newly +;;; created ?x string in the setup-terminal-keymap. + +(keypad-default "2" 'advertised-undo) +(keypad-default "4" 'save-buffers-kill-emacs) +(keypad-default "5" 'save-buffer) +(keypad-default "6" 'beginning-of-buffer) +(keypad-default "8" 'end-of-buffer) +(keypad-default "w" 'kill-word) +(keypad-default "p" 'fill-paragraph) +(keypad-default "," 'copy-region-as-kill) + +(if ATT-map-1 + nil + (setq ATT-map-1 (make-keymap)) ; <ESC>O commands + (setup-terminal-keymap ATT-map-1 + '(("a" . ?\^d) ; Clear Line (kill-line) + ("A" . ?\^d) ; Shift-Clear Line (kill-line) + ("b" . ?u) ; Ref + ("B" . ?u) ; Rstrt + ("c" . ?u) ; F1 + ("d" . ?u) ; F2 + ("e" . ?u) ; F3 + ("f" . ?u) ; F4 + ("g" . ?u) ; F5 + ("h" . ?u) ; F6 + ("i" . ?u) ; F7 + ("j" . ?u) ; F8 + ("k" . ?4) ; Exit (save-buffers-kill-emacs) + ("K" . ?4) ; Shift-Exit (save-buffers-kill-emacs) + ("m" . ??) ; Help (help-command) + ("M" . ??) ; Shift-Help (help-command) + ("n" . ?u) ; Creat + ("N" . ?u) ; Shift-Creat + ("o" . ?5) ; Save (save-buffer) + ("O" . ?5) ; Shift-Save (save-buffer) + ("r" . ?u) ; Opts + ("R" . ?u) ; Shift-Opts + ("s" . ?2) ; Undo (advertised-undo) + ("S" . ?2) ; Shift-Undo (advertised-undo) + ("t" . ?p) ; Redo (fill-paragraph) + ("T" . ?p) ; Shift-Redo (fill-paragraph) + ("u" . ?u) ; Cmd + ("U" . ?u) ; Shift-Cmd + ("v" . ?e) ; Open (open-line) + ("V" . ?\^d) ; Close (kill-line) + ("w" . ?u) ; Cancl + ("W" . ?u) ; Shift-Cancl + ("x" . ?\^c) ; Find (isearch-forward) + ("X" . ?f) ; Shift-Find (re-search-forward) + ("y" . ?0) ; Rplac (yank) + ("Y" . ?0) ; Shift-Rplac (yank) + ("z" . ?u) ; Print + ))) + +(if ATT-map-2 + nil + (setq ATT-map-2 (make-keymap)) ; <ESC>N commands + (setup-terminal-keymap ATT-map-2 + '(("a" . ?C) ; Rfrsh (recenter) + ("B" . ?6) ; Shift-Beg (beginning-of-buffer) + ("c" . ?0) ; Move (yank) + ("C" . ?0) ; Shift-Move (yank) + ("d" . ?,) ; Copy (copy-region-as-kill) + ("D" . ?,) ; Shift-Copy (copy-region-as-kill) + ("e" . ?k) ; Dlete (kill-region) + ("E" . ?k) ; Shift-Dlete (kill-region) + ("f" . ?.) ; Dlete Char (delete-char) + ("F" . ?w) ; Shift-Dlete Char (kill-word) + ("g" . ?P) ; Prev (scroll-down) + ("G" . ?P) ; Shift-Prev (scroll-down) + ("h" . ?N) ; Next (scroll-up) + ("H" . ?N) ; Shift-Next (scroll-up) + ("i" . ?s) ; Mark (set-mark-command) + ("I" . ?s) ; Slect (set-mark-command) + ("j" . ?u) ; Input Mode + ("J" . ?u) ; Shift-Input Mode + ("K" . ?1) ; Shift-LeftArrow (backward-word) + ("L" . ?3) ; Shift-RightArrow (forward-word) + ("M" . ?h) ; Shift-Home (move-to-window-line) + ("N" . ?8) ; Shift-End (end-of-buffer) + ))) + +(if ATT-map-3 + nil + (setq ATT-map-3 (make-keymap)) ; <ESC>[ commands + (setup-terminal-keymap ATT-map-3 + '(("A" . ?u) ; Up Arrow (previous-line) + ("B" . ?d) ; Down Arrow (next-line) + ("C" . ?r) ; Right Arrow (forward-char) + ("D" . ?l) ; Left Arrow (backward-char) + ("H" . ?h) ; Home (move-to-window-line) + ("J" . ?C) ; Clear (recenter) + ("S" . ?9) ; Shift-DownArrow (forward-paragraph) + ("T" . ?7) ; Shift-UpArrow (backward-paragraph) + ("U" . ?N) ; Page (scroll-up) + ("V" . ?P) ; Shift-Page (scroll-down) + ))) diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el new file mode 100644 index 00000000000..435157c9663 --- /dev/null +++ b/lisp/term/vt100.el @@ -0,0 +1,66 @@ +;; Map VT100 function key escape sequences +;; into the standard slots in function-keymap. + +(require 'keypad) + +(defvar CSI-map nil + "The CSI-map maps the CSI function keys on the VT100 keyboard. +The CSI keys are the arrow keys.") + +(if (not CSI-map) + (progn + (setq CSI-map (lookup-key global-map "\e[")) + (if (not (keymapp CSI-map)) + (setq CSI-map (make-sparse-keymap))) ;; <ESC>[ commands + + (setup-terminal-keymap CSI-map + '(("A" . ?u) ; up arrow + ("B" . ?d) ; down-arrow + ("C" . ?r) ; right-arrow + ("D" . ?l))))) ; left-arrow + +(defun enable-arrow-keys () + "Enable the use of the VT100 arrow keys for cursor motion. +Because of the nature of the VT100, this unavoidably breaks +the standard Emacs command ESC [; therefore, it is not done by default, +but only if you give this command." + (interactive) + (global-set-key "\e[" CSI-map)) + +(defvar SS3-map nil + "SS3-map maps the SS3 function keys on the VT100 keyboard. +The SS3 keys are the numeric keypad keys in keypad application mode +\(DECKPAM). SS3 is DEC's name for the sequence <ESC>O which is +the common prefix of what these keys transmit.") + +(if (not SS3-map) + (progn + + (setq SS3-map (lookup-key global-map "\eO")) + (if (not (keymapp SS3-map)) + (setq SS3-map (make-keymap))) ;; <ESC>O commands + (setup-terminal-keymap SS3-map + '(("A" . ?u) ; up arrow + ("B" . ?d) ; down-arrow + ("C" . ?r) ; right-arrow + ("D" . ?l) ; left-arrow + ("M" . ?e) ; Enter + ("P" . ?\C-a) ; PF1 + ("Q" . ?\C-b) ; PF2 + ("R" . ?\C-c) ; PF3 + ("S" . ?\C-d) ; PF4 + ("l" . ?,) ; , + ("m" . ?-) ; - + ("n" . ?.) ; . + ("p" . ?0) ; 0 + ("q" . ?1) ; 1 + ("r" . ?2) ; 2 + ("s" . ?3) ; 3 + ("t" . ?4) ; 4 + ("u" . ?5) ; 5 + ("v" . ?6) ; 6 + ("w" . ?7) ; 7 + ("x" . ?8) ; 8 + ("y" . ?9))) ; 9 + + (define-key global-map "\eO" SS3-map))) diff --git a/lisp/term/vt101.el b/lisp/term/vt101.el new file mode 100644 index 00000000000..c35790b72c0 --- /dev/null +++ b/lisp/term/vt101.el @@ -0,0 +1 @@ +(load (concat term-file-prefix "vt100") nil t) diff --git a/lisp/term/vt102.el b/lisp/term/vt102.el new file mode 100644 index 00000000000..c35790b72c0 --- /dev/null +++ b/lisp/term/vt102.el @@ -0,0 +1 @@ +(load (concat term-file-prefix "vt100") nil t) diff --git a/lisp/term/vt125.el b/lisp/term/vt125.el new file mode 100644 index 00000000000..c35790b72c0 --- /dev/null +++ b/lisp/term/vt125.el @@ -0,0 +1 @@ +(load (concat term-file-prefix "vt100") nil t) diff --git a/lisp/term/vt131.el b/lisp/term/vt131.el new file mode 100644 index 00000000000..c35790b72c0 --- /dev/null +++ b/lisp/term/vt131.el @@ -0,0 +1 @@ +(load (concat term-file-prefix "vt100") nil t) diff --git a/lisp/term/vt200.el b/lisp/term/vt200.el index 162baecd7c1..a394de1cc3d 100644 --- a/lisp/term/vt200.el +++ b/lisp/term/vt200.el @@ -1,9 +1,85 @@ -(defun terminal-80-columns () - (interactive) - (send-string-to-terminal "\033[?3l") - (set-screen-width 80)) +;; vt200 series terminal stuff. +;; April 1985, Joe Kelsey + +(require 'keypad) -(defun terminal-132-columns () +(defvar CSI-map nil + "The CSI-map maps the CSI function keys on the VT200 keyboard. +The CSI keys are the dark function keys, and are only active in +VT200-mode, except for the arrow keys.") + +(defun enable-arrow-keys () + "Enable the use of the VT200 arrow keys and dark function keys. +Because of the nature of the VT200, this unavoidably breaks +the standard Emacs command ESC [; therefore, it is not done by default, +but only if you give this command." (interactive) - (send-string-to-terminal "\033[?3h") - (set-screen-width 132)) + (global-set-key "\e[" CSI-map)) + +;; I suggest that someone establish standard mappings for all of +;; the VT200 CSI function keys into the function-keymap. + +(if CSI-map + nil + (setq CSI-map (make-keymap)) ; <ESC>[ commands + (setup-terminal-keymap CSI-map + '(("A" . ?u) ; up arrow + ("B" . ?d) ; down-arrow + ("C" . ?r) ; right-arrow + ("D" . ?l) ; left-arrow + ("1~" . ?f) ; Find + ("2~" . ?I) ; Insert Here + ("3~" . ?k) ; Re-move + ("4~" . ?s) ; Select + ("5~" . ?P) ; Prev Screen + ("6~" . ?N) ; Next Screen + ("17~" . ?\C-f) ; F6 + ("18~" . ?\C-g) ; F7 + ("19~" . ?\C-h) ; F8 + ("20~" . ?\C-i) ; F9 + ("21~" . ?\C-j) ; F10 + ("23~" . ESC-prefix) ; F11 (ESC) + ("24~" . ?\C-l) ; F12 + ("25~" . ?\C-m) ; F13 + ("26~" . ?\C-n) ; F14 + ("31~" . ?\C-q) ; F17 + ("32~" . ?\C-r) ; F18 + ("33~" . ?\C-s) ; F19 + ("34~" . ?\C-t) ; F20 + ("28~" . ??) ; Help + ("29~" . ?x)))) ; Do + +(defvar SS3-map nil + "SS3-map maps the SS3 function keys on the VT200 keyboard. +The SS3 keys are the numeric keypad keys in keypad application mode +\(DECKPAM). SS3 is DEC's name for the sequence <ESC>O which is +the common prefix of what these keys transmit.") + +(if SS3-map + nil + (setq SS3-map (make-keymap)) ; <ESC>O commands + (setup-terminal-keymap SS3-map + '(("A" . ?u) ; up arrow + ("B" . ?d) ; down-arrow + ("C" . ?r) ; right-arrow + ("D" . ?l) ; left-arrow + ("M" . ?e) ; Enter + ("P" . ?\C-a) ; PF1 + ("Q" . ?\C-b) ; PF2 + ("R" . ?\C-c) ; PF3 + ("S" . ?\C-d) ; PF4 + ("l" . ?,) ; , + ("m" . ?-) ; - + ("n" . ?.) ; . + ("p" . ?0) ; 0 + ("q" . ?1) ; 1 + ("r" . ?2) ; 2 + ("s" . ?3) ; 3 + ("t" . ?4) ; 4 + ("u" . ?5) ; 5 + ("v" . ?6) ; 6 + ("w" . ?7) ; 7 + ("x" . ?8) ; 8 + ("y" . ?9))) ; 9 + + (define-key global-map "\eO" SS3-map)) diff --git a/lisp/term/vt220.el b/lisp/term/vt220.el new file mode 100644 index 00000000000..fdfa64d4f9d --- /dev/null +++ b/lisp/term/vt220.el @@ -0,0 +1 @@ +(load (concat term-file-prefix "vt200") nil t) diff --git a/lisp/term/vt240.el b/lisp/term/vt240.el new file mode 100644 index 00000000000..fdfa64d4f9d --- /dev/null +++ b/lisp/term/vt240.el @@ -0,0 +1 @@ +(load (concat term-file-prefix "vt200") nil t) diff --git a/lisp/term/vt300.el b/lisp/term/vt300.el new file mode 100644 index 00000000000..fdfa64d4f9d --- /dev/null +++ b/lisp/term/vt300.el @@ -0,0 +1 @@ +(load (concat term-file-prefix "vt200") nil t) diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el deleted file mode 100644 index 712e1062d00..00000000000 --- a/lisp/term/wyse50.el +++ /dev/null @@ -1,235 +0,0 @@ -; Like all the other files in this dir, this one needs to be redone -; for the new way of handling function keys. - -; Terminal mode for Wyse 50 -; should work well for Televideo Tvi 925 though it's an overkill -; Author Daniel Pfeiffer <pfeiffer@cix.cict.fr> january 1991 - -(require 'keypad) - -; at least some of these should be transferred to keypad.el -(keypad-default "A" '(lambda () (interactive) - ; actually insert an empty line - (beginning-of-line) - (open-line 1))) -(keypad-default "E" 'kill-line) -; (keypad-default "h" 'execute-extended-command) -(define-key function-keymap "h" 'execute-extended-command) ; bad, bad !! -(keypad-default "H" 'shell-command) -(keypad-default "I" '(lambda () (interactive) - (insert ? ))) ; works even in overwrite-mode -(keypad-default "L" '(lambda () (interactive) - ; delete the whole line - (beginning-of-line) - (kill-line 1))) -(keypad-default "M" 'overwrite-mode) -(keypad-default "\^e" 'shell) ; F5 -(keypad-default "\^f" 'dired) ; F6 -(keypad-default "\^g" 'rnews) ; F7 -(keypad-default "\^h" 'rmail) ; F8 - -(keypad-default "\^i" 'delete-other-windows) ; F9 -(keypad-default "\^j" 'other-window) ; F10 -(keypad-default "\^k" 'split-window-vertically) ; F11 - -(keypad-default "\^m" 'help-for-help) ; F13 -(keypad-default "\^n" 'toggle-screen-width) ; F14 -(keypad-default "\^o" 'set-function-key) ; F15 - - -; Keys that don't conflict with Emacs defaults -; I write \M-x and \C-x for what the user types, \ex and \^x for key sequences -(setup-terminal-keymap global-map - '(("\M-?" . ?\?) ; Esc ? - ("\eI" . ?T) ; Shift Tab - ("\eJ" . ?P) ; Shift Prev PAGE - ("\eK" . ?N) ; PAGE Next - ("\eY" . ?C) ; Shift Scrn CLR - ("\eT" . ?E) ; CLR Line - ("\^^" . ?h) ; Home - ("\M-\^^" . ?H) ; Esc Home - ("\eQ" . ?I) ; INS Char - ("\eE" . ?A) ; Shift Line INS - ("\eW" . ?D) ; DEL Char - ("\eR" . ?L))) ; Shift Line DEL - -; Print -- put in some extra security -(global-set-key "\eP" '(lambda () (interactive) - (if (y-or-n-p - (concat "Print buffer " - (buffer-name) "? ")) - (print-buffer)))) - - -; this is an ugly hack for a nasty problem: -; Wyse 50 takes one character cell to store video attributes (which seems to -; explain width 79 rather than 80, column 1 is not used!!!). -; On killing (C-x C-c) the end inverse code (on column 1 of line 24) -; of the mode line is overwritten AFTER all the y-or-n questions. -; This causes the attribute to remain in effect until the mode line has -; scrolled of the screen. Suspending (C-z) does not cause this problem. -; On such terminals, Emacs should sacrifice the first and last character of -; each mode line, rather than a whole screen column! -(setq kill-emacs-hook '(lambda () (interactive) - (send-string-to-terminal - (concat "\ea23R" (1+ (screen-width)) "C\eG0")))) - - -; This function does more than its name which was copied from term/vt100.el -; Some more neutral name should be used thru-out term/*.el to simplify -; programming term-setup-hook -(defun enable-arrow-keys () - "To be called by term-setup-hook. Overrides 6 Emacs standard keys -whose functions are then typed as follows: -C-a Funct left-arrow, C-a C-a -C-h M-? -LFD Funct Return, some modes override down-arrow via LFD -C-k CLR Line -C-l Shift Scrn CLR -M-r M-x move-to-window-line, Funct up-arrow or down-arrow are similar -All special keys except Send, Shift Ins, Shift Home and shifted functions keys -are assigned some hopefully useful meaning." - (interactive) - - ; Function keys - (define-key global-map "\^a" (define-prefix-command 'Funct-prefix)) - - ; Arrow keys - (setup-terminal-keymap global-map - '(("\C-a\C-a" . beginning-of-line) ; for auld lang syne - ("\^a\^m\^m" . newline-and-indent) - - ("\^k" . ?u) ; up-arrow - ("\^j" . ?d) ; down-arrow - ("\^l" . ?r) ; right-arrow - ("\^h" . ?l) ; left-arrow - - ; Terminal needs both Ins and Repl but Emacs knows how to toggle - ; with just one key. No need to override Ins which is "\eq". - ("\er" . ?M) ; Repl - - ("\^a\^i\^m" . ?t) ; Funct Tab - - ; Function keys F1 thru F16 (we don't define shifted function keys, - ; they send the same code with the middle character in lowercase. - ; eg. "Shift F2" is the same as "Funct a" which is more mnemonic but - ; keypad.el doesn't provide enough codes to accomodate all these) - ("\^a@\^m" . 1) ("\^aH\^m" . 9) - ("\^aA\^m" . 2) ("\^aI\^m" . 10) - ("\^aB\^m" . 3) ("\^aJ\^m" . 11) - ("\^aC\^m" . 4) ("\^aK\^m" . 12) - ("\^aD\^m" . 5) ("\^aL\^m" . 13) - ("\^aE\^m" . 6) ("\^aM\^m" . 14) - ("\^aF\^m" . 7) ("\^aN\^m" . 15) - ("\^aG\^m" . 8) ("\^aO\^m" . 16) - - ; Funct Arrow keys - ("\^a\^k\^m" . (lambda (n) (interactive "p") - (move-to-window-line (1- n)))) - ("\^a\^j\^m" . (lambda (n) (interactive "p") - (move-to-window-line (- n)))) - ("\^a\^h\^m" . beginning-of-line) - ("\^a\^l\^m" . end-of-line))) - - ; forget self to put memory to some serious use - (fmakunbound 'enable-arrow-keys)) - - -(defun toggle-screen-width () - "Alternate between 80 and 132 columns." - (interactive) - (if (<= (screen-width) 80) - (progn - (send-string-to-terminal "\e`;") - (set-screen-width 131)) - (send-string-to-terminal "\e`:") - (set-screen-width 79))) - -;----------------------------------------------------------------------------- -; this function is completely independent of wyse, it should be auto-loadable -; (presumably from keypad.el) for use in ~/emacs. It should be the only thing -; users need to know about all this unintelligible "forwarding" gibberish. -; This paves the way for a save-function-keys (some day or sleepless night) -; that will edit calls like (set-function-key ?x 'do-whatever) in ~/.emacs. -(defun set-function-key (key &optional def) - "Prompt for a function or other special key and assign it a meaning. -The key must have been \"forwarded\" to a character by term/*.el. - -As a function takes two args CHAR and DEF, with DEF as in define-key. -If your terminals term/*.el forwards a physical key to CHAR (before or after -calling this function), then that key will mean DEF, else it is ignored. -CHAR is one of the following: -For numbered function keys - 0, 1, ..., 24 (or ?\\^@, ?\\^a, ..., ?\\^x which is the same) -For keypad keys in application mode - ?0, ?1, ..., ?9 -- keypad key labelled with that digit, - but only if that key is not an arrow key (see ?u, ?d, ?r, ?l). - ?- -- keypad key labelled `-'. - ?. -- keypad key labelled `.'. - ?, -- keypad key labelled `,'. - ?e -- key labelled enter. -For keys labelled with some words or a symbol - ?a -- clear all tabs key. - ?A -- insert line key. - ?C -- clear screen key. - ?c -- erase key. - ?D -- delete character key. - ?d -- down-arrow. - ?E -- clear to end of line key. - ?e -- key labelled enter. - ?f -- find key or search key. - ?F -- scroll forward key. - ?H -- home-down. - ?h -- home-position key. - ?I -- insert character key - If there is just an \"insert\" key, it should be this. - ?k -- delete key or remove key. - ?L -- delete line key. - ?l -- left-arrow. - ?M -- exit insert mode key. - ?N -- next page key. - ?p -- portrait mode. - ?P -- previous page key. - ?q -- landscape mode. - ?r -- right-arrow. - ?R -- scroll reverse key. - ?S -- clear to end of screen key. - ?s -- select key. - ?t -- clear tab this column key. - ?T -- set tab this column key. - ?u -- up-arrow. - ?x -- do key. - ?\\? -- help." - (interactive "kHit key to redefine") - (let ((map function-keymap)) - (if (integerp key) - () - ; reinvent lookup-key to get (map . char) instead of def of char in map - (setq map (or (lookup-key global-map - (substring key 0 (1- (length key)))) - global-map) - key (string-to-char (substring key (1- (length key))))) - (while (symbolp map) - (setq map (symbol-function map))) - (setq map (if (listp map) - (cdr (assq key (cdr map))) - (aref map key))) - (if (and (consp map) - (integerp (cdr map))) - (setq key (cdr map) - map (car map)) ; function-keymap usually - (error "Key is not a \"forwarded\" definition."))) - (if def - () - (setq def (read-command "command (default last keyboard macro): ")) - (if (string-equal (symbol-name def) "") - (setq def last-kbd-macro)) - (setq command-history ; nonsense really, since you don't see - (cons ; key as in a function call (?char) - (list 'set-function-key key - (if (stringp def) def (list 'quote def))) - command-history))) - ; all we do when called as a function - (define-key map (char-to-string key) def))) - - diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index feff6de1865..5d7670a66ac 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1,615 +1,222 @@ ;; Parse switches controlling how Emacs interfaces with X window system. -;; Copyright (C) 1990 Free Software Foundation, Inc. +;; Copyright (C) 1986, 1988 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY. No author or distributor -;; accepts responsibility to anyone for the consequences of using it -;; or for whether it serves any particular purpose or works at all, -;; unless he says so in writing. Refer to the GNU Emacs General Public -;; License for full details. - -;; Everyone is granted permission to copy, modify and redistribute -;; GNU Emacs, but only under the conditions described in the -;; GNU Emacs General Public License. A copy of this license is -;; supposed to have been given to you along with GNU Emacs so you -;; can know your rights and responsibilities. It should be in a -;; file named COPYING. Among other things, the copyright notice -;; and this notice must be preserved on all copies. - - -;; X-win.el: this file is loaded from ../lisp/startup.el when it recognizes -;; that X windows are to be used. Command line switches are parsed and those -;; pertaining to X are processed and removed from the command line. The -;; X display is opened and hooks are set for popping up the initial window. - -;; startup.el will then examine startup files, and eventually call the hooks -;; which create the first window (s). - -;; These are the standard X switches from the Xt Initialize.c file of -;; Release 4. - -;; Command line Resource Manager string - -;; +rv *reverseVideo -;; +synchronous *synchronous -;; -background *background -;; -bd *borderColor -;; -bg *background -;; -bordercolor *borderColor -;; -borderwidth .borderWidth -;; -bw .borderWidth -;; -display .display -;; -fg *foreground -;; -fn *font -;; -font *font -;; -foreground *foreground -;; -geometry .geometry -;; -iconic .iconic -;; -name .name -;; -reverse *reverseVideo -;; -rv *reverseVideo -;; -selectionTimeout .selectionTimeout -;; -synchronous *synchronous -;; -title .title -;; -xrm - -;; An alist of X options and the function which handles them. See -;; ../startup.el. - -;; This is a temporary work-around while we the separate keymap -;; stuff isn't yet fixed. These variables aren't used anymore, -;; but the lisp code wants them to exist. -JimB -(setq global-mouse-map (make-sparse-keymap)) -(setq global-function-map (make-sparse-keymap)) - -(setq command-switch-alist - (append '(("-dm" . x-establish-daemon-mode) - ("-bw" . x-handle-numeric-switch) - ("-d" . x-handle-display) - ("-display" . x-handle-display) - ("-name" . x-handle-switch) - ("-T" . x-handle-switch) - ("-r" . x-handle-switch) - ("-rv" . x-handle-switch) - ("-reverse" . x-handle-switch) - ("-fn" . x-handle-switch) - ("-font" . x-handle-switch) - ("-ib" . x-handle-switch) - ("-g" . x-handle-geometry) - ("-geometry" . x-handle-geometry) - ("-fg" . x-handle-switch) - ("-foreground" . x-handle-switch) - ("-bg" . x-handle-switch) - ("-background" . x-handle-switch) - ("-ms" . x-handle-switch) - ("-ib" . x-handle-switch) - ("-iconic" . x-handle-switch) - ("-cr" . x-handle-switch) - ("-vb" . x-handle-switch) - ("-hb" . x-handle-switch) - ("-bd" . x-handle-switch)) - command-switch-alist)) - -(defvar x-switches-specified nil) +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. -(defconst x-switch-definitions - '(("-name" name) - ("-T" name) - ("-r" lose) - ("-rv" lose) - ("-reverse" lose) - ("-fn" font) - ("-font" font) - ("-ib" internal-border-width) - ("-fg" foreground-color) - ("-foreground" foreground-color) - ("-bg" background-color) - ("-background" background-color) - ("-ms" mouse-color) - ("-cr" cursor-color) - ("-ib" icon-type t) - ("-iconic" iconic-startup t) - ("-vb" vertical-scroll-bar t) - ("-hb" horizontal-scroll-bar t) - ("-bd" border-color) - ("-bw" border-width))) - -;; Handler for switches of the form "-switch value" or "-switch". +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +(defconst window-system-version window-system-version + "*Window system version number now in use.") + +(defvar x-sigio-bug nil + "Non-NIL means don't use interrupts for input when using X.") + +(defvar x-processed-defaults nil + "Non-NIL means that user's X defaults have already been processed.") + +(defvar x-switches nil + "Alist of command switches and values for X window system interface. +You can set this in your init file, if you want some defaults +for these switches. Example: + (setq x-switches '((\"-r\" . t) (\"-font\" . \"foo\") (\"-b\" . \"8\"))) +This feature is currently broken for X11.") + +(if (= window-system-version 10) + (setq command-switch-alist + (append '(("-r" . x-handle-switch) + ("-i" . x-handle-switch) + ("-font" . x-handle-switch) + ("-w" . x-handle-switch) + ("-b" . x-handle-switch) + ("-ib" . x-handle-switch) + ("-fg" . x-handle-switch) + ("-bg" . x-handle-switch) + ("-bd" . x-handle-switch) + ("-cr" . x-handle-switch) + ("-ms" . x-handle-switch)) + command-switch-alist)) + (setq command-switch-alist + (append '(("-rn" . x-ignore-arg) + ("-xrm" . x-ignore-arg) + ("-r" . ignore) + ("-i" . ignore) + ("-rn" . x-ignore-arg) + ("-font" . x-ignore-arg) + ("-fn" . x-ignore-arg) + ("-wn" . x-ignore-arg) + ("-in" . x-ignore-arg) + ("-w" . x-ignore-arg) + ("-geometry" . x-ignore-arg) + ("-b" . x-ignore-arg) + ("-ib" . x-ignore-arg) + ("-fg" . x-ignore-arg) + ("-bg" . x-ignore-arg) + ("-bd" . x-ignore-arg) + ("-cr" . x-ignore-arg) + ("-ms" . x-ignore-arg)) + command-switch-alist))) + +(defun x-ignore-arg (&rest ignore) + (setq command-line-args-left (cdr command-line-args-left))) + +;; This is run after the command args are parsed. (defun x-handle-switch (switch) - (let ((aelt (assoc switch x-switch-definitions))) - (if aelt - (if (nth 2 aelt) - (setq x-switches-specified - (cons (cons (nth 1 aelt) (nth 2 aelt)) - x-switches-specified)) - (setq x-switches-specified - (cons (cons (nth 1 aelt) - (car x-invocation-args)) - x-switches-specified) - x-invocation-args (cdr x-invocation-args)))))) - -;; Handler for switches of the form "-switch n" -(defun x-handle-numeric-switch (switch) - (let ((aelt (assoc switch x-switch-definitions))) - (if aelt - (setq x-switches-specified - (cons (cons (nth 1 aelt) - (string-to-int (car x-invocation-args))) - x-switches-specified) - x-invocation-args - (cdr x-invocation-args))))) - -;; Handle the geometry option -(defun x-handle-geometry (switch) - (setq x-switches-specified (append x-switches-specified - (x-geometry (car x-invocation-args))) - x-invocation-args (cdr x-invocation-args))) - -;; The daemon stuff isn't really useful at the moment. -(defvar x-daemon-mode nil - "When set, means initially create just a minibuffer.") - -(defun x-establish-daemon-mode (switch) - (setq x-daemon-mode t)) - -(defvar x-display-name nil - "The X display name specifying server and X screen.") - -(defun x-handle-display (switch) - (setq x-display-name (car x-invocation-args) - x-invocation-args (cdr x-invocation-args))) - -;; Here the X-related command line options are processed, before the user's -;; startup file is loaded. These are present in ARGS (see startup.el). -;; They are copied to x-invocation args from which the X-related things -;; are extracted, first the switch (e.g., "-fg") in the following code, -;; and possible values (e.g., "black") in the option handler code -;; (e.g., x-handle-switch). - -;; When finished, only things not pertaining to X (e.g., "-q", filenames) -;; are left in ARGS - -(defvar x-invocation-args nil) + (if (x-handle-switch-1 switch (car command-line-args-left)) + (setq command-line-args-left (cdr command-line-args-left)))) + +(defun x-handle-switch-1 (switch arg) + (cond ((string= switch "-r") + (x-flip-color) + nil) + ((string= switch "-i") + (x-set-icon t) + nil) + ((string= switch "-font") + (x-set-font arg) + t) + ((string= switch "-b") + (x-set-border-width (string-to-int arg)) + t) + ((string= switch "-ib") + (x-set-internal-border-width (string-to-int arg)) + t) + ((string= switch "-w") + (x-create-x-window arg) + t) + ((string= switch "-fg") + (x-set-foreground-color arg) + t) + ((string= switch "-bg") + (x-set-background-color arg) + t) + ((string= switch "-bd") + (x-set-border-color arg) + t) + ((string= switch "-cr") + (x-set-cursor-color arg) + t) + ((string= switch "-ms") + (x-set-mouse-color arg) + t))) + +;; Convert a string of the form "WWxHH+XO+YO", +;; where WW, HH, XO and YO are numerals, +;; into a list (WW HH XO YO). +;; "xHH" may be omitted; then 0 is used for HH. +;; XO and YO may be preceded by - instead of + to make them negative. +;; Either YO or both XO and YO may be omitted; zero is used. +(defun x-parse-edge-spec (arg) + (let ((cols-by-font 0) + (rows-by-font 0) + (xoffset 0) + (yoffset 0)) + (if (string-match "^=" arg) + (setq cols-by-font (x-extract-number)) + (error "Invalid X window size/position spec")) + (if (string-match "^x" arg) ;get rows-by-font + (setq rows-by-font (x-extract-number))) + (if (string-match "^[-+]" arg) + (setq xoffset (x-extract-number))) + (if (string-match "^[-+]" arg) + (setq yoffset (x-extract-number))) + (or (equal arg "") + (error "Invalid X window size/position spec")) + (list cols-by-font rows-by-font xoffset yoffset))) + +;; Subroutine to extract the next numeral from the front of arg, +;; returning it and shortening arg to remove its text. +;; If arg is negative, subtract 1 before returning it. +(defun x-extract-number () + (if (string-match "^[x=]" arg) + (setq arg (substring arg 1))) + (or (string-match "[-+]?[0-9]+" arg) + (error "Invalid X window size/position spec")) + (prog1 + (+ (string-to-int arg) + (if (string-match "^-" arg) -1 0)) + (setq arg + (substring arg + (or (string-match "[^0-9]" arg 1) + (length arg)))))) + +(defun x-get-default-args () + (setq x-processed-defaults t) + (let (value) + (if (not (string= (setq value (x-get-default "bodyfont")) "")) + (x-handle-switch-1 "-font" value)) + (if (string-match "on" (x-get-default "bitmapicon")) + (x-handle-switch-1 "-i" t)) + (if (not (string= (setq value (x-get-default "borderwidth")) "")) + (x-handle-switch-1 "-b" value)) + (if (not (string= (setq value (x-get-default "internalborder")) "")) + (x-handle-switch-1 "-ib" value)) + (if (not (string= (setq value (x-get-default "foreground")) "")) + (x-handle-switch-1 "-fg" value)) + (if (not (string= (setq value (x-get-default "background")) "")) + (x-handle-switch-1 "-bg" value)) + (if (not (string= (setq value (x-get-default "border")) "")) + (x-handle-switch-1 "-bd" value)) + (if (not (string= (setq value (x-get-default "cursor")) "")) + (x-handle-switch-1 "-cr" value)) + (if (not (string= (setq value (x-get-default "mouse")) "")) + (x-handle-switch-1 "-ms" value)) + (if (string-match "on" (x-get-default "reversevideo")) + (x-handle-switch-1 "-r" t)))) + +;; So far we have only defined some functions. +;; Now we start processing X-related switches +;; and redefining commands and variables, +;; only if Emacs has been compiled to support direct interface to X. (if (eq window-system 'x) (progn - (setq window-setup-hook 'x-pop-initial-window - x-invocation-args args - args nil) (require 'x-mouse) - (require 'screen) - (setq suspend-hook - '(lambda () - (error "Suspending an emacs running under X makes no sense"))) - (define-key global-map "" 'iconify-emacs) - (while x-invocation-args - (let* ((this-switch (car x-invocation-args)) - (aelt (assoc this-switch command-switch-alist))) - (setq x-invocation-args (cdr x-invocation-args)) - (if aelt - (funcall (cdr aelt) this-switch) - (setq args (cons this-switch args))))) - (setq args (nreverse args)) - (x-open-connection (or x-display-name - (setq x-display-name (getenv "DISPLAY")))) - ;; - ;; This is the place to handle Xresources - ;; - ) - (error "Loading x-win.el but not compiled for X")) - - -;; This is the function which creates the first X window. It is called -;; from startup.el after the user's init file is processed. - -(defun x-pop-initial-window () - ;; xterm.c depends on using interrupt-driven input. - (set-input-mode t nil t) - (setq mouse-motion-handler 'x-track-pointer) - (setq x-switches-specified (append x-switches-specified - initial-screen-alist - screen-default-alist)) - ;; see screen.el for this function - (pop-initial-screen x-switches-specified) - (delete-screen terminal-screen)) - - -;; -;; Standard X cursor shapes, courtesy of Mr. Fox, who wanted ALL of them. -;; - -(defconst x-pointer-X-cursor 0) -(defconst x-pointer-arrow 2) -(defconst x-pointer-based-arrow-down 4) -(defconst x-pointer-based-arrow-up 6) -(defconst x-pointer-boat 8) -(defconst x-pointer-bogosity 10) -(defconst x-pointer-bottom-left-corner 12) -(defconst x-pointer-bottom-right-corner 14) -(defconst x-pointer-bottom-side 16) -(defconst x-pointer-bottom-tee 18) -(defconst x-pointer-box-spiral 20) -(defconst x-pointer-center-ptr 22) -(defconst x-pointer-circle 24) -(defconst x-pointer-clock 26) -(defconst x-pointer-coffee-mug 28) -(defconst x-pointer-cross 30) -(defconst x-pointer-cross-reverse 32) -(defconst x-pointer-crosshair 34) -(defconst x-pointer-diamond-cross 36) -(defconst x-pointer-dot 38) -(defconst x-pointer-dotbox 40) -(defconst x-pointer-double-arrow 42) -(defconst x-pointer-draft-large 44) -(defconst x-pointer-draft-small 46) -(defconst x-pointer-draped-box 48) -(defconst x-pointer-exchange 50) -(defconst x-pointer-fleur 52) -(defconst x-pointer-gobbler 54) -(defconst x-pointer-gumby 56) -(defconst x-pointer-hand1 58) -(defconst x-pointer-hand2 60) -(defconst x-pointer-heart 62) -(defconst x-pointer-icon 64) -(defconst x-pointer-iron-cross 66) -(defconst x-pointer-left-ptr 68) -(defconst x-pointer-left-side 70) -(defconst x-pointer-left-tee 72) -(defconst x-pointer-leftbutton 74) -(defconst x-pointer-ll-angle 76) -(defconst x-pointer-lr-angle 78) -(defconst x-pointer-man 80) -(defconst x-pointer-middlebutton 82) -(defconst x-pointer-mouse 84) -(defconst x-pointer-pencil 86) -(defconst x-pointer-pirate 88) -(defconst x-pointer-plus 90) -(defconst x-pointer-question-arrow 92) -(defconst x-pointer-right-ptr 94) -(defconst x-pointer-right-side 96) -(defconst x-pointer-right-tee 98) -(defconst x-pointer-rightbutton 100) -(defconst x-pointer-rtl-logo 102) -(defconst x-pointer-sailboat 104) -(defconst x-pointer-sb-down-arrow 106) -(defconst x-pointer-sb-h-double-arrow 108) -(defconst x-pointer-sb-left-arrow 110) -(defconst x-pointer-sb-right-arrow 112) -(defconst x-pointer-sb-up-arrow 114) -(defconst x-pointer-sb-v-double-arrow 116) -(defconst x-pointer-shuttle 118) -(defconst x-pointer-sizing 120) -(defconst x-pointer-spider 122) -(defconst x-pointer-spraycan 124) -(defconst x-pointer-star 126) -(defconst x-pointer-target 128) -(defconst x-pointer-tcross 130) -(defconst x-pointer-top-left-arrow 132) -(defconst x-pointer-top-left-corner 134) -(defconst x-pointer-top-right-corner 136) -(defconst x-pointer-top-side 138) -(defconst x-pointer-top-tee 140) -(defconst x-pointer-trek 142) -(defconst x-pointer-ul-angle 144) -(defconst x-pointer-umbrella 146) -(defconst x-pointer-ur-angle 148) -(defconst x-pointer-watch 150) -(defconst x-pointer-xterm 152) - -;; -;; Available colors -;; - -(defvar x-colors '("aquamarine" - "Aquamarine" - "medium aquamarine" - "MediumAquamarine" - "black" - "Black" - "blue" - "Blue" - "cadet blue" - "CadetBlue" - "cornflower blue" - "CornflowerBlue" - "dark slate blue" - "DarkSlateBlue" - "light blue" - "LightBlue" - "light steel blue" - "LightSteelBlue" - "medium blue" - "MediumBlue" - "medium slate blue" - "MediumSlateBlue" - "midnight blue" - "MidnightBlue" - "navy blue" - "NavyBlue" - "navy" - "Navy" - "sky blue" - "SkyBlue" - "slate blue" - "SlateBlue" - "steel blue" - "SteelBlue" - "coral" - "Coral" - "cyan" - "Cyan" - "firebrick" - "Firebrick" - "brown" - "Brown" - "gold" - "Gold" - "goldenrod" - "Goldenrod" - "medium goldenrod" - "MediumGoldenrod" - "green" - "Green" - "dark green" - "DarkGreen" - "dark olive green" - "DarkOliveGreen" - "forest green" - "ForestGreen" - "lime green" - "LimeGreen" - "medium forest green" - "MediumForestGreen" - "medium sea green" - "MediumSeaGreen" - "medium spring green" - "MediumSpringGreen" - "pale green" - "PaleGreen" - "sea green" - "SeaGreen" - "spring green" - "SpringGreen" - "yellow green" - "YellowGreen" - "dark slate grey" - "DarkSlateGrey" - "dark slate gray" - "DarkSlateGray" - "dim grey" - "DimGrey" - "dim gray" - "DimGray" - "light grey" - "LightGrey" - "light gray" - "LightGray" - "gray" - "grey" - "Gray" - "Grey" - "khaki" - "Khaki" - "magenta" - "Magenta" - "maroon" - "Maroon" - "orange" - "Orange" - "orchid" - "Orchid" - "dark orchid" - "DarkOrchid" - "medium orchid" - "MediumOrchid" - "pink" - "Pink" - "plum" - "Plum" - "red" - "Red" - "indian red" - "IndianRed" - "medium violet red" - "MediumVioletRed" - "orange red" - "OrangeRed" - "violet red" - "VioletRed" - "salmon" - "Salmon" - "sienna" - "Sienna" - "tan" - "Tan" - "thistle" - "Thistle" - "turquoise" - "Turquoise" - "dark turquoise" - "DarkTurquoise" - "medium turquoise" - "MediumTurquoise" - "violet" - "Violet" - "blue violet" - "BlueViolet" - "wheat" - "Wheat" - "white" - "White" - "yellow" - "Yellow" - "green yellow" - "GreenYellow") - "The full list of X colors from the rgb.text file.") - -(defun x-defined-colors () - "Return a list of colors supported by the current X-Display." - (let ((all-colors x-colors) - (this-color nil) - (defined-colors nil)) - (while all-colors - (setq this-color (car all-colors) - all-colors (cdr all-colors)) - (and (x-defined-color this-color) - (setq defined-colors (cons this-color defined-colors)))) - defined-colors)) - - -;; -;; Function key processing under X. Function keys are received through -;; in the input stream as Lisp symbols. -;; - -(defun define-function-key (map sym definition) - (let ((exist (assq sym (cdr map)))) - (if exist - (setcdr exist definition) - (setcdr map - (cons (cons sym definition) - (cdr map)))))) - -;; For unused keysyms. If this happens, it's probably a server or -;; Xlib bug. - -(defun weird-x-keysym () - (interactive) - (error "Bizarre X keysym received.")) -(define-function-key global-function-map 'xk-not-serious 'weird-x-keysym) - -;; Keypad type things - -(define-function-key global-function-map 'xk-home 'beginning-of-line) -(define-function-key global-function-map 'xk-left 'backward-char) -(define-function-key global-function-map 'xk-up 'previous-line) -(define-function-key global-function-map 'xk-right 'forward-char) -(define-function-key global-function-map 'xk-down 'next-line) -(define-function-key global-function-map 'xk-prior 'previous-line) -(define-function-key global-function-map 'xk-next 'next-line) -(define-function-key global-function-map 'xk-end 'end-of-line) -(define-function-key global-function-map 'xk-begin 'beginning-of-line) - - ;; IsMiscFunctionKey - -(define-function-key global-function-map 'xk-select nil) -(define-function-key global-function-map 'xk-print nil) -(define-function-key global-function-map 'xk-execute nil) -(define-function-key global-function-map 'xk-insert nil) -(define-function-key global-function-map 'xk-undo nil) -(define-function-key global-function-map 'xk-redo nil) -(define-function-key global-function-map 'xk-menu nil) -(define-function-key global-function-map 'xk-find nil) -(define-function-key global-function-map 'xk-cancel nil) -(define-function-key global-function-map 'xk-help nil) -(define-function-key global-function-map 'xk-break nil) - - ;; IsKeypadKey - -(define-function-key global-function-map 'xk-kp-space - '(lambda nil (interactive) - (insert " "))) -(define-function-key global-function-map 'xk-kp-tab - '(lambda nil (interactive) - (insert "\t"))) -(define-function-key global-function-map 'xk-kp-enter - '(lambda nil (interactive) - (insert "\n"))) - -(define-function-key global-function-map 'xk-kp-f1 nil) -(define-function-key global-function-map 'xk-kp-f2 nil) -(define-function-key global-function-map 'xk-kp-f3 nil) -(define-function-key global-function-map 'xk-kp-f4 nil) - -(define-function-key global-function-map 'xk-kp-equal - '(lambda nil (interactive) - (insert "="))) -(define-function-key global-function-map 'xk-kp-multiply - '(lambda nil (interactive) - (insert "*"))) -(define-function-key global-function-map 'xk-kp-add - '(lambda nil (interactive) - (insert "+"))) -(define-function-key global-function-map 'xk-kp-separator - '(lambda nil (interactive) - (insert ";"))) -(define-function-key global-function-map 'xk-kp-subtract - '(lambda nil (interactive) - (insert "-"))) -(define-function-key global-function-map 'xk-kp-decimal - '(lambda nil (interactive) - (insert "."))) -(define-function-key global-function-map 'xk-kp-divide - '(lambda nil (interactive) - (insert "/"))) - -(define-function-key global-function-map 'xk-kp-0 - '(lambda nil (interactive) - (insert "0"))) -(define-function-key global-function-map 'xk-kp-1 - '(lambda nil (interactive) - (insert "1"))) -(define-function-key global-function-map 'xk-kp-2 - '(lambda nil (interactive) - (insert "2"))) -(define-function-key global-function-map 'xk-kp-3 - '(lambda nil (interactive) - (insert "3"))) -(define-function-key global-function-map 'xk-kp-4 - '(lambda nil (interactive) - (insert "4"))) -(define-function-key global-function-map 'xk-kp-5 - '(lambda nil (interactive) - (insert "5"))) -(define-function-key global-function-map 'xk-kp-6 - '(lambda nil (interactive) - (insert "6"))) -(define-function-key global-function-map 'xk-kp-7 - '(lambda nil (interactive) - (insert "7"))) -(define-function-key global-function-map 'xk-kp-8 - '(lambda nil (interactive) - (insert "8"))) -(define-function-key global-function-map 'xk-kp-9 - '(lambda nil (interactive) - (insert "9"))) - - ;; IsFunctionKey - -(define-function-key global-function-map 'xk-f1 'rmail) -(define-function-key global-function-map 'xk-f2 nil) -(define-function-key global-function-map 'xk-f3 nil) -(define-function-key global-function-map 'xk-f4 nil) -(define-function-key global-function-map 'xk-f5 nil) -(define-function-key global-function-map 'xk-f6 nil) -(define-function-key global-function-map 'xk-f7 nil) -(define-function-key global-function-map 'xk-f8 nil) -(define-function-key global-function-map 'xk-f9 nil) -(define-function-key global-function-map 'xk-f10 nil) -(define-function-key global-function-map 'xk-f11 nil) -(define-function-key global-function-map 'xk-f12 nil) -(define-function-key global-function-map 'xk-f13 nil) -(define-function-key global-function-map 'xk-f14 nil) -(define-function-key global-function-map 'xk-f15 nil) -(define-function-key global-function-map 'xk-f16 nil) -(define-function-key global-function-map 'xk-f17 nil) -(define-function-key global-function-map 'xk-f18 nil) -(define-function-key global-function-map 'xk-f19 nil) -(define-function-key global-function-map 'xk-f20 nil) -(define-function-key global-function-map 'xk-f21 nil) -(define-function-key global-function-map 'xk-f22 nil) -(define-function-key global-function-map 'xk-f23 nil) -(define-function-key global-function-map 'xk-f24 nil) -(define-function-key global-function-map 'xk-f25 nil) -(define-function-key global-function-map 'xk-f26 nil) -(define-function-key global-function-map 'xk-f27 nil) -(define-function-key global-function-map 'xk-f28 nil) -(define-function-key global-function-map 'xk-f29 nil) -(define-function-key global-function-map 'xk-f30 nil) -(define-function-key global-function-map 'xk-f31 nil) -(define-function-key global-function-map 'xk-f32 nil) -(define-function-key global-function-map 'xk-f33 nil) -(define-function-key global-function-map 'xk-f34 nil) -(define-function-key global-function-map 'xk-f35 nil) + (if (= window-system-version 10) + (progn + ;; xterm.c depends on using interrupt-driven input. + (set-input-mode t nil) + + (defun x-new-display (display) + "This function takes one argument, the display where you wish to +continue your editing session. Your current window will be unmapped and +the current display will be closed. The new X display will be opened and +the rubber-band outline of the new window will appear on the new X display." + (interactive "sDisplay to switch emacs to: ") + (x-change-display display) + (x-get-default-args)) + + ;; Not defvar! This is not DEFINING this variable, just specifying + ;; a value for it. + (setq window-setup-hook 'x-pop-up-window) + + ;; Process switch settings made by .emacs file. + (while x-switches + (x-handle-switch-1 (car (car x-switches)) (cdr (car x-switches))) + (setq x-switches (cdr x-switches))))) + + ;; On certain systems, turn off use of sigio, because it's broken. + (if x-sigio-bug + (set-input-mode nil nil)) + + (put 'suspend-emacs 'disabled + "Suspending a program running in an X window is silly +and you would not be able to start it again. Just switch windows instead.\n") + (setq suspend-hook '(lambda () (error "Suspending an emacs running under X makes no sense"))) + (substitute-key-definition 'suspend-emacs nil global-map) + (substitute-key-definition 'suspend-emacs nil esc-map) + (substitute-key-definition 'suspend-emacs nil ctl-x-map) + ;; Not needed any more -- done in C. + ;; (if (not x-processed-defaults) (x-get-default-args)) +)) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el new file mode 100644 index 00000000000..abb8a85ce0d --- /dev/null +++ b/lisp/term/xterm.el @@ -0,0 +1,2 @@ +;; Don't send the `ti' string when screen is cleared. +(setq reset-terminal-on-clear nil) |