cgit.sxemacs.org Git - packages/blob - xemacs-packages/w3/lisp/w3-props.el

   1 ;;; w3-props.el --- Additional text property stuff
   2 ;; Author: $Author: fx $
   3 ;; Created: $Date: 2001/09/09 15:33:14 $
   4 ;; Version: $Revision: 1.2 $
   5 ;; Keywords: faces
   6
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8 ;;; Copyright (c) 1995, 1996 by William M. Perry <wmperry@cs.indiana.edu>
   9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
  10 ;;;
  11 ;;; This file is part of GNU Emacs.
  12 ;;;
  13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;;; it under the terms of the GNU General Public License as published by
  15 ;;; the Free Software Foundation; either version 2, or (at your option)
  16 ;;; any later version.
  17 ;;;
  18 ;;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;;; GNU General Public License for more details.
  22 ;;;
  23 ;;; You should have received a copy of the GNU General Public License
  24 ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;;; Boston, MA 02111-1307, USA.
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28
  29 ;;; Additional text property functions.
  30
  31 ;; The following three text property functions are not generally available (and
  32 ;; it's not certain that they should be) so they are inlined for speed.
  33 ;; The case for `fillin-text-property' is simple; it may or not be generally
  34 ;; useful.  (Since it is used here, it is useful in at least one place.;-)
  35 ;; However, the case for `append-text-property' and `prepend-text-property' is
  36 ;; more complicated.  Should they remove duplicate property values or not?  If
  37 ;; so, should the first or last duplicate item remain?  Or the one that was
  38 ;; added?  In our implementation, the first duplicate remains.
  39
  40 (defsubst w3-fillin-text-property (start end setprop markprop value
  41                                          &optional object)
  42   "Fill in one property of the text from START to END.
  43 Arguments PROP and VALUE specify the property and value to put where none are
  44 already in place.  Therefore existing property values are not overwritten.
  45 Optional argument OBJECT is the string or buffer containing the text."
  46   (let ((start (text-property-any start end markprop nil object)) next)
  47     (while start
  48       (setq next (next-single-property-change start markprop object end))
  49       (put-text-property start next setprop value object)
  50       (put-text-property start next markprop value object)
  51       (setq start (text-property-any next end markprop nil object)))))
  52
  53 (defsubst w3-props-unique (list)
  54   "Uniquify LIST, deleting elements using `delq'.
  55 Return the list with subsequent duplicate items removed by side effects."
  56   (let ((list list))
  57     (while list
  58       (setq list (setcdr list (delq (car list) (cdr list))))))
  59   list)
  60
  61 ;; A generalisation of `facemenu-add-face' for any property, but without the
  62 ;; removal of inactive faces via `facemenu-discard-redundant-faces' and special
  63 ;; treatment of `default'.  Uses `unique' to remove duplicate property values.
  64 (defsubst prepend-text-property (start end prop value &optional object)
  65   "Prepend to one property of the text from START to END.
  66 Arguments PROP and VALUE specify the property and value to prepend to the value
  67 already in place.  The resulting property values are always lists, and unique.
  68 Optional argument OBJECT is the string or buffer containing the text."
  69   (let ((val (if (listp value) value (list value))) next prev)
  70     (while (/= start end)
  71       (setq next (next-single-property-change start prop object end)
  72             prev (get-text-property start prop object))
  73       (put-text-property
  74        start next prop
  75        (w3-props-unique (append val (if (listp prev) prev (list prev))))
  76        object)
  77       (setq start next))))
  78
  79 (defsubst append-text-property (start end prop value &optional object)
  80   "Append to one property of the text from START to END.
  81 Arguments PROP and VALUE specify the property and value to append to the value
  82 already in place.  The resulting property values are always lists, and unique.
  83 Optional argument OBJECT is the string or buffer containing the text."
  84   (let ((val (if (listp value) value (list value))) next prev)
  85     (while (/= start end)
  86       (setq next (next-single-property-change start prop object end)
  87             prev (get-text-property start prop object))
  88       (put-text-property
  89        start next prop
  90        (w3-props-unique (append (if (listp prev) prev (list prev)) val))
  91        object)
  92       (setq start next))))
  93
  94 (provide 'w3-props)