Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/kotl/kprop-xe.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 441bb1e64a06
children 4be1180a9e89
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
4 ;; SUMMARY: Koutline text property handling under XEmacs. 4 ;; SUMMARY: Koutline text property handling under XEmacs.
5 ;; USAGE: XEmacs Lisp Library 5 ;; USAGE: XEmacs Lisp Library
6 ;; KEYWORDS: outlines, wp 6 ;; KEYWORDS: outlines, wp
7 ;; 7 ;;
8 ;; AUTHOR: Bob Weiner 8 ;; AUTHOR: Bob Weiner
9 ;; ORG: InfoDock Associates
10 ;; 9 ;;
11 ;; ORIG-DATE: 7/27/93 10 ;; ORIG-DATE: 7/27/93
12 ;; LAST-MOD: 28-Feb-97 at 23:41:02 by Bob Weiner 11 ;; LAST-MOD: 30-Oct-95 at 21:21:20 by Bob Weiner
13 ;; 12 ;;
14 ;; This file is part of Hyperbole. 13 ;; This file is part of Hyperbole.
15 ;; Available for use and distribution under the same terms as GNU Emacs. 14 ;; Available for use and distribution under the same terms as GNU Emacs.
16 ;; 15 ;;
17 ;; Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc. 16 ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
18 ;; Developed with support from Motorola Inc. 17 ;; Developed with support from Motorola Inc.
19 ;; 18 ;;
20 ;; DESCRIPTION: 19 ;; DESCRIPTION:
21 ;; DESCRIP-END. 20 ;; DESCRIP-END.
22 21
28 27
29 ;;; ************************************************************************ 28 ;;; ************************************************************************
30 ;;; Public functions 29 ;;; Public functions
31 ;;; ************************************************************************ 30 ;;; ************************************************************************
32 31
33 ;; (get-text-property (pos prop &optional object)) 32 (defun kproperty:get (pos prop &optional object)
34 ;; Return the value of position POS's property PROP, in OBJECT. 33 "Return the value of position POS's property PROP, in OBJECT.
35 ;; OBJECT is optional and defaults to the current buffer. 34 OBJECT is optional and defaults to the current buffer.
36 ;; If POSITION is at the end of OBJECT, the value is nil. 35 If POSITION is at the end of OBJECT, the value is nil."
37 (fset 'kproperty:get 'get-text-property) 36 (extent-property (extent-at pos object) prop))
38 37
39 (if (and hyperb:xemacs-p (or (>= emacs-minor-version 12) 38 (if (and hyperb:xemacs-p (or (>= emacs-minor-version 12)
40 (> emacs-major-version 19))) 39 (> emacs-major-version 19)))
41 (defun kproperty:map (function property &optional value) 40 (defun kproperty:map (function property &optional value)
42 "Apply FUNCTION to each PROPERTY `eq' to VALUE in the current buffer. 41 "Apply FUNCTION to each PROPERTY `eq' to VALUE in the current buffer.
91 "From START to END, add PROPERTY-LIST properties to the text. 90 "From START to END, add PROPERTY-LIST properties to the text.
92 The optional fourth argument, OBJECT, is the string or buffer containing the 91 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 92 text. Text inserted before or after this region does not inherit the added
94 properties." 93 properties."
95 ;; Don't use text properties internally because they don't work as desired 94 ;; Don't use text properties internally because they don't work as desired
96 ;; when copied to a string and then reinserted, at least in some versions 95 ;; when copied to a string and then reinserted.
97 ;; of XEmacs.
98 (let ((extent (make-extent start end object))) 96 (let ((extent (make-extent start end object)))
99 (if (null extent) 97 (if (null extent)
100 (error "(kproperty:put): No extent at %d-%d to add properties %s" 98 (error "(kproperty:put): No extent at %d-%d to add properties %s"
101 start end property-list)) 99 start end property-list))
102 (if (/= (mod (length property-list) 2) 0) 100 (if (/= (mod (length property-list) 2) 0)
103 (error "(kproperty:put): Property-list has odd number of elements, %s" 101 (error "(kproperty:put): Property-list has odd number of elements, %s"
104 property-list)) 102 property-list))
105 (set-extent-property extent 'text-prop (car property-list)) 103 (set-extent-property extent 'text-prop t)
106 (set-extent-property extent 'duplicable t) 104 (set-extent-property extent 'duplicable t)
107 (set-extent-property extent 'start-open t) 105 (set-extent-property extent 'start-open t)
108 (set-extent-property extent 'end-open t) 106 (set-extent-property extent 'end-open t)
109 (while property-list 107 (while property-list
110 (set-extent-property 108 (set-extent-property