Mercurial > hg > xemacs-beta
comparison lisp/utils/atomic-extents.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | 0293115a14e9 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; atomic-extents.el --- treat regions of text as a single object | |
| 2 | |
| 3 ;; Copyright (C) 1993 Free Software Foundation, Inc. | |
| 4 ;; Created: 21-Dec-93, Chuck Thompson <cthomp@cs.uiuc.edu> | |
| 5 ;; Keywords: extensions | |
| 6 ;; Changed: 08-Aug-94, Heiko Muenkel <muenkel@tnt.uni-hannover.de> | |
| 7 | |
| 8 ;; This file is part of XEmacs. | |
| 9 | |
| 10 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 11 ;; under the terms of the GNU General Public License as published by | |
| 12 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 13 ;; any later version. | |
| 14 | |
| 15 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 18 ;; General Public License for more details. | |
| 19 | |
| 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 Free | |
| 22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 23 | |
| 24 ;;; Point is not allowed to fall inside of an atomic extent. This has | |
| 25 ;;; the effect of making all text covered by an atomic extent be | |
| 26 ;;; treated as a single object. Normally point will be adjusted to an | |
| 27 ;;; end of an atomic extent in the direction of motion. If point | |
| 28 ;;; appears inside of an atomic extent (via goto-char for example), | |
| 29 ;;; point will be adjusted to the side closest to the entry point. | |
| 30 | |
| 31 ;;; Synched up with: Not in FSF. | |
| 32 | |
| 33 ;;; To make an extent atomic use the command: | |
| 34 ;;; (set-extent-property #<extent obj> 'atomic t) | |
| 35 | |
| 36 ;;; Known bug: the atomic property is not detected when sweeping | |
| 37 ;;; regions with the mouse until after the mouse button is released. | |
| 38 ;;; The release point will then be treated as if it had been reached | |
| 39 ;;; using 'goto-char. | |
| 40 | |
| 41 ;;; atomic-extent-goto-char-p is defined in editfns.c | |
| 42 | |
| 43 (provide 'atomic-extents) | |
| 44 | |
| 45 (defvar atomic-extent-old-point nil | |
| 46 "The value of point when pre-command-hook is called. | |
| 47 Used to determine the direction of motion.") | |
| 48 | |
| 49 (defun atomic-extent-pre-hook () | |
| 50 (setq atomic-extent-old-point (point)) | |
| 51 (setq atomic-extent-goto-char-p nil)) | |
| 52 | |
| 53 (defun atomic-extent-post-hook () | |
| 54 (let ((extent (extent-at (point) nil 'atomic))) | |
| 55 (if extent | |
| 56 (let ((begin (extent-start-position extent)) | |
| 57 (end (extent-end-position extent)) | |
| 58 (pos (point)) | |
| 59 (region-set (and (point) (mark)))) | |
| 60 (if (eq this-command | |
| 61 'x-set-point-and-insert-selection) | |
| 62 (delete-region (region-beginning) (region-end))) | |
| 63 (if (/= pos begin) | |
| 64 (if atomic-extent-goto-char-p | |
| 65 (progn | |
| 66 (if (> (- pos begin) (- end pos)) | |
| 67 (goto-char end) | |
| 68 (goto-char begin))) | |
| 69 (if (> pos atomic-extent-old-point) | |
| 70 (goto-char end) | |
| 71 (goto-char begin)))) | |
| 72 (if (and region-set (/= pos begin)) | |
| 73 (progn | |
| 74 (run-hooks 'zmacs-update-region-hook) | |
| 75 (x-store-cutbuffer (buffer-substring (region-beginning) | |
| 76 (region-end))) | |
| 77 ))))) | |
| 78 (if (mark) | |
| 79 (progn | |
| 80 (exchange-point-and-mark t) | |
| 81 (let ((extent (extent-at (point) nil 'atomic))) | |
| 82 (if extent | |
| 83 (let ((begin (extent-start-position extent)) | |
| 84 (end (extent-end-position extent)) | |
| 85 (pos (point)) | |
| 86 (region-set (and (point) (mark)))) | |
| 87 (if (/= pos begin) | |
| 88 (if atomic-extent-goto-char-p | |
| 89 (progn | |
| 90 (if (> (- pos begin) (- end pos)) | |
| 91 (goto-char end) | |
| 92 (goto-char begin))) | |
| 93 (if (> pos atomic-extent-old-point) | |
| 94 (goto-char end) | |
| 95 (goto-char begin)))) | |
| 96 (if (and region-set (/= pos begin)) | |
| 97 (progn | |
| 98 (run-hooks 'zmacs-update-region-hook) | |
| 99 (x-store-cutbuffer (buffer-substring (region-beginning) | |
| 100 (region-end))) | |
| 101 (message "%d, %d" (region-beginning) (region-end)) | |
| 102 ))))) | |
| 103 (exchange-point-and-mark t))) | |
| 104 ) | |
| 105 | |
| 106 (add-hook 'pre-command-hook 'atomic-extent-pre-hook) | |
| 107 (add-hook 'post-command-hook 'atomic-extent-post-hook) | |
| 108 | |
| 109 ;;; atomic-extents.el ends here |