Mercurial > hg > xemacs-beta

comparison lisp/gnus/custom.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 0293115a14e9
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
111 "Return the text from BEG to END, without text properties, as a string." 111 "Return the text from BEG to END, without text properties, as a string."
112 (let ((string (buffer-substring beg end))) 112 (let ((string (buffer-substring beg end)))
113 (custom-set-text-properties 0 (length string) nil string) 113 (custom-set-text-properties 0 (length string) nil string)
114 string)) 114 string))
115 115
116 (or (fboundp 'add-to-list)
117 ;; Introduced in Emacs 19.29.
118 (defun add-to-list (list-var element)
119 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
120 If you want to use `add-to-list' on a variable that is not defined
121 until a certain package is loaded, you should put the call to `add-to-list'
122 into a hook function that will be run only after loading the package.
123 `eval-after-load' provides one way to do this. In some cases
124 other hooks, such as major mode hooks, can do the job."
125 (or (member element (symbol-value list-var))
126 (set list-var (cons element (symbol-value list-var))))))
127
128 (or (fboundp 'plist-get)
129 ;; Introduced in Emacs 19.29.
130 (defun plist-get (plist prop)
131 "Extract a value from a property list.
132 PLIST is a property list, which is a list of the form
133 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
134 corresponding to the given PROP, or nil if PROP is not
135 one of the properties on the list."
136 (let (result)
137 (while plist
138 (if (eq (car plist) prop)
139 (setq result (car (cdr plist))
140 plist nil)
141 (set plist (cdr (cdr plist)))))
142 result)))
143
144 (or (fboundp 'plist-put)
145 ;; Introduced in Emacs 19.29.
146 (defun plist-put (plist prop val)
147 "Change value in PLIST of PROP to VAL.
148 PLIST is a property list, which is a list of the form
149 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.
150 If PROP is already a property on the list, its value is set to VAL,
151 otherwise the new PROP VAL pair is added. The new plist is returned;
152 use `(setq x (plist-put x prop val))' to be sure to use the new value.
153 The PLIST is modified by side effects."
154 (if (null plist)
155 (list prop val)
156 (let ((current plist))
157 (while current
158 (cond ((eq (car current) prop)
159 (setcar (cdr current) val)
160 (setq current nil))
161 ((null (cdr (cdr current)))
162 (setcdr (cdr current) (list prop val))
163 (setq current nil))
164 (t
165 (setq current (cdr (cdr current)))))))
166 plist)))
167
168 (or (fboundp 'match-string)
169 ;; Introduced in Emacs 19.29.
170 (defun match-string (num &optional string)
171 "Return string of text matched by last search.
172 NUM specifies which parenthesized expression in the last regexp.
173 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
174 Zero means the entire text matched by the whole regexp or whole string.
175 STRING should be given if the last search was by `string-match' on STRING."
176 (if (match-beginning num)
177 (if string
178 (substring string (match-beginning num) (match-end num))
179 (buffer-substring (match-beginning num) (match-end num))))))
180
181 (or (fboundp 'facep)
182 ;; Introduced in Emacs 19.29.
183 (defun facep (x)
184 "Return t if X is a face name or an internal face vector."
185 (and (or (and (fboundp 'internal-facep) (internal-facep x))
186 (and
187 (symbolp x)
188 (assq x (and (boundp 'global-face-data) global-face-data))))
189 t)))
190
191 ;; XEmacs and Emacs 19.29 facep does different things. 116 ;; XEmacs and Emacs 19.29 facep does different things.
192 (if (fboundp 'find-face) 117 (defalias 'custom-facep
193 (fset 'custom-facep 'find-face) 118 (cond ((fboundp 'find-face)
194 (fset 'custom-facep 'facep)) 119 'find-face)
120 ((fboundp 'facep)
121 'facep)
122 (t
123 'ignore)))
195 124
196 (if (custom-facep 'underline) 125 (if (custom-facep 'underline)
197 () 126 ()
198 ;; No underline face in XEmacs 19.12. 127 ;; No underline face in XEmacs 19.12.
199 (and (fboundp 'make-face) 128 (and (fboundp 'make-face)