Mercurial > hg > xemacs-beta

comparison lisp/prim/mouse.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents e04119814345
children 54cc21c15cbb
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details. 18 ;; General Public License for more details.
19 19
20 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the 21 ;; along with XEmacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA. 23 ;; Boston, MA 02111-1307, USA.
24 24
25 ;;; Synched up with: Not synched with FSF. Almost completely divergent. 25 ;;; Synched up with: Not synched with FSF. Almost completely divergent.
26 26
27 (provide 'mouse) 27 (provide 'mouse)
769 769
770 (defun default-mouse-track-normalize-point (type forwardp) 770 (defun default-mouse-track-normalize-point (type forwardp)
771 (cond ((eq type 'word) 771 (cond ((eq type 'word)
772 ;; trap the beginning and end of buffer errors 772 ;; trap the beginning and end of buffer errors
773 (condition-case () 773 (condition-case ()
774 (progn 774 (if forwardp
775 (setq type (char-syntax (char-after (point)))) 775 (default-mouse-track-end-of-word t)
776 (if forwardp 776 (default-mouse-track-beginning-of-word t))
777 (if (= type ?\()
778 (goto-char (scan-sexps (point) 1))
779 (if (= type ?\))
780 (forward-char 1)
781 (default-mouse-track-end-of-word t)))
782 (if (= type ?\))
783 (goto-char (scan-sexps (1+ (point)) -1))
784 (default-mouse-track-beginning-of-word t))))
785 (error ()))) 777 (error ())))
786 ((eq type 'line) 778 ((eq type 'line)
787 (if forwardp (end-of-line) (beginning-of-line))) 779 (if forwardp (end-of-line) (beginning-of-line)))
788 ((eq type 'buffer) 780 ((eq type 'buffer)
789 (if forwardp (end-of-buffer) (beginning-of-buffer))))) 781 (if forwardp (end-of-buffer) (beginning-of-buffer)))))
1034 1026
1035 (defun default-mouse-track-down-hook (event click-count) 1027 (defun default-mouse-track-down-hook (event click-count)
1036 (setq default-mouse-track-down-event (copy-event event)) 1028 (setq default-mouse-track-down-event (copy-event event))
1037 nil) 1029 nil)
1038 1030
1039 (defun default-mouse-track-cleanup-extents-hook () 1031 (defun default-mouse-track-cleanup-hook ()
1040 (remove-hook 'pre-command-hook 'default-mouse-track-cleanup-extents-hook)
1041 (let ((extent default-mouse-track-extent)) 1032 (let ((extent default-mouse-track-extent))
1042 (if (consp extent) ; rectangle-p 1033 (if (consp extent) ; rectangle-p
1043 (mapcar 'delete-extent extent) 1034 (mapcar 'delete-extent extent)
1044 (if extent 1035 (if extent
1045 (delete-extent extent))))) 1036 (delete-extent extent)))))
1046
1047 (defun default-mouse-track-cleanup-hook ()
1048 (if zmacs-regions
1049 (funcall 'default-mouse-track-cleanup-extents-hook)
1050 (let ((extent default-mouse-track-extent)
1051 (func #'(lambda (e)
1052 (and (extent-live-p e)
1053 (set-extent-face e 'primary-selection)))))
1054 (add-hook 'pre-command-hook 'default-mouse-track-cleanup-extents-hook)
1055 (if (consp extent) ; rectangle-p
1056 (mapcar func extent)
1057 (if extent
1058 (funcall func extent))))))
1059 1037
1060 (defun default-mouse-track-cleanup-extent () 1038 (defun default-mouse-track-cleanup-extent ()
1061 (let ((dead-func 1039 (let ((dead-func
1062 (function (lambda (x) 1040 (function (lambda (x)
1063 (or (not (extent-live-p x)) 1041 (or (not (extent-live-p x))