Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-props.el @ 138:6608ceec7cf8 r20-2b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-2b3
author cvs
date Mon, 13 Aug 2007 09:31:46 +0200
parents b980b6286996
children
comparison
equal deleted inserted replaced
137:cae984061f40 138:6608ceec7cf8
1 ;;; w3-props.el --- Additional text property stuff 1 ;;; w3-props.el --- Additional text property stuff
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/04/20 19:19:14 3 ;; Created: 1997/04/22 14:50:19
4 ;; Version: 1.1 4 ;; Version: 1.2
5 ;; Keywords: faces 5 ;; Keywords: faces
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
47 (setq next (next-single-property-change start markprop object end)) 47 (setq next (next-single-property-change start markprop object end))
48 (put-text-property start next setprop value object) 48 (put-text-property start next setprop value object)
49 (put-text-property start next markprop value object) 49 (put-text-property start next markprop value object)
50 (setq start (text-property-any next end markprop nil object))))) 50 (setq start (text-property-any next end markprop nil object)))))
51 51
52 (if (not (fboundp 'unique)) 52 (defsubst w3-props-unique (list)
53 (defsubst unique (list) 53 "Uniquify LIST, deleting elements using `delq'.
54 "Uniquify LIST, deleting elements using `delq'.
55 Return the list with subsequent duplicate items removed by side effects." 54 Return the list with subsequent duplicate items removed by side effects."
56 (let ((list list)) 55 (let ((list list))
57 (while list 56 (while list
58 (setq list (setcdr list (delq (car list) (cdr list)))))) 57 (setq list (setcdr list (delq (car list) (cdr list))))))
59 list)) 58 list)
60 59
61 ;; A generalisation of `facemenu-add-face' for any property, but without the 60 ;; A generalisation of `facemenu-add-face' for any property, but without the
62 ;; removal of inactive faces via `facemenu-discard-redundant-faces' and special 61 ;; removal of inactive faces via `facemenu-discard-redundant-faces' and special
63 ;; treatment of `default'. Uses `unique' to remove duplicate property values. 62 ;; treatment of `default'. Uses `unique' to remove duplicate property values.
64 (defsubst prepend-text-property (start end prop value &optional object) 63 (defsubst prepend-text-property (start end prop value &optional object)
70 (while (/= start end) 69 (while (/= start end)
71 (setq next (next-single-property-change start prop object end) 70 (setq next (next-single-property-change start prop object end)
72 prev (get-text-property start prop object)) 71 prev (get-text-property start prop object))
73 (put-text-property 72 (put-text-property
74 start next prop 73 start next prop
75 (unique (append val (if (listp prev) prev (list prev)))) 74 (w3-props-unique (append val (if (listp prev) prev (list prev))))
76 object) 75 object)
77 (setq start next)))) 76 (setq start next))))
78 77
79 (defsubst append-text-property (start end prop value &optional object) 78 (defsubst append-text-property (start end prop value &optional object)
80 "Append to one property of the text from START to END. 79 "Append to one property of the text from START to END.
85 (while (/= start end) 84 (while (/= start end)
86 (setq next (next-single-property-change start prop object end) 85 (setq next (next-single-property-change start prop object end)
87 prev (get-text-property start prop object)) 86 prev (get-text-property start prop object))
88 (put-text-property 87 (put-text-property
89 start next prop 88 start next prop
90 (unique (append (if (listp prev) prev (list prev)) val)) 89 (w3-props-unique (append (if (listp prev) prev (list prev)) val))
91 object) 90 object)
92 (setq start next)))) 91 (setq start next))))
93 92
94 (provide 'w3-props) 93 (provide 'w3-props)