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