Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/kotl/kprop-em.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;!emacs
2 ;;
3 ;; FILE: kprop-em.el
4 ;; SUMMARY: Koutline text property handling under Emacs 19.
5 ;; USAGE: GNU Emacs 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 20:59:54 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 (fset 'kproperty:get 'get-text-property)
33
34 (defun kproperty:map (function property value)
35 "Apply FUNCTION to each PROPERTY `eq' to VALUE in the current buffer.
36 FUNCTION is called with point preceding PROPERTY and receives the list of
37 properties at point as an argument. FUNCTION may not modify this list of
38 properties."
39 (let ((result)
40 (start (point-min)))
41 (save-excursion
42 (while (setq start
43 (text-property-any start (point-max) property value))
44 (goto-char start)
45 (setq result (cons (funcall function (text-properties-at start))
46 result))))
47 (nreverse result)))
48
49 (fset 'kproperty:next-single-change 'next-single-property-change)
50
51 (fset 'kproperty:previous-single-change 'previous-single-property-change)
52
53 (fset 'kproperty:properties 'text-properties-at)
54
55 (defun kproperty:put (start end property-list &optional object)
56 "From START to END, add PROPERTY-LIST properties to the text.
57 The optional fourth argument, OBJECT, is the string or buffer containing the
58 text. Text inserted before or after this region does not inherit the added
59 properties."
60 (add-text-properties
61 start end (append property-list '(rear-nonsticky t)) object))
62
63 (defun kproperty:remove (start end property-list &optional object)
64 "From START to END, remove the text properties in PROPERTY-LIST.
65 The optional fourth argument, OBJECT, is the string or buffer containing the
66 text. PROPERTY-LIST should be a plist; if the value of a property is
67 non-nil, then only a property with a matching value will be removed.
68 Returns t if any property was changed, nil otherwise."
69 (let ((changed) plist property value next)
70 (while property-list
71 (setq property (car property-list)
72 value (car (cdr property-list))
73 plist (list property value)
74 property-list (nthcdr 2 property-list)
75 next start)
76 (while (setq next (text-property-any next end property value object))
77 (remove-text-properties next (1+ next) plist object)
78 (setq changed t next (1+ next))))
79 changed))
80
81 (defun kproperty:replace-separator (pos label-separator old-sep-len)
82 "Replace at POS the cell label separator with LABEL-SEPARATOR.
83 OLD-SEP-LEN is the length of the separator being replaced."
84 (let (properties)
85 (while (setq pos (kproperty:next-single-change (point) 'kcell))
86 (goto-char pos)
87 (setq properties (text-properties-at pos))
88 ;; Replace label-separator while maintaining cell properties.
89 (insert label-separator)
90 (add-text-properties pos (+ pos 2) properties)
91 (delete-region (point) (+ (point) old-sep-len)))))
92
93 (defun kproperty:set (property value)
94 "Set PROPERTY of character at point to VALUE."
95 (kproperty:put (point) (min (+ 2 (point)) (point-max))
96 (list property value)))