Mercurial > emacs
changeset 39021:b2a0a21002ae
Moved to obsolete/.
| author | Gerd Moellmann <gerd@gnu.org> |
|---|---|
| date | Thu, 30 Aug 2001 07:34:39 +0000 |
| parents | 758df10fd66b |
| children | 9a10bb9ac325 |
| files | lisp/rsz-mini.el lisp/sun-curs.el lisp/sun-fns.el lisp/x-apollo.el lisp/x-menu.el |
| diffstat | 5 files changed, 0 insertions(+), 1193 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/rsz-mini.el Thu Aug 30 06:52:19 2001 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,84 +0,0 @@ -;;; rsz-mini.el --- dynamically resize minibuffer to display entire contents - -;; Copyright (C) 1990, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. - -;; Author: Noah Friedman <friedman@splode.com> -;; Roland McGrath <roland@gnu.org> -;; Maintainer: Noah Friedman <friedman@splode.com> -;; Keywords: minibuffer, window, frame, display - -;; $Id: rsz-mini.el,v 1.28 2000/12/06 19:36:57 fx Exp $ - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This package is obsolete. Emacs now resizes mini-windows -;; automatically. - -;;; Code: - - -(defgroup resize-minibuffer nil - "This customization group is obsolete." - :group 'frames) - -;;;###autoload -(defcustom resize-minibuffer-mode nil - "*This variable is obsolete." - :type 'boolean - :group 'resize-minibuffer - :require 'rsz-mini) - -;;;###autoload -(defcustom resize-minibuffer-window-max-height nil - "*This variable is obsolete." - :type '(choice (const nil) integer) - :group 'resize-minibuffer) - -;;;###autoload -(defcustom resize-minibuffer-window-exactly t - "*This variable is obsolete." - :type 'boolean - :group 'resize-minibuffer) - -;;;###autoload -(defcustom resize-minibuffer-frame nil - "*This variable is obsolete." - :type 'boolean - :group 'resize-minibuffer) - -;;;###autoload -(defcustom resize-minibuffer-frame-max-height nil - "*This variable is obsolete.") - -;;;###autoload -(defcustom resize-minibuffer-frame-exactly t - "*This variable is obsolete." - :type 'boolean - :group 'resize-minibuffer) - - -;;;###autoload -(defun resize-minibuffer-mode (&optional prefix) - "This function is obsolete." - (interactive "P")) - -(provide 'rsz-mini) - -;;; rsz-mini.el ends here
--- a/lisp/sun-curs.el Thu Aug 30 06:52:19 2001 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,221 +0,0 @@ -;;; sun-curs.el --- cursor definitions for Sun windows - -;; Copyright (C) 1987 Free Software Foundation, Inc. - -;; Author: Jeff Peck <peck@sun.com> -;; Keywords: hardware - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -;;; -;;; Added some more cursors and moved the hot spots -;;; Cursor defined by 16 pairs of 16-bit numbers -;;; -;;; 9-dec-86 Jeff Peck, Sun Microsystems Inc. <peck@sun.com> - -(eval-when-compile (require 'cl)) -(require 'sun-fns) - -(eval-and-compile - (defvar sc::cursors nil "List of known cursors")) - -(defmacro defcursor (name x y string) - (if (not (memq name sc::cursors)) - (setq sc::cursors (cons name sc::cursors))) - (list 'defconst name (list 'vector x y string))) - -;;; push should be defined in common lisp, but if not use this: -;(defmacro push (v l) -; "The ITEM is evaluated and consed onto LIST, a list-valued atom" -; (list 'setq l (list 'cons v l))) - -;;; -;;; The standard default cursor -;;; -(defcursor sc:right-arrow 15 0 - (concat '(0 1 0 3 0 7 0 15 0 31 0 63 0 127 0 15 - 0 27 0 25 0 48 0 48 0 96 0 96 0 192 0 192))) - -;;(sc:set-cursor sc:right-arrow) - -(defcursor sc:fat-left-arrow 0 8 - (concat '(1 0 3 0 7 0 15 0 31 0 63 255 127 255 255 255 - 255 255 127 255 63 255 31 0 15 0 7 0 3 0 1 0))) - -(defcursor sc:box 8 8 - (concat '(15 252 8 4 8 4 8 4 8 4 8 4 8 4 8 4 - 8 132 8 4 8 4 8 4 8 4 8 4 8 4 15 252))) - -(defcursor sc:hourglass 8 8 - (concat "\177\376\100\002\040\014\032\070" - "\017\360\007\340\003\300\001\200" - "\001\200\002\100\005\040\010\020" - "\021\210\043\304\107\342\177\376")) - -(defun sc:set-cursor (icon) - "Change the Sun mouse cursor to ICON. -If ICON is nil, switch to the system default cursor, -Otherwise, ICON should be a vector or the name of a vector of [x y 32-chars]" - (interactive "XIcon Name: ") - (if (symbolp icon) (setq icon (symbol-value icon))) - (sun-change-cursor-icon icon)) - -(make-local-variable '*edit-icon*) -(make-variable-buffer-local 'icon-edit) -(setq-default icon-edit nil) -(or (assq 'icon-edit minor-mode-alist) - (push '(icon-edit " IconEdit") minor-mode-alist)) - -(defun sc:edit-cursor (icon) - "convert icon to rectangle, edit, and repack" - (interactive "XIcon Name: ") - (if (not icon) (setq icon (sc::menu-choose-cursor (selected-window) 1 1))) - (if (symbolp icon) (setq icon (symbol-value icon))) - (if (get-buffer "icon-edit") (kill-buffer "icon-edit")) - (switch-to-buffer "icon-edit") - (local-set-mouse '(text right) 'sc::menu-function) - (local-set-mouse '(text left) '(sc::pic-ins-at-mouse 32)) - (local-set-mouse '(text middle) '(sc::pic-ins-at-mouse 64)) - (local-set-mouse '(text left middle) 'sc::hotspot) - (sc::display-icon icon) - (picture-mode) - (setq icon-edit t) ; for mode line display -) - -(defun sc::pic-ins-at-mouse (char) - "Picture insert char at mouse location" - (mouse-move-point *mouse-window* (min 15 *mouse-x*) (min 15 *mouse-y*)) - (move-to-column (1+ (min 15 (current-column))) t) - (delete-char -1) - (insert char) - (sc::goto-hotspot)) - -(defun sc::menu-function (window x y) - (sun-menu-evaluate window (1+ x) y sc::menu)) - -(defmenu sc::menu - ("Cursor Menu") - ("Pack & Use" sc::pack-buffer-to-cursor) - ("Pack to Icon" sc::pack-buffer-to-icon - (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) - ("New Icon" call-interactively 'sc::make-cursor) - ("Edit Icon" sc:edit-cursor - (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) - ("Set Cursor" sc:set-cursor - (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) - ("Reset Cursor" sc:set-cursor nil) - ("Help" sc::edit-icon-help-menu) - ("Quit" sc::quit-edit) - ) - -(defun sc::quit-edit () - (interactive) - (bury-buffer (current-buffer)) - (switch-to-buffer (other-buffer) 'no-record)) - -(defun sc::make-cursor (symbol) - (interactive "SIcon Name: ") - (eval (list 'defcursor symbol 0 0 "")) - (sc::pack-buffer-to-icon (symbol-value symbol))) - -(defmenu sc::edit-icon-help-menu - ("Simple Icon Editor") - ("Left => CLEAR") - ("Middle => SET") - ("L & M => HOTSPOT") - ("Right => MENU")) - -(defun sc::edit-icon-help () - (message "Left=> CLEAR Middle=> SET Left+Middle=> HOTSPOT Right=> MENU")) - -(defun sc::pack-buffer-to-cursor () - (sc::pack-buffer-to-icon *edit-icon*) - (sc:set-cursor *edit-icon*)) - -(defun sc::menu-choose-cursor (window x y) - "Presents a menu of cursor names, and returns one or nil" - (let ((curs sc::cursors) - (items)) - (while curs - (push (sc::menu-item-for-cursor (car curs)) items) - (setq curs (cdr curs))) - (push (list "Choose Cursor") items) - (setq menu (menu-create items)) - (sun-menu-evaluate window x y menu))) - -(defun sc::menu-item-for-cursor (cursor) - "apply function to selected cursor" - (list (symbol-name cursor) 'quote cursor)) - -(defun sc::hotspot (window x y) - (aset *edit-icon* 0 x) - (aset *edit-icon* 1 y) - (sc::goto-hotspot)) - -(defun sc::goto-hotspot () - (goto-line (1+ (aref *edit-icon* 1))) - (move-to-column (aref *edit-icon* 0))) - -(defun sc::display-icon (icon) - (setq *edit-icon* (copy-sequence icon)) - (let ((string (aref *edit-icon* 2)) - (index 0)) - (while (< index 32) - (let ((char (aref string index)) - (bit 128)) - (while (> bit 0) - (insert (sc::char-at-bit char bit)) - (setq bit (lsh bit -1)))) - (if (eq 1 (% index 2)) (newline)) - (setq index (1+ index)))) - (sc::goto-hotspot)) - -(defun sc::char-at-bit (char bit) - (if (> (logand char bit) 0) "@" " ")) - -(defun sc::pack-buffer-to-icon (icon) - "Pack 16 x 16 field into icon string" - (goto-char (point-min)) - (aset icon 0 (aref *edit-icon* 0)) - (aset icon 1 (aref *edit-icon* 1)) - (aset icon 2 (mapconcat 'sc::pack-one-line "1234567890123456" "")) - (sc::goto-hotspot) - ) - -(defun sc::pack-one-line (dummy) - (let* (char chr1 chr2) - (setq char 0 chr1 (mapconcat 'sc::pack-one-char "12345678" "") chr1 char) - (setq char 0 chr2 (mapconcat 'sc::pack-one-char "12345678" "") chr2 char) - (forward-line 1) - (concat (char-to-string chr1) (char-to-string chr2)) - )) - -(defun sc::pack-one-char (dummy) - "pack following char into char, unless eolp" - (if (or (eolp) (char-equal (following-char) 32)) - (setq char (lsh char 1)) - (setq char (1+ (lsh char 1)))) - (if (not (eolp))(forward-char))) - -(provide 'sun-curs) - -;;; sun-curs.el ends here
--- a/lisp/sun-fns.el Thu Aug 30 06:52:19 2001 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,643 +0,0 @@ -;;; sun-fns.el --- subroutines of Mouse handling for Sun windows - -;; Copyright (C) 1987 Free Software Foundation, Inc. - -;; Author: Jeff Peck <peck@sun.com> -;; Maintainer: none -;; Keywords: hardware - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Submitted Mar. 1987, Jeff Peck -;; Sun Microsystems Inc. <peck@sun.com> -;; Conceived Nov. 1986, Stan Jefferson, -;; Computer Science Lab, SRI International. -;; GoodIdeas Feb. 1987, Steve Greenbaum -;; & UpClicks Reasoning Systems, Inc. -;; -;; -;; Functions for manipulating via the mouse and mouse-map definitions -;; for accessing them. Also definitions of mouse menus. -;; This file you should freely modify to reflect you personal tastes. -;; -;; First half of file defines functions to implement mouse commands, -;; Don't delete any of those, just add what ever else you need. -;; Second half of file defines mouse bindings, do whatever you want there. - -;; -;; Mouse Functions. -;; -;; These functions follow the sun-mouse-handler convention of being called -;; with three arguments: (window x-pos y-pos) -;; This makes it easy for a mouse executed command to know where the mouse is. -;; Use the macro "eval-in-window" to execute a function -;; in a temporarily selected window. -;; -;; If you have a function that must be called with other arguments -;; bind the mouse button to an s-exp that contains the necessary parameters. -;; See "minibuffer" bindings for examples. -;; - -;;; Code: - -(require 'term/sun-mouse) - -(defconst cursor-pause-milliseconds 300 - "*Number of milliseconds to display alternate cursor (usually the mark)") - -(defun indicate-region (&optional pause) - "Bounce cursor to mark for cursor-pause-milliseconds and back again" - (or pause (setq pause cursor-pause-milliseconds)) - (let ((point (point))) - (goto-char (mark)) - (sit-for-millisecs pause) - ;(update-display) - ;(sleep-for-millisecs pause) - (goto-char point))) - - -;;; -;;; Text buffer operations -;;; -(defun mouse-move-point (window x y) - "Move point to mouse cursor." - (select-window window) - (move-to-loc x y) - (if (memq last-command ; support the mouse-copy/delete/yank - '(mouse-copy mouse-delete mouse-yank-move)) - (setq this-command 'mouse-yank-move)) - ) - -(defun mouse-set-mark (window x y) - "Set mark at mouse cursor." - (eval-in-window window ;; use this to get the unwind protect - (let ((point (point))) - (move-to-loc x y) - (set-mark (point)) - (goto-char point) - (indicate-region))) - ) - -(defun mouse-set-mark-and-select (window x y) - "Set mark at mouse cursor, and select that window." - (select-window window) - (mouse-set-mark window x y) - ) - -(defun mouse-set-mark-and-stuff (w x y) - "Set mark at mouse cursor, and put region in stuff buffer." - (mouse-set-mark-and-select w x y) - (sun-select-region (region-beginning) (region-end))) - -;;; -;;; Simple mouse dragging stuff: marking with button up -;;; - -(defvar *mouse-drag-window* nil) -(defvar *mouse-drag-x* -1) -(defvar *mouse-drag-y* -1) - -(defun mouse-drag-move-point (window x y) - "Move point to mouse cursor, and allow dragging." - (mouse-move-point window x y) - (setq *mouse-drag-window* window - *mouse-drag-x* x - *mouse-drag-y* y)) - -(defun mouse-drag-set-mark-stuff (window x y) - "The up click handler that goes with mouse-drag-move-point. -If mouse is in same WINDOW but at different X or Y than when -mouse-drag-move-point was last executed, set the mark at mouse -and put the region in the stuff buffer." - (if (and (eq *mouse-drag-window* window) - (not (and (equal *mouse-drag-x* x) - (equal *mouse-drag-y* y)))) - (mouse-set-mark-and-stuff window x y) - (setq this-command last-command)) ; this was just an upclick no-op. - ) - -(defun mouse-select-or-drag-move-point (window x y) - "Select window if not selected, otherwise do mouse-drag-move-point." - (if (eq (selected-window) window) - (mouse-drag-move-point window x y) - (mouse-select-window window x y))) - -;;; -;;; esoterica: -;;; -(defun mouse-exch-pt-and-mark (window x y) - "Exchange point and mark." - (select-window window) - (exchange-point-and-mark) - ) - -(defun mouse-call-kbd-macro (window x y) - "Invokes last keyboard macro at mouse cursor." - (mouse-move-point window x y) - (call-last-kbd-macro) - ) - -(defun mouse-mark-thing (window x y) - "Set point and mark to text object using syntax table. -The resulting region is put in the sun-window stuff buffer. -Left or right Paren syntax marks an s-expression. -Clicking at the end of a line marks the line including a trailing newline. -If it doesn't recognize one of these it marks the character at point." - (mouse-move-point window x y) - (if (eobp) (open-line 1)) - (let* ((char (char-after (point))) - (syntax (char-syntax char))) - (cond - ((eq syntax ?w) ; word. - (forward-word 1) - (set-mark (point)) - (forward-word -1)) - ;; try to include a single following whitespace (is this a good idea?) - ;; No, not a good idea since inconsistent. - ;;(if (eq (char-syntax (char-after (mark))) ?\ ) - ;; (set-mark (1+ (mark)))) - ((eq syntax ?\( ) ; open paren. - (mark-sexp 1)) - ((eq syntax ?\) ) ; close paren. - (forward-char 1) - (mark-sexp -1) - (exchange-point-and-mark)) - ((eolp) ; mark line if at end. - (set-mark (1+ (point))) - (beginning-of-line 1)) - (t ; mark character - (set-mark (1+ (point))))) - (indicate-region)) ; display region boundary. - (sun-select-region (region-beginning) (region-end)) - ) - -(defun mouse-kill-thing (window x y) - "Kill thing at mouse, and put point there." - (mouse-mark-thing window x y) - (kill-region-and-unmark (region-beginning) (region-end)) - ) - -(defun mouse-kill-thing-there (window x y) - "Kill thing at mouse, leave point where it was. -See mouse-mark-thing for a description of the objects recognized." - (eval-in-window window - (save-excursion - (mouse-mark-thing window x y) - (kill-region (region-beginning) (region-end)))) - ) - -(defun mouse-save-thing (window x y &optional quiet) - "Put thing at mouse in kill ring. -See mouse-mark-thing for a description of the objects recognized." - (mouse-mark-thing window x y) - (copy-region-as-kill (region-beginning) (region-end)) - (if (not quiet) (message "Thing saved")) - ) - -(defun mouse-save-thing-there (window x y &optional quiet) - "Put thing at mouse in kill ring, leave point as is. -See mouse-mark-thing for a description of the objects recognized." - (eval-in-window window - (save-excursion - (mouse-save-thing window x y quiet)))) - -;;; -;;; Mouse yanking... -;;; -(defun mouse-copy-thing (window x y) - "Put thing at mouse in kill ring, yank to point. -See mouse-mark-thing for a description of the objects recognized." - (setq last-command 'not-kill) ;Avoids appending to previous kills. - (mouse-save-thing-there window x y t) - (yank) - (setq this-command 'yank)) - -(defun mouse-move-thing (window x y) - "Kill thing at mouse, yank it to point. -See mouse-mark-thing for a description of the objects recognized." - (setq last-command 'not-kill) ;Avoids appending to previous kills. - (mouse-kill-thing-there window x y) - (yank) - (setq this-command 'yank)) - -(defun mouse-yank-at-point (&optional window x y) - "Yank from kill-ring at point; then cycle thru kill ring." - (if (eq last-command 'yank) - (let ((before (< (point) (mark)))) - (delete-region (point) (mark)) - (insert (current-kill 1)) - (if before (exchange-point-and-mark))) - (yank)) - (setq this-command 'yank)) - -(defun mouse-yank-at-mouse (window x y) - "Yank from kill-ring at mouse; then cycle thru kill ring." - (mouse-move-point window x y) - (mouse-yank-at-point window x y)) - -(defun mouse-save/delete/yank (&optional window x y) - "Context sensitive save/delete/yank. -Consecutive clicks perform as follows: - * first click saves region to kill ring, - * second click kills region, - * third click yanks from kill ring, - * subsequent clicks cycle thru kill ring. -If mouse-move-point is performed after the first or second click, -the next click will do a yank, etc. Except for a possible mouse-move-point, -this command is insensitive to mouse location." - (cond - ((memq last-command '(mouse-delete yank mouse-yank-move)) ; third+ click - (mouse-yank-at-point)) - ((eq last-command 'mouse-copy) ; second click - (kill-region (region-beginning) (region-end)) - (setq this-command 'mouse-delete)) - (t ; first click - (copy-region-as-kill (region-beginning) (region-end)) - (message "Region saved") - (setq this-command 'mouse-copy)) - )) - - -(defun mouse-split-horizontally (window x y) - "Splits the window horizontally at mouse cursor." - (eval-in-window window (split-window-horizontally (1+ x)))) - -(defun mouse-split-vertically (window x y) - "Split the window vertically at the mouse cursor." - (eval-in-window window (split-window-vertically (1+ y)))) - -(defun mouse-select-window (window x y) - "Selects the window, restoring point." - (select-window window)) - -(defun mouse-delete-other-windows (window x y) - "Deletes all windows except the one mouse is in." - (delete-other-windows window)) - -(defun mouse-delete-window (window x y) - "Deletes the window mouse is in." - (delete-window window)) - -(defun mouse-undo (window x y) - "Invokes undo in the window mouse is in." - (eval-in-window window (undo))) - -;;; -;;; Scroll operations -;;; - -;;; The move-to-window-line is used below because otherwise -;;; scrolling a non-selected process window with the mouse, after -;;; the process has written text past the bottom of the window, -;;; gives an "End of buffer" error, and then scrolls. The -;;; move-to-window-line seems to force recomputing where things are. -(defun mouse-scroll-up (window x y) - "Scrolls the window upward." - (eval-in-window window (move-to-window-line 1) (scroll-up nil))) - -(defun mouse-scroll-down (window x y) - "Scrolls the window downward." - (eval-in-window window (scroll-down nil))) - -(defun mouse-scroll-proportional (window x y) - "Scrolls the window proportionally corresponding to window -relative X divided by window width." - (eval-in-window window - (if (>= x (1- (window-width))) - ;; When x is maximum (equal to or 1 less than window width), - ;; goto end of buffer. We check for this special case - ;; because the calculated goto-char often goes short of the - ;; 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 miscellaneous 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) '(select-previous-complex-command)) -(global-set-mouse '(minibuffer double middle) '(select-previous-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) - -(provide 'sun-fns) - -;;; sun-fns.el ends here
--- a/lisp/x-apollo.el Thu Aug 30 06:52:19 2001 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,96 +0,0 @@ -;;; x-apollo.el --- Apollo support functions - -;; Copyright (C) 1995 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(defun apollo-kill-entire-line () - "Kill the entire line containing point." - (interactive) - (beginning-of-line) - (kill-line 1)) - -(defun apollo-scroll-window-right () - "Scroll window to right ten columns." - (interactive) - (scroll-left 10)) - -(defun apollo-scroll-window-left () - "Scroll window to left ten columns." - (interactive) - (scroll-right 10)) - -(defun apollo-scroll-window-forward-line () - "Move window forward one line leaving cursor at position in window." - (interactive) - (scroll-up 1)) - -(defun apollo-scroll-window-backward-line () - "Move window backward one line leaving cursor at position in window." - (interactive) - (scroll-down 1)) - -;;; Define and Enable the Function Key Bindings. - -(global-set-key [S-tab] "\C-i") ;Shift TAB -(global-set-key [C-tab] "\C-i") ;Control TAB -(global-set-key [S-return] "\C-m") ;Shift RET -(global-set-key [C-return] "\C-m") ;Control RET -(global-set-key [linedel] 'apollo-kill-entire-line) ;LINE DEL -(global-set-key [chardel] 'delete-char) ;CHAR DEL -(global-set-key [leftbar] 'beginning-of-line) ;LEFT BAR ARROW -(global-set-key [rightbar] 'end-of-line) ;RIGHT BAR ARROW -(global-set-key [leftbox] 'apollo-scroll-window-left) ;LEFT BOX ARROW -(global-set-key [rightbox] 'apollo-scroll-window-right) ;RIGHT BOX ARROW -(global-set-key [S-up] 'apollo-scroll-window-backward-line) ;Shift UP ARROW -(global-set-key [S-down] 'apollo-scroll-window-forward-line) ;Shift DOWN ARROW -(global-set-key [select] 'set-mark-command) ;MARK -(global-set-key [S-insert] 'overwrite-mode) ;INS MODE -(global-set-key [S-linedel] 'yank) ;Shift LINE DEL -(global-set-key [S-chardel] 'delete-char) ;Shift CHAR DEL -(global-set-key [copy] 'copy-region-as-kill) ;COPY -(global-set-key [S-cut] 'kill-region) ;CUT -(global-set-key [paste] 'yank) ;PASTE -(global-set-key [S-undo] 'undo) ;UNDO -(global-set-key [S-left] 'backward-word) ;Shift LEFT ARROW -(global-set-key [S-right] 'forward-word) ;Shift RIGHT ARROW -(global-set-key [upbox] 'scroll-down) ;UP BOX ARROW -(global-set-key [S-upbox] 'beginning-of-buffer) ;Shift UP BOX ARROW -(global-set-key [downbox] 'scroll-up) ;DOWN BOX ARROW -(global-set-key [S-downbox] 'end-of-buffer) ;Shift DOWN BOX ARROW -(global-set-key [S-redo] 'toggle-read-only) ;Shift AGAIN -(global-set-key [exit] 'save-buffer) ;EXIT -(global-set-key [S-cancel] 'kill-buffer) ;ABORT -(global-set-key [S-save] 'save-buffer) ;SAVE -(global-set-key [S-leftbar] 'beginning-of-buffer) ;Shift LEFT BAR ARROW -(global-set-key [cmd] 'execute-extended-command) ;CMD -(global-set-key [S-rightbar] 'end-of-buffer) ;Shift RIGHT BAR ARROW -(global-set-key [next] 'other-window) ;NEXT WNDW -(global-set-key [S-next] 'delete-window) ;Shift NEXT WNDW -(global-set-key [read] 'find-file-read-only) ;READ -(global-set-key [edit] 'find-file) ;EDIT -(global-set-key [S-shell] 'shell) ;SHELL -(global-set-key [S-help] 'manual-entry) ;HELP - -(provide 'x-apollo) - -;;; x-apollo.el ends here
--- a/lisp/x-menu.el Thu Aug 30 06:52:19 2001 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -;;; x-menu.el --- menu support for X - -;; Copyright (C) 1986 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(defun x-menu-mode () - "Major mode for creating permanent menus for use with X. -These menus are implemented entirely in Lisp; popup menus, implemented -with x-popup-menu, are implemented using XMenu primitives." - (make-local-variable 'x-menu-items-per-line) - (make-local-variable 'x-menu-item-width) - (make-local-variable 'x-menu-items-alist) - (make-local-variable 'x-process-mouse-hook) - (make-local-variable 'x-menu-assoc-buffer) - (setq buffer-read-only t) - (setq truncate-lines t) - (setq x-process-mouse-hook 'x-menu-pick-entry) - (setq mode-line-buffer-identification '("MENU: %32b"))) - -(defvar x-menu-max-width 0) -(defvar x-menu-items-per-line 0) -(defvar x-menu-item-width 0) -(defvar x-menu-items-alist nil) -(defvar x-menu-assoc-buffer nil) - -(defvar x-menu-item-spacing 1 - "*Minimum horizontal spacing between objects in a permanent X menu.") - -(defun x-menu-create-menu (name) - "Create a permanent X menu. -Returns an item which should be used as a -menu object whenever referring to the menu." - (let ((old (current-buffer)) - (buf (get-buffer-create name))) - (set-buffer buf) - (x-menu-mode) - (setq x-menu-assoc-buffer old) - (set-buffer old) - buf)) - -(defun x-menu-change-associated-buffer (menu buffer) - "Change associated buffer of MENU to BUFFER. -BUFFER should be a buffer object." - (let ((old (current-buffer))) - (set-buffer menu) - (setq x-menu-assoc-buffer buffer) - (set-buffer old))) - -(defun x-menu-add-item (menu item binding) - "Add to MENU an item with name ITEM, associated with BINDING. -Following a sequence of calls to x-menu-add-item, a call to x-menu-compute -should be performed before the menu will be made available to the user. - -BINDING should be a function of one argument, which is the numerical -button/key code as defined in x-menu.el." - (let ((old (current-buffer)) - elt) - (set-buffer menu) - (if (setq elt (assoc item x-menu-items-alist)) - (rplacd elt binding) - (setq x-menu-items-alist (append x-menu-items-alist - (list (cons item binding))))) - (set-buffer old) - item)) - -(defun x-menu-delete-item (menu item) - "Delete from MENU the item named ITEM. -Call `x-menu-compute' before making the menu available to the user." - (let ((old (current-buffer)) - elt) - (set-buffer menu) - (if (setq elt (assoc item x-menu-items-alist)) - (rplaca elt nil)) - (set-buffer old) - item)) - -(defun x-menu-activate (menu) - "Compute all necessary parameters for MENU. -This must be called whenever a menu is modified before it is made -available to the user. This also creates the menu itself." - (let ((buf (current-buffer))) - (pop-to-buffer menu) - (let (buffer-read-only) - (setq x-menu-max-width (1- (frame-width))) - (setq x-menu-item-width 0) - (let (items-head - (items-tail x-menu-items-alist)) - (while items-tail - (if (car (car items-tail)) - (progn (setq items-head (cons (car items-tail) items-head)) - (setq x-menu-item-width - (max x-menu-item-width - (length (car (car items-tail))))))) - (setq items-tail (cdr items-tail))) - (setq x-menu-items-alist (reverse items-head))) - (setq x-menu-item-width (+ x-menu-item-spacing x-menu-item-width)) - (setq x-menu-items-per-line - (max 1 (/ x-menu-max-width x-menu-item-width))) - (erase-buffer) - (let ((items-head x-menu-items-alist)) - (while items-head - (let ((items 0)) - (while (and items-head - (<= (setq items (1+ items)) x-menu-items-per-line)) - (insert (format (concat "%" - (int-to-string x-menu-item-width) "s") - (car (car items-head)))) - (setq items-head (cdr items-head)))) - (insert ?\n))) - (shrink-window (max 0 - (- (window-height) - (1+ (count-lines (point-min) (point-max)))))) - (goto-char (point-min))) - (pop-to-buffer buf))) - -(defun x-menu-pick-entry (position event) - "Internal function for dispatching on mouse/menu events" - (let* ((x (min (1- x-menu-items-per-line) - (/ (current-column) x-menu-item-width))) - (y (- (count-lines (point-min) (point)) - (if (zerop (current-column)) 0 1))) - (item (+ x (* y x-menu-items-per-line))) - (litem (cdr (nth item x-menu-items-alist)))) - (and litem (funcall litem event))) - (pop-to-buffer x-menu-assoc-buffer)) - -(provide 'x-menu) - -;;; x-menu.el ends here