Return to sun-fns.el CVS log

Up to [Apple XNU] / GNUtools / emacs / lisp

Annotation of GNUtools/emacs/lisp/sun-fns.el, revision 1.1

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.