Initial commit

site-lisp/nxml-mode-20041004/rng-util.el

@@ -0,0 +1,172 @@
+;;; rng-util.el --- utility functions for RELAX NG library
+
+;; Copyright (C) 2003 Free Software Foundation, Inc.
+
+;; Author: James Clark
+;; Keywords: XML, RelaxNG
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be
+;; useful, but WITHOUT ANY WARRANTY; without even the implied
+;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;; PURPOSE.  See the GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public
+;; License along with this program; if not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
+;; MA 02111-1307 USA
+
+;;; Commentary:
+
+;;; Code:
+
+(defun rng-make-datatypes-uri (uri)
+  (if (string-equal uri "")
+      ;; The spec doesn't say to do this, but it's perfectly conformant
+      ;; and better than using nil, I think.
+      'http://relaxng.org/ns/structure/1.0
+    (intern uri)))
+
+(defconst rng-xsd-datatypes-uri
+  (rng-make-datatypes-uri "http://www.w3.org/2001/XMLSchema-datatypes"))
+
+(defconst rng-builtin-datatypes-uri (rng-make-datatypes-uri ""))
+
+(defun rng-uniquify-eq (list)
+  "Destructively remove any element from LIST that is eq to
+its predecessor."
+  (and list
+       (let ((head list))
+	 (while (cdr head)
+	   (if (eq (car head) (cadr head))
+	       (setcdr head (cddr head)))
+	   (setq head (cdr head)))
+	 list)))
+
+(defun rng-uniquify-equal (list)
+  "Destructively remove any element from LIST that is equal to
+its predecessor."
+  (and list
+       (let ((head list))
+	 (while (cdr head)
+	   (if (equal (car head) (cadr head))
+	       (setcdr head (cddr head)))
+	   (setq head (cdr head)))
+	 list)))
+
+(defun rng-blank-p (str) (string-match "\\`[ \t\n\r]*\\'" str))
+
+(defun rng-substq (new old list)
+  "Replace first member of LIST (if any) that is eq to OLD by NEW.
+LIST is not modified."
+  (cond ((null list) nil)
+	((eq (car list) old)
+	 (cons new (cdr list)))
+	(t
+	 (let ((tail (cons (car list)
+			   nil))
+	       (rest (cdr list)))
+	   (setq list tail)
+	   (while rest
+	     (let ((item (car rest)))
+	       (setq rest (cdr rest))
+	       (cond ((eq item old)
+		      (setcdr tail
+			      (cons new rest))
+		      (setq rest nil))
+		     (t
+		      (setq tail
+			    (setcdr tail
+				    (cons item nil))))))))
+	 list)))
+
+(defun rng-complete-before-point (start table prompt &optional predicate hist)
+  "Complete text between START and point.
+Replaces the text between START and point with a string chosen using a
+completion table and, when needed, input read from the user with the
+minibuffer.
+Returns the new string if either a complete and unique completion was
+determined automatically or input was read from the user. Otherwise,
+returns nil.
+TABLE is an alist, a symbol bound to a function or an obarray as with
+the function `completing-read'.
+PROMPT is the string to prompt with if user input is needed.
+PREDICATE is nil or a function as with `completing-read'.
+HIST, if non-nil, specifies a history list as with `completing-read'."
+  (let* ((orig (buffer-substring-no-properties start (point)))
+	 (completion (try-completion orig table predicate)))
+    (cond ((not completion)
+	   (if (string= orig "")
+	       (message "No completions available")
+	     (message "No completion for %s" (rng-quote-string orig)))
+	   (ding)
+	   nil)
+	  ((eq completion t) orig)
+	  ((not (string= completion orig))
+	   (delete-region start (point))
+	   (insert completion)
+	   (cond ((not (rng-completion-exact-p completion table predicate))
+		  (message "Incomplete")
+		  nil)
+		 ((eq (try-completion completion table predicate) t)
+		  completion)
+		 (t
+		  (message "Complete but not unique")
+		  nil)))
+	  (t
+	   (setq completion
+		 (let ((saved-minibuffer-setup-hook
+			(default-value 'minibuffer-setup-hook)))
+		   (add-hook 'minibuffer-setup-hook
+			     'minibuffer-completion-help
+			     t)
+		   (unwind-protect
+		       (completing-read prompt
+					table
+					predicate
+					nil
+					orig
+					hist)
+		     (setq-default minibuffer-setup-hook
+				   saved-minibuffer-setup-hook))))
+	   (delete-region start (point))
+	   (insert completion)
+	   completion))))
+
+(defun rng-completion-exact-p (string table predicate)
+  (cond ((symbolp table)
+	 (funcall table string predicate 'lambda))
+	((vectorp table)
+	 (intern-soft string table))
+	(t (assoc string table))))
+
+(defun rng-quote-string (s)
+  (concat "\"" s "\""))
+
+(defun rng-escape-string (s)
+  (replace-regexp-in-string "[&\"<>]"
+			    (lambda (match)
+			      (cdr (assoc match
+					  '(("&" . "&amp;")
+					    ("\"" . "&quot;")
+					    (">" . "&gt;")
+					    ("<" . "&lt;")))))
+			    s
+			    t))
+
+(defun rng-collapse-space (string)
+  (setq string
+	(replace-regexp-in-string "[ \t\r\n]+" " " string t t))
+  (when (string-match "\\` " string)
+    (setq string (substring string 1)))
+  (when (string-match " \\'" string)
+    (setq string (substring string 0 -1)))
+  string)
+
+(provide 'rng-util)
+
+;;; rng-util.el ends here