|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: kprop-xe.el
|
|
|
4 ;; SUMMARY: Koutline text property handling under XEmacs.
|
|
|
5 ;; USAGE: XEmacs Lisp Library
|
|
|
6 ;; KEYWORDS: outlines, wp
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
26
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 7/27/93
|
|
26
|
12 ;; LAST-MOD: 28-Feb-97 at 23:41:02 by Bob Weiner
|
|
0
|
13 ;;
|
|
|
14 ;; This file is part of Hyperbole.
|
|
|
15 ;; Available for use and distribution under the same terms as GNU Emacs.
|
|
|
16 ;;
|
|
26
|
17 ;; Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
|
|
0
|
18 ;; Developed with support from Motorola Inc.
|
|
|
19 ;;
|
|
|
20 ;; DESCRIPTION:
|
|
|
21 ;; DESCRIP-END.
|
|
|
22
|
|
|
23 ;;; ************************************************************************
|
|
|
24 ;;; Other required Elisp libraries
|
|
|
25 ;;; ************************************************************************
|
|
|
26
|
|
|
27 (require 'hversion)
|
|
|
28
|
|
|
29 ;;; ************************************************************************
|
|
|
30 ;;; Public functions
|
|
|
31 ;;; ************************************************************************
|
|
|
32
|
|
24
|
33 ;; (get-text-property (pos prop &optional object))
|
|
|
34 ;; Return the value of position POS's property PROP, in OBJECT.
|
|
|
35 ;; OBJECT is optional and defaults to the current buffer.
|
|
|
36 ;; If POSITION is at the end of OBJECT, the value is nil.
|
|
|
37 (fset 'kproperty:get 'get-text-property)
|
|
0
|
38
|
|
|
39 (if (and hyperb:xemacs-p (or (>= emacs-minor-version 12)
|
|
|
40 (> emacs-major-version 19)))
|
|
|
41 (defun kproperty:map (function property &optional value)
|
|
|
42 "Apply FUNCTION to each PROPERTY `eq' to VALUE in the current buffer.
|
|
|
43 FUNCTION is called with point preceding PROPERTY and receives PROPERTY as an
|
|
|
44 argument."
|
|
|
45 (let ((result))
|
|
|
46 (save-excursion
|
|
|
47 (map-extents
|
|
|
48 (function (lambda (extent unused)
|
|
|
49 (goto-char (or (extent-start-position extent) (point)))
|
|
|
50 (setq result (cons (funcall function extent) result))
|
|
|
51 nil))
|
|
|
52 nil nil nil nil nil property value))
|
|
|
53 (nreverse result)))
|
|
|
54 (defun kproperty:map (function property &optional value)
|
|
|
55 "Apply FUNCTION to each PROPERTY `eq' to VALUE in the current buffer.
|
|
|
56 FUNCTION is called with point preceding PROPERTY and receives PROPERTY as an
|
|
|
57 argument."
|
|
|
58 (let ((result))
|
|
|
59 (save-excursion
|
|
|
60 (map-extents
|
|
|
61 (function (lambda (extent unused)
|
|
|
62 (if (eq (extent-property extent property) value)
|
|
|
63 (progn (goto-char (or (extent-start-position extent)
|
|
|
64 (point)))
|
|
|
65 (setq result (cons (funcall function extent)
|
|
|
66 result))))
|
|
|
67 nil))))
|
|
|
68 (nreverse result))))
|
|
|
69
|
|
|
70 ;; (next-single-property-change (pos prop &optional object))
|
|
|
71 ;; Return the position of next property change for a specific property.
|
|
|
72 ;; Scans characters forward from POS till it finds
|
|
|
73 ;; a change in the PROP property, then returns the position of the change.
|
|
|
74 ;; The optional third argument OBJECT is the string or buffer to scan.
|
|
|
75 ;; Return nil if the property is constant all the way to the end of OBJECT.
|
|
|
76 ;; If the value is non-nil, it is a position greater than POS, never equal.
|
|
|
77 (fset 'kproperty:next-single-change 'next-single-property-change)
|
|
|
78
|
|
|
79 ;; (previous-single-property-change (pos prop &optional object))
|
|
|
80 ;; Return the position of previous property change for a specific property.
|
|
|
81 ;; Scans characters backward from POS till it finds
|
|
|
82 ;; a change in the PROP property, then returns the position of the change.
|
|
|
83 ;; The optional third argument OBJECT is the string or buffer to scan.
|
|
|
84 ;; Return nil if the property is constant all the way to the start of OBJECT.
|
|
|
85 ;; If the value is non-nil, it is a position less than POS, never equal.
|
|
|
86 (fset 'kproperty:previous-single-change 'previous-single-property-change)
|
|
|
87
|
|
|
88 (fset 'kproperty:properties 'extent-properties-at)
|
|
|
89
|
|
|
90 (defun kproperty:put (start end property-list &optional object)
|
|
|
91 "From START to END, add PROPERTY-LIST properties to the text.
|
|
|
92 The optional fourth argument, OBJECT, is the string or buffer containing the
|
|
|
93 text. Text inserted before or after this region does not inherit the added
|
|
|
94 properties."
|
|
|
95 ;; Don't use text properties internally because they don't work as desired
|
|
26
|
96 ;; when copied to a string and then reinserted, at least in some versions
|
|
|
97 ;; of XEmacs.
|
|
0
|
98 (let ((extent (make-extent start end object)))
|
|
|
99 (if (null extent)
|
|
|
100 (error "(kproperty:put): No extent at %d-%d to add properties %s"
|
|
|
101 start end property-list))
|
|
|
102 (if (/= (mod (length property-list) 2) 0)
|
|
|
103 (error "(kproperty:put): Property-list has odd number of elements, %s"
|
|
|
104 property-list))
|
|
26
|
105 (set-extent-property extent 'text-prop (car property-list))
|
|
0
|
106 (set-extent-property extent 'duplicable t)
|
|
|
107 (set-extent-property extent 'start-open t)
|
|
|
108 (set-extent-property extent 'end-open t)
|
|
|
109 (while property-list
|
|
|
110 (set-extent-property
|
|
|
111 extent (car property-list) (car (cdr property-list)))
|
|
|
112 (setq property-list (nthcdr 2 property-list)))
|
|
|
113 extent))
|
|
|
114
|
|
|
115 (defun kproperty:remove (start end property-list &optional object)
|
|
|
116 "From START to END, remove the text properties in PROPERTY-LIST.
|
|
|
117 The optional fourth argument, OBJECT, is the string or buffer containing the
|
|
|
118 text. PROPERTY-LIST should be a plist; if the value of a property is
|
|
|
119 non-nil, then only a property with a matching value will be removed.
|
|
|
120 Returns t if any property was changed, nil otherwise."
|
|
|
121 ;; Don't use text property functions internally because they only look for
|
|
|
122 ;; closed extents, which kproperty does not use.
|
|
|
123 (let ((changed) property value)
|
|
|
124 (while property-list
|
|
|
125 (setq property (car property-list)
|
|
|
126 value (car (cdr property-list))
|
|
|
127 property-list (nthcdr 2 property-list))
|
|
|
128 (map-extents
|
|
|
129 (function (lambda (extent maparg)
|
|
|
130 (if (extent-live-p extent)
|
|
|
131 (progn (setq changed t)
|
|
|
132 (delete-extent extent)))
|
|
|
133 nil))
|
|
|
134 object start end nil nil property value))
|
|
|
135 changed))
|
|
|
136
|
|
|
137 (defun kproperty:replace-separator (pos label-separator old-sep-len)
|
|
|
138 "Replace at POS the cell label separator with LABEL-SEPARATOR.
|
|
|
139 OLD-SEP-LEN is the length of the separator being replaced."
|
|
|
140 (let (extent)
|
|
|
141 (while (setq pos (kproperty:next-single-change (point) 'kcell))
|
|
|
142 (goto-char pos)
|
|
|
143 (setq extent (extent-at pos))
|
|
|
144 ;; Replace label-separator while maintaining cell properties.
|
|
|
145 (insert label-separator)
|
|
|
146 (set-extent-endpoints extent pos (+ pos 2))
|
|
|
147 (delete-region (point) (+ (point) old-sep-len)))))
|
|
|
148
|
|
|
149 (defun kproperty:set (property value)
|
|
|
150 "Set PROPERTY of character at point to VALUE."
|
|
|
151 (kproperty:put (point) (min (+ 2 (point)) (point-max))
|
|
|
152 (list property value)))
|
