1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
;;; atomic-extents.el --- treat regions of text as a single object
;; Copyright (C) 1993 Free Software Foundation, Inc.
;; Created: 21-Dec-93, Chuck Thompson <cthomp@cs.uiuc.edu>
;; Keywords: extensions
;; Changed: 08-Aug-94, Heiko Muenkel <muenkel@tnt.uni-hannover.de>
;; This file is part of XEmacs.
;; XEmacs 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.
;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Point is not allowed to fall inside of an atomic extent. This has
;;; the effect of making all text covered by an atomic extent be
;;; treated as a single object. Normally point will be adjusted to an
;;; end of an atomic extent in the direction of motion. If point
;;; appears inside of an atomic extent (via goto-char for example),
;;; point will be adjusted to the side closest to the entry point.
;;; Synched up with: Not in FSF.
;;; To make an extent atomic use the command:
;;; (set-extent-property #<extent obj> 'atomic t)
;;; Known bug: the atomic property is not detected when sweeping
;;; regions with the mouse until after the mouse button is released.
;;; The release point will then be treated as if it had been reached
;;; using 'goto-char.
;;; atomic-extent-goto-char-p is defined in editfns.c
(provide 'atomic-extents)
(defvar atomic-extent-old-point nil
"The value of point when pre-command-hook is called.
Used to determine the direction of motion.")
(defun atomic-extent-pre-hook ()
(setq atomic-extent-old-point (point))
(setq atomic-extent-goto-char-p nil))
(defun atomic-extent-post-hook ()
(let ((extent (extent-at (point) nil 'atomic)))
(if extent
(let ((begin (extent-start-position extent))
(end (extent-end-position extent))
(pos (point))
(region-set (and (point) (mark))))
(if (eq this-command
'x-set-point-and-insert-selection)
(delete-region (region-beginning) (region-end)))
(if (/= pos begin)
(if atomic-extent-goto-char-p
(progn
(if (> (- pos begin) (- end pos))
(goto-char end)
(goto-char begin)))
(if (> pos atomic-extent-old-point)
(goto-char end)
(goto-char begin))))
(if (and region-set (/= pos begin))
(progn
(run-hooks 'zmacs-update-region-hook)
(x-store-cutbuffer (buffer-substring (region-beginning)
(region-end)))
)))))
(if (mark)
(progn
(exchange-point-and-mark t)
(let ((extent (extent-at (point) nil 'atomic)))
(if extent
(let ((begin (extent-start-position extent))
(end (extent-end-position extent))
(pos (point))
(region-set (and (point) (mark))))
(if (/= pos begin)
(if atomic-extent-goto-char-p
(progn
(if (> (- pos begin) (- end pos))
(goto-char end)
(goto-char begin)))
(if (> pos atomic-extent-old-point)
(goto-char end)
(goto-char begin))))
(if (and region-set (/= pos begin))
(progn
(run-hooks 'zmacs-update-region-hook)
(x-store-cutbuffer (buffer-substring (region-beginning)
(region-end)))
(message "%d, %d" (region-beginning) (region-end))
)))))
(exchange-point-and-mark t)))
)
(add-hook 'pre-command-hook 'atomic-extent-pre-hook)
(add-hook 'post-command-hook 'atomic-extent-post-hook)
;;; atomic-extents.el ends here
|
