1 ;;; rng-util.el --- utility functions for RELAX NG library
3 ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
6 ;; Keywords: XML, RelaxNG
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 (defun rng-make-datatypes-uri (uri)
28 (if (string-equal uri
"")
29 ;; The spec doesn't say to do this, but it's perfectly conformant
30 ;; and better than using nil, I think.
31 'http
://relaxng.org
/ns
/structure
/1.0
34 (defconst rng-xsd-datatypes-uri
35 (rng-make-datatypes-uri "http://www.w3.org/2001/XMLSchema-datatypes"))
37 (defconst rng-builtin-datatypes-uri
(rng-make-datatypes-uri ""))
39 (defun rng-uniquify-eq (list)
40 "Destructively remove `eq' duplicates from LIST."
44 (if (eq (car head
) (cadr head
))
45 (setcdr head
(cddr head
)))
46 (setq head
(cdr head
)))
49 (defun rng-uniquify-equal (list)
50 "Destructively remove `equal' duplicates from LIST."
54 (if (equal (car head
) (cadr head
))
55 (setcdr head
(cddr head
)))
56 (setq head
(cdr head
)))
59 (defun rng-blank-p (str) (string-match "\\`[ \t\n\r]*\\'" str
))
61 (defun rng-substq (new old list
)
62 "Replace first member of LIST (if any) that is `eq' to OLD by NEW.
63 LIST is not modified."
64 (cond ((null list
) nil
)
66 (cons new
(cdr list
)))
68 (let ((tail (cons (car list
)
73 (let ((item (car rest
)))
74 (setq rest
(cdr rest
))
82 (cons item nil
))))))))
85 (defun rng-complete-before-point (start table prompt
&optional predicate hist
)
86 "Complete text between START and point.
87 Replaces the text between START and point with a string chosen using a
88 completion table and, when needed, input read from the user with the
90 Returns the new string if either a complete and unique completion was
91 determined automatically or input was read from the user. Otherwise,
93 TABLE is an alist, a symbol bound to a function or an obarray as with
94 the function `completing-read'.
95 PROMPT is the string to prompt with if user input is needed.
96 PREDICATE is nil or a function as with `completing-read'.
97 HIST, if non-nil, specifies a history list as with `completing-read'."
98 (let* ((orig (buffer-substring-no-properties start
(point)))
99 (completion (try-completion orig table predicate
)))
100 (cond ((not completion
)
101 (if (string= orig
"")
102 (message "No completions available")
103 (message "No completion for %s" (rng-quote-string orig
)))
106 ((eq completion t
) orig
)
107 ((not (string= completion orig
))
108 (delete-region start
(point))
110 (cond ((not (rng-completion-exact-p completion table predicate
))
111 (message "Incomplete")
113 ((eq (try-completion completion table predicate
) t
)
116 (message "Complete but not unique")
120 (let ((saved-minibuffer-setup-hook
121 (default-value 'minibuffer-setup-hook
)))
122 (add-hook 'minibuffer-setup-hook
123 'minibuffer-completion-help
126 (completing-read prompt
132 (setq-default minibuffer-setup-hook
133 saved-minibuffer-setup-hook
))))
134 (delete-region start
(point))
138 (defun rng-completion-exact-p (string table predicate
)
139 (cond ((symbolp table
)
140 (funcall table string predicate
'lambda
))
142 (intern-soft string table
))
143 (t (assoc string table
))))
145 (defun rng-quote-string (s)
146 (concat "\"" s
"\""))
148 (defun rng-escape-string (s)
149 (replace-regexp-in-string "[&\"<>]"
159 (defun rng-collapse-space (string)
161 (replace-regexp-in-string "[ \t\r\n]+" " " string t t
))
162 (when (string-match "\\` " string
)
163 (setq string
(substring string
1)))
164 (when (string-match " \\'" string
)
165 (setq string
(substring string
0 -
1)))
170 ;; arch-tag: 2dc233e0-5e7a-488f-bfc4-5909512dbaf0
171 ;;; rng-util.el ends here