| 1 | ;;; sun-fns.el --- subroutines of Mouse handling for Sun windows |
| 2 | |
| 3 | ;; Copyright (C) 1987 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Jeff Peck <peck@sun.com> |
| 6 | ;; Keywords: hardware |
| 7 | |
| 8 | ;; This file is part of GNU Emacs. |
| 9 | |
| 10 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 11 | ;; it under the terms of the GNU General Public License as published by |
| 12 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 13 | ;; any later version. |
| 14 | |
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 18 | ;; GNU General Public License for more details. |
| 19 | |
| 20 | ;; You should have received a copy of the GNU General Public License |
| 21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 23 | ;; Boston, MA 02111-1307, USA. |
| 24 | |
| 25 | ;;; Commentary: |
| 26 | |
| 27 | ;; Submitted Mar. 1987, Jeff Peck |
| 28 | ;; Sun Microsystems Inc. <peck@sun.com> |
| 29 | ;; Conceived Nov. 1986, Stan Jefferson, |
| 30 | ;; Computer Science Lab, SRI International. |
| 31 | ;; GoodIdeas Feb. 1987, Steve Greenbaum |
| 32 | ;; & UpClicks Reasoning Systems, Inc. |
| 33 | ;; |
| 34 | ;; |
| 35 | ;; Functions for manipulating via the mouse and mouse-map definitions |
| 36 | ;; for accessing them. Also definitions of mouse menus. |
| 37 | ;; This file you should freely modify to reflect you personal tastes. |
| 38 | ;; |
| 39 | ;; First half of file defines functions to implement mouse commands, |
| 40 | ;; Don't delete any of those, just add what ever else you need. |
| 41 | ;; Second half of file defines mouse bindings, do whatever you want there. |
| 42 | |
| 43 | ;; |
| 44 | ;; Mouse Functions. |
| 45 | ;; |
| 46 | ;; These functions follow the sun-mouse-handler convention of being called |
| 47 | ;; with three arguments: (window x-pos y-pos) |
| 48 | ;; This makes it easy for a mouse executed command to know where the mouse is. |
| 49 | ;; Use the macro "eval-in-window" to execute a function |
| 50 | ;; in a temporarily selected window. |
| 51 | ;; |
| 52 | ;; If you have a function that must be called with other arguments |
| 53 | ;; bind the mouse button to an s-exp that contains the necessary parameters. |
| 54 | ;; See "minibuffer" bindings for examples. |
| 55 | ;; |
| 56 | |
| 57 | ;;; Code: |
| 58 | |
| 59 | (require 'sun-mouse) |
| 60 | |
| 61 | (defconst cursor-pause-milliseconds 300 |
| 62 | "*Number of milliseconds to display alternate cursor (usually the mark)") |
| 63 | |
| 64 | (defun indicate-region (&optional pause) |
| 65 | "Bounce cursor to mark for cursor-pause-milliseconds and back again" |
| 66 | (or pause (setq pause cursor-pause-milliseconds)) |
| 67 | (let ((point (point))) |
| 68 | (goto-char (mark)) |
| 69 | (sit-for-millisecs pause) |
| 70 | ;(update-display) |
| 71 | ;(sleep-for-millisecs pause) |
| 72 | (goto-char point))) |
| 73 | |
| 74 | \f |
| 75 | ;;; |
| 76 | ;;; Text buffer operations |
| 77 | ;;; |
| 78 | (defun mouse-move-point (window x y) |
| 79 | "Move point to mouse cursor." |
| 80 | (select-window window) |
| 81 | (move-to-loc x y) |
| 82 | (if (memq last-command ; support the mouse-copy/delete/yank |
| 83 | '(mouse-copy mouse-delete mouse-yank-move)) |
| 84 | (setq this-command 'mouse-yank-move)) |
| 85 | ) |
| 86 | |
| 87 | (defun mouse-set-mark (window x y) |
| 88 | "Set mark at mouse cursor." |
| 89 | (eval-in-window window ;; use this to get the unwind protect |
| 90 | (let ((point (point))) |
| 91 | (move-to-loc x y) |
| 92 | (set-mark (point)) |
| 93 | (goto-char point) |
| 94 | (indicate-region))) |
| 95 | ) |
| 96 | |
| 97 | (defun mouse-set-mark-and-select (window x y) |
| 98 | "Set mark at mouse cursor, and select that window." |
| 99 | (select-window window) |
| 100 | (mouse-set-mark window x y) |
| 101 | ) |
| 102 | |
| 103 | (defun mouse-set-mark-and-stuff (w x y) |
| 104 | "Set mark at mouse cursor, and put region in stuff buffer." |
| 105 | (mouse-set-mark-and-select w x y) |
| 106 | (sun-select-region (region-beginning) (region-end))) |
| 107 | |
| 108 | ;;; |
| 109 | ;;; Simple mouse dragging stuff: marking with button up |
| 110 | ;;; |
| 111 | |
| 112 | (defvar *mouse-drag-window* nil) |
| 113 | (defvar *mouse-drag-x* -1) |
| 114 | (defvar *mouse-drag-y* -1) |
| 115 | |
| 116 | (defun mouse-drag-move-point (window x y) |
| 117 | "Move point to mouse cursor, and allow dragging." |
| 118 | (mouse-move-point window x y) |
| 119 | (setq *mouse-drag-window* window |
| 120 | *mouse-drag-x* x |
| 121 | *mouse-drag-y* y)) |
| 122 | |
| 123 | (defun mouse-drag-set-mark-stuff (window x y) |
| 124 | "The up click handler that goes with mouse-drag-move-point. |
| 125 | If mouse is in same WINDOW but at different X or Y than when |
| 126 | mouse-drag-move-point was last executed, set the mark at mouse |
| 127 | and put the region in the stuff buffer." |
| 128 | (if (and (eq *mouse-drag-window* window) |
| 129 | (not (and (equal *mouse-drag-x* x) |
| 130 | (equal *mouse-drag-y* y)))) |
| 131 | (mouse-set-mark-and-stuff window x y) |
| 132 | (setq this-command last-command)) ; this was just an upclick no-op. |
| 133 | ) |
| 134 | |
| 135 | (defun mouse-select-or-drag-move-point (window x y) |
| 136 | "Select window if not selected, otherwise do mouse-drag-move-point." |
| 137 | (if (eq (selected-window) window) |
| 138 | (mouse-drag-move-point window x y) |
| 139 | (mouse-select-window window x y))) |
| 140 | |
| 141 | ;;; |
| 142 | ;;; esoterica: |
| 143 | ;;; |
| 144 | (defun mouse-exch-pt-and-mark (window x y) |
| 145 | "Exchange point and mark." |
| 146 | (select-window window) |
| 147 | (exchange-point-and-mark) |
| 148 | ) |
| 149 | |
| 150 | (defun mouse-call-kbd-macro (window x y) |
| 151 | "Invokes last keyboard macro at mouse cursor." |
| 152 | (mouse-move-point window x y) |
| 153 | (call-last-kbd-macro) |
| 154 | ) |
| 155 | \f |
| 156 | (defun mouse-mark-thing (window x y) |
| 157 | "Set point and mark to text object using syntax table. |
| 158 | The resulting region is put in the sun-window stuff buffer. |
| 159 | Left or right Paren syntax marks an s-expression. |
| 160 | Clicking at the end of a line marks the line including a trailing newline. |
| 161 | If it doesn't recognize one of these it marks the character at point." |
| 162 | (mouse-move-point window x y) |
| 163 | (if (eobp) (open-line 1)) |
| 164 | (let* ((char (char-after (point))) |
| 165 | (syntax (char-syntax char))) |
| 166 | (cond |
| 167 | ((eq syntax ?w) ; word. |
| 168 | (forward-word 1) |
| 169 | (set-mark (point)) |
| 170 | (forward-word -1)) |
| 171 | ;; try to include a single following whitespace (is this a good idea?) |
| 172 | ;; No, not a good idea since inconsistent. |
| 173 | ;;(if (eq (char-syntax (char-after (mark))) ?\ ) |
| 174 | ;; (set-mark (1+ (mark)))) |
| 175 | ((eq syntax ?\( ) ; open paren. |
| 176 | (mark-sexp 1)) |
| 177 | ((eq syntax ?\) ) ; close paren. |
| 178 | (forward-char 1) |
| 179 | (mark-sexp -1) |
| 180 | (exchange-point-and-mark)) |
| 181 | ((eolp) ; mark line if at end. |
| 182 | (set-mark (1+ (point))) |
| 183 | (beginning-of-line 1)) |
| 184 | (t ; mark character |
| 185 | (set-mark (1+ (point))))) |
| 186 | (indicate-region)) ; display region boundary. |
| 187 | (sun-select-region (region-beginning) (region-end)) |
| 188 | ) |
| 189 | |
| 190 | (defun mouse-kill-thing (window x y) |
| 191 | "Kill thing at mouse, and put point there." |
| 192 | (mouse-mark-thing window x y) |
| 193 | (kill-region-and-unmark (region-beginning) (region-end)) |
| 194 | ) |
| 195 | |
| 196 | (defun mouse-kill-thing-there (window x y) |
| 197 | "Kill thing at mouse, leave point where it was. |
| 198 | See mouse-mark-thing for a description of the objects recognized." |
| 199 | (eval-in-window window |
| 200 | (save-excursion |
| 201 | (mouse-mark-thing window x y) |
| 202 | (kill-region (region-beginning) (region-end)))) |
| 203 | ) |
| 204 | |
| 205 | (defun mouse-save-thing (window x y &optional quiet) |
| 206 | "Put thing at mouse in kill ring. |
| 207 | See mouse-mark-thing for a description of the objects recognized." |
| 208 | (mouse-mark-thing window x y) |
| 209 | (copy-region-as-kill (region-beginning) (region-end)) |
| 210 | (if (not quiet) (message "Thing saved")) |
| 211 | ) |
| 212 | |
| 213 | (defun mouse-save-thing-there (window x y &optional quiet) |
| 214 | "Put thing at mouse in kill ring, leave point as is. |
| 215 | See mouse-mark-thing for a description of the objects recognized." |
| 216 | (eval-in-window window |
| 217 | (save-excursion |
| 218 | (mouse-save-thing window x y quiet)))) |
| 219 | \f |
| 220 | ;;; |
| 221 | ;;; Mouse yanking... |
| 222 | ;;; |
| 223 | (defun mouse-copy-thing (window x y) |
| 224 | "Put thing at mouse in kill ring, yank to point. |
| 225 | See mouse-mark-thing for a description of the objects recognized." |
| 226 | (setq last-command 'not-kill) ;Avoids appending to previous kills. |
| 227 | (mouse-save-thing-there window x y t) |
| 228 | (yank) |
| 229 | (setq this-command 'yank)) |
| 230 | |
| 231 | (defun mouse-move-thing (window x y) |
| 232 | "Kill thing at mouse, yank it to point. |
| 233 | See mouse-mark-thing for a description of the objects recognized." |
| 234 | (setq last-command 'not-kill) ;Avoids appending to previous kills. |
| 235 | (mouse-kill-thing-there window x y) |
| 236 | (yank) |
| 237 | (setq this-command 'yank)) |
| 238 | |
| 239 | (defun mouse-yank-at-point (&optional window x y) |
| 240 | "Yank from kill-ring at point; then cycle thru kill ring." |
| 241 | (if (eq last-command 'yank) |
| 242 | (let ((before (< (point) (mark)))) |
| 243 | (delete-region (point) (mark)) |
| 244 | (insert (current-kill 1)) |
| 245 | (if before (exchange-point-and-mark))) |
| 246 | (yank)) |
| 247 | (setq this-command 'yank)) |
| 248 | |
| 249 | (defun mouse-yank-at-mouse (window x y) |
| 250 | "Yank from kill-ring at mouse; then cycle thru kill ring." |
| 251 | (mouse-move-point window x y) |
| 252 | (mouse-yank-at-point window x y)) |
| 253 | |
| 254 | (defun mouse-save/delete/yank (&optional window x y) |
| 255 | "Context sensitive save/delete/yank. |
| 256 | Consecutive clicks perform as follows: |
| 257 | * first click saves region to kill ring, |
| 258 | * second click kills region, |
| 259 | * third click yanks from kill ring, |
| 260 | * subsequent clicks cycle thru kill ring. |
| 261 | If mouse-move-point is performed after the first or second click, |
| 262 | the next click will do a yank, etc. Except for a possible mouse-move-point, |
| 263 | this command is insensitive to mouse location." |
| 264 | (cond |
| 265 | ((memq last-command '(mouse-delete yank mouse-yank-move)) ; third+ click |
| 266 | (mouse-yank-at-point)) |
| 267 | ((eq last-command 'mouse-copy) ; second click |
| 268 | (kill-region (region-beginning) (region-end)) |
| 269 | (setq this-command 'mouse-delete)) |
| 270 | (t ; first click |
| 271 | (copy-region-as-kill (region-beginning) (region-end)) |
| 272 | (message "Region saved") |
| 273 | (setq this-command 'mouse-copy)) |
| 274 | )) |
| 275 | |
| 276 | \f |
| 277 | (defun mouse-split-horizontally (window x y) |
| 278 | "Splits the window horizontally at mouse cursor." |
| 279 | (eval-in-window window (split-window-horizontally (1+ x)))) |
| 280 | |
| 281 | (defun mouse-split-vertically (window x y) |
| 282 | "Split the window vertically at the mouse cursor." |
| 283 | (eval-in-window window (split-window-vertically (1+ y)))) |
| 284 | |
| 285 | (defun mouse-select-window (window x y) |
| 286 | "Selects the window, restoring point." |
| 287 | (select-window window)) |
| 288 | |
| 289 | (defun mouse-delete-other-windows (window x y) |
| 290 | "Deletes all windows except the one mouse is in." |
| 291 | (delete-other-windows window)) |
| 292 | |
| 293 | (defun mouse-delete-window (window x y) |
| 294 | "Deletes the window mouse is in." |
| 295 | (delete-window window)) |
| 296 | |
| 297 | (defun mouse-undo (window x y) |
| 298 | "Invokes undo in the window mouse is in." |
| 299 | (eval-in-window window (undo))) |
| 300 | \f |
| 301 | ;;; |
| 302 | ;;; Scroll operations |
| 303 | ;;; |
| 304 | |
| 305 | ;;; The move-to-window-line is used below because otherwise |
| 306 | ;;; scrolling a non-selected process window with the mouse, after |
| 307 | ;;; the process has written text past the bottom of the window, |
| 308 | ;;; gives an "End of buffer" error, and then scrolls. The |
| 309 | ;;; move-to-window-line seems to force recomputing where things are. |
| 310 | (defun mouse-scroll-up (window x y) |
| 311 | "Scrolls the window upward." |
| 312 | (eval-in-window window (move-to-window-line 1) (scroll-up nil))) |
| 313 | |
| 314 | (defun mouse-scroll-down (window x y) |
| 315 | "Scrolls the window downward." |
| 316 | (eval-in-window window (scroll-down nil))) |
| 317 | |
| 318 | (defun mouse-scroll-proportional (window x y) |
| 319 | "Scrolls the window proportionally corresponding to window |
| 320 | relative X divided by window width." |
| 321 | (eval-in-window window |
| 322 | (if (>= x (1- (window-width))) |
| 323 | ;; When x is maximum (equal to or 1 less than window width), |
| 324 | ;; goto end of buffer. We check for this special case |
| 325 | ;; because the calculated goto-char often goes short of the |
| 326 | ;; end due to roundoff error, and we often really want to go |
| 327 | ;; to the end. |
| 328 | (goto-char (point-max)) |
| 329 | (progn |
| 330 | (goto-char (+ (point-min) ; For narrowed regions. |
| 331 | (* x (/ (- (point-max) (point-min)) |
| 332 | (1- (window-width)))))) |
| 333 | (beginning-of-line)) |
| 334 | ) |
| 335 | (what-cursor-position) ; Report position. |
| 336 | )) |
| 337 | |
| 338 | (defun mouse-line-to-top (window x y) |
| 339 | "Scrolls the line at the mouse cursor up to the top." |
| 340 | (eval-in-window window (scroll-up y))) |
| 341 | |
| 342 | (defun mouse-top-to-line (window x y) |
| 343 | "Scrolls the top line down to the mouse cursor." |
| 344 | (eval-in-window window (scroll-down y))) |
| 345 | |
| 346 | (defun mouse-line-to-bottom (window x y) |
| 347 | "Scrolls the line at the mouse cursor to the bottom." |
| 348 | (eval-in-window window (scroll-up (+ y (- 2 (window-height)))))) |
| 349 | |
| 350 | (defun mouse-bottom-to-line (window x y) |
| 351 | "Scrolls the bottom line up to the mouse cursor." |
| 352 | (eval-in-window window (scroll-down (+ y (- 2 (window-height)))))) |
| 353 | |
| 354 | (defun mouse-line-to-middle (window x y) |
| 355 | "Scrolls the line at the mouse cursor to the middle." |
| 356 | (eval-in-window window (scroll-up (- y -1 (/ (window-height) 2))))) |
| 357 | |
| 358 | (defun mouse-middle-to-line (window x y) |
| 359 | "Scrolls the line at the middle to the mouse cursor." |
| 360 | (eval-in-window window (scroll-up (- (/ (window-height) 2) y 1)))) |
| 361 | |
| 362 | \f |
| 363 | ;;; |
| 364 | ;;; main emacs menu. |
| 365 | ;;; |
| 366 | (defmenu expand-menu |
| 367 | ("Vertically" mouse-expand-vertically *menu-window*) |
| 368 | ("Horizontally" mouse-expand-horizontally *menu-window*)) |
| 369 | |
| 370 | (defmenu delete-window-menu |
| 371 | ("This One" delete-window *menu-window*) |
| 372 | ("All Others" delete-other-windows *menu-window*)) |
| 373 | |
| 374 | (defmenu mouse-help-menu |
| 375 | ("Text Region" |
| 376 | mouse-help-region *menu-window* *menu-x* *menu-y* 'text) |
| 377 | ("Scrollbar" |
| 378 | mouse-help-region *menu-window* *menu-x* *menu-y* 'scrollbar) |
| 379 | ("Modeline" |
| 380 | mouse-help-region *menu-window* *menu-x* *menu-y* 'modeline) |
| 381 | ("Minibuffer" |
| 382 | mouse-help-region *menu-window* *menu-x* *menu-y* 'minibuffer) |
| 383 | ) |
| 384 | |
| 385 | (defmenu emacs-quit-menu |
| 386 | ("Suspend" suspend-emacstool) |
| 387 | ("Quit" save-buffers-kill-emacs)) |
| 388 | |
| 389 | (defmenu emacs-menu |
| 390 | ("Emacs Menu") |
| 391 | ("Stuff Selection" sun-yank-selection) |
| 392 | ("Expand" . expand-menu) |
| 393 | ("Delete Window" . delete-window-menu) |
| 394 | ("Previous Buffer" mouse-select-previous-buffer *menu-window*) |
| 395 | ("Save Buffers" save-some-buffers) |
| 396 | ("List Directory" list-directory nil) |
| 397 | ("Dired" dired nil) |
| 398 | ("Mouse Help" . mouse-help-menu) |
| 399 | ("Quit" . emacs-quit-menu)) |
| 400 | |
| 401 | (defun emacs-menu-eval (window x y) |
| 402 | "Pop-up menu of editor commands." |
| 403 | (sun-menu-evaluate window (1+ x) (1- y) 'emacs-menu)) |
| 404 | |
| 405 | (defun mouse-expand-horizontally (window) |
| 406 | (eval-in-window window |
| 407 | (enlarge-window 4 t) |
| 408 | (update-display) ; Try to redisplay, since can get confused. |
| 409 | )) |
| 410 | |
| 411 | (defun mouse-expand-vertically (window) |
| 412 | (eval-in-window window (enlarge-window 4))) |
| 413 | |
| 414 | (defun mouse-select-previous-buffer (window) |
| 415 | "Switch buffer in mouse window to most recently selected buffer." |
| 416 | (eval-in-window window (switch-to-buffer (other-buffer)))) |
| 417 | \f |
| 418 | ;;; |
| 419 | ;;; minibuffer menu |
| 420 | ;;; |
| 421 | (defmenu minibuffer-menu |
| 422 | ("Minibuffer" message "Just some miscellaneous minibuffer commands") |
| 423 | ("Stuff" sun-yank-selection) |
| 424 | ("Do-It" exit-minibuffer) |
| 425 | ("Abort" abort-recursive-edit) |
| 426 | ("Suspend" suspend-emacs)) |
| 427 | |
| 428 | (defun minibuffer-menu-eval (window x y) |
| 429 | "Pop-up menu of commands." |
| 430 | (sun-menu-evaluate window x (1- y) 'minibuffer-menu)) |
| 431 | |
| 432 | (defun mini-move-point (window x y) |
| 433 | ;; -6 is good for most common cases |
| 434 | (mouse-move-point window (- x 6) 0)) |
| 435 | |
| 436 | (defun mini-set-mark-and-stuff (window x y) |
| 437 | ;; -6 is good for most common cases |
| 438 | (mouse-set-mark-and-stuff window (- x 6) 0)) |
| 439 | |
| 440 | \f |
| 441 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 442 | ;;; Buffer-mode Mouse commands |
| 443 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 444 | |
| 445 | (defun Buffer-at-mouse (w x y) |
| 446 | "Calls Buffer-menu-buffer from mouse click." |
| 447 | (save-window-excursion |
| 448 | (mouse-move-point w x y) |
| 449 | (beginning-of-line) |
| 450 | (Buffer-menu-buffer t))) |
| 451 | |
| 452 | (defun mouse-buffer-bury (w x y) |
| 453 | "Bury the indicated buffer." |
| 454 | (bury-buffer (Buffer-at-mouse w x y)) |
| 455 | ) |
| 456 | |
| 457 | (defun mouse-buffer-select (w x y) |
| 458 | "Put the indicated buffer in selected window." |
| 459 | (switch-to-buffer (Buffer-at-mouse w x y)) |
| 460 | (list-buffers) |
| 461 | ) |
| 462 | |
| 463 | (defun mouse-buffer-delete (w x y) |
| 464 | "mark indicated buffer for delete" |
| 465 | (save-window-excursion |
| 466 | (mouse-move-point w x y) |
| 467 | (Buffer-menu-delete) |
| 468 | )) |
| 469 | |
| 470 | (defun mouse-buffer-execute (w x y) |
| 471 | "execute buffer-menu selections" |
| 472 | (save-window-excursion |
| 473 | (mouse-move-point w x y) |
| 474 | (Buffer-menu-execute) |
| 475 | )) |
| 476 | |
| 477 | (defun enable-mouse-in-buffer-list () |
| 478 | "Call this to enable mouse selections in *Buffer List* |
| 479 | LEFT puts the indicated buffer in the selected window. |
| 480 | MIDDLE buries the indicated buffer. |
| 481 | RIGHT marks the indicated buffer for deletion. |
| 482 | MIDDLE-RIGHT deletes the marked buffers. |
| 483 | To unmark a buffer marked for deletion, select it with LEFT." |
| 484 | (save-window-excursion |
| 485 | (list-buffers) ; Initialize *Buffer List* |
| 486 | (set-buffer "*Buffer List*") |
| 487 | (local-set-mouse '(text middle) 'mouse-buffer-bury) |
| 488 | (local-set-mouse '(text left) 'mouse-buffer-select) |
| 489 | (local-set-mouse '(text right) 'mouse-buffer-delete) |
| 490 | (local-set-mouse '(text middle right) 'mouse-buffer-execute) |
| 491 | ) |
| 492 | ) |
| 493 | |
| 494 | \f |
| 495 | ;;;******************************************************************* |
| 496 | ;;; |
| 497 | ;;; Global Mouse Bindings. |
| 498 | ;;; |
| 499 | ;;; There is some sense to this mouse binding madness: |
| 500 | ;;; LEFT and RIGHT scrolls are inverses. |
| 501 | ;;; SHIFT makes an opposite meaning in the scroll bar. |
| 502 | ;;; SHIFT is an alternative to DOUBLE (but double chords do not exist). |
| 503 | ;;; META makes the scrollbar functions work in the text region. |
| 504 | ;;; MIDDLE operates the mark |
| 505 | ;;; LEFT operates at point |
| 506 | |
| 507 | ;;; META commands are generally non-destructive, |
| 508 | ;;; SHIFT is a little more dangerous. |
| 509 | ;;; CONTROL is for the really complicated ones. |
| 510 | |
| 511 | ;;; CONTROL-META-SHIFT-RIGHT gives help on that region. |
| 512 | |
| 513 | ;;; |
| 514 | ;;; Text Region mousemap |
| 515 | ;;; |
| 516 | ;; The basics: Point, Mark, Menu, Sun-Select: |
| 517 | (global-set-mouse '(text left) 'mouse-drag-move-point) |
| 518 | (global-set-mouse '(text up left) 'mouse-drag-set-mark-stuff) |
| 519 | (global-set-mouse '(text shift left) 'mouse-exch-pt-and-mark) |
| 520 | (global-set-mouse '(text double left) 'mouse-exch-pt-and-mark) |
| 521 | |
| 522 | (global-set-mouse '(text middle) 'mouse-set-mark-and-stuff) |
| 523 | |
| 524 | (global-set-mouse '(text right) 'emacs-menu-eval) |
| 525 | (global-set-mouse '(text shift right) '(sun-yank-selection)) |
| 526 | (global-set-mouse '(text double right) '(sun-yank-selection)) |
| 527 | |
| 528 | ;; The Slymoblics multi-command for Save, Kill, Copy, Move: |
| 529 | (global-set-mouse '(text shift middle) 'mouse-save/delete/yank) |
| 530 | (global-set-mouse '(text double middle) 'mouse-save/delete/yank) |
| 531 | |
| 532 | ;; Save, Kill, Copy, Move Things: |
| 533 | ;; control-left composes with control middle/right to produce copy/move |
| 534 | (global-set-mouse '(text control middle ) 'mouse-save-thing-there) |
| 535 | (global-set-mouse '(text control right ) 'mouse-kill-thing-there) |
| 536 | (global-set-mouse '(text control left) 'mouse-yank-at-point) |
| 537 | (global-set-mouse '(text control middle left) 'mouse-copy-thing) |
| 538 | (global-set-mouse '(text control right left) 'mouse-move-thing) |
| 539 | (global-set-mouse '(text control right middle) 'mouse-mark-thing) |
| 540 | |
| 541 | ;; The Universal mouse help command (press all buttons): |
| 542 | (global-set-mouse '(text shift control meta right) 'mouse-help-region) |
| 543 | (global-set-mouse '(text double control meta right) 'mouse-help-region) |
| 544 | |
| 545 | ;;; Meta in Text Region is like meta version in scrollbar: |
| 546 | (global-set-mouse '(text meta left) 'mouse-line-to-top) |
| 547 | (global-set-mouse '(text meta shift left) 'mouse-line-to-bottom) |
| 548 | (global-set-mouse '(text meta double left) 'mouse-line-to-bottom) |
| 549 | (global-set-mouse '(text meta middle) 'mouse-line-to-middle) |
| 550 | (global-set-mouse '(text meta shift middle) 'mouse-middle-to-line) |
| 551 | (global-set-mouse '(text meta double middle) 'mouse-middle-to-line) |
| 552 | (global-set-mouse '(text meta control middle) 'mouse-split-vertically) |
| 553 | (global-set-mouse '(text meta right) 'mouse-top-to-line) |
| 554 | (global-set-mouse '(text meta shift right) 'mouse-bottom-to-line) |
| 555 | (global-set-mouse '(text meta double right) 'mouse-bottom-to-line) |
| 556 | |
| 557 | ;; Miscellaneous: |
| 558 | (global-set-mouse '(text meta control left) 'mouse-call-kbd-macro) |
| 559 | (global-set-mouse '(text meta control right) 'mouse-undo) |
| 560 | \f |
| 561 | ;;; |
| 562 | ;;; Scrollbar mousemap. |
| 563 | ;;; Are available in the Scrollbar Region, or with Meta Text (or Meta Scrollbar) |
| 564 | ;;; |
| 565 | (global-set-mouse '(scrollbar left) 'mouse-line-to-top) |
| 566 | (global-set-mouse '(scrollbar shift left) 'mouse-line-to-bottom) |
| 567 | (global-set-mouse '(scrollbar double left) 'mouse-line-to-bottom) |
| 568 | |
| 569 | (global-set-mouse '(scrollbar middle) 'mouse-line-to-middle) |
| 570 | (global-set-mouse '(scrollbar shift middle) 'mouse-middle-to-line) |
| 571 | (global-set-mouse '(scrollbar double middle) 'mouse-middle-to-line) |
| 572 | (global-set-mouse '(scrollbar control middle) 'mouse-split-vertically) |
| 573 | |
| 574 | (global-set-mouse '(scrollbar right) 'mouse-top-to-line) |
| 575 | (global-set-mouse '(scrollbar shift right) 'mouse-bottom-to-line) |
| 576 | (global-set-mouse '(scrollbar double right) 'mouse-bottom-to-line) |
| 577 | |
| 578 | (global-set-mouse '(scrollbar meta left) 'mouse-line-to-top) |
| 579 | (global-set-mouse '(scrollbar meta shift left) 'mouse-line-to-bottom) |
| 580 | (global-set-mouse '(scrollbar meta double left) 'mouse-line-to-bottom) |
| 581 | (global-set-mouse '(scrollbar meta middle) 'mouse-line-to-middle) |
| 582 | (global-set-mouse '(scrollbar meta shift middle) 'mouse-middle-to-line) |
| 583 | (global-set-mouse '(scrollbar meta double middle) 'mouse-middle-to-line) |
| 584 | (global-set-mouse '(scrollbar meta control middle) 'mouse-split-vertically) |
| 585 | (global-set-mouse '(scrollbar meta right) 'mouse-top-to-line) |
| 586 | (global-set-mouse '(scrollbar meta shift right) 'mouse-bottom-to-line) |
| 587 | (global-set-mouse '(scrollbar meta double right) 'mouse-bottom-to-line) |
| 588 | |
| 589 | ;; And the help menu: |
| 590 | (global-set-mouse '(scrollbar shift control meta right) 'mouse-help-region) |
| 591 | (global-set-mouse '(scrollbar double control meta right) 'mouse-help-region) |
| 592 | \f |
| 593 | ;;; |
| 594 | ;;; Modeline mousemap. |
| 595 | ;;; |
| 596 | ;;; Note: meta of any single button selects window. |
| 597 | |
| 598 | (global-set-mouse '(modeline left) 'mouse-scroll-up) |
| 599 | (global-set-mouse '(modeline meta left) 'mouse-select-window) |
| 600 | |
| 601 | (global-set-mouse '(modeline middle) 'mouse-scroll-proportional) |
| 602 | (global-set-mouse '(modeline meta middle) 'mouse-select-window) |
| 603 | (global-set-mouse '(modeline control middle) 'mouse-split-horizontally) |
| 604 | |
| 605 | (global-set-mouse '(modeline right) 'mouse-scroll-down) |
| 606 | (global-set-mouse '(modeline meta right) 'mouse-select-window) |
| 607 | |
| 608 | ;;; control-left selects this window, control-right deletes it. |
| 609 | (global-set-mouse '(modeline control left) 'mouse-delete-other-windows) |
| 610 | (global-set-mouse '(modeline control right) 'mouse-delete-window) |
| 611 | |
| 612 | ;; in case of confusion, just select it: |
| 613 | (global-set-mouse '(modeline control left right)'mouse-select-window) |
| 614 | |
| 615 | ;; even without confusion (and without the keyboard) select it: |
| 616 | (global-set-mouse '(modeline left right) 'mouse-select-window) |
| 617 | |
| 618 | ;; And the help menu: |
| 619 | (global-set-mouse '(modeline shift control meta right) 'mouse-help-region) |
| 620 | (global-set-mouse '(modeline double control meta right) 'mouse-help-region) |
| 621 | |
| 622 | ;;; |
| 623 | ;;; Minibuffer Mousemap |
| 624 | ;;; Demonstrating some variety: |
| 625 | ;;; |
| 626 | (global-set-mouse '(minibuffer left) 'mini-move-point) |
| 627 | |
| 628 | (global-set-mouse '(minibuffer middle) 'mini-set-mark-and-stuff) |
| 629 | |
| 630 | (global-set-mouse '(minibuffer shift middle) '(select-previous-complex-command)) |
| 631 | (global-set-mouse '(minibuffer double middle) '(select-previous-complex-command)) |
| 632 | (global-set-mouse '(minibuffer control middle) '(next-complex-command 1)) |
| 633 | (global-set-mouse '(minibuffer meta middle) '(previous-complex-command 1)) |
| 634 | |
| 635 | (global-set-mouse '(minibuffer right) 'minibuffer-menu-eval) |
| 636 | |
| 637 | (global-set-mouse '(minibuffer shift control meta right) 'mouse-help-region) |
| 638 | (global-set-mouse '(minibuffer double control meta right) 'mouse-help-region) |
| 639 | |
| 640 | (provide 'sun-fns) |
| 641 | |
| 642 | ;;; sun-fns.el ends here |