86361
|
1 ;;; rng-util.el --- utility functions for RELAX NG library
|
|
2
|
|
3 ;; Copyright (C) 2003 Free Software Foundation, Inc.
|
|
4
|
|
5 ;; Author: James Clark
|
|
6 ;; Keywords: XML, RelaxNG
|
|
7
|
|
8 ;; This program is free software; you can redistribute it and/or
|
|
9 ;; modify it under the terms of the GNU General Public License as
|
|
10 ;; published by the Free Software Foundation; either version 2 of
|
|
11 ;; the License, or (at your option) any later version.
|
|
12
|
|
13 ;; This program is distributed in the hope that it will be
|
|
14 ;; useful, but WITHOUT ANY WARRANTY; without even the implied
|
|
15 ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
|
|
16 ;; PURPOSE. See the GNU General Public License for more details.
|
|
17
|
|
18 ;; You should have received a copy of the GNU General Public
|
|
19 ;; License along with this program; if not, write to the Free
|
|
20 ;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
|
|
21 ;; MA 02111-1307 USA
|
|
22
|
|
23 ;;; Commentary:
|
|
24
|
|
25 ;;; Code:
|
|
26
|
|
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
|
|
32 (intern uri)))
|
|
33
|
|
34 (defconst rng-xsd-datatypes-uri
|
|
35 (rng-make-datatypes-uri "http://www.w3.org/2001/XMLSchema-datatypes"))
|
|
36
|
|
37 (defconst rng-builtin-datatypes-uri (rng-make-datatypes-uri ""))
|
|
38
|
|
39 (defun rng-uniquify-eq (list)
|
|
40 "Destructively remove any element from LIST that is eq to
|
|
41 its predecessor."
|
|
42 (and list
|
|
43 (let ((head list))
|
|
44 (while (cdr head)
|
|
45 (if (eq (car head) (cadr head))
|
|
46 (setcdr head (cddr head)))
|
|
47 (setq head (cdr head)))
|
|
48 list)))
|
|
49
|
|
50 (defun rng-uniquify-equal (list)
|
|
51 "Destructively remove any element from LIST that is equal to
|
|
52 its predecessor."
|
|
53 (and list
|
|
54 (let ((head list))
|
|
55 (while (cdr head)
|
|
56 (if (equal (car head) (cadr head))
|
|
57 (setcdr head (cddr head)))
|
|
58 (setq head (cdr head)))
|
|
59 list)))
|
|
60
|
|
61 (defun rng-blank-p (str) (string-match "\\`[ \t\n\r]*\\'" str))
|
|
62
|
|
63 (defun rng-substq (new old list)
|
|
64 "Replace first member of LIST (if any) that is eq to OLD by NEW.
|
|
65 LIST is not modified."
|
|
66 (cond ((null list) nil)
|
|
67 ((eq (car list) old)
|
|
68 (cons new (cdr list)))
|
|
69 (t
|
|
70 (let ((tail (cons (car list)
|
|
71 nil))
|
|
72 (rest (cdr list)))
|
|
73 (setq list tail)
|
|
74 (while rest
|
|
75 (let ((item (car rest)))
|
|
76 (setq rest (cdr rest))
|
|
77 (cond ((eq item old)
|
|
78 (setcdr tail
|
|
79 (cons new rest))
|
|
80 (setq rest nil))
|
|
81 (t
|
|
82 (setq tail
|
|
83 (setcdr tail
|
|
84 (cons item nil))))))))
|
|
85 list)))
|
|
86
|
|
87 (defun rng-complete-before-point (start table prompt &optional predicate hist)
|
|
88 "Complete text between START and point.
|
|
89 Replaces the text between START and point with a string chosen using a
|
|
90 completion table and, when needed, input read from the user with the
|
|
91 minibuffer.
|
|
92 Returns the new string if either a complete and unique completion was
|
|
93 determined automatically or input was read from the user. Otherwise,
|
|
94 returns nil.
|
|
95 TABLE is an alist, a symbol bound to a function or an obarray as with
|
|
96 the function `completing-read'.
|
|
97 PROMPT is the string to prompt with if user input is needed.
|
|
98 PREDICATE is nil or a function as with `completing-read'.
|
|
99 HIST, if non-nil, specifies a history list as with `completing-read'."
|
|
100 (let* ((orig (buffer-substring-no-properties start (point)))
|
|
101 (completion (try-completion orig table predicate)))
|
|
102 (cond ((not completion)
|
|
103 (if (string= orig "")
|
|
104 (message "No completions available")
|
|
105 (message "No completion for %s" (rng-quote-string orig)))
|
|
106 (ding)
|
|
107 nil)
|
|
108 ((eq completion t) orig)
|
|
109 ((not (string= completion orig))
|
|
110 (delete-region start (point))
|
|
111 (insert completion)
|
|
112 (cond ((not (rng-completion-exact-p completion table predicate))
|
|
113 (message "Incomplete")
|
|
114 nil)
|
|
115 ((eq (try-completion completion table predicate) t)
|
|
116 completion)
|
|
117 (t
|
|
118 (message "Complete but not unique")
|
|
119 nil)))
|
|
120 (t
|
|
121 (setq completion
|
|
122 (let ((saved-minibuffer-setup-hook
|
|
123 (default-value 'minibuffer-setup-hook)))
|
|
124 (add-hook 'minibuffer-setup-hook
|
|
125 'minibuffer-completion-help
|
|
126 t)
|
|
127 (unwind-protect
|
|
128 (completing-read prompt
|
|
129 table
|
|
130 predicate
|
|
131 nil
|
|
132 orig
|
|
133 hist)
|
|
134 (setq-default minibuffer-setup-hook
|
|
135 saved-minibuffer-setup-hook))))
|
|
136 (delete-region start (point))
|
|
137 (insert completion)
|
|
138 completion))))
|
|
139
|
|
140 (defun rng-completion-exact-p (string table predicate)
|
|
141 (cond ((symbolp table)
|
|
142 (funcall table string predicate 'lambda))
|
|
143 ((vectorp table)
|
|
144 (intern-soft string table))
|
|
145 (t (assoc string table))))
|
|
146
|
|
147 (defun rng-quote-string (s)
|
|
148 (concat "\"" s "\""))
|
|
149
|
|
150 (defun rng-escape-string (s)
|
|
151 (replace-regexp-in-string "[&\"<>]"
|
|
152 (lambda (match)
|
|
153 (cdr (assoc match
|
|
154 '(("&" . "&")
|
|
155 ("\"" . """)
|
|
156 (">" . ">")
|
|
157 ("<" . "<")))))
|
|
158 s
|
|
159 t))
|
|
160
|
|
161 (defun rng-collapse-space (string)
|
|
162 (setq string
|
|
163 (replace-regexp-in-string "[ \t\r\n]+" " " string t t))
|
|
164 (when (string-match "\\` " string)
|
|
165 (setq string (substring string 1)))
|
|
166 (when (string-match " \\'" string)
|
|
167 (setq string (substring string 0 -1)))
|
|
168 string)
|
|
169
|
|
170 (provide 'rng-util)
|
|
171
|
|
172 ;;; rng-util.el ends here
|