xemacs-beta: lisp/mouse.el comparison

comparison lisp/mouse.el @ 793:e38acbeb1cae

[xemacs-hg @ 2002-03-29 04:46:17 by ben] lots o' fixes etc/ChangeLog: New file. Separated out all entries for etc/ into their own ChangeLog. Includes entries for the following files: etc/BABYL, etc/BETA, etc/CHARSETS, etc/DISTRIB, etc/Emacs.ad, etc/FTP, etc/GNUS-NEWS, etc/GOATS, etc/HELLO, etc/INSTALL, etc/MACHINES, etc/MAILINGLISTS, etc/MSDOS, etc/MYTHOLOGY, etc/NEWS, etc/OXYMORONS, etc/PACKAGES, etc/README, etc/TUTORIAL, etc/TUTORIAL.de, etc/TUTORIAL.ja, etc/TUTORIAL.ko, etc/TUTORIAL.se, etc/aliases.ksh, etc/altrasoft-logo.xpm, etc/check_cygwin_setup.sh, etc/custom/example-themes/europe-theme.el, etc/custom/example-themes/ex-custom-file, etc/custom/example-themes/example-theme.el, etc/e/eterm.ti, etc/edt-user.doc, etc/enriched.doc, etc/etags.1, etc/gnuserv.1, etc/gnuserv.README, etc/package-index.LATEST.gpg, etc/package-index.LATEST.pgp, etc/photos/jan.png, etc/recycle.xpm, etc/refcard.tex, etc/sample.Xdefaults, etc/sample.emacs, etc/sgml/CATALOG, etc/sgml/HTML32.dtd, etc/skk/SKK.tut.E, etc/smilies/Face_ase.xbm, etc/smilies/Face_ase2.xbm, etc/smilies/Face_ase3.xbm, etc/smilies/Face_smile.xbm, etc/smilies/Face_weep.xbm, etc/sounds, etc/toolbar, etc/toolbar/workshop-cap-up.xpm, etc/xemacs-ja.1, etc/xemacs.1, etc/yow.lines, etc\BETA, etc\NEWS, etc\README, etc\TUTORIAL, etc\TUTORIAL.de, etc\check_cygwin_setup.sh, etc\sample.init.el, etc\unicode\README, etc\unicode\mule-ucs\*, etc\unicode\other\* unicode/unicode-consortium/8859-16.TXT: New file. mule/english.el: Define this charset now, since a bug was fixed that formerly prevented it. mule/ethio-util.el: Fix compile errors involving Unicode `characters', which should be integers. Makefile.in.in: Always include gui.c, to fix compile error when TTY-only. EmacsFrame.c, abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, bytecode.h, callint.c, callproc.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.c, console-msw.h, console-tty.c, console-x.c, console-x.h, console.c, console.h, data.c, database.c, device-gtk.c, device-msw.c, device-x.c, device.c, device.h, dialog-msw.c, doc.c, doprnt.c, dumper.c, dynarr.c, editfns.c, eldap.c, eldap.h, elhash.c, elhash.h, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.c, events.h, extents.c, extents.h, faces.c, faces.h, file-coding.c, file-coding.h, fileio.c, filelock.c, fns.c, frame-gtk.c, frame-msw.c, frame-tty.c, frame-x.c, frame.c, frame.h, free-hook.c, general-slots.h, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gpmevent.c, gtk-xemacs.c, gui-msw.c, gui-x.c, gui-x.h, gui.c, gui.h, gutter.c, gutter.h, indent.c, input-method-xlib.c, insdel.c, keymap.c, keymap.h, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-canna.c, mule-ccl.c, mule-charset.c, mule-wnnfns.c, native-gtk-toolbar.c, objects-msw.c, objects-tty.c, objects-x.c, objects.c, objects.h, opaque.c, opaque.h, postgresql.c, postgresql.h, print.c, process-unix.c, process.c, process.h, rangetab.c, rangetab.h, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-tty.c, redisplay-x.c, redisplay.c, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, scrollbar.h, search.c, select-gtk.c, select-x.c, sound.c, specifier.c, specifier.h, strftime.c, symbols.c, symeval.h, syntax.h, text.c, text.h, toolbar-common.c, toolbar-msw.c, toolbar.c, toolbar.h, tooltalk.c, tooltalk.h, ui-gtk.c, ui-gtk.h, undo.c, vm-limit.c, window.c, window.h: Eliminate XSETFOO. Replace all usages with wrap_foo(). Make symbol->name a Lisp_Object, not Lisp_String *. Eliminate nearly all uses of Lisp_String * in favor of Lisp_Object, and correct macros so most of them favor Lisp_Object. Create new error-behavior ERROR_ME_DEBUG_WARN -- output warnings, but at level `debug' (usually ignored). Use it when instantiating specifiers, so problems can be debugged. Move log-warning-minimum-level into C so that we can optimize ERROR_ME_DEBUG_WARN. Fix warning levels consistent with new definitions. Add default_ and parent fields to char table; not yet implemented. New fun Dynarr_verify(); use for further error checking on Dynarrs. Rearrange code at top of lisp.h in conjunction with dynarr changes. Fix eifree(). Use Eistrings in various places (format_event_object(), where_is_to_char(), and callers thereof) to avoid fixed-size strings buffers. New fun write_eistring(). Reindent and fix GPM code to follow standards. Set default MS Windows font to Lucida Console (same size as Courier New but less interline spacing, so more lines fit). Increase default frame size on Windows to 50 lines. (If that's too big for the workspace, the frame will be shrunk as necessary.) Fix problem with text files with no newlines (). (Change `convert-eol' coding system to use `nil' for autodetect, consistent with make-coding-system.) Correct compile warnings in vm-limit.c. Fix handling of reverse-direction charsets to avoid errors when opening (e.g.) mule-ucs/lisp/reldata/uiso8859-6.el. Recode some object printing methods to use write_fmt_string() instead of a fixed buffer and sprintf. Turn on display of png comments as warnings (level `info'), now that they're unobtrusive. Revamped the sound documentation. Fixed bug in redisplay w.r.t. hscroll/truncation/continuation glyphs causing jumping up and down of the lines, since they're bigger than the line size. (It was seen most obviously when there's a horizontal scroll bar, e.g. do C-h a glyph or something like that.) The problem was that the glyph-contrib-p setting on glyphs was ignored even if it was set properly, which it wasn't until now.

author	ben
date	Fri, 29 Mar 2002 04:49:13 +0000
parents	2923009caf47
children	e17beacca645

comparison

equal deleted inserted replaced

-:4e83fdb13eb9
+:e38acbeb1cae
 ;;; mouse.el --- window system-independent mouse support.
 ;; Copyright (C) 1988, 1992-4, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Tinker Systems
-;; Copyright (C) 1995, 1996, 2000 Ben Wing.
+;; Copyright (C) 1995, 1996, 2000, 2002 Ben Wing.
 ;; Maintainer: XEmacs Development Team
 ;; Keywords: mouse, dumped
 ;; This file is part of XEmacs.
 (provide 'mouse)
 (global-set-key 'button1 'mouse-track)
 (global-set-key '(shift button1) 'mouse-track-adjust)
+(global-set-key '(meta button1) 'mouse-track-by-lines)
+(global-set-key '(meta shift button1) 'mouse-track-adjust-by-lines)
 (global-set-key '(control button1) 'mouse-track-insert)
 (global-set-key '(control shift button1) 'mouse-track-delete-and-insert)
-(global-set-key '(meta button1) 'mouse-track-do-rectangle)
+(global-set-key '(meta control button1) 'mouse-track-insert-by-lines)
+(global-set-key '(meta shift control button1)
+'mouse-track-delete-and-insert-by-lines)
 (global-set-key 'button2 'mouse-track)
+(global-set-key '(meta button2) 'mouse-track-do-rectangle)
 (defgroup mouse nil
 "Window system-independent mouse support."
 :group 'editing)
 (defvar mouse-yank-function 'mouse-consolidated-yank
 "Function that is called upon by `mouse-yank' to actually insert text.")
 (defun mouse-consolidated-yank ()
-"Insert the current selection or, if there is none under X insert
+"Insert the current selection at point.
-the X cutbuffer.  A mark is pushed, so that the inserted text lies
+\(Under X Windows, if there is none, insert the X cutbuffer.)  A mark is
-between point and mark."
+pushed, so that the inserted text lies between point and mark.  This is the
+default value of `mouse-yank-function', and as such is called by
+`mouse-yank' to do the actual work."
 (interactive)
 (if (and (not (console-on-window-system-p))
 	   (and (featurep 'gpm)
 		(not (declare-boundp gpm-minor-mode))))
 (yank)
 (defun mouse-yank (event)
 "Paste text with the mouse.
 If the variable `mouse-yank-at-point' is nil, then pasting occurs at the
 location of the click; otherwise, pasting occurs at the current cursor
-location."
+location.  This calls the value of the variable `mouse-yank-function'
+(normally the function `mouse-consolidated-yank') to do the actual work.
+This is normally called as a result of a click of button2 by
+`default-mouse-track-click-hook'."
 (interactive "e")
 (and (not mouse-yank-at-point)
 (mouse-set-point event))
 (funcall mouse-yank-function))
 ;; attempting to debug a click-hook (which is pretty damn
 ;; difficult to do), this function may get called.
 )
 (defun mouse-track (event &optional overriding-hooks)
-"Generalized mouse-button handler.  This should be bound to a mouse button.
+"Generalized mouse-button handler.
-The behavior of this function is customizable using various hooks and
+This is the function that handles standard mouse behavior -- moving point
-variables: see `mouse-track-click-hook', `mouse-track-drag-hook',
+when clicked, selecting text when dragged, etc. -- and should be bound to a
+mouse button (normally, button1 and button2).
+This allows for overloading of different mouse strokes with different
+commands.  The behavior of this function is customizable using various
+hooks and variables: see `mouse-track-click-hook', `mouse-track-drag-hook',
 `mouse-track-drag-up-hook', `mouse-track-down-hook', `mouse-track-up-hook',
 `mouse-track-cleanup-hook', `mouse-track-multi-click-time',
 `mouse-track-scroll-delay', `mouse-track-x-threshold', and
 `mouse-track-y-threshold'.
 If you drag the mouse off the top or bottom of the window, you can select
 pieces of text which are larger than the visible part of the buffer; the
 buffer will scroll as necessary.
-The selected text becomes the current X Selection.  The point will be left
+The point will be left at the position at which you released the button,
-at the position at which you released the button, and the mark will be left
+and the mark will be left at the initial click position.
-at the initial click position."
+Under X Windows, the selected text becomes the current X Selection, and can
+be immediately inserted elsewhere using button2.  Under MS Windows, this
+also works, because the behavior is emulated."
 (interactive "e")
 (let ((mouse-down t)
 	(xthresh (eval mouse-track-x-threshold))
 	(ythresh (eval mouse-track-y-threshold))
 	(orig-x (event-x-pixel event))
 ;; This remembers the last position at which the user clicked, for the
 ;; benefit of mouse-track-adjust (for example, button1; scroll until the
 ;; position of the click is off the frame; then Sh-button1 to select the
-;; new region.
+;; new region).
 (defvar default-mouse-track-previous-point nil)
 (defun default-mouse-track-set-point (event window)
 (if (default-mouse-track-set-point-in-window event window)
 nil
 			  (not (default-mouse-track-point-at-opening-quote-p))))
 		 (goto-char (scan-sexps (1+ (point)) -1))
 	       (default-mouse-track-beginning-of-word
 		 (default-mouse-track-symbolp type))))))
 	((eq type 'line)
-	 (if forwardp (end-of-line) (beginning-of-line)))
+	 (if forwardp
+	     ;; Counter-kludge.  If we are adjusting a line-oriented
+	     ;; selection, default-mouse-track-return-dragged-selection
+	     ;; fixed it to include the final newline.  Unfortunately, that
+	     ;; will cause us to add another line at the end (the wrong
+	     ;; side of the selection) unless we take evasive action.
+	     (unless (and default-mouse-track-adjust
+			  (bolp))
+	       (end-of-line))
+	   (beginning-of-line)))
 	((eq type 'buffer)
 	 (if forwardp (end-of-buffer) (beginning-of-buffer)))))
 (defun default-mouse-track-next-move (min-anchor max-anchor extent)
 (let ((anchor (if (<= (point) min-anchor) max-anchor min-anchor)))
 		      (= (point) (extent-end-position first)))
 		 (goto-char (car result)))))
 	  (extent
 	   (setq result (cons (extent-start-position extent)
 			      (extent-end-position extent)))))
-;; Minor kludge: if we're selecting in line-mode, include the
+;; Minor kludge: if we're selecting in line-mode, include the final
-;; final newline.  It's hard to do this in *-normalize-point.
+;; newline.  It's hard to do this in *-normalize-point.  Unfortunately
+;; this necessitates a counter-kludge in
+;; default-mouse-track-normalize-point.
 (if (and result (eq default-mouse-track-type 'line))
 	(let ((end-p (= (point) (cdr result))))
 	  (goto-char (cdr result))
-	  (if (not (eobp))
+	  (if (and (eolp) (not (eobp)))
 	      (setcdr result (1+ (cdr result))))
 	  (goto-char (if end-p (cdr result) (car result)))))
 ;;;	  ;; Minor kludge sub 2.  If in char mode, and we drag the
 ;;;	  ;; mouse past EOL, include the newline.
 ;;;	  ;;
 "Like `mouse-track' but selects rectangles instead of regions."
 (interactive "e")
 (let ((mouse-track-rectangle-p t))
 	(mouse-track event)))
+(defun mouse-track-by-lines (event)
+"Make a line-by-line selection with the mouse.
+This actually works the same as `mouse-track' (which handles all
+mouse-button behavior) but forces whole lines to be selected."
+(interactive "e")
+(let ((default-mouse-track-type-list '(line)))
+(mouse-track event)))
 (defun mouse-track-adjust (event)
 "Extend the existing selection.  This should be bound to a mouse button.
 The selection will be enlarged or shrunk so that the point of the mouse
 click is one of its endpoints.  This function in fact behaves fairly
 similarly to `mouse-track', but begins by extending the existing selection
 custom mouse-track handlers that the user may have installed."
 (interactive "e")
 (let ((default-mouse-track-adjust t))
 (mouse-track-default event)))
-(defun mouse-track-insert (event &optional delete)
+(defun mouse-track-adjust-by-lines (event)
-"Make a selection with the mouse and insert it at point.
+"Extend the existing selection by lines.
-This is exactly the same as the `mouse-track' command on \\[mouse-track],
+This works the same as `mouse-track-adjust' (bound to \\[mouse-track-adjust])
-except that point is not moved; the selected text is immediately inserted
+but forces whole lines to be selected."
-after being selected\; and the selection is immediately disowned afterwards."
+(interactive "e")
+(let ((default-mouse-track-type-list '(line))
+	(default-mouse-track-adjust t))
+(mouse-track event)))
+(defun mouse-track-insert-1 (event &optional delete line-p)
+"Guts of mouse-track-insert and friends.
+If DELETE, delete the selection as well as inserting it at the new place.
+If LINE-P, select by lines and insert before current line."
 (interactive "*e")
-(let (s selreg)
+(let ((default-mouse-track-type-list
+	  (if line-p '(line) default-mouse-track-type-list))
+	s selreg)
 (flet ((Mouse-track-insert-drag-up-hook (event count)
 	     (setq selreg
 		   (default-mouse-track-return-dragged-selection event))
 	     t)
 	   (Mouse-track-insert-click-hook (event count)
 	      (let ((pair selreg))
 		(setq s (prog1
 			    (buffer-substring (car pair) (cdr pair))
 			  (if delete
 			      (kill-region (car pair) (cdr pair))))))))))
-(or (null s) (equal s "") (insert s))))
+(or (null s) (equal s "")
+	(progn
+	  (if line-p (beginning-of-line))
+	  (insert s)))))
+(defun mouse-track-insert (event)
+"Make a selection with the mouse and insert it at point.
+This works the same as just selecting text using the mouse (the
+`mouse-track' command), except that point is not moved; the selected text
+is immediately inserted after being selected\; and the selection is
+immediately disowned afterwards."
+(interactive "*e")
+(mouse-track-insert-1 event))
 (defun mouse-track-delete-and-insert (event)
-"Make a selection with the mouse and insert it at point.
+"Make a selection with the mouse and move it to point.
-This is exactly the same as the `mouse-track' command on \\[mouse-track],
+This works the same as just selecting text using the mouse (the
-except that point is not moved; the selected text is immediately inserted
+`mouse-track' command), except that point is not moved; the selected text
-after being selected\; and the text of the selection is deleted."
+is immediately inserted after being selected\; and the text of the
+selection is deleted."
 (interactive "*e")
-(mouse-track-insert event t))
+(mouse-track-insert-1 event t))
+(defun mouse-track-insert-by-lines (event)
+"Make a line-oriented selection with the mouse and insert it at line start.
+This is similar to `mouse-track-insert' except that it always selects
+entire lines and inserts the lines before the current line rather than at
+point."
+(interactive "*e")
+(mouse-track-insert-1 event nil t))
+(defun mouse-track-delete-and-insert-by-lines (event)
+"Make a line-oriented selection with the mouse and move it to line start.
+This is similar to `mouse-track-insert' except that it always selects
+entire lines and inserts the lines before the current line rather than at
+point."
+(interactive "*e")
+(mouse-track-insert-1 event nil t))
 ;;;;;;;;;;;;;;;;;;;;;;;;
 (defvar inhibit-help-echo nil

Mercurial > hg > xemacs-beta

comparison lisp/mouse.el @ 793:e38acbeb1cae