![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sun-fns.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to sun-fns.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;; Subroutines of Mouse handling for Sun windows
2: ;; Copyright (C) 1987, 1991, 1992 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is free software; you can redistribute it and/or modify
7: ;; it under the terms of the GNU General Public License as published by
8: ;; the Free Software Foundation; either version 1, or (at your option)
9: ;; any later version.
10:
11: ;; GNU Emacs is distributed in the hope that it will be useful,
12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: ;; GNU General Public License for more details.
15:
16: ;; You should have received a copy of the GNU General Public License
17: ;; along with GNU Emacs; see the file COPYING. If not, write to
18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19:
20: ;;; Upgrade Apr, 1992, Jeff Peck
21: ;;; modeline-menu
22: ;;; modeline resize
23: ;;; mouse-fill-paragraph(s)
24: ;;; mouse in Buffer-menu
25: ;;;
26: ;;; Fix Aug, 1989, Jeff Peck
27: ;;; minibuf-prompt-length
28: ;;;
29: ;;; Submitted Mar. 1987, Jeff Peck
30: ;;; Sun Microsystems Inc. <[email protected]>
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: (provide 'sun-fns)
37: (require 'sun-mouse)
38: ;;;
39: ;;; Functions for manipulating via the mouse and mouse-map definitions
40: ;;; for accessing them. Also definitons of mouse menus.
41: ;;; This file you should freely modify to reflect you personal tastes.
42: ;;;
43: ;;; First half of file defines functions to implement mouse commands,
44: ;;; Don't delete any of those, just add what ever else you need.
45: ;;; Second half of file defines mouse bindings, do whatever you want there.
46:
47: ;;;
48: ;;; Mouse Functions.
49: ;;;
50: ;;; These functions follow the sun-mouse-handler convention of being called
51: ;;; with three arguements: (window x-pos y-pos)
52: ;;; This makes it easy for a mouse executed command to know where the mouse is.
53: ;;; Use the macro "eval-in-window" to execute a function
54: ;;; in a temporarily selected window.
55: ;;;
56: ;;; If you have a function that must be called with other arguments
57: ;;; bind the mouse button to an s-exp that contains the necessary parameters.
58: ;;; See "minibuffer" bindings for examples.
59: ;;;
60: (defconst cursor-pause-milliseconds 300
61: "*Number of milliseconds to display alternate cursor (usually the mark)")
62:
63: (defun indicate-region (&optional pause)
64: "Bounce cursor to mark for cursor-pause-milliseconds and back again"
65: (or pause (setq pause cursor-pause-milliseconds))
66: (let ((point (point)))
67: (goto-char (mark))
68: (sit-for-millisecs pause)
69: ;(update-display)
70: ;(sleep-for-millisecs pause)
71: (goto-char point)))
72:
73:
74: ;;;
75: ;;; Text buffer operations
76: ;;;
77: (defun mouse-move-point (window x y)
78: "Move point to mouse cursor."
79: (select-window window)
80: (move-to-loc x y)
81: (if (memq last-command ; support the mouse-copy/delete/yank
82: '(mouse-copy mouse-delete mouse-yank-move))
83: (setq this-command 'mouse-yank-move))
84: )
85:
86: (defun mouse-set-mark (window x y)
87: "Set mark at mouse cursor."
88: (eval-in-window window ;; use this to get the unwind protect
89: (let ((point (point)))
90: (move-to-loc x y)
91: (set-mark (point))
92: (goto-char point)
93: (indicate-region)))
94: )
95:
96: (defun mouse-set-mark-and-select (window x y)
97: "Set mark at mouse cursor, and select that window."
98: (select-window window)
99: (mouse-set-mark window x y)
100: )
101:
102: (defun mouse-set-mark-and-stuff (w x y)
103: "Set mark at mouse cursor, and put region in stuff buffer."
104: (mouse-set-mark-and-select w x y)
105: (sun-select-region (region-beginning) (region-end)))
106:
107: ;;;
108: ;;; Simple mouse dragging stuff: marking with button up
109: ;;;
110:
111: (defvar *mouse-drag-window* nil)
112: (defvar *mouse-drag-x* -1)
113: (defvar *mouse-drag-y* -1)
114:
115: (defun mouse-drag-move-point (window x y)
116: "Move point to mouse cursor, and allow dragging."
117: (mouse-move-point window x y)
118: (setq *mouse-drag-window* window
119: *mouse-drag-x* x
120: *mouse-drag-y* y))
121:
122: (defun mouse-drag-set-mark-stuff (window x y)
123: "The up click handler that goes with mouse-drag-move-point.
124: If mouse is in same WINDOW but at different X or Y than when
125: mouse-drag-move-point was last executed, set the mark at mouse
126: and put the region in the stuff buffer."
127: (if (and (eq *mouse-drag-window* window)
128: (not (and (equal *mouse-drag-x* x)
129: (equal *mouse-drag-y* y))))
130: (mouse-set-mark-and-stuff window x y)
131: (setq this-command last-command)) ; this was just an upclick no-op.
132: )
133:
134: (defun mouse-select-or-drag-move-point (window x y)
135: "Select window if not selected, otherwise do mouse-drag-move-point."
136: (if (eq (selected-window) window)
137: (mouse-drag-move-point window x y)
138: (mouse-select-window window x y)))
139:
140: ;;;
141: ;;; esoteria:
142: ;;;
143: (defun mouse-exch-pt-and-mark (window x y)
144: "Exchange point and mark."
145: (select-window window)
146: (exchange-point-and-mark)
147: )
148:
149: (defun mouse-call-kbd-macro (window x y)
150: "Invokes last keyboard macro at mouse cursor."
151: (mouse-move-point window x y)
152: (call-last-kbd-macro)
153: )
154:
155: (defun mouse-mark-thing (window x y)
156: "Set point and mark to text object using syntax table.
157: The resulting region is put in the sun-window stuff buffer.
158: Left or right Paren syntax marks an s-expression.
159: Clicking at the end of a line marks the line including a trailing newline.
160: If it doesn't recognize one of these it marks the character at point."
161: (mouse-move-point window x y)
162: (if (eobp) (open-line 1))
163: (let* ((char (char-after (point)))
164: (syntax (char-syntax char)))
165: (cond
166: ((eq syntax ?w) ; word.
167: (forward-word 1)
168: (set-mark (point))
169: (forward-word -1))
170: ;; try to include a single following whitespace (is this a good idea?)
171: ;; No, not a good idea since inconsistent.
172: ;;(if (eq (char-syntax (char-after (mark))) ?\ )
173: ;; (set-mark (1+ (mark))))
174: ((eq syntax ?\( ) ; open paren.
175: (mark-sexp 1))
176: ((eq syntax ?\) ) ; close paren.
177: (forward-char 1)
178: (mark-sexp -1)
179: (exchange-point-and-mark))
180: ((eolp) ; mark line if at end.
181: (set-mark (1+ (point)))
182: (beginning-of-line 1))
183: (t ; mark character
184: (set-mark (1+ (point)))))
185: (indicate-region)) ; display region boundary.
186: (sun-select-region (region-beginning) (region-end))
187: )
188:
189: (defun mouse-kill-thing (window x y)
190: "Kill thing at mouse, and put point there."
191: (mouse-mark-thing window x y)
192: (kill-region-and-unmark (region-beginning) (region-end))
193: )
194:
195: (defun mouse-kill-thing-there (window x y)
196: "Kill thing at mouse, leave point where it was.
197: See mouse-mark-thing for a description of the objects recognized."
198: (eval-in-window window
199: (save-excursion
200: (mouse-mark-thing window x y)
201: (kill-region (region-beginning) (region-end))))
202: )
203:
204: (defun mouse-save-thing (window x y &optional quiet)
205: "Put thing at mouse in kill ring.
206: See mouse-mark-thing for a description of the objects recognized."
207: (mouse-mark-thing window x y)
208: (copy-region-as-kill (region-beginning) (region-end))
209: (if (not quiet) (message "Thing saved"))
210: )
211:
212: (defun mouse-save-thing-there (window x y &optional quiet)
213: "Put thing at mouse in kill ring, leave point as is.
214: See mouse-mark-thing for a description of the objects recognized."
215: (eval-in-window window
216: (save-excursion
217: (mouse-save-thing window x y quiet))))
218:
219: ;;;
220: ;;; Mouse yanking...
221: ;;;
222: (defun mouse-copy-thing (window x y)
223: "Put thing at mouse in kill ring, yank to point.
224: See mouse-mark-thing for a description of the objects recognized."
225: (setq last-command 'not-kill) ;Avoids appending to previous kills.
226: (mouse-save-thing-there window x y t)
227: (yank)
228: (setq this-command 'yank))
229:
230: (defun mouse-move-thing (window x y)
231: "Kill thing at mouse, yank it to point.
232: See mouse-mark-thing for a description of the objects recognized."
233: (setq last-command 'not-kill) ;Avoids appending to previous kills.
234: (mouse-kill-thing-there window x y)
235: (yank)
236: (setq this-command 'yank))
237:
238: (defun mouse-yank-at-point (&optional window x y)
239: "Yank from kill-ring at point; then cycle thru kill ring."
240: (if (eq last-command 'yank)
241: (let ((before (< (point) (mark))))
242: (delete-region (point) (mark))
243: (rotate-yank-pointer 1)
244: (insert (car kill-ring-yank-pointer))
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:
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:
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 maximun (equal to or 1 less than window width),
324: ;; goto end of buffer. We check for this special case
325: ;; becuase 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:
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:
418: ;;;
419: ;;; minibuffer menu
420: ;;;
421: (defmenu minibuffer-menu
422: ("Minibuffer" message "Just some miscellanous 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: ;;; Thanks to Joe Wells for this hack.
433: ;;; GNU Emacs should supply something better... Oh well.
434: (defun minibuf-prompt-length ()
435: "Returns the length of the current minibuffer prompt."
436: (save-window-excursion
437: (select-window (minibuffer-window))
438: (save-excursion
439: (let ((screen-width (screen-width))
440: (point-min (point-min))
441: length)
442: (goto-char point-min)
443: (insert-char ?a screen-width)
444: (goto-char point-min)
445: (vertical-motion 1)
446: (setq length (- screen-width (point)))
447: (goto-char point-min)
448: (delete-char screen-width)
449: length))))
450:
451: (defun mini-move-point (window x y)
452: (mouse-move-point window (- x (minibuf-prompt-length)) 0))
453:
454: (defun mini-set-mark-and-stuff (window x y)
455: (mouse-set-mark-and-stuff window (- x (minibuf-prompt-length)) 0))
456:
457:
458: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
459: ;;; resize from modeline
460: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
461:
462: (defvar *modeline-hit* nil "store original modline-hit data")
463:
464: (defun modeline-hit (w x y) (interactive)
465: (setq *modeline-hit* (cons w (caddr hit))))
466:
467: (defun mouse-drag-modeline (w x y) (interactive)
468: (if *modeline-hit*
469: (let ((delta (- (cdr *modeline-hit*) (caddr hit)))
470: (win (car *modeline-hit*)))
471: (setq *modeline-hit* nil)
472: (eval-in-window win (shrink-window delta)))))
473:
474: ;; Modeline drag to resize:
475: ;; Watch out for interference if you use "up" for something else
476: ;; For example: '(text up left) is used...
477: (global-set-mouse '(modeline middle) 'modeline-hit)
478: (global-set-mouse '(modeline up middle) 'mouse-drag-modeline)
479: (global-set-mouse '(text up middle) 'mouse-drag-modeline)
480: (global-set-mouse '(scrollbar up middle) 'mouse-drag-modeline)
481: (global-set-mouse '(minibuffer up middle) 'mouse-drag-modeline)
482:
483: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
484: ;;; modeline-menu functions
485: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
486:
487:
488: ;; parse thru a modeline-menu, finding item under nth character
489: (defun nth-menu-elt (n menu)
490: (let ((n (- n (length (caar menu)))))
491: (if (< n 0)
492: (cdar menu)
493: (if (consp (cdr menu))
494: (nth-menu-elt n (cdr menu))
495: (cdar menu)))))
496:
497: (defun modeline-menu-command (x menu)
498: "*Evaluate the command associated with the character N of the MENU.
499: Each element of MENU is of the form (STRING . ACTION). The STRING is
500: displayed in the modeline and ACTION to invoked when that string is moused.
501: If (commandp ACTION) is true,the ACTION is called interactively;
502: otherwise, ACTION is evaled."
503: (let ((command (nth-menu-elt x menu)))
504: (if (commandp command)
505: (call-interactively command)
506: (eval command))))
507:
508: (defun modeline-menu-string (menu)
509: "*Extract the strings in (cdr MENU) and concatenate them into a string.
510: The string in (car MENU) is not included in the returned string.
511: For best results, (length (caar menu)) should equal
512: the prefix in the actual modeline format string."
513: (apply 'concat (mapcar 'car (cdr menu))))
514:
515:
516: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
517: ;;; Buffer-mode Mouse commands
518: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
519:
520: (defun Buffer-at-mouse (w x y)
521: (save-window-excursion
522: (mouse-move-point w x y)
523: (Buffer-menu-buffer t)))
524:
525: (defun mouse-buffer-bury (w x y)
526: "Bury the indicated buffer."
527: (bury-buffer (Buffer-at-mouse w x y))
528: (list-buffers)
529: )
530:
531: (defun mouse-buffer-select (w x y)
532: "Select the indicated buffer in other-window."
533: (switch-to-buffer (Buffer-at-mouse w x y))
534: (list-buffers)
535: )
536:
537: (defun mouse-buffer-delete (w x y)
538: "mark indicated buffer for delete"
539: (save-window-excursion
540: (mouse-move-point w x y)
541: (Buffer-menu-delete)
542: ))
543:
544: (defun mouse-buffer-mark (w x y)
545: "mark indicated buffer for delete"
546: (save-window-excursion
547: (mouse-move-point w x y)
548: (Buffer-menu-mark)
549: ))
550:
551: (defun mouse-buffer-execute (w x y)
552: "execute buffer-menu selections"
553: (save-window-excursion
554: (mouse-move-point w x y)
555: (Buffer-menu-execute)
556: ))
557:
558: (defun buffer-modeline-menu-cmd (w x y)
559: (select-window w)
560: ;; goto a line with a buffer, skip first two lines
561: (let ((line-no (count-lines 1 (point))))
562: (if (< line-no 2) (forward-line (- 2 line-no))))
563: (modeline-menu-command x buffer-modeline-menu))
564:
565: (defvar buffer-modeline-menu '(("--%%-" . (forward-line -1))
566: (" [ " . (forward-line -1))
567: ("Mark " . Buffer-menu-mark)
568: ("Del " . Buffer-menu-delete)
569: ("Save " . Buffer-menu-save)
570: ("Undo " . Buffer-menu-unmark)
571: ("Prev " . (forward-line -1))
572: ("Next " . (forward-line 1))
573: ("Edit " . Buffer-menu-select)
574: ("eXec " . Buffer-menu-execute)
575: ("] " . (forward-line 1))
576: )
577: "*Each element of this list is a character STRING
578: \(that is displayed in the modeline\) consed to an ACTION to invoke
579: when that string is moused. If (commandp ACTION) is true,
580: the ACTION is called interactively; otherwise, ACTION is evaled."
581: )
582:
583: (defun enable-mouse-in-buffer-list ()
584: "Call this to enable mouse selections in *Buffer List*
585: LEFT puts the indicated buffer in the selected window.
586: MIDDLE buries the indicated buffer.
587: RIGHT marks the indicated buffer for deletion.
588: MIDDLE-RIGHT deletes the marked buffers.
589: To unmark a buffer marked for deletion, select it with LEFT."
590:
591: (local-set-mouse '(text left) 'mouse-buffer-select)
592: (local-set-mouse '(text middle) 'mouse-buffer-bury)
593: (local-set-mouse '(text right) 'mouse-buffer-delete)
594: (local-set-mouse '(text middle left) 'mouse-buffer-mark)
595: (local-set-mouse '(text middle right) 'mouse-buffer-execute)
596: (setq mode-line-buffer-identification
597: (list (modeline-menu-string buffer-modeline-menu) "%b"))
598: (local-set-mouse '(modeline left) 'buffer-modeline-menu-cmd)
599: (local-set-mouse '(modeline left double) 'buffer-modeline-menu-cmd)
600: )
601:
602: (defvar buffer-menu-mode-hook nil "run-hooks when entering Buffer Menu mode.")
603:
604: (if (memq 'enable-mouse-in-buffer-list buffer-menu-mode-hook)
605: nil
606: (setq buffer-menu-mode-hook
607: (cons 'enable-mouse-in-buffer-list buffer-menu-mode-hook)))
608:
609: ;; make sure a new buffer is created using buffer-menu-mode-hook
610: (if (get-buffer "*Buffer List*") (kill-buffer "*Buffer List*"))
611:
612: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
613: ;;; mouse fill (useful to re-format mail messages with long lines
614: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
615: (defun mouse-fill-paragraph (w x y)
616: "Utility function to fill paragraphs from mouse click,
617: useful in Mail to read things that have long lines."
618: (eval-in-window w
619: (mouse-move-point w x y)
620: (let (fill-prefix)
621: (fill-paragraph nil))))
622:
623:
624: (defun fill-some-paragraphs ()
625: "*Fill the succeeding paragraphs that have the same prefix."
626: (interactive)
627: (let (fill-prefix fpr eop beg end)
628: (set-fill-prefix)
629: ;; if no fill-prefix, then match lines beginning with an alpha char.
630: (setq fpr (or fill-prefix "[a-zA-Z]"))
631: (setq fpr (if (let ((sm (string-match "[ \t]*" fpr)))
632: (and sm (= (length fpr) (match-end 0))))
633: ;; if fill-prefix is just TAB-SPACE, then also accept
634: ;; empty lines in the region.
635: (concat "\\(" fpr "\\)\\|\\(^$\\)")
636: (regexp-quote fpr)
637: ))
638: ;; now that we have the prefix, find a region of lines that match:
639: (save-excursion
640: (beginning-of-line 1)
641: (setq beg (point))
642: ;; find lines with similar prefixes:
643: (while (progn (forward-line 1)
644: (setq end (point))
645: (and (not (eobp)) (looking-at fpr))))
646: (fill-region beg end nil))))
647:
648: ;; fill all succeeding paragraphs with this fill prefix
649: (defun mouse-fill-paragraphs (w x y)
650: "Utility function to fill paragraphs from mouse click,
651: useful in Mail to read things that have long lines."
652: (eval-in-window w
653: (mouse-move-point w x y)
654: (fill-some-paragraphs)))
655:
656: ;;;*******************************************************************
657: ;;;
658: ;;; Global Mouse Bindings.
659: ;;;
660: ;;; There is some sense to this mouse binding madness:
661: ;;; LEFT and RIGHT scrolls are inverses.
662: ;;; SHIFT makes an opposite meaning in the scroll bar.
663: ;;; SHIFT is an alternative to DOUBLE (but double chords do not exist).
664: ;;; META makes the scrollbar functions work in the text region.
665: ;;; MIDDLE operates the mark
666: ;;; LEFT operates at point
667:
668: ;;; META commands are generally non-destructive,
669: ;;; SHIFT is a little more dangerous.
670: ;;; CONTROL is for the really complicated ones.
671:
672: ;;; CONTROL-META-SHIFT-RIGHT gives help on that region.
673:
674: ;;;
675: ;;; Text Region mousemap
676: ;;;
677: ;; The basics: Point, Mark, Menu, Sun-Select:
678: (global-set-mouse '(text left) 'mouse-drag-move-point)
679: (global-set-mouse '(text up left) 'mouse-drag-set-mark-stuff)
680: (global-set-mouse '(text shift left) 'mouse-exch-pt-and-mark)
681: (global-set-mouse '(text double left) 'mouse-exch-pt-and-mark)
682:
683: (global-set-mouse '(text middle) 'mouse-set-mark-and-stuff)
684:
685: (global-set-mouse '(text right) 'emacs-menu-eval)
686: (global-set-mouse '(text shift right) '(sun-yank-selection))
687: (global-set-mouse '(text double right) '(sun-yank-selection))
688:
689: ;; The Slymoblics multi-command for Save, Kill, Copy, Move:
690: (global-set-mouse '(text shift middle) 'mouse-save/delete/yank)
691: (global-set-mouse '(text double middle) 'mouse-save/delete/yank)
692:
693: ;; Save, Kill, Copy, Move Things:
694: ;; control-left composes with control middle/right to produce copy/move
695: (global-set-mouse '(text control middle ) 'mouse-save-thing-there)
696: (global-set-mouse '(text control right ) 'mouse-kill-thing-there)
697: (global-set-mouse '(text control left) 'mouse-yank-at-point)
698: (global-set-mouse '(text control middle left) 'mouse-copy-thing)
699: (global-set-mouse '(text control right left) 'mouse-move-thing)
700: (global-set-mouse '(text control right middle) 'mouse-mark-thing)
701:
702: ;; The Universal mouse help command (press all buttons):
703: (global-set-mouse '(text shift control meta right) 'mouse-help-region)
704: (global-set-mouse '(text double control meta right) 'mouse-help-region)
705:
706: ;;; Meta in Text Region is like meta version in scrollbar:
707: (global-set-mouse '(text meta left) 'mouse-line-to-top)
708: (global-set-mouse '(text meta shift left) 'mouse-line-to-bottom)
709: (global-set-mouse '(text meta double left) 'mouse-line-to-bottom)
710: (global-set-mouse '(text meta middle) 'mouse-line-to-middle)
711: (global-set-mouse '(text meta shift middle) 'mouse-middle-to-line)
712: (global-set-mouse '(text meta double middle) 'mouse-middle-to-line)
713: (global-set-mouse '(text meta control middle) 'mouse-split-vertically)
714: (global-set-mouse '(text meta right) 'mouse-top-to-line)
715: (global-set-mouse '(text meta shift right) 'mouse-bottom-to-line)
716: (global-set-mouse '(text meta double right) 'mouse-bottom-to-line)
717:
718: ;; Miscellaneous:
719: (global-set-mouse '(text meta control left) 'mouse-call-kbd-macro)
720: (global-set-mouse '(text meta control right) 'mouse-undo)
721:
722: ;;;
723: ;;; Scrollbar mousemap.
724: ;;; Are available in the Scrollbar Region, or with Meta Text (or Meta Scrollbar)
725: ;;;
726: (global-set-mouse '(scrollbar left) 'mouse-line-to-top)
727: (global-set-mouse '(scrollbar shift left) 'mouse-line-to-bottom)
728: (global-set-mouse '(scrollbar double left) 'mouse-line-to-bottom)
729:
730: (global-set-mouse '(scrollbar middle) 'mouse-line-to-middle)
731: (global-set-mouse '(scrollbar shift middle) 'mouse-middle-to-line)
732: (global-set-mouse '(scrollbar double middle) 'mouse-middle-to-line)
733: (global-set-mouse '(scrollbar control middle) 'mouse-split-vertically)
734:
735: (global-set-mouse '(scrollbar right) 'mouse-top-to-line)
736: (global-set-mouse '(scrollbar shift right) 'mouse-bottom-to-line)
737: (global-set-mouse '(scrollbar double right) 'mouse-bottom-to-line)
738:
739: (global-set-mouse '(scrollbar meta left) 'mouse-line-to-top)
740: (global-set-mouse '(scrollbar meta shift left) 'mouse-line-to-bottom)
741: (global-set-mouse '(scrollbar meta double left) 'mouse-line-to-bottom)
742: (global-set-mouse '(scrollbar meta middle) 'mouse-line-to-middle)
743: (global-set-mouse '(scrollbar meta shift middle) 'mouse-middle-to-line)
744: (global-set-mouse '(scrollbar meta double middle) 'mouse-middle-to-line)
745: (global-set-mouse '(scrollbar meta control middle) 'mouse-split-vertically)
746: (global-set-mouse '(scrollbar meta right) 'mouse-top-to-line)
747: (global-set-mouse '(scrollbar meta shift right) 'mouse-bottom-to-line)
748: (global-set-mouse '(scrollbar meta double right) 'mouse-bottom-to-line)
749:
750: ;; And the help menu:
751: (global-set-mouse '(scrollbar shift control meta right) 'mouse-help-region)
752: (global-set-mouse '(scrollbar double control meta right) 'mouse-help-region)
753:
754: ;;;
755: ;;; Modeline mousemap.
756: ;;;
757: ;;; Note: meta of any single button selects window.
758:
759: (global-set-mouse '(modeline double left) 'mouse-scroll-up)
760: (global-set-mouse '(modeline shift left) 'mouse-scroll-up)
761: (global-set-mouse '(modeline double middle) 'mouse-scroll-proportional)
762: (global-set-mouse '(modeline shift middle) 'mouse-scroll-proportional)
763: (global-set-mouse '(modeline double right) 'mouse-scroll-down)
764: (global-set-mouse '(modeline shift right) 'mouse-scroll-down)
765:
766: (global-set-mouse '(modeline meta left) 'mouse-select-window)
767: (global-set-mouse '(modeline meta middle) 'mouse-select-window)
768: (global-set-mouse '(modeline meta right) 'mouse-select-window)
769:
770: ;;; control-left selects this window, control-right deletes it.
771: (global-set-mouse '(modeline control left) 'mouse-delete-other-windows)
772: (global-set-mouse '(modeline control middle) 'mouse-split-horizontally)
773: (global-set-mouse '(modeline control right) 'mouse-delete-window)
774:
775: ;; in case of confusion, just select it:
776: (global-set-mouse '(modeline control left right)'mouse-select-window)
777:
778: ;; even without confusion (and without the keyboard) select it:
779: (global-set-mouse '(modeline left right) 'mouse-select-window)
780:
781: ;; And the help menu:
782: (global-set-mouse '(modeline shift control meta right) 'mouse-help-region)
783: (global-set-mouse '(modeline double control meta right) 'mouse-help-region)
784:
785:
786: ;;;
787: ;;; Minibuffer Mousemap
788: ;;; Demonstrating some variety:
789: ;;;
790: (global-set-mouse '(minibuffer left) 'mini-move-point)
791:
792: (global-set-mouse '(minibuffer middle) 'mini-set-mark-and-stuff)
793:
794: (global-set-mouse '(minibuffer shift middle) '(prev-complex-command))
795: (global-set-mouse '(minibuffer double middle) '(prev-complex-command))
796: (global-set-mouse '(minibuffer control middle) '(next-complex-command 1))
797: (global-set-mouse '(minibuffer meta middle) '(previous-complex-command 1))
798:
799: (global-set-mouse '(minibuffer right) 'minibuffer-menu-eval)
800:
801: (global-set-mouse '(minibuffer shift control meta right) 'mouse-help-region)
802: (global-set-mouse '(minibuffer double control meta right) 'mouse-help-region)
803:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.