aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDan Nicolaescu2007-11-01 03:06:23 +0000
committerDan Nicolaescu2007-11-01 03:06:23 +0000
commit07e5c0b0b70e308b4dc4ac5b3ee832894f746a81 (patch)
tree4749f6371c093acd662f44d98739eb8bcd10a6bc
parent88406d6ee8a9108ae8265aac2f023e61f4bff827 (diff)
downloademacs-07e5c0b0b70e308b4dc4ac5b3ee832894f746a81.tar.gz
emacs-07e5c0b0b70e308b4dc4ac5b3ee832894f746a81.zip
* cmdargs.texi (Misc Variables): Remove Sun windows info.
* MACHINES: Remove Sun windows info. * term/sun-mouse.el: * obsolete/sun-fns.el: * obsolete/sun-curs.el: Remove files. * term/sun.el (select-previous-complex-command): * sunfns.c: Remove file * m/sun386.h: * m/sun2.h: * m/sparc.h: Remove Sun windows code.
-rw-r--r--doc/emacs/ChangeLog4
-rw-r--r--doc/emacs/cmdargs.texi3
-rw-r--r--etc/ChangeLog4
-rw-r--r--etc/MACHINES11
-rw-r--r--etc/NEWS2
-rw-r--r--lisp/obsolete/sun-curs.el234
-rw-r--r--lisp/obsolete/sun-fns.el644
-rw-r--r--lisp/term/sun-mouse.el667
-rw-r--r--lisp/term/sun.el8
-rw-r--r--src/ChangeLog8
-rw-r--r--src/m/sparc.h12
-rw-r--r--src/m/sun2.h12
-rw-r--r--src/m/sun386.h12
-rw-r--r--src/sunfns.c519
14 files changed, 18 insertions, 2122 deletions
diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog
index 37ee660577a..0f36d30798b 100644
--- a/doc/emacs/ChangeLog
+++ b/doc/emacs/ChangeLog
@@ -1,3 +1,7 @@
12007-11-01 Dan Nicolaescu <dann@ics.uci.edu>
2
3 * cmdargs.texi (Misc Variables): Remove Sun windows info.
4
12007-10-27 Emanuele Giaquinta <e.giaquinta@glauco.it> (tiny change) 52007-10-27 Emanuele Giaquinta <e.giaquinta@glauco.it> (tiny change)
2 6
3 * gnus-faq.texi ([5.12]): Remove reference to discontinued service. 7 * gnus-faq.texi ([5.12]): Remove reference to discontinued service.
diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi
index 28bad72f0bf..f2f3a85af77 100644
--- a/doc/emacs/cmdargs.texi
+++ b/doc/emacs/cmdargs.texi
@@ -635,9 +635,6 @@ Emacs switches the DOS display to a mode where all 16 colors can be used
635for the background, so all four bits of the background color are 635for the background, so all four bits of the background color are
636actually used. 636actually used.
637 637
638@item WINDOW_GFX
639Used when initializing the Sun windows system.
640
641@item PRELOAD_WINSOCK 638@item PRELOAD_WINSOCK
642On MS-Windows, if you set this variable, Emacs will load and initialize 639On MS-Windows, if you set this variable, Emacs will load and initialize
643the network library at startup, instead of waiting until the first 640the network library at startup, instead of waiting until the first
diff --git a/etc/ChangeLog b/etc/ChangeLog
index 017db136df7..589e5365474 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,7 @@
12007-11-01 Dan Nicolaescu <dann@ics.uci.edu>
2
3 * MACHINES: Remove Sun windows info.
4
12007-10-30 Michael Olson <mwolson@gnu.org> 52007-10-30 Michael Olson <mwolson@gnu.org>
2 6
3 * NEWS: Add entry for Remember Mode. 7 * NEWS: Add entry for Remember Mode.
diff --git a/etc/MACHINES b/etc/MACHINES
index a4db1df76c7..9f84d8ac18a 100644
--- a/etc/MACHINES
+++ b/etc/MACHINES
@@ -1158,17 +1158,6 @@ Sun 3, Sun 4 (sparc), Sun 386 (m68k-sun-sunos, sparc-sun-sunos, i386-sun-sunos,
1158 src/s/sunos4-1.h to src/config.h. This problem is due to obsolete 1158 src/s/sunos4-1.h to src/config.h. This problem is due to obsolete
1159 software in the nonshared standard library. 1159 software in the nonshared standard library.
1160 1160
1161 If you want to use SunWindows, define HAVE_SUN_WINDOWS
1162 in config.h to enable a special interface called `emacstool'.
1163 The definition must *precede* the #include "machine.h".
1164 System version 3.2 is required for this facility to work.
1165
1166 We recommend that you instead use the X window system, which
1167 has technical advantages, is an industry standard, and is also
1168 free software. The FSF does not support the SunWindows code;
1169 we installed it only on the understanding we would not let it
1170 divert our efforts from what we think is important.
1171
1172 If you are compiling for X windows, and the X window library was 1161 If you are compiling for X windows, and the X window library was
1173 compiled to use the 68881, then you must edit config.h according 1162 compiled to use the 68881, then you must edit config.h according
1174 the comments at the end of `src/m/sun3.h'. 1163 the comments at the end of `src/m/sun3.h'.
diff --git a/etc/NEWS b/etc/NEWS
index 87773104dbc..8b9d8711bb2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -33,6 +33,8 @@ a GIF library.
33 33
34** Support for systems without alloca has been removed. 34** Support for systems without alloca has been removed.
35 35
36** Support for Sun windows has been removed.
37
36** The `emacstool' utility has been removed. 38** The `emacstool' utility has been removed.
37 39
38 40
diff --git a/lisp/obsolete/sun-curs.el b/lisp/obsolete/sun-curs.el
deleted file mode 100644
index 612102159df..00000000000
--- a/lisp/obsolete/sun-curs.el
+++ /dev/null
@@ -1,234 +0,0 @@
1;;; sun-curs.el --- cursor definitions for Sun windows
2
3;; Copyright (C) 1987, 2001, 2002, 2003, 2004, 2005,
4;; 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Jeff Peck <peck@sun.com>
7;; Keywords: hardware
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;;; Code:
29
30;;;
31;;; Added some more cursors and moved the hot spots
32;;; Cursor defined by 16 pairs of 16-bit numbers
33;;;
34;;; 9-dec-86 Jeff Peck, Sun Microsystems Inc. <peck@sun.com>
35
36(eval-when-compile (require 'cl))
37
38(defvar *edit-icon*)
39(defvar char)
40;; These are from term/sun-mouse.el
41(defvar *mouse-window*)
42(defvar *mouse-x*)
43(defvar *mouse-y*)
44(defvar menu)
45
46(require 'sun-fns)
47
48(eval-and-compile
49 (defvar sc::cursors nil "List of known cursors"))
50
51(defmacro defcursor (name x y string)
52 (if (not (memq name sc::cursors))
53 (setq sc::cursors (cons name sc::cursors)))
54 (list 'defconst name (list 'vector x y string)))
55
56;;; push should be defined in common lisp, but if not use this:
57;(defmacro push (v l)
58; "The ITEM is evaluated and consed onto LIST, a list-valued atom"
59; (list 'setq l (list 'cons v l)))
60
61;;;
62;;; The standard default cursor
63;;;
64(defcursor sc:right-arrow 15 0
65 (concat '(0 1 0 3 0 7 0 15 0 31 0 63 0 127 0 15
66 0 27 0 25 0 48 0 48 0 96 0 96 0 192 0 192)))
67
68;;(sc:set-cursor sc:right-arrow)
69
70(defcursor sc:fat-left-arrow 0 8
71 (concat '(1 0 3 0 7 0 15 0 31 0 63 255 127 255 255 255
72 255 255 127 255 63 255 31 0 15 0 7 0 3 0 1 0)))
73
74(defcursor sc:box 8 8
75 (concat '(15 252 8 4 8 4 8 4 8 4 8 4 8 4 8 4
76 8 132 8 4 8 4 8 4 8 4 8 4 8 4 15 252)))
77
78(defcursor sc:hourglass 8 8
79 (concat "\177\376\100\002\040\014\032\070"
80 "\017\360\007\340\003\300\001\200"
81 "\001\200\002\100\005\040\010\020"
82 "\021\210\043\304\107\342\177\376"))
83
84(defun sc:set-cursor (icon)
85 "Change the Sun mouse cursor to ICON.
86If ICON is nil, switch to the system default cursor,
87Otherwise, ICON should be a vector or the name of a vector of [x y 32-chars]"
88 (interactive "XIcon Name: ")
89 (if (symbolp icon) (setq icon (symbol-value icon)))
90 (sun-change-cursor-icon icon))
91
92;; This does not make much sense...
93(make-local-variable '*edit-icon*)
94
95(defvar icon-edit nil)
96(make-variable-buffer-local 'icon-edit)
97(or (assq 'icon-edit minor-mode-alist)
98 (push '(icon-edit " IconEdit") minor-mode-alist))
99
100(defun sc:edit-cursor (icon)
101 "convert icon to rectangle, edit, and repack"
102 (interactive "XIcon Name: ")
103 (if (not icon) (setq icon (sc::menu-choose-cursor (selected-window) 1 1)))
104 (if (symbolp icon) (setq icon (symbol-value icon)))
105 (if (get-buffer "icon-edit") (kill-buffer "icon-edit"))
106 (switch-to-buffer "icon-edit")
107 (local-set-mouse '(text right) 'sc::menu-function)
108 (local-set-mouse '(text left) '(sc::pic-ins-at-mouse 32))
109 (local-set-mouse '(text middle) '(sc::pic-ins-at-mouse 64))
110 (local-set-mouse '(text left middle) 'sc::hotspot)
111 (sc::display-icon icon)
112 (picture-mode)
113 (setq icon-edit t) ; for mode line display
114)
115
116(defun sc::pic-ins-at-mouse (char)
117 "Picture insert char at mouse location"
118 (mouse-move-point *mouse-window* (min 15 *mouse-x*) (min 15 *mouse-y*))
119 (move-to-column (1+ (min 15 (current-column))) t)
120 (delete-char -1)
121 (insert char)
122 (sc::goto-hotspot))
123
124(defmenu sc::menu
125 ("Cursor Menu")
126 ("Pack & Use" sc::pack-buffer-to-cursor)
127 ("Pack to Icon" sc::pack-buffer-to-icon
128 (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*))
129 ("New Icon" call-interactively 'sc::make-cursor)
130 ("Edit Icon" sc:edit-cursor
131 (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*))
132 ("Set Cursor" sc:set-cursor
133 (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*))
134 ("Reset Cursor" sc:set-cursor nil)
135 ("Help" sc::edit-icon-help-menu)
136 ("Quit" sc::quit-edit)
137 )
138
139(defun sc::menu-function (window x y)
140 (sun-menu-evaluate window (1+ x) y sc::menu))
141
142(defun sc::quit-edit ()
143 (interactive)
144 (bury-buffer (current-buffer))
145 (switch-to-buffer (other-buffer) 'no-record))
146
147(defun sc::make-cursor (symbol)
148 (interactive "SIcon Name: ")
149 (eval (list 'defcursor symbol 0 0 ""))
150 (sc::pack-buffer-to-icon (symbol-value symbol)))
151
152(defmenu sc::edit-icon-help-menu
153 ("Simple Icon Editor")
154 ("Left => CLEAR")
155 ("Middle => SET")
156 ("L & M => HOTSPOT")
157 ("Right => MENU"))
158
159(defun sc::edit-icon-help ()
160 (message "Left=> CLEAR Middle=> SET Left+Middle=> HOTSPOT Right=> MENU"))
161
162(defun sc::pack-buffer-to-cursor ()
163 (sc::pack-buffer-to-icon *edit-icon*)
164 (sc:set-cursor *edit-icon*))
165
166(defun sc::menu-choose-cursor (window x y)
167 "Presents a menu of cursor names, and returns one or nil"
168 (let ((curs sc::cursors)
169 (items))
170 (while curs
171 (push (sc::menu-item-for-cursor (car curs)) items)
172 (setq curs (cdr curs)))
173 (push (list "Choose Cursor") items)
174 (setq menu (menu-create items))
175 (sun-menu-evaluate window x y menu)))
176
177(defun sc::menu-item-for-cursor (cursor)
178 "apply function to selected cursor"
179 (list (symbol-name cursor) 'quote cursor))
180
181(defun sc::hotspot (window x y)
182 (aset *edit-icon* 0 x)
183 (aset *edit-icon* 1 y)
184 (sc::goto-hotspot))
185
186(defun sc::goto-hotspot ()
187 (goto-line (1+ (aref *edit-icon* 1)))
188 (move-to-column (aref *edit-icon* 0)))
189
190(defun sc::display-icon (icon)
191 (setq *edit-icon* (copy-sequence icon))
192 (let ((string (aref *edit-icon* 2))
193 (index 0))
194 (while (< index 32)
195 (let ((char (aref string index))
196 (bit 128))
197 (while (> bit 0)
198 (insert (sc::char-at-bit char bit))
199 (setq bit (lsh bit -1))))
200 (if (eq 1 (% index 2)) (newline))
201 (setq index (1+ index))))
202 (sc::goto-hotspot))
203
204(defun sc::char-at-bit (char bit)
205 (if (> (logand char bit) 0) "@" " "))
206
207(defun sc::pack-buffer-to-icon (icon)
208 "Pack 16 x 16 field into icon string"
209 (goto-char (point-min))
210 (aset icon 0 (aref *edit-icon* 0))
211 (aset icon 1 (aref *edit-icon* 1))
212 (aset icon 2 (mapconcat 'sc::pack-one-line "1234567890123456" ""))
213 (sc::goto-hotspot)
214 )
215
216(defun sc::pack-one-line (dummy)
217 (let (char chr1 chr2)
218 (setq char 0 chr1 (mapconcat 'sc::pack-one-char "12345678" "") chr1 char)
219 (setq char 0 chr2 (mapconcat 'sc::pack-one-char "12345678" "") chr2 char)
220 (forward-line 1)
221 (concat (char-to-string chr1) (char-to-string chr2))
222 ))
223
224(defun sc::pack-one-char (dummy)
225 "pack following char into char, unless eolp"
226 (if (or (eolp) (char-equal (following-char) 32))
227 (setq char (lsh char 1))
228 (setq char (1+ (lsh char 1))))
229 (if (not (eolp))(forward-char)))
230
231(provide 'sun-curs)
232
233;;; arch-tag: 7cc861e5-e2d9-4191-b211-2baaaab54e78
234;;; sun-curs.el ends here
diff --git a/lisp/obsolete/sun-fns.el b/lisp/obsolete/sun-fns.el
deleted file mode 100644
index 1b6a5d239bd..00000000000
--- a/lisp/obsolete/sun-fns.el
+++ /dev/null
@@ -1,644 +0,0 @@
1;;; sun-fns.el --- subroutines of Mouse handling for Sun windows
2
3;; Copyright (C) 1987, 2001, 2002, 2003, 2004, 2005,
4;; 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Jeff Peck <peck@sun.com>
7;; Maintainer: none
8;; Keywords: hardware
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 3, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
26
27;;; Commentary:
28
29;; Submitted Mar. 1987, Jeff Peck
30;; Sun Microsystems Inc. <peck@sun.com>
31;; Conceived Nov. 1986, Stan Jefferson,
32;; Computer Science Lab, SRI International.
33;; GoodIdeas Feb. 1987, Steve Greenbaum
34;; & UpClicks Reasoning Systems, Inc.
35;;
36;;
37;; Functions for manipulating via the mouse and mouse-map definitions
38;; for accessing them. Also definitions of mouse menus.
39;; This file you should freely modify to reflect you personal tastes.
40;;
41;; First half of file defines functions to implement mouse commands,
42;; Don't delete any of those, just add what ever else you need.
43;; Second half of file defines mouse bindings, do whatever you want there.
44
45;;
46;; Mouse Functions.
47;;
48;; These functions follow the sun-mouse-handler convention of being called
49;; with three arguments: (window x-pos y-pos)
50;; This makes it easy for a mouse executed command to know where the mouse is.
51;; Use the macro "eval-in-window" to execute a function
52;; in a temporarily selected window.
53;;
54;; If you have a function that must be called with other arguments
55;; bind the mouse button to an s-exp that contains the necessary parameters.
56;; See "minibuffer" bindings for examples.
57;;
58
59;;; Code:
60
61(require 'term/sun-mouse)
62
63(defconst cursor-pause-milliseconds 300
64 "*Number of milliseconds to display alternate cursor (usually the mark)")
65
66(defun indicate-region (&optional pause)
67 "Bounce cursor to mark for cursor-pause-milliseconds and back again"
68 (or pause (setq pause cursor-pause-milliseconds))
69 (let ((point (point)))
70 (goto-char (mark))
71 (sit-for-millisecs pause)
72 ;(update-display)
73 ;(sleep-for-millisecs pause)
74 (goto-char point)))
75
76
77;;;
78;;; Text buffer operations
79;;;
80(defun mouse-move-point (window x y)
81 "Move point to mouse cursor."
82 (select-window window)
83 (move-to-loc x y)
84 (if (memq last-command ; support the mouse-copy/delete/yank
85 '(mouse-copy mouse-delete mouse-yank-move))
86 (setq this-command 'mouse-yank-move))
87 )
88
89(defun mouse-set-mark (&optional window x y)
90 "Set mark at mouse cursor."
91 (eval-in-window window ;; use this to get the unwind protect
92 (let ((point (point)))
93 (move-to-loc x y)
94 (set-mark (point))
95 (goto-char point)
96 (indicate-region)))
97 )
98
99(defun mouse-set-mark-and-select (window x y)
100 "Set mark at mouse cursor, and select that window."
101 (select-window window)
102 (mouse-set-mark window x y)
103 )
104
105(defun mouse-set-mark-and-stuff (w x y)
106 "Set mark at mouse cursor, and put region in stuff buffer."
107 (mouse-set-mark-and-select w x y)
108 (sun-select-region (region-beginning) (region-end)))
109
110;;;
111;;; Simple mouse dragging stuff: marking with button up
112;;;
113
114(defvar *mouse-drag-window* nil)
115(defvar *mouse-drag-x* -1)
116(defvar *mouse-drag-y* -1)
117
118(defun mouse-drag-move-point (window x y)
119 "Move point to mouse cursor, and allow dragging."
120 (mouse-move-point window x y)
121 (setq *mouse-drag-window* window
122 *mouse-drag-x* x
123 *mouse-drag-y* y))
124
125(defun mouse-drag-set-mark-stuff (window x y)
126 "The up click handler that goes with mouse-drag-move-point.
127If mouse is in same WINDOW but at different X or Y than when
128mouse-drag-move-point was last executed, set the mark at mouse
129and put the region in the stuff buffer."
130 (if (and (eq *mouse-drag-window* window)
131 (not (and (equal *mouse-drag-x* x)
132 (equal *mouse-drag-y* y))))
133 (mouse-set-mark-and-stuff window x y)
134 (setq this-command last-command)) ; this was just an upclick no-op.
135 )
136
137(defun mouse-select-or-drag-move-point (window x y)
138 "Select window if not selected, otherwise do mouse-drag-move-point."
139 (if (eq (selected-window) window)
140 (mouse-drag-move-point window x y)
141 (mouse-select-window window)))
142
143;;;
144;;; esoterica:
145;;;
146(defun mouse-exch-pt-and-mark (window x y)
147 "Exchange point and mark."
148 (select-window window)
149 (exchange-point-and-mark)
150 )
151
152(defun mouse-call-kbd-macro (window x y)
153 "Invokes last keyboard macro at mouse cursor."
154 (mouse-move-point window x y)
155 (call-last-kbd-macro)
156 )
157
158(defun mouse-mark-thing (window x y)
159 "Set point and mark to text object using syntax table.
160The resulting region is put in the sun-window stuff buffer.
161Left or right Paren syntax marks an s-expression.
162Clicking at the end of a line marks the line including a trailing newline.
163If it doesn't recognize one of these it marks the character at point."
164 (mouse-move-point window x y)
165 (if (eobp) (open-line 1))
166 (let* ((char (char-after (point)))
167 (syntax (char-syntax char)))
168 (cond
169 ((eq syntax ?w) ; word.
170 (forward-word 1)
171 (set-mark (point))
172 (forward-word -1))
173 ;; try to include a single following whitespace (is this a good idea?)
174 ;; No, not a good idea since inconsistent.
175 ;;(if (eq (char-syntax (char-after (mark))) ?\ )
176 ;; (set-mark (1+ (mark))))
177 ((eq syntax ?\( ) ; open paren.
178 (mark-sexp 1))
179 ((eq syntax ?\) ) ; close paren.
180 (forward-char 1)
181 (mark-sexp -1)
182 (exchange-point-and-mark))
183 ((eolp) ; mark line if at end.
184 (set-mark (1+ (point)))
185 (beginning-of-line 1))
186 (t ; mark character
187 (set-mark (1+ (point)))))
188 (indicate-region)) ; display region boundary.
189 (sun-select-region (region-beginning) (region-end))
190 )
191
192(defun mouse-kill-thing (window x y)
193 "Kill thing at mouse, and put point there."
194 (mouse-mark-thing window x y)
195 (kill-region-and-unmark (region-beginning) (region-end))
196 )
197
198(defun mouse-kill-thing-there (window x y)
199 "Kill thing at mouse, leave point where it was.
200See mouse-mark-thing for a description of the objects recognized."
201 (eval-in-window window
202 (save-excursion
203 (mouse-mark-thing window x y)
204 (kill-region (region-beginning) (region-end))))
205 )
206
207(defun mouse-save-thing (window x y &optional quiet)
208 "Put thing at mouse in kill ring.
209See mouse-mark-thing for a description of the objects recognized."
210 (mouse-mark-thing window x y)
211 (copy-region-as-kill (region-beginning) (region-end))
212 (if (not quiet) (message "Thing saved"))
213 )
214
215(defun mouse-save-thing-there (window x y &optional quiet)
216 "Put thing at mouse in kill ring, leave point as is.
217See mouse-mark-thing for a description of the objects recognized."
218 (eval-in-window window
219 (save-excursion
220 (mouse-save-thing window x y quiet))))
221
222;;;
223;;; Mouse yanking...
224;;;
225(defun mouse-copy-thing (window x y)
226 "Put thing at mouse in kill ring, yank to point.
227See mouse-mark-thing for a description of the objects recognized."
228 (setq last-command 'not-kill) ;Avoids appending to previous kills.
229 (mouse-save-thing-there window x y t)
230 (yank)
231 (setq this-command 'yank))
232
233(defun mouse-move-thing (window x y)
234 "Kill thing at mouse, yank it to point.
235See mouse-mark-thing for a description of the objects recognized."
236 (setq last-command 'not-kill) ;Avoids appending to previous kills.
237 (mouse-kill-thing-there window x y)
238 (yank)
239 (setq this-command 'yank))
240
241(defun mouse-yank-at-point (&optional window x y)
242 "Yank from kill-ring at point; then cycle thru kill ring."
243 (if (eq last-command 'yank)
244 (let ((before (< (point) (mark))))
245 (delete-region (point) (mark))
246 (insert (current-kill 1))
247 (if before (exchange-point-and-mark)))
248 (yank))
249 (setq this-command 'yank))
250
251(defun mouse-yank-at-mouse (window x y)
252 "Yank from kill-ring at mouse; then cycle thru kill ring."
253 (mouse-move-point window x y)
254 (mouse-yank-at-point window x y))
255
256(defun mouse-save/delete/yank (&optional window x y)
257 "Context sensitive save/delete/yank.
258Consecutive clicks perform as follows:
259 * first click saves region to kill ring,
260 * second click kills region,
261 * third click yanks from kill ring,
262 * subsequent clicks cycle thru kill ring.
263If mouse-move-point is performed after the first or second click,
264the next click will do a yank, etc. Except for a possible mouse-move-point,
265this command is insensitive to mouse location."
266 (cond
267 ((memq last-command '(mouse-delete yank mouse-yank-move)) ; third+ click
268 (mouse-yank-at-point))
269 ((eq last-command 'mouse-copy) ; second click
270 (kill-region (region-beginning) (region-end))
271 (setq this-command 'mouse-delete))
272 (t ; first click
273 (copy-region-as-kill (region-beginning) (region-end))
274 (message "Region saved")
275 (setq this-command 'mouse-copy))
276 ))
277
278
279(defun mouse-split-horizontally (window x y)
280 "Splits the window horizontally at mouse cursor."
281 (eval-in-window window (split-window-horizontally (1+ x))))
282
283(defun mouse-split-vertically (window x y)
284 "Split the window vertically at the mouse cursor."
285 (eval-in-window window (split-window-vertically (1+ y))))
286
287(defun mouse-select-window (&optional window x y)
288 "Selects the window, restoring point."
289 (select-window window))
290
291(defun mouse-delete-other-windows (&optional window x y)
292 "Deletes all windows except the one mouse is in."
293 (delete-other-windows window))
294
295(defun mouse-delete-window (window &optional x y)
296 "Deletes the window mouse is in."
297 (delete-window window))
298
299(defun mouse-undo (window x y)
300 "Invokes undo in the window mouse is in."
301 (eval-in-window window (undo)))
302
303;;;
304;;; Scroll operations
305;;;
306
307;;; The move-to-window-line is used below because otherwise
308;;; scrolling a non-selected process window with the mouse, after
309;;; the process has written text past the bottom of the window,
310;;; gives an "End of buffer" error, and then scrolls. The
311;;; move-to-window-line seems to force recomputing where things are.
312(defun mouse-scroll-up (window x y)
313 "Scrolls the window upward."
314 (eval-in-window window (move-to-window-line 1) (scroll-up nil)))
315
316(defun mouse-scroll-down (window x y)
317 "Scrolls the window downward."
318 (eval-in-window window (scroll-down nil)))
319
320(defun mouse-scroll-proportional (window x y)
321 "Scrolls the window proportionally corresponding to window
322relative X divided by window width."
323 (eval-in-window window
324 (if (>= x (1- (window-width)))
325 ;; When x is maximum (equal to or 1 less than window width),
326 ;; goto end of buffer. We check for this special case
327 ;; because the calculated goto-char often goes short of the
328 ;; end due to roundoff error, and we often really want to go
329 ;; to the end.
330 (goto-char (point-max))
331 (progn
332 (goto-char (+ (point-min) ; For narrowed regions.
333 (* x (/ (- (point-max) (point-min))
334 (1- (window-width))))))
335 (beginning-of-line))
336 )
337 (what-cursor-position) ; Report position.
338 ))
339
340(defun mouse-line-to-top (window x y)
341 "Scrolls the line at the mouse cursor up to the top."
342 (eval-in-window window (scroll-up y)))
343
344(defun mouse-top-to-line (window x y)
345 "Scrolls the top line down to the mouse cursor."
346 (eval-in-window window (scroll-down y)))
347
348(defun mouse-line-to-bottom (window x y)
349 "Scrolls the line at the mouse cursor to the bottom."
350 (eval-in-window window (scroll-up (+ y (- 2 (window-height))))))
351
352(defun mouse-bottom-to-line (window x y)
353 "Scrolls the bottom line up to the mouse cursor."
354 (eval-in-window window (scroll-down (+ y (- 2 (window-height))))))
355
356(defun mouse-line-to-middle (window x y)
357 "Scrolls the line at the mouse cursor to the middle."
358 (eval-in-window window (scroll-up (- y -1 (/ (window-height) 2)))))
359
360(defun mouse-middle-to-line (window x y)
361 "Scrolls the line at the middle to the mouse cursor."
362 (eval-in-window window (scroll-up (- (/ (window-height) 2) y 1))))
363
364
365;;;
366;;; main emacs menu.
367;;;
368(defmenu expand-menu
369 ("Vertically" mouse-expand-vertically *menu-window*)
370 ("Horizontally" mouse-expand-horizontally *menu-window*))
371
372(defmenu delete-window-menu
373 ("This One" delete-window *menu-window*)
374 ("All Others" delete-other-windows *menu-window*))
375
376(defmenu mouse-help-menu
377 ("Text Region"
378 mouse-help-region *menu-window* *menu-x* *menu-y* 'text)
379 ("Scrollbar"
380 mouse-help-region *menu-window* *menu-x* *menu-y* 'scrollbar)
381 ("Modeline"
382 mouse-help-region *menu-window* *menu-x* *menu-y* 'modeline)
383 ("Minibuffer"
384 mouse-help-region *menu-window* *menu-x* *menu-y* 'minibuffer)
385 )
386
387(defmenu emacs-quit-menu
388 ("Quit" save-buffers-kill-emacs))
389
390(defmenu emacs-menu
391 ("Emacs Menu")
392 ("Stuff Selection" sun-yank-selection)
393 ("Expand" . expand-menu)
394 ("Delete Window" . delete-window-menu)
395 ("Previous Buffer" mouse-select-previous-buffer *menu-window*)
396 ("Save Buffers" save-some-buffers)
397 ("List Directory" list-directory nil)
398 ("Dired" dired nil)
399 ("Mouse Help" . mouse-help-menu)
400 ("Quit" . emacs-quit-menu))
401
402(defun emacs-menu-eval (window x y)
403 "Pop-up menu of editor commands."
404 (sun-menu-evaluate window (1+ x) (1- y) 'emacs-menu))
405
406(defun mouse-expand-horizontally (window)
407 (eval-in-window window
408 (enlarge-window 4 t)
409 (update-display) ; Try to redisplay, since can get confused.
410 ))
411
412(defun mouse-expand-vertically (window)
413 (eval-in-window window (enlarge-window 4)))
414
415(defun mouse-select-previous-buffer (window)
416 "Switch buffer in mouse window to most recently selected buffer."
417 (eval-in-window window (switch-to-buffer (other-buffer))))
418
419;;;
420;;; minibuffer menu
421;;;
422(defmenu minibuffer-menu
423 ("Minibuffer" message "Just some miscellaneous minibuffer commands")
424 ("Stuff" sun-yank-selection)
425 ("Do-It" exit-minibuffer)
426 ("Abort" abort-recursive-edit)
427 ("Suspend" suspend-emacs))
428
429(defun minibuffer-menu-eval (window x y)
430 "Pop-up menu of commands."
431 (sun-menu-evaluate window x (1- y) 'minibuffer-menu))
432
433(defun mini-move-point (window x y)
434 ;; -6 is good for most common cases
435 (mouse-move-point window (- x 6) 0))
436
437(defun mini-set-mark-and-stuff (window x y)
438 ;; -6 is good for most common cases
439 (mouse-set-mark-and-stuff window (- x 6) 0))
440
441
442;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
443;;; Buffer-mode Mouse commands
444;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
445
446(defun Buffer-at-mouse (w x y)
447 "Calls Buffer-menu-buffer from mouse click."
448 (save-window-excursion
449 (mouse-move-point w x y)
450 (beginning-of-line)
451 (Buffer-menu-buffer t)))
452
453(defun mouse-buffer-bury (w x y)
454 "Bury the indicated buffer."
455 (bury-buffer (Buffer-at-mouse w x y))
456 )
457
458(defun mouse-buffer-select (w x y)
459 "Put the indicated buffer in selected window."
460 (switch-to-buffer (Buffer-at-mouse w x y))
461 (list-buffers)
462 )
463
464(defun mouse-buffer-delete (w x y)
465 "mark indicated buffer for delete"
466 (save-window-excursion
467 (mouse-move-point w x y)
468 (Buffer-menu-delete)
469 ))
470
471(defun mouse-buffer-execute (w x y)
472 "execute buffer-menu selections"
473 (save-window-excursion
474 (mouse-move-point w x y)
475 (Buffer-menu-execute)
476 ))
477
478(defun enable-mouse-in-buffer-list ()
479 "Call this to enable mouse selections in *Buffer List*
480 LEFT puts the indicated buffer in the selected window.
481 MIDDLE buries the indicated buffer.
482 RIGHT marks the indicated buffer for deletion.
483 MIDDLE-RIGHT deletes the marked buffers.
484To unmark a buffer marked for deletion, select it with LEFT."
485 (save-window-excursion
486 (list-buffers) ; Initialize *Buffer List*
487 (set-buffer "*Buffer List*")
488 (local-set-mouse '(text middle) 'mouse-buffer-bury)
489 (local-set-mouse '(text left) 'mouse-buffer-select)
490 (local-set-mouse '(text right) 'mouse-buffer-delete)
491 (local-set-mouse '(text middle right) 'mouse-buffer-execute)
492 )
493 )
494
495
496;;;*******************************************************************
497;;;
498;;; Global Mouse Bindings.
499;;;
500;;; There is some sense to this mouse binding madness:
501;;; LEFT and RIGHT scrolls are inverses.
502;;; SHIFT makes an opposite meaning in the scroll bar.
503;;; SHIFT is an alternative to DOUBLE (but double chords do not exist).
504;;; META makes the scrollbar functions work in the text region.
505;;; MIDDLE operates the mark
506;;; LEFT operates at point
507
508;;; META commands are generally non-destructive,
509;;; SHIFT is a little more dangerous.
510;;; CONTROL is for the really complicated ones.
511
512;;; CONTROL-META-SHIFT-RIGHT gives help on that region.
513
514;;;
515;;; Text Region mousemap
516;;;
517;; The basics: Point, Mark, Menu, Sun-Select:
518(global-set-mouse '(text left) 'mouse-drag-move-point)
519(global-set-mouse '(text up left) 'mouse-drag-set-mark-stuff)
520(global-set-mouse '(text shift left) 'mouse-exch-pt-and-mark)
521(global-set-mouse '(text double left) 'mouse-exch-pt-and-mark)
522
523(global-set-mouse '(text middle) 'mouse-set-mark-and-stuff)
524
525(global-set-mouse '(text right) 'emacs-menu-eval)
526(global-set-mouse '(text shift right) '(sun-yank-selection))
527(global-set-mouse '(text double right) '(sun-yank-selection))
528
529;; The Slymoblics multi-command for Save, Kill, Copy, Move:
530(global-set-mouse '(text shift middle) 'mouse-save/delete/yank)
531(global-set-mouse '(text double middle) 'mouse-save/delete/yank)
532
533;; Save, Kill, Copy, Move Things:
534;; control-left composes with control middle/right to produce copy/move
535(global-set-mouse '(text control middle ) 'mouse-save-thing-there)
536(global-set-mouse '(text control right ) 'mouse-kill-thing-there)
537(global-set-mouse '(text control left) 'mouse-yank-at-point)
538(global-set-mouse '(text control middle left) 'mouse-copy-thing)
539(global-set-mouse '(text control right left) 'mouse-move-thing)
540(global-set-mouse '(text control right middle) 'mouse-mark-thing)
541
542;; The Universal mouse help command (press all buttons):
543(global-set-mouse '(text shift control meta right) 'mouse-help-region)
544(global-set-mouse '(text double control meta right) 'mouse-help-region)
545
546;;; Meta in Text Region is like meta version in scrollbar:
547(global-set-mouse '(text meta left) 'mouse-line-to-top)
548(global-set-mouse '(text meta shift left) 'mouse-line-to-bottom)
549(global-set-mouse '(text meta double left) 'mouse-line-to-bottom)
550(global-set-mouse '(text meta middle) 'mouse-line-to-middle)
551(global-set-mouse '(text meta shift middle) 'mouse-middle-to-line)
552(global-set-mouse '(text meta double middle) 'mouse-middle-to-line)
553(global-set-mouse '(text meta control middle) 'mouse-split-vertically)
554(global-set-mouse '(text meta right) 'mouse-top-to-line)
555(global-set-mouse '(text meta shift right) 'mouse-bottom-to-line)
556(global-set-mouse '(text meta double right) 'mouse-bottom-to-line)
557
558;; Miscellaneous:
559(global-set-mouse '(text meta control left) 'mouse-call-kbd-macro)
560(global-set-mouse '(text meta control right) 'mouse-undo)
561
562;;;
563;;; Scrollbar mousemap.
564;;; Are available in the Scrollbar Region, or with Meta Text (or Meta Scrollbar)
565;;;
566(global-set-mouse '(scrollbar left) 'mouse-line-to-top)
567(global-set-mouse '(scrollbar shift left) 'mouse-line-to-bottom)
568(global-set-mouse '(scrollbar double left) 'mouse-line-to-bottom)
569
570(global-set-mouse '(scrollbar middle) 'mouse-line-to-middle)
571(global-set-mouse '(scrollbar shift middle) 'mouse-middle-to-line)
572(global-set-mouse '(scrollbar double middle) 'mouse-middle-to-line)
573(global-set-mouse '(scrollbar control middle) 'mouse-split-vertically)
574
575(global-set-mouse '(scrollbar right) 'mouse-top-to-line)
576(global-set-mouse '(scrollbar shift right) 'mouse-bottom-to-line)
577(global-set-mouse '(scrollbar double right) 'mouse-bottom-to-line)
578
579(global-set-mouse '(scrollbar meta left) 'mouse-line-to-top)
580(global-set-mouse '(scrollbar meta shift left) 'mouse-line-to-bottom)
581(global-set-mouse '(scrollbar meta double left) 'mouse-line-to-bottom)
582(global-set-mouse '(scrollbar meta middle) 'mouse-line-to-middle)
583(global-set-mouse '(scrollbar meta shift middle) 'mouse-middle-to-line)
584(global-set-mouse '(scrollbar meta double middle) 'mouse-middle-to-line)
585(global-set-mouse '(scrollbar meta control middle) 'mouse-split-vertically)
586(global-set-mouse '(scrollbar meta right) 'mouse-top-to-line)
587(global-set-mouse '(scrollbar meta shift right) 'mouse-bottom-to-line)
588(global-set-mouse '(scrollbar meta double right) 'mouse-bottom-to-line)
589
590;; And the help menu:
591(global-set-mouse '(scrollbar shift control meta right) 'mouse-help-region)
592(global-set-mouse '(scrollbar double control meta right) 'mouse-help-region)
593
594;;;
595;;; Modeline mousemap.
596;;;
597;;; Note: meta of any single button selects window.
598
599(global-set-mouse '(modeline left) 'mouse-scroll-up)
600(global-set-mouse '(modeline meta left) 'mouse-select-window)
601
602(global-set-mouse '(modeline middle) 'mouse-scroll-proportional)
603(global-set-mouse '(modeline meta middle) 'mouse-select-window)
604(global-set-mouse '(modeline control middle) 'mouse-split-horizontally)
605
606(global-set-mouse '(modeline right) 'mouse-scroll-down)
607(global-set-mouse '(modeline meta right) 'mouse-select-window)
608
609;;; control-left selects this window, control-right deletes it.
610(global-set-mouse '(modeline control left) 'mouse-delete-other-windows)
611(global-set-mouse '(modeline control right) 'mouse-delete-window)
612
613;; in case of confusion, just select it:
614(global-set-mouse '(modeline control left right)'mouse-select-window)
615
616;; even without confusion (and without the keyboard) select it:
617(global-set-mouse '(modeline left right) 'mouse-select-window)
618
619;; And the help menu:
620(global-set-mouse '(modeline shift control meta right) 'mouse-help-region)
621(global-set-mouse '(modeline double control meta right) 'mouse-help-region)
622
623;;;
624;;; Minibuffer Mousemap
625;;; Demonstrating some variety:
626;;;
627(global-set-mouse '(minibuffer left) 'mini-move-point)
628
629(global-set-mouse '(minibuffer middle) 'mini-set-mark-and-stuff)
630
631(global-set-mouse '(minibuffer shift middle) '(select-previous-complex-command))
632(global-set-mouse '(minibuffer double middle) '(select-previous-complex-command))
633(global-set-mouse '(minibuffer control middle) '(next-complex-command 1))
634(global-set-mouse '(minibuffer meta middle) '(previous-complex-command 1))
635
636(global-set-mouse '(minibuffer right) 'minibuffer-menu-eval)
637
638(global-set-mouse '(minibuffer shift control meta right) 'mouse-help-region)
639(global-set-mouse '(minibuffer double control meta right) 'mouse-help-region)
640
641(provide 'sun-fns)
642
643;;; arch-tag: 1c4c1192-f71d-4d5f-b883-ae659c28e132
644;;; sun-fns.el ends here
diff --git a/lisp/term/sun-mouse.el b/lisp/term/sun-mouse.el
deleted file mode 100644
index d3e85508b03..00000000000
--- a/lisp/term/sun-mouse.el
+++ /dev/null
@@ -1,667 +0,0 @@
1;;; sun-mouse.el --- mouse handling for Sun windows
2
3;; Copyright (C) 1987, 2001, 2002, 2003, 2004, 2005,
4;; 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Jeff Peck
7;; Maintainer: FSF
8;; Keywords: hardware
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 3, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
26
27;;; Commentary:
28
29;; Jeff Peck, Sun Microsystems, Jan 1987.
30;; Original idea by Stan Jefferson
31
32;; Modeled after the GNUEMACS keymap interface.
33;;
34;; User Functions:
35;; make-mousemap, copy-mousemap,
36;; define-mouse, global-set-mouse, local-set-mouse,
37;; use-global-mousemap, use-local-mousemap,
38;; mouse-lookup, describe-mouse-bindings
39;;
40;; Options:
41;; extra-click-wait, scrollbar-width
42
43;;; Code:
44
45(defvar extra-click-wait 150
46 "*Number of milliseconds to wait for an extra click.
47Set this to zero if you don't want chords or double clicks.")
48
49(defvar scrollbar-width 5
50 "*The character width of the scrollbar.
51The cursor is deemed to be in the right edge scrollbar if it is this near the
52right edge, and more than two chars past the end of the indicated line.
53Setting to nil limits the scrollbar to the edge or vertical dividing bar.")
54
55;;;
56;;; Mousemaps
57;;;
58(defun make-mousemap ()
59 "Returns a new mousemap."
60 (cons 'mousemap nil))
61
62;;; initialize mouse maps
63(defvar current-global-mousemap (make-mousemap))
64(defvar current-local-mousemap nil)
65(make-variable-buffer-local 'current-local-mousemap)
66
67(defun copy-mousemap (mousemap)
68 "Return a copy of mousemap."
69 (copy-alist mousemap))
70
71(defun define-mouse (mousemap mouse-list def)
72 "Args MOUSEMAP, MOUSE-LIST, DEF. Define MOUSE-LIST in MOUSEMAP as DEF.
73MOUSE-LIST is a list of atoms specifying a mouse hit according to these rules:
74 * One of these atoms specifies the active region of the definition.
75 text, scrollbar, modeline, minibuffer
76 * One or two or these atoms specify the button or button combination.
77 left, middle, right, double
78 * Any combination of these atoms specify the active shift keys.
79 control, shift, meta
80 * With a single unshifted button, you can add
81 up
82 to indicate an up-click.
83The atom `double' is used with a button designator to denote a double click.
84Two button chords are denoted by listing the two buttons.
85See sun-mouse-handler for the treatment of the form DEF."
86 (mousemap-set (mouse-list-to-mouse-code mouse-list) mousemap def))
87
88(defun global-set-mouse (mouse-list def)
89 "Give MOUSE-EVENT-LIST a local definition of DEF.
90See define-mouse for a description of MOUSE-EVENT-LIST and DEF.
91Note that if MOUSE-EVENT-LIST has a local definition in the current buffer,
92that local definition will continue to shadow any global definition."
93 (interactive "xMouse event: \nxDefinition: ")
94 (define-mouse current-global-mousemap mouse-list def))
95
96(defun local-set-mouse (mouse-list def)
97 "Give MOUSE-EVENT-LIST a local definition of DEF.
98See define-mouse for a description of the arguments.
99The definition goes in the current buffer's local mousemap.
100Normally buffers in the same major mode share a local mousemap."
101 (interactive "xMouse event: \nxDefinition: ")
102 (if (null current-local-mousemap)
103 (setq current-local-mousemap (make-mousemap)))
104 (define-mouse current-local-mousemap mouse-list def))
105
106(defun use-global-mousemap (mousemap)
107 "Selects MOUSEMAP as the global mousemap."
108 (setq current-global-mousemap mousemap))
109
110(defun use-local-mousemap (mousemap)
111 "Selects MOUSEMAP as the local mousemap.
112nil for MOUSEMAP means no local mousemap."
113 (setq current-local-mousemap mousemap))
114
115
116;;;
117;;; Interface to the Mouse encoding defined in Emacstool.c
118;;;
119;;; Called when mouse-prefix is sent to emacs, additional
120;;; information is read in as a list (button x y time-delta)
121;;;
122;;; First, some generally useful functions:
123;;;
124
125(defun logtest (x y)
126 "True if any bits set in X are also set in Y.
127Just like the Common Lisp function of the same name."
128 (not (zerop (logand x y))))
129
130
131;;;
132;;; Hit accessors.
133;;;
134
135(defconst sm::ButtonBits 7) ; Lowest 3 bits.
136(defconst sm::ShiftmaskBits 56) ; Second lowest 3 bits (56 = 63 - 7).
137(defconst sm::DoubleBits 64) ; Bit 7.
138(defconst sm::UpBits 128) ; Bit 8.
139
140;;; All the useful code bits
141(defmacro sm::hit-code (hit)
142 `(nth 0 ,hit))
143;;; The button, or buttons if a chord.
144(defmacro sm::hit-button (hit)
145 `(logand sm::ButtonBits (nth 0 ,hit)))
146;;; The shift, control, and meta flags.
147(defmacro sm::hit-shiftmask (hit)
148 `(logand sm::ShiftmaskBits (nth 0 ,hit)))
149;;; Set if a double click (but not a chord).
150(defmacro sm::hit-double (hit)
151 `(logand sm::DoubleBits (nth 0 ,hit)))
152;;; Set on button release (as opposed to button press).
153(defmacro sm::hit-up (hit)
154 `(logand sm::UpBits (nth 0 ,hit)))
155;;; Screen x position.
156(defmacro sm::hit-x (hit) (list 'nth 1 hit))
157;;; Screen y position.
158(defmacro sm::hit-y (hit) (list 'nth 2 hit))
159;;; Milliseconds since last hit.
160(defmacro sm::hit-delta (hit) (list 'nth 3 hit))
161
162(defmacro sm::hit-up-p (hit) ; A predicate.
163 `(not (zerop (sm::hit-up ,hit))))
164
165;;;
166;;; Loc accessors. for sm::window-xy
167;;;
168(defmacro sm::loc-w (loc) (list 'nth 0 loc))
169(defmacro sm::loc-x (loc) (list 'nth 1 loc))
170(defmacro sm::loc-y (loc) (list 'nth 2 loc))
171
172(defmacro eval-in-buffer (buffer &rest forms)
173 "Macro to switches to BUFFER, evaluates FORMS, returns to original buffer."
174 ;; When you don't need the complete window context of eval-in-window
175 `(let ((StartBuffer (current-buffer)))
176 (unwind-protect
177 (progn
178 (set-buffer ,buffer)
179 ,@forms)
180 (set-buffer StartBuffer))))
181
182(put 'eval-in-buffer 'lisp-indent-function 1)
183
184;;; this is used extensively by sun-fns.el
185;;;
186(defmacro eval-in-window (window &rest forms)
187 "Switch to WINDOW, evaluate FORMS, return to original window."
188 `(let ((OriginallySelectedWindow (selected-window)))
189 (unwind-protect
190 (progn
191 (select-window ,window)
192 ,@forms)
193 (select-window OriginallySelectedWindow))))
194(put 'eval-in-window 'lisp-indent-function 1)
195
196;;;
197;;; handy utility, generalizes window_loop
198;;;
199
200;;; It's a macro (and does not evaluate its arguments).
201(defmacro eval-in-windows (form &optional yesmini)
202 "Switches to each window and evaluates FORM. Optional argument
203YESMINI says to include the minibuffer as a window.
204This is a macro, and does not evaluate its arguments."
205 `(let ((OriginallySelectedWindow (selected-window)))
206 (unwind-protect
207 (while (progn
208 ,form
209 (not (eq OriginallySelectedWindow
210 (select-window
211 (next-window nil ,yesmini))))))
212 (select-window OriginallySelectedWindow))))
213(put 'eval-in-window 'lisp-indent-function 0)
214
215(defun move-to-loc (x y)
216 "Move cursor to window location X, Y.
217Handles wrapped and horizontally scrolled lines correctly."
218 (move-to-window-line y)
219 ;; window-line-end expects this to return the window column it moved to.
220 (let ((cc (current-column))
221 (nc (move-to-column
222 (if (zerop (window-hscroll))
223 (+ (current-column)
224 (min (- (window-width) 2) ; To stay on the line.
225 x))
226 (+ (window-hscroll) -1
227 (min (1- (window-width)) ; To stay on the line.
228 x))))))
229 (- nc cc)))
230
231
232(defun minibuffer-window-p (window)
233 "True if this WINDOW is minibuffer."
234 (= (frame-height)
235 (nth 3 (window-edges window)) ; The bottom edge.
236 ))
237
238
239(defun sun-mouse-handler (&optional hit)
240 "Evaluates the function or list associated with a mouse hit.
241Expecting to read a hit, which is a list: (button x y delta).
242A form bound to button by define-mouse is found by mouse-lookup.
243The variables: *mouse-window*, *mouse-x*, *mouse-y* are bound.
244If the form is a symbol (symbolp), it is funcall'ed with *mouse-window*,
245*mouse-x*, and *mouse-y* as arguments; if the form is a list (listp),
246the form is eval'ed; if the form is neither of these, it is an error.
247Returns nil."
248 (interactive)
249 (if (null hit) (setq hit (sm::combined-hits)))
250 (let ((loc (sm::window-xy (sm::hit-x hit) (sm::hit-y hit))))
251 (let ((*mouse-window* (sm::loc-w loc))
252 (*mouse-x* (sm::loc-x loc))
253 (*mouse-y* (sm::loc-y loc))
254 (mouse-code (mouse-event-code hit loc)))
255 (let ((form (eval-in-buffer (window-buffer *mouse-window*)
256 (mouse-lookup mouse-code))))
257 (cond ((null form)
258 (if (not (sm::hit-up-p hit)) ; undefined up hits are ok.
259 (error "Undefined mouse event: %s"
260 (prin1-to-string
261 (mouse-code-to-mouse-list mouse-code)))))
262 ((symbolp form)
263 (setq this-command form)
264 (funcall form *mouse-window* *mouse-x* *mouse-y*))
265 ((listp form)
266 (setq this-command (car form))
267 (eval form))
268 (t
269 (error "Mouse action must be symbol or list, but was: %s"
270 form))))))
271 ;; Don't let 'sun-mouse-handler get on last-command,
272 ;; since this function should be transparent.
273 (if (eq this-command 'sun-mouse-handler)
274 (setq this-command last-command))
275 ;; (message (prin1-to-string this-command)) ; to see what your buttons did
276 nil)
277
278(defun sm::combined-hits ()
279 "Read and return next mouse-hit, include possible double click"
280 (let ((hit1 (mouse-hit-read)))
281 (if (not (sm::hit-up-p hit1)) ; Up hits don't start doubles or chords.
282 (let ((hit2 (mouse-second-hit extra-click-wait)))
283 (if hit2 ; we cons'd it, we can smash it.
284 ; (setf (sm::hit-code hit1) (logior (sm::hit-code hit1) ...))
285 (setcar hit1 (logior (sm::hit-code hit1)
286 (sm::hit-code hit2)
287 (if (= (sm::hit-button hit1)
288 (sm::hit-button hit2))
289 sm::DoubleBits 0))))))
290 hit1))
291
292(defun mouse-hit-read ()
293 "Read mouse-hit list from keyboard. Like (read 'read-char),
294but that uses minibuffer, and mucks up last-command."
295 (let ((char-list nil) (char nil))
296 (while (not (equal 13 ; Carriage return.
297 (prog1 (setq char (read-char))
298 (setq char-list (cons char char-list))))))
299 (read (mapconcat 'char-to-string (nreverse char-list) ""))
300 ))
301
302;;; Second Click Hackery....
303;;; if prefix is not mouse-prefix, need a way to unread the char...
304;;; or else have mouse flush input queue, or else need a peek at next char.
305
306;;; There is no peek, but since one character can be unread, we only
307;;; have to flush the queue when the command after a mouse click
308;;; starts with mouse-prefix1 (see below).
309;;; Something to do later: We could buffer the read commands and
310;;; execute them ourselves after doing the mouse command (using
311;;; lookup-key ??).
312
313(defvar mouse-prefix1 24 ; C-x
314 "First char of mouse-prefix. Used to detect double clicks and chords.")
315
316(defvar mouse-prefix2 0 ; C-@
317 "Second char of mouse-prefix. Used to detect double clicks and chords.")
318
319
320(defun mouse-second-hit (hit-wait)
321 "Returns the next mouse hit occurring within HIT-WAIT milliseconds."
322 (if (sit-for-millisecs hit-wait) nil ; No input within hit-wait millisecs.
323 (let ((pc1 (read-char)))
324 (if (or (not (equal pc1 mouse-prefix1))
325 (sit-for-millisecs 3)) ; a mouse prefix will have second char
326 ;; Can get away with one unread.
327 (progn (setq unread-command-events (list pc1))
328 nil) ; Next input not mouse event.
329 (let ((pc2 (read-char)))
330 (if (not (equal pc2 mouse-prefix2))
331 (progn (setq unread-command-events (list pc1)) ; put back the ^X
332;;; Too bad can't do two: (setq unread-command-event (list pc1 pc2))
333;;; Well, now we can, but I don't understand this code well enough to fix it...
334 (ding) ; user will have to retype that pc2.
335 nil) ; This input is not a mouse event.
336 ;; Next input has mouse prefix and is within time limit.
337 (let ((new-hit (mouse-hit-read))) ; Read the new hit.
338 (if (sm::hit-up-p new-hit) ; Ignore up events when timing.
339 (mouse-second-hit (- hit-wait (sm::hit-delta new-hit)))
340 new-hit ; New down hit within limit, return it.
341 ))))))))
342
343(defun sm::window-xy (x y)
344 "Find window containing screen coordinates X and Y.
345Returns list (window x y) where x and y are relative to window."
346 (or
347 (catch 'found
348 (eval-in-windows
349 (let ((we (window-edges (selected-window))))
350 (let ((le (nth 0 we))
351 (te (nth 1 we))
352 (re (nth 2 we))
353 (be (nth 3 we)))
354 (if (= re (frame-width))
355 ;; include the continuation column with this window
356 (setq re (1+ re)))
357 (if (= be (frame-height))
358 ;; include partial line at bottom of frame with this window
359 ;; id est, if window is not multiple of char size.
360 (setq be (1+ be)))
361
362 (if (and (>= x le) (< x re)
363 (>= y te) (< y be))
364 (throw 'found
365 (list (selected-window) (- x le) (- y te))))))
366 t)) ; include minibuffer in eval-in-windows
367 ;;If x,y from a real mouse click, we shouldn't get here.
368 (list nil x y)
369 ))
370
371(defun sm::window-region (loc)
372 "Parse LOC into a region symbol.
373Returns one of (text scrollbar modeline minibuffer)"
374 (let ((w (sm::loc-w loc))
375 (x (sm::loc-x loc))
376 (y (sm::loc-y loc)))
377 (let ((right (1- (window-width w)))
378 (bottom (1- (window-height w))))
379 (cond ((minibuffer-window-p w) 'minibuffer)
380 ((>= y bottom) 'modeline)
381 ((>= x right) 'scrollbar)
382 ;; far right column (window separator) is always a scrollbar
383 ((and scrollbar-width
384 ;; mouse within scrollbar-width of edge.
385 (>= x (- right scrollbar-width))
386 ;; mouse a few chars past the end of line.
387 (>= x (+ 2 (window-line-end w x y))))
388 'scrollbar)
389 (t 'text)))))
390
391(defun window-line-end (w x y)
392 "Return WINDOW column (ignore X) containing end of line Y"
393 (eval-in-window w (save-excursion (move-to-loc (frame-width) y))))
394
395;;;
396;;; The encoding of mouse events into a mousemap.
397;;; These values must agree with coding in emacstool:
398;;;
399(defconst sm::keyword-alist
400 '((left . 1) (middle . 2) (right . 4)
401 (shift . 8) (control . 16) (meta . 32) (double . 64) (up . 128)
402 (text . 256) (scrollbar . 512) (modeline . 1024) (minibuffer . 2048)
403 ))
404
405(defun mouse-event-code (hit loc)
406 "Maps MOUSE-HIT and LOC into a mouse-code."
407;;;Region is a code for one of text, modeline, scrollbar, or minibuffer.
408 (logior (sm::hit-code hit)
409 (mouse-region-to-code (sm::window-region loc))))
410
411(defun mouse-region-to-code (region)
412 "Returns partial mouse-code for specified REGION."
413 (cdr (assq region sm::keyword-alist)))
414
415(defun mouse-list-to-mouse-code (mouse-list)
416 "Map a MOUSE-LIST to a mouse-code."
417 (apply 'logior
418 (mapcar (function (lambda (x)
419 (cdr (assq x sm::keyword-alist))))
420 mouse-list)))
421
422(defun mouse-code-to-mouse-list (mouse-code)
423 "Map a MOUSE-CODE to a mouse-list."
424 (apply 'nconc (mapcar
425 (function (lambda (x)
426 (if (logtest mouse-code (cdr x))
427 (list (car x)))))
428 sm::keyword-alist)))
429
430(defun mousemap-set (code mousemap value)
431 (let* ((alist (cdr mousemap))
432 (assq-result (assq code alist)))
433 (if assq-result
434 (setcdr assq-result value)
435 (setcdr mousemap (cons (cons code value) alist)))))
436
437(defun mousemap-get (code mousemap)
438 (cdr (assq code (cdr mousemap))))
439
440(defun mouse-lookup (mouse-code)
441 "Look up MOUSE-EVENT and return the definition. nil means undefined."
442 (or (mousemap-get mouse-code current-local-mousemap)
443 (mousemap-get mouse-code current-global-mousemap)))
444
445;;;
446;;; I (jpeck) don't understand the utility of the next four functions
447;;; ask Steven Greenbaum <froud@kestrel>
448;;;
449(defun mouse-mask-lookup (mask list)
450 "Args MASK (a bit mask) and LIST (a list of (code . form) pairs).
451Returns a list of elements of LIST whose code or'ed with MASK is non-zero."
452 (let ((result nil))
453 (while list
454 (if (logtest mask (car (car list)))
455 (setq result (cons (car list) result)))
456 (setq list (cdr list)))
457 result))
458
459(defun mouse-union (l l-unique)
460 "Return the union of list of mouse (code . form) pairs L and L-UNIQUE,
461where L-UNIQUE is considered to be union'ized already."
462 (let ((result l-unique))
463 (while l
464 (let ((code-form-pair (car l)))
465 (if (not (assq (car code-form-pair) result))
466 (setq result (cons code-form-pair result))))
467 (setq l (cdr l)))
468 result))
469
470(defun mouse-union-first-preferred (l1 l2)
471 "Return the union of lists of mouse (code . form) pairs L1 and L2,
472based on the code's, with preference going to elements in L1."
473 (mouse-union l2 (mouse-union l1 nil)))
474
475(defun mouse-code-function-pairs-of-region (region)
476 "Return a list of (code . function) pairs, where each code is
477currently set in the REGION."
478 (let ((mask (mouse-region-to-code region)))
479 (mouse-union-first-preferred
480 (mouse-mask-lookup mask (cdr current-local-mousemap))
481 (mouse-mask-lookup mask (cdr current-global-mousemap))
482 )))
483
484;;;
485;;; Functions for DESCRIBE-MOUSE-BINDINGS
486;;; And other mouse documentation functions
487;;; Still need a good procedure to print out a help sheet in readable format.
488;;;
489
490(defun one-line-doc-string (function)
491 "Returns first line of documentation string for FUNCTION.
492If there is no documentation string, then the string
493\"No documentation\" is returned."
494 (while (consp function) (setq function (car function)))
495 (let ((doc (documentation function)))
496 (if (null doc)
497 "No documentation."
498 (string-match "^.*$" doc)
499 (substring doc 0 (match-end 0)))))
500
501(defun print-mouse-format (binding)
502 (princ (car binding))
503 (princ ": ")
504 (mapc (function
505 (lambda (mouse-list)
506 (princ mouse-list)
507 (princ " ")))
508 (cdr binding))
509 (terpri)
510 (princ " ")
511 (princ (one-line-doc-string (car binding)))
512 (terpri)
513 )
514
515(defun print-mouse-bindings (region)
516 "Prints mouse-event bindings for REGION."
517 (mapcar 'print-mouse-format (sm::event-bindings region)))
518
519(defun sm::event-bindings (region)
520 "Returns an alist of (function . (mouse-list1 ... mouse-listN)) for REGION,
521where each mouse-list is bound to the function in REGION."
522 (let ((mouse-bindings (mouse-code-function-pairs-of-region region))
523 (result nil))
524 (while mouse-bindings
525 (let* ((code-function-pair (car mouse-bindings))
526 (current-entry (assoc (cdr code-function-pair) result)))
527 (if current-entry
528 (setcdr current-entry
529 (cons (mouse-code-to-mouse-list (car code-function-pair))
530 (cdr current-entry)))
531 (setq result (cons (cons (cdr code-function-pair)
532 (list (mouse-code-to-mouse-list
533 (car code-function-pair))))
534 result))))
535 (setq mouse-bindings (cdr mouse-bindings))
536 )
537 result))
538
539(defun describe-mouse-bindings ()
540 "Lists all current mouse-event bindings."
541 (interactive)
542 (with-output-to-temp-buffer "*Help*"
543 (princ "Text Region") (terpri)
544 (princ "---- ------") (terpri)
545 (print-mouse-bindings 'text) (terpri)
546 (princ "Modeline Region") (terpri)
547 (princ "-------- ------") (terpri)
548 (print-mouse-bindings 'modeline) (terpri)
549 (princ "Scrollbar Region") (terpri)
550 (princ "--------- ------") (terpri)
551 (print-mouse-bindings 'scrollbar)))
552
553(defun describe-mouse-briefly (mouse-list)
554 "Print a short description of the function bound to MOUSE-LIST."
555 (interactive "xDescribe mouse list briefly: ")
556 (let ((function (mouse-lookup (mouse-list-to-mouse-code mouse-list))))
557 (if function
558 (message "%s runs the command %s" mouse-list function)
559 (message "%s is undefined" mouse-list))))
560
561(defun mouse-help-menu (function-and-binding)
562 (cons (prin1-to-string (car function-and-binding))
563 (menu-create ; Two sub-menu items of form ("String" . nil)
564 (list (list (one-line-doc-string (car function-and-binding)))
565 (list (prin1-to-string (cdr function-and-binding)))))))
566
567(defun mouse-help-region (w x y &optional region)
568 "Displays a menu of mouse functions callable in this region."
569 (let* ((region (or region (sm::window-region (list w x y))))
570 (mlist (mapcar (function mouse-help-menu)
571 (sm::event-bindings region)))
572 (menu (menu-create (cons (list (symbol-name region)) mlist)))
573 (item (sun-menu-evaluate w 0 y menu))
574 )))
575
576;;;
577;;; Menu interface functions
578;;;
579;;; use defmenu, because this interface is subject to change
580;;; really need a menu-p, but we use vectorp and the context...
581;;;
582(defun menu-create (items)
583 "Functional form for defmenu, given a list of ITEMS returns a menu.
584Each ITEM is a (STRING . VALUE) pair."
585 (apply 'vector items)
586 )
587
588(defmacro defmenu (menu &rest itemlist)
589 "Defines MENU to be a menu, the ITEMS are (STRING . VALUE) pairs.
590See sun-menu-evaluate for interpretation of ITEMS."
591 (list 'defconst menu (funcall 'menu-create itemlist))
592 )
593
594(defun sun-menu-evaluate (*menu-window* *menu-x* *menu-y* menu)
595 "Display a pop-up menu in WINDOW at X Y and evaluate selected item
596of MENU. MENU (or its symbol-value) should be a menu defined by defmenu.
597 A menu ITEM is a (STRING . FORM) pair;
598the FORM associated with the selected STRING is evaluated,
599and the resulting value is returned. Generally these FORMs are
600evaluated for their side-effects rather than their values.
601 If the selected form is a menu or a symbol whose value is a menu,
602then it is displayed and evaluated as a pullright menu item.
603 If the FORM of the first ITEM is nil, the STRING of the item
604is used as a label for the menu, i.e. it's inverted and not selectable."
605
606 (if (symbolp menu) (setq menu (symbol-value menu)))
607 (eval (sun-menu-internal *menu-window* *menu-x* *menu-y* 4 menu)))
608
609(defun sun-get-frame-data (code)
610 "Sends the tty-sub-window escape sequence CODE to terminal,
611and returns a cons of the two numbers in returned escape sequence.
612That is it returns (cons <car> <cdr>) from \"\\E[n;<car>;<cdr>t\".
613CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars."
614 (send-string-to-terminal (concat "\033[" (int-to-string code) "t"))
615 (let (char str x y)
616 (while (not (equal 116 (setq char (read-char)))) ; #\t = 116
617 (setq str (cons char str)))
618 (setq str (mapconcat 'char-to-string (nreverse str) ""))
619 (string-match ";[0-9]*" str)
620 (setq y (substring str (1+ (match-beginning 0)) (match-end 0)))
621 (setq str (substring str (match-end 0)))
622 (string-match ";[0-9]*" str)
623 (setq x (substring str (1+ (match-beginning 0)) (match-end 0)))
624 (cons (string-to-number y) (string-to-number x))))
625
626(defun sm::font-size ()
627 "Returns font size in pixels: (cons Ysize Xsize)"
628 (let ((pix (sun-get-frame-data 14)) ; returns size in pixels
629 (chr (sun-get-frame-data 18))) ; returns size in chars
630 (cons (/ (car pix) (car chr)) (/ (cdr pix) (cdr chr)))))
631
632(defvar sm::menu-kludge-x nil
633 "Cached frame-to-window X-Offset for sm::menu-kludge")
634(defvar sm::menu-kludge-y nil
635 "Cached frame-to-window Y-Offset for sm::menu-kludge")
636
637(defun sm::menu-kludge ()
638 "If sunfns.c uses <Menu_Base_Kludge> this function must be here!"
639 (or sm::menu-kludge-y
640 (let ((fs (sm::font-size)))
641 (setq sm::menu-kludge-y (+ 8 (car fs)) ; a title line and borders
642 sm::menu-kludge-x 4))) ; best values depend on .defaults/Menu
643 (let ((wl (sun-get-frame-data 13))) ; returns frame location
644 (cons (+ (car wl) sm::menu-kludge-y)
645 (+ (cdr wl) sm::menu-kludge-x))))
646
647;;;
648;;; Function interface to selection/region
649;;; primitive functions are defined in sunfns.c
650;;;
651(defun sun-yank-selection ()
652 "Set mark and yank the contents of the current sunwindows selection.
653Insert contents into the current buffer at point."
654 (interactive "*")
655 (set-mark-command nil)
656 (insert (sun-get-selection)))
657
658(defun sun-select-region (beg end)
659 "Set the sunwindows selection to the region in the current buffer."
660 (interactive "r")
661 (sun-set-selection (buffer-substring beg end)))
662
663(provide 'sun-mouse)
664(provide 'term/sun-mouse) ; have to (require 'term/sun-mouse)
665
666;;; arch-tag: 6e879372-b899-4509-833f-d7f6250e309a
667;;; sun-mouse.el ends here
diff --git a/lisp/term/sun.el b/lisp/term/sun.el
index 4736e57340c..22b29c92790 100644
--- a/lisp/term/sun.el
+++ b/lisp/term/sun.el
@@ -47,14 +47,6 @@
47 (setq this-command 'kill-region-and-unmark) 47 (setq this-command 'kill-region-and-unmark)
48 (set-mark-command t)) 48 (set-mark-command t))
49 49
50(defun select-previous-complex-command ()
51 "Select Previous-complex-command"
52 (interactive)
53 (if (zerop (minibuffer-depth))
54 (repeat-complex-command 1)
55 ;; FIXME: this function does not seem to exist. -stef'01
56 (previous-complex-command 1)))
57
58(defun rerun-prev-command () 50(defun rerun-prev-command ()
59 "Repeat Previous-complex-command." 51 "Repeat Previous-complex-command."
60 (interactive) 52 (interactive)
diff --git a/src/ChangeLog b/src/ChangeLog
index 638ca30e047..4e93e3937f6 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
12007-11-01 Dan Nicolaescu <dann@ics.uci.edu>
2
3 * sunfns.c: Remove file
4
5 * m/sun386.h:
6 * m/sun2.h:
7 * m/sparc.h: Remove Sun windows code.
8
12007-10-31 Stefan Monnier <monnier@iro.umontreal.ca> 92007-10-31 Stefan Monnier <monnier@iro.umontreal.ca>
2 10
3 * keyboard.c (syms_of_keyboard): Initialize the initial_kboard. 11 * keyboard.c (syms_of_keyboard): Initialize the initial_kboard.
diff --git a/src/m/sparc.h b/src/m/sparc.h
index 8df81ee91aa..bf122d857cc 100644
--- a/src/m/sparc.h
+++ b/src/m/sparc.h
@@ -64,18 +64,6 @@ NOTE-END */
64 64
65#define SEGMENT_MASK (SEGSIZ - 1) 65#define SEGMENT_MASK (SEGSIZ - 1)
66 66
67/* Arrange to link with sun windows, if requested. */
68/* For details on emacstool and sunfns, see etc/SUN-SUPPORT */
69/* These programs require Sun UNIX 4.2 Release 3.2 or greater */
70
71#ifdef HAVE_SUN_WINDOWS
72#define OTHER_FILES ${etcdir}emacstool
73#define LIBS_MACHINE -lsuntool -lsunwindow -lpixrect
74#define OBJECTS_MACHINE sunfns.o
75#define SYMS_MACHINE syms_of_sunfns ()
76#define PURESIZE 130000
77#endif
78
79#if !defined (__NetBSD__) && !defined (__linux__) && !defined (__OpenBSD__) 67#if !defined (__NetBSD__) && !defined (__linux__) && !defined (__OpenBSD__)
80/* This really belongs in s/sun.h. */ 68/* This really belongs in s/sun.h. */
81 69
diff --git a/src/m/sun2.h b/src/m/sun2.h
index e764ded3ce7..a872bf6f3bb 100644
--- a/src/m/sun2.h
+++ b/src/m/sun2.h
@@ -85,17 +85,5 @@ NOTE-END */
85 85
86#define SEGMENT_MASK (SEGSIZ - 1) 86#define SEGMENT_MASK (SEGSIZ - 1)
87 87
88/* Arrange to link with sun windows, if requested. */
89/* For details on emacstool and sunfns, see etc/SUN-SUPPORT */
90/* These programs require Sun UNIX 4.2 Release 3.2 or greater */
91
92#ifdef HAVE_SUN_WINDOWS
93#define OTHER_FILES ${libsrc}emacstool
94#define LIBS_MACHINE -lsuntool -lsunwindow -lpixrect
95#define OBJECTS_MACHINE sunfns.o
96#define SYMS_MACHINE syms_of_sunfns ()
97#define PURESIZE 132000
98#endif
99
100/* arch-tag: 543c3570-74ca-4099-aa47-db7c7b691c8e 88/* arch-tag: 543c3570-74ca-4099-aa47-db7c7b691c8e
101 (do not change this comment) */ 89 (do not change this comment) */
diff --git a/src/m/sun386.h b/src/m/sun386.h
index a3eedbe755e..ed98960c809 100644
--- a/src/m/sun386.h
+++ b/src/m/sun386.h
@@ -56,18 +56,6 @@ NOTE-END */
56 56
57#define LIBS_TERMCAP -ltermcap 57#define LIBS_TERMCAP -ltermcap
58 58
59/* Arrange to link with sun windows, if requested. */
60/* For details on emacstool and sunfns, see etc/SUN-SUPPORT */
61/* These programs require Sun UNIX 4.2 Release 3.2 or greater */
62
63#ifdef HAVE_SUN_WINDOWS
64#define OTHER_FILES ${etcdir}emacstool
65#define LIBS_MACHINE -lsuntool -lsunwindow -lpixrect
66#define OBJECTS_MACHINE sunfns.o
67#define SYMS_MACHINE syms_of_sunfns ()
68#define PURESIZE 132000
69#endif
70
71/* Roadrunner uses 'COFF' format */ 59/* Roadrunner uses 'COFF' format */
72#define COFF 60#define COFF
73 61
diff --git a/src/sunfns.c b/src/sunfns.c
deleted file mode 100644
index 86e64cbcdcc..00000000000
--- a/src/sunfns.c
+++ /dev/null
@@ -1,519 +0,0 @@
1/* Functions for Sun Windows menus and selection buffer.
2 Copyright (C) 1987, 1999, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007 Free Software Foundation, Inc.
4
5This file is probably totally obsolete. In any case, the FSF is
6unwilling to support it. We agreed to include it in our distribution
7only on the understanding that we would spend no time at all on it.
8
9If you have complaints about this file, send them to peck@sun.com.
10If no one at Sun wants to maintain this, then consider it not
11maintained at all. It would be a bad thing for the GNU project if
12this file took our effort away from higher-priority things.
13
14
15This file is part of GNU Emacs.
16
17GNU Emacs is free software; you can redistribute it and/or modify
18it under the terms of the GNU General Public License as published by
19the Free Software Foundation; either version 3, or (at your option)
20any later version.
21
22GNU Emacs is distributed in the hope that it will be useful,
23but WITHOUT ANY WARRANTY; without even the implied warranty of
24MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25GNU General Public License for more details.
26
27You should have received a copy of the GNU General Public License
28along with GNU Emacs; see the file COPYING. If not, write to
29the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
30Boston, MA 02110-1301, USA. */
31
32/* Author: Jeff Peck, Sun Microsystems, Inc. <peck@sun.com>
33Original ideas by David Kastan and Eric Negaard, SRI International
34Major help from: Steve Greenbaum, Reasoning Systems, Inc.
35 <froud@kestrel.arpa>
36who first discovered the Menu_Base_Kludge.
37 */
38
39/*
40 * Emacs Lisp-Callable functions for sunwindows
41 */
42#include <config.h>
43
44#include <stdio.h>
45#include <errno.h>
46#include <signal.h>
47#include <sunwindow/window_hs.h>
48#include <suntool/selection.h>
49#include <suntool/menu.h>
50#include <suntool/walkmenu.h>
51#include <suntool/frame.h>
52#include <suntool/window.h>
53
54#include <fcntl.h>
55#undef NULL /* We don't need sunview's idea of NULL */
56#include "lisp.h"
57#include "window.h"
58#include "buffer.h"
59#include "termhooks.h"
60
61/* conversion to/from character & frame coordinates */
62/* From Gosling Emacs SunWindow driver by Chris Torek */
63
64/* Chars to frame coords. Note that we speak in zero origin. */
65#define CtoSX(cx) ((cx) * Sun_Font_Xsize)
66#define CtoSY(cy) ((cy) * Sun_Font_Ysize)
67
68/* Frame coords to chars */
69#define StoCX(sx) ((sx) / Sun_Font_Xsize)
70#define StoCY(sy) ((sy) / Sun_Font_Ysize)
71
72#define CHECK_GFX(x) if((win_fd<0)&&(Fsun_window_init(),(win_fd<0)))return(x)
73int win_fd = -1;
74struct pixfont *Sun_Font; /* The font */
75int Sun_Font_Xsize; /* Width of font */
76int Sun_Font_Ysize; /* Height of font */
77
78#define Menu_Base_Kludge /* until menu_show_using_fd gets fixed */
79#ifdef Menu_Base_Kludge
80static Frame Menu_Base_Frame;
81static int Menu_Base_fd;
82static Lisp_Object sm_kludge_string;
83#endif
84struct cursor CurrentCursor; /* The current cursor */
85
86static short CursorData[16]; /* Build cursor here */
87static mpr_static(CursorMpr, 16, 16, 1, CursorData);
88static struct cursor NewCursor = {0, 0, PIX_SRC ^ PIX_DST, &CursorMpr};
89
90#define RIGHT_ARROW_CURSOR /* if you want the right arrow */
91#ifdef RIGHT_ARROW_CURSOR
92/* The default right-arrow cursor, with XOR drawing. */
93static short ArrowCursorData[16] = {
94 0x0001,0x0003,0x0007,0x000F,0x001F,0x003F,0x007F,0x000F,
95 0x001B,0x0019,0x0030,0x0030,0x0060,0x0060,0x00C0,0x00C0};
96static mpr_static(ArrowCursorMpr, 16, 16, 1, ArrowCursorData);
97struct cursor DefaultCursor = {15, 0, PIX_SRC ^ PIX_DST, &ArrowCursorMpr};
98
99#else
100/* The default left-arrow cursor, with XOR drawing. */
101static short ArrowCursorData[16] = {
102 0x8000,0xC000,0xE000,0xF000,0xF800,0xFC00,0xFE00,0xF000,
103 0xD800,0x9800,0x0C00,0x0C00,0x0600,0x0600,0x0300,0x0300};
104static mpr_static(ArrowCursorMpr, 16, 16, 1, ArrowCursorData);
105struct cursor DefaultCursor = {0, 0, PIX_SRC ^ PIX_DST, &ArrowCursorMpr};
106#endif
107
108/*
109 * Initialize window
110 */
111DEFUN ("sun-window-init", Fsun_window_init, Ssun_window_init, 0, 1, 0,
112 doc: /* One time setup for using Sun Windows with mouse.
113Unless optional argument FORCE is non-nil, is a noop after its first call.
114Returns a number representing the file descriptor of the open Sun Window,
115or -1 if can not open it. */)
116 (force)
117 Lisp_Object force;
118{
119 char *cp;
120 static int already_initialized = 0;
121
122 if ((! already_initialized) || (!NILP(force))) {
123 cp = getenv("WINDOW_GFX");
124 if (cp != 0) win_fd = emacs_open (cp, O_RDWR, 0);
125 if (win_fd > 0)
126 {
127 Sun_Font = pf_default();
128 Sun_Font_Xsize = Sun_Font->pf_defaultsize.x;
129 Sun_Font_Ysize = Sun_Font->pf_defaultsize.y;
130 Fsun_change_cursor_icon (Qnil); /* set up the default cursor */
131 already_initialized = 1;
132#ifdef Menu_Base_Kludge
133
134 /* Make a frame to use for putting the menu on, and get its fd. */
135 Menu_Base_Frame = window_create(0, FRAME,
136 WIN_X, 0, WIN_Y, 0,
137 WIN_ROWS, 1, WIN_COLUMNS, 1,
138 WIN_SHOW, FALSE,
139 FRAME_NO_CONFIRM, 1,
140 0);
141 Menu_Base_fd = (int) window_get(Menu_Base_Frame, WIN_FD);
142#endif
143 }
144 }
145 return(make_number(win_fd));
146}
147
148/*
149 * Mouse sit-for (allows a shorter interval than the regular sit-for
150 * and can be interrupted by the mouse)
151 */
152DEFUN ("sit-for-millisecs", Fsit_for_millisecs, Ssit_for_millisecs, 1, 1, 0,
153 doc: /* Like sit-for, but ARG is milliseconds.
154Perform redisplay, then wait for ARG milliseconds or until
155input is available. Returns t if wait completed with no input.
156Redisplay does not happen if input is available before it starts. */)
157 (n)
158 Lisp_Object n;
159{
160 struct timeval Timeout;
161 int waitmask = 1;
162
163 CHECK_NUMBER (n);
164 Timeout.tv_sec = XINT(n) / 1000;
165 Timeout.tv_usec = (XINT(n) - (Timeout.tv_sec * 1000)) * 1000;
166
167 if (detect_input_pending()) return(Qnil);
168 redisplay_preserve_echo_area (16);
169 /*
170 * Check for queued keyboard input/mouse hits again
171 * (A bit screen update can take some time!)
172 */
173 if (detect_input_pending()) return(Qnil);
174 select(1,&waitmask,0,0,&Timeout);
175 if (detect_input_pending()) return(Qnil);
176 return(Qt);
177}
178
179/*
180 * Sun sleep-for (allows a shorter interval than the regular sleep-for)
181 */
182DEFUN ("sleep-for-millisecs",
183 Fsleep_for_millisecs,
184 Ssleep_for_millisecs, 1, 1, 0,
185 doc: /* Pause, without updating display, for ARG milliseconds. */)
186 (n)
187 Lisp_Object n;
188{
189 unsigned useconds;
190
191 CHECK_NUMBER (n);
192 useconds = XINT(n) * 1000;
193 usleep(useconds);
194 return(Qt);
195}
196
197DEFUN ("update-display", Fupdate_display, Supdate_display, 0, 0, 0,
198 doc: /* Perform redisplay. */)
199 ()
200{
201 redisplay_preserve_echo_area (17);
202 return(Qt);
203}
204
205
206/*
207 * Change the Sun mouse icon
208 */
209DEFUN ("sun-change-cursor-icon",
210 Fsun_change_cursor_icon,
211 Ssun_change_cursor_icon, 1, 1, 0,
212 doc: /* Change the Sun mouse cursor icon.
213ICON is a lisp vector whose 1st element
214is the X offset of the cursor hot-point, whose 2nd element is the Y offset
215of the cursor hot-point and whose 3rd element is the cursor pixel data
216expressed as a string. If ICON is nil then the original arrow cursor is used. */)
217 (Icon)
218 Lisp_Object Icon;
219{
220 register unsigned char *cp;
221 register short *p;
222 register int i;
223 Lisp_Object X_Hot, Y_Hot, Data;
224
225 CHECK_GFX (Qnil);
226 /*
227 * If the icon is null, we just restore the DefaultCursor
228 */
229 if (NILP(Icon))
230 CurrentCursor = DefaultCursor;
231 else {
232 /*
233 * extract the data from the vector
234 */
235 CHECK_VECTOR (Icon);
236 if (XVECTOR(Icon)->size < 3) return(Qnil);
237 X_Hot = XVECTOR(Icon)->contents[0];
238 Y_Hot = XVECTOR(Icon)->contents[1];
239 Data = XVECTOR(Icon)->contents[2];
240
241 CHECK_NUMBER (X_Hot);
242 CHECK_NUMBER (Y_Hot);
243 CHECK_STRING (Data);
244 if (SCHARS (Data) != 32) return(Qnil);
245 /*
246 * Setup the new cursor
247 */
248 NewCursor.cur_xhot = X_Hot;
249 NewCursor.cur_yhot = Y_Hot;
250 cp = SDATA (Data);
251 p = CursorData;
252 i = 16;
253 while(--i >= 0)
254 *p++ = (cp[0] << 8) | cp[1], cp += 2;
255 CurrentCursor = NewCursor;
256 }
257 win_setcursor(win_fd, &CurrentCursor);
258 return(Qt);
259}
260
261/*
262 * Interface for sunwindows selection
263 */
264static Lisp_Object Current_Selection;
265
266static
267sel_write (sel, file)
268 struct selection *sel;
269 FILE *file;
270{
271 fwrite (SDATA (Current_Selection), sizeof (char),
272 sel->sel_items, file);
273}
274
275static
276sel_clear (sel, windowfd)
277 struct selection *sel;
278 int windowfd;
279{
280}
281
282static
283sel_read (sel, file)
284 struct selection *sel;
285 FILE *file;
286{
287 register int i, n;
288 register char *cp;
289
290 Current_Selection = empty_unibyte_string;
291 if (sel->sel_items <= 0)
292 return (0);
293 cp = (char *) malloc(sel->sel_items);
294 if (cp == (char *)0) {
295 error("malloc failed in sel_read");
296 return(-1);
297 }
298 n = fread(cp, sizeof(char), sel->sel_items, file);
299 if (n > sel->sel_items) {
300 error("fread botch in sel_read");
301 return(-1);
302 } else if (n < 0) {
303 error("Error reading selection");
304 return(-1);
305 }
306 /*
307 * The shelltool select saves newlines as carriage returns,
308 * but emacs wants newlines.
309 */
310 for (i = 0; i < n; i++)
311 if (cp[i] == '\r') cp[i] = '\n';
312
313 Current_Selection = make_string (cp, n);
314 free (cp);
315 return (0);
316}
317
318/*
319 * Set the window system "selection" to be the arg STRING
320 */
321DEFUN ("sun-set-selection", Fsun_set_selection, Ssun_set_selection, 1, 1,
322 "sSet selection to: ",
323 doc: /* Set the current sunwindow selection to STRING. */)
324 (str)
325 Lisp_Object str;
326{
327 struct selection selection;
328
329 CHECK_STRING (str);
330 Current_Selection = str;
331
332 CHECK_GFX (Qnil);
333 selection.sel_type = SELTYPE_CHAR;
334 selection.sel_items = SCHARS (str);
335 selection.sel_itembytes = 1;
336 selection.sel_pubflags = 1;
337 selection_set(&selection, sel_write, sel_clear, win_fd);
338 return (Qt);
339}
340/*
341 * Stuff the current window system selection into the current buffer
342 */
343DEFUN ("sun-get-selection", Fsun_get_selection, Ssun_get_selection, 0, 0, 0,
344 doc: /* Return the current sunwindows selection as a string. */)
345 ()
346{
347 CHECK_GFX (Current_Selection);
348 selection_get (sel_read, win_fd);
349 return (Current_Selection);
350}
351
352Menu sun_menu_create();
353
354Menu_item
355sun_item_create (Pair)
356 Lisp_Object Pair;
357{
358 /* In here, we depend on Lisp supplying zero terminated strings in the data*/
359 /* so we can just pass the pointers, and not recopy anything */
360
361 Menu_item menu_item;
362 Menu submenu;
363 Lisp_Object String;
364 Lisp_Object Value;
365
366 CHECK_LIST_CONS (Pair, Pair);
367 String = Fcar(Pair);
368 CHECK_STRING(String);
369 Value = Fcdr(Pair);
370 if (SYMBOLP (Value))
371 Value = SYMBOL_VALUE (Value);
372 if (VECTORP (Value)) {
373 submenu = sun_menu_create (Value);
374 menu_item = menu_create_item
375 (MENU_RELEASE, MENU_PULLRIGHT_ITEM, SDATA (String), submenu, 0);
376 } else {
377 menu_item = menu_create_item
378 (MENU_RELEASE, MENU_STRING_ITEM, SDATA (String), Value, 0);
379 }
380 return menu_item;
381}
382
383Menu
384sun_menu_create (Vector)
385 Lisp_Object Vector;
386{
387 Menu menu;
388 int i;
389 CHECK_VECTOR(Vector);
390 menu=menu_create(0);
391 for(i = 0; i < XVECTOR(Vector)->size; i++) {
392 menu_set (menu, MENU_APPEND_ITEM,
393 sun_item_create(XVECTOR(Vector)->contents[i]), 0);
394 }
395 return menu;
396}
397
398/*
399 * If the first item of the menu has nil as its value, then make the
400 * item look like a label by inverting it and making it unselectable.
401 * Returns 1 if the label was made, 0 otherwise.
402 */
403int
404make_menu_label (menu)
405 Menu menu;
406{
407 int made_label_p = 0;
408
409 if (( menu_get(menu, MENU_NITEMS) > 0 ) && /* At least one item */
410 ((Lisp_Object) menu_get(menu_get(menu, MENU_NTH_ITEM, 1),
411 MENU_VALUE) == Qnil )) {
412 menu_set(menu_get(menu, MENU_NTH_ITEM, 1),
413 MENU_INVERT, TRUE,
414 MENU_FEEDBACK, FALSE,
415 0);
416 made_label_p = 1;
417 }
418 return made_label_p;
419}
420
421/*
422 * Do a pop-up menu and return the selected value
423 */
424DEFUN ("sun-menu-internal",
425 Fsun_menu_internal,
426 Ssun_menu_internal, 5, 5, 0,
427 doc: /* Set up a SunView pop-up menu and return the user's choice.
428Arguments WINDOW, X, Y, BUTTON, and MENU.
429*** User code should generally use sun-menu-evaluate ***
430
431Arguments WINDOW, X, Y, BUTTON, and MENU.
432Put MENU up in WINDOW at position X, Y.
433The BUTTON argument specifies the button to be released that selects an item:
434 1 = LEFT BUTTON
435 2 = MIDDLE BUTTON
436 4 = RIGHT BUTTON
437The MENU argument is a vector containing (STRING . VALUE) pairs.
438The VALUE of the selected item is returned.
439If the VALUE of the first pair is nil, then the first STRING will be used
440as a menu label. */)
441 (window, X_Position, Y_Position, Button, MEnu)
442 Lisp_Object window, X_Position, Y_Position, Button, MEnu;
443{
444 Menu menu;
445 int button, xpos, ypos;
446 Event event0;
447 Event *event = &event0;
448 Lisp_Object Value, Pair;
449
450 CHECK_NUMBER(X_Position);
451 CHECK_NUMBER(Y_Position);
452 CHECK_LIVE_WINDOW(window);
453 CHECK_NUMBER(Button);
454 CHECK_VECTOR(MEnu);
455
456 CHECK_GFX (Qnil);
457
458 xpos = CtoSX (WINDOW_LEFT_EDGE_COL (XWINDOW (window))
459 + WINDOW_LEFT_SCROLL_BAR_COLS (XWINDOW (window))
460 + XINT(X_Position));
461 ypos = CtoSY (WINDOW_TOP_EDGE_LINE (XWINDOW(window)) + XINT(Y_Position));
462#ifdef Menu_Base_Kludge
463 {static Lisp_Object symbol[2];
464 symbol[0] = Fintern (sm_kludge_string, Qnil);
465 Pair = Ffuncall (1, symbol);
466 xpos += XINT (XCDR (Pair));
467 ypos += XINT (XCAR (Pair));
468 }
469#endif
470
471 button = XINT(Button);
472 if(button == 4) button = 3;
473 event_set_id (event, BUT(button));
474 event_set_down (event);
475 event_set_x (event, xpos);
476 event_set_y (event, ypos);
477
478 menu = sun_menu_create(MEnu);
479 make_menu_label(menu);
480
481#ifdef Menu_Base_Kludge
482 Value = (Lisp_Object) menu_show(menu, Menu_Base_Frame, event, 0);
483#else
484/* This confuses the notifier or something: */
485 Value = (Lisp_Object) menu_show_using_fd(menu, win_fd, event, 0);
486/*
487 * Right button gets lost, and event sequencing or delivery gets mixed up
488 * So, until that gets fixed, we use this <Menu_Base_Frame> kludge:
489 */
490#endif
491 menu_destroy (menu);
492
493 return ((int)Value ? Value : Qnil);
494}
495
496
497/*
498 * Define everything
499 */
500syms_of_sunfns()
501{
502#ifdef Menu_Base_Kludge
503 /* i'm just too lazy to re-write this into C code */
504 /* so we will call this elisp function from C */
505 sm_kludge_string = make_pure_string ("sm::menu-kludge", 15, 15, 0);
506#endif /* Menu_Base_Kludge */
507
508 defsubr(&Ssun_window_init);
509 defsubr(&Ssit_for_millisecs);
510 defsubr(&Ssleep_for_millisecs);
511 defsubr(&Supdate_display);
512 defsubr(&Ssun_change_cursor_icon);
513 defsubr(&Ssun_set_selection);
514 defsubr(&Ssun_get_selection);
515 defsubr(&Ssun_menu_internal);
516}
517
518/* arch-tag: 2d7decb7-58f6-41aa-b45b-077ccfab7158
519 (do not change this comment) */