sun-fns.el

早期freebsd实现

	;; end due to roundoff error, and we often really want to go
	;; to the end.
	(goto-char (point-max))
      (progn
	(goto-char (+ (point-min)	; For narrowed regions.
		      (* x (/ (- (point-max) (point-min))
			      (1- (window-width))))))
	(beginning-of-line))
      )
    (what-cursor-position)		; Report position.
    ))

(defun mouse-line-to-top (window x y)
  "Scrolls the line at the mouse cursor up to the top."
  (eval-in-window window (scroll-up y)))

(defun mouse-top-to-line (window x y)
  "Scrolls the top line down to the mouse cursor."
  (eval-in-window window (scroll-down y)))

(defun mouse-line-to-bottom (window x y)
  "Scrolls the line at the mouse cursor to the bottom."
  (eval-in-window window (scroll-up (+ y (- 2 (window-height))))))

(defun mouse-bottom-to-line (window x y)
  "Scrolls the bottom line up to the mouse cursor."
  (eval-in-window window (scroll-down (+ y (- 2 (window-height))))))

(defun mouse-line-to-middle (window x y)
  "Scrolls the line at the mouse cursor to the middle."
  (eval-in-window window (scroll-up (- y -1 (/ (window-height) 2)))))

(defun mouse-middle-to-line (window x y)
  "Scrolls the line at the middle to the mouse cursor."
  (eval-in-window window (scroll-up (- (/ (window-height) 2) y 1))))


;;;
;;; main emacs menu.
;;;
(defmenu expand-menu
  ("Vertically" mouse-expand-vertically *menu-window*)
  ("Horizontally" mouse-expand-horizontally *menu-window*))

(defmenu delete-window-menu
  ("This One" delete-window *menu-window*)
  ("All Others" delete-other-windows *menu-window*))

(defmenu mouse-help-menu
  ("Text Region"
   mouse-help-region *menu-window* *menu-x* *menu-y* 'text)
  ("Scrollbar"
   mouse-help-region *menu-window* *menu-x* *menu-y* 'scrollbar)
  ("Modeline"
   mouse-help-region *menu-window* *menu-x* *menu-y* 'modeline)
  ("Minibuffer"
   mouse-help-region *menu-window* *menu-x* *menu-y* 'minibuffer)
  )
  
(defmenu emacs-quit-menu
  ("Suspend" suspend-emacstool)
  ("Quit" save-buffers-kill-emacs))

(defmenu emacs-menu
  ("Emacs Menu")
  ("Stuff Selection" sun-yank-selection)
  ("Expand" . expand-menu)
  ("Delete Window" . delete-window-menu)
  ("Previous Buffer" mouse-select-previous-buffer *menu-window*)
  ("Save Buffers" save-some-buffers)
  ("List Directory" list-directory nil)
  ("Dired" dired nil)
  ("Mouse Help" . mouse-help-menu)
  ("Quit" . emacs-quit-menu))

(defun emacs-menu-eval (window x y)
  "Pop-up menu of editor commands."
  (sun-menu-evaluate window (1+ x) (1- y) 'emacs-menu))

(defun mouse-expand-horizontally (window)
  (eval-in-window window
    (enlarge-window 4 t)
    (update-display)		; Try to redisplay, since can get confused.
    ))

(defun mouse-expand-vertically (window)
  (eval-in-window window (enlarge-window 4)))

(defun mouse-select-previous-buffer (window)
  "Switch buffer in mouse window to most recently selected buffer."
  (eval-in-window window (switch-to-buffer (other-buffer))))

;;;
;;; minibuffer menu
;;;
(defmenu minibuffer-menu 
  ("Minibuffer" message "Just some miscellanous minibuffer commands")
  ("Stuff" sun-yank-selection)
  ("Do-It" exit-minibuffer)
  ("Abort" abort-recursive-edit)
  ("Suspend" suspend-emacs))

(defun minibuffer-menu-eval (window x y)
  "Pop-up menu of commands."
  (sun-menu-evaluate window x (1- y) 'minibuffer-menu))

(defun mini-move-point (window x y)
  ;; -6 is good for most common cases
  (mouse-move-point window (- x 6) 0))

(defun mini-set-mark-and-stuff (window x y)
  ;; -6 is good for most common cases
  (mouse-set-mark-and-stuff window (- x 6) 0))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;; Buffer-mode Mouse commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 

(defun Buffer-at-mouse (w x y)
  "Calls Buffer-menu-buffer from mouse click."
  (save-window-excursion 
    (mouse-move-point w x y)
    (beginning-of-line)
    (Buffer-menu-buffer t)))

(defun mouse-buffer-bury (w x y)
  "Bury the indicated buffer."
  (bury-buffer (Buffer-at-mouse w x y))
  )

(defun mouse-buffer-select (w x y)
  "Put the indicated buffer in selected window."
  (switch-to-buffer (Buffer-at-mouse w x y))
  (list-buffers)
  )

(defun mouse-buffer-delete (w x y)
  "mark indicated buffer for delete"
  (save-window-excursion
    (mouse-move-point w x y)
    (Buffer-menu-delete)
    ))

(defun mouse-buffer-execute (w x y)
  "execute buffer-menu selections"
  (save-window-excursion
    (mouse-move-point w x y)
    (Buffer-menu-execute)
    ))
  
(defun enable-mouse-in-buffer-list ()
  "Call this to enable mouse selections in *Buffer List*
    LEFT puts the indicated buffer in the selected window.
    MIDDLE buries the indicated buffer.
    RIGHT marks the indicated buffer for deletion.
    MIDDLE-RIGHT deletes the marked buffers.
To unmark a buffer marked for deletion, select it with LEFT."
  (save-window-excursion
    (list-buffers)			; Initialize *Buffer List*
    (set-buffer "*Buffer List*")
    (local-set-mouse '(text middle) 'mouse-buffer-bury)
    (local-set-mouse '(text left) 'mouse-buffer-select)	    
    (local-set-mouse '(text right) 'mouse-buffer-delete)
    (local-set-mouse '(text middle right) 'mouse-buffer-execute)
    )
  )


;;;*******************************************************************
;;;
;;;           Global Mouse Bindings.
;;;
;;; There is some sense to this mouse binding madness:
;;; LEFT and RIGHT scrolls are inverses.
;;; SHIFT makes an opposite meaning in the scroll bar.
;;; SHIFT is an alternative to DOUBLE (but double chords do not exist).
;;; META makes the scrollbar functions work in the text region.
;;; MIDDLE operates the mark
;;; LEFT operates at point

;;; META commands are generally non-destructive,
;;; SHIFT is a little more dangerous.
;;; CONTROL is for the really complicated ones.

;;; CONTROL-META-SHIFT-RIGHT gives help on that region.

;;;
;;; Text Region mousemap
;;;
;; The basics: Point, Mark, Menu, Sun-Select:
(global-set-mouse '(text        left)	'mouse-drag-move-point)
(global-set-mouse '(text     up left)	'mouse-drag-set-mark-stuff)
(global-set-mouse '(text shift  left)	'mouse-exch-pt-and-mark)
(global-set-mouse '(text double left)	'mouse-exch-pt-and-mark)

(global-set-mouse '(text	middle)	'mouse-set-mark-and-stuff)

(global-set-mouse '(text	right)	'emacs-menu-eval)
(global-set-mouse '(text shift	right)	'(sun-yank-selection))
(global-set-mouse '(text double	right)	'(sun-yank-selection))

;; The Slymoblics multi-command for Save, Kill, Copy, Move:
(global-set-mouse '(text shift	middle)	'mouse-save/delete/yank)
(global-set-mouse '(text double	middle)	'mouse-save/delete/yank)

;; Save, Kill, Copy, Move Things:
;; control-left composes with control middle/right to produce copy/move
(global-set-mouse '(text control middle	    )	'mouse-save-thing-there)
(global-set-mouse '(text control right      )	'mouse-kill-thing-there)
(global-set-mouse '(text control 	left)	'mouse-yank-at-point)
(global-set-mouse '(text control middle	left)	'mouse-copy-thing)
(global-set-mouse '(text control right	left)	'mouse-move-thing)
(global-set-mouse '(text control right middle)	'mouse-mark-thing)

;; The Universal mouse help command (press all buttons):
(global-set-mouse '(text shift  control meta right)	'mouse-help-region)
(global-set-mouse '(text double control meta right)	'mouse-help-region)

;;; Meta in Text Region is like meta version in scrollbar:
(global-set-mouse '(text meta        left)	'mouse-line-to-top)
(global-set-mouse '(text meta shift  left)	'mouse-line-to-bottom)
(global-set-mouse '(text meta double left)	'mouse-line-to-bottom)
(global-set-mouse '(text meta         middle)	'mouse-line-to-middle)
(global-set-mouse '(text meta shift   middle)	'mouse-middle-to-line)
(global-set-mouse '(text meta double  middle)	'mouse-middle-to-line)
(global-set-mouse '(text meta control middle)	'mouse-split-vertically)
(global-set-mouse '(text meta        right)	'mouse-top-to-line)
(global-set-mouse '(text meta shift  right)	'mouse-bottom-to-line)
(global-set-mouse '(text meta double right)	'mouse-bottom-to-line)

;; Miscellaneous:
(global-set-mouse '(text meta control left)	'mouse-call-kbd-macro)
(global-set-mouse '(text meta control right)	'mouse-undo)

;;;
;;; Scrollbar mousemap.
;;; Are available in the Scrollbar Region, or with Meta Text (or Meta Scrollbar)
;;;
(global-set-mouse '(scrollbar        left)	'mouse-line-to-top)
(global-set-mouse '(scrollbar shift  left)	'mouse-line-to-bottom)
(global-set-mouse '(scrollbar double left)	'mouse-line-to-bottom)

(global-set-mouse '(scrollbar         middle)	'mouse-line-to-middle)
(global-set-mouse '(scrollbar shift   middle)	'mouse-middle-to-line)
(global-set-mouse '(scrollbar double  middle)	'mouse-middle-to-line)
(global-set-mouse '(scrollbar control middle)	'mouse-split-vertically)

(global-set-mouse '(scrollbar        right)	'mouse-top-to-line)
(global-set-mouse '(scrollbar shift  right)	'mouse-bottom-to-line)
(global-set-mouse '(scrollbar double right)	'mouse-bottom-to-line)

(global-set-mouse '(scrollbar meta        left)		'mouse-line-to-top)
(global-set-mouse '(scrollbar meta shift  left)		'mouse-line-to-bottom)
(global-set-mouse '(scrollbar meta double left)		'mouse-line-to-bottom)
(global-set-mouse '(scrollbar meta         middle)	'mouse-line-to-middle)
(global-set-mouse '(scrollbar meta shift   middle)	'mouse-middle-to-line)
(global-set-mouse '(scrollbar meta double  middle)	'mouse-middle-to-line)
(global-set-mouse '(scrollbar meta control middle)	'mouse-split-vertically)
(global-set-mouse '(scrollbar meta        right)	'mouse-top-to-line)
(global-set-mouse '(scrollbar meta shift  right)	'mouse-bottom-to-line)
(global-set-mouse '(scrollbar meta double right)	'mouse-bottom-to-line)

;; And the help menu:
(global-set-mouse '(scrollbar shift  control meta right) 'mouse-help-region)
(global-set-mouse '(scrollbar double control meta right) 'mouse-help-region)

;;;
;;; Modeline mousemap.
;;;
;;; Note: meta of any single button selects window.

(global-set-mouse '(modeline      left)	'mouse-scroll-up)
(global-set-mouse '(modeline meta left)	'mouse-select-window)

(global-set-mouse '(modeline         middle)	'mouse-scroll-proportional)
(global-set-mouse '(modeline meta    middle)	'mouse-select-window)
(global-set-mouse '(modeline control middle)	'mouse-split-horizontally)

(global-set-mouse '(modeline      right)	'mouse-scroll-down)
(global-set-mouse '(modeline meta right)	'mouse-select-window)

;;; control-left selects this window, control-right deletes it.
(global-set-mouse '(modeline control left)	'mouse-delete-other-windows)
(global-set-mouse '(modeline control right)	'mouse-delete-window)

;; in case of confusion, just select it:
(global-set-mouse '(modeline control left right)'mouse-select-window)

;; even without confusion (and without the keyboard) select it:
(global-set-mouse '(modeline left right)	'mouse-select-window)

;; And the help menu:
(global-set-mouse '(modeline shift  control meta right)	'mouse-help-region)
(global-set-mouse '(modeline double control meta right)	'mouse-help-region)

;;;
;;; Minibuffer Mousemap
;;; Demonstrating some variety:
;;;
(global-set-mouse '(minibuffer left)		'mini-move-point)

(global-set-mouse '(minibuffer         middle)	'mini-set-mark-and-stuff)

(global-set-mouse '(minibuffer shift   middle) '(prev-complex-command))
(global-set-mouse '(minibuffer double  middle) '(prev-complex-command))
(global-set-mouse '(minibuffer control middle) '(next-complex-command 1))
(global-set-mouse '(minibuffer meta    middle) '(previous-complex-command 1))

(global-set-mouse '(minibuffer right)	'minibuffer-menu-eval)

(global-set-mouse '(minibuffer shift  control meta right)  'mouse-help-region)
(global-set-mouse '(minibuffer double control meta right)  'mouse-help-region)