--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/tl/tl-str.el	Mon Aug 13 08:46:56 2007 +0200
@@ -0,0 +1,343 @@
+;;; tl-str.el --- Emacs Lisp Library module about string
+
+;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Version:
+;;	$Id: tl-str.el,v 1.1.1.1 1996/12/18 03:55:31 steve Exp $
+;; Keywords: string
+
+;; This file is part of tl (Tiny Library).
+
+;; 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, 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 GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'emu)
+(require 'tl-list)
+
+
+;;; @ converter
+;;;
+
+(defun expand-char-ranges (str)
+  (let ((i 0)
+	(len (length str))
+	chr pchr nchr
+	(dest ""))
+    (while (< i len)
+      (setq chr (elt str i))
+      (cond ((and pchr (eq chr ?-))
+	     (setq pchr (1+ pchr))
+	     (setq i (1+ i))
+	     (setq nchr (elt str i))
+	     (while (<= pchr nchr)
+	       (setq dest (concat dest (char-to-string pchr)))
+	       (setq pchr (1+ pchr))
+	       )
+	     )
+	    (t
+	     (setq dest (concat dest (char-to-string chr)))
+	     ))
+      (setq pchr chr)
+      (setq i (1+ i))
+      )
+    dest))
+
+
+;;; @ space
+;;;
+
+(defun eliminate-top-spaces (str)
+  "Eliminate top sequence of space or tab and return it. [tl-str.el]"
+  (if (string-match "^[ \t]+" str)
+      (substring str (match-end 0))
+    str))
+
+(defun eliminate-last-spaces (str)
+  "Eliminate last sequence of space or tab and return it. [tl-str.el]"
+  (if (string-match "[ \t]+$" str)
+      (substring str 0 (match-beginning 0))
+    str))
+
+(defun replace-space-with-underline (str)
+  (mapconcat (function
+	      (lambda (arg)
+		(char-to-string
+		 (if (eq arg ?\ )
+		     ?_
+		   arg)))) str "")
+  )
+
+
+;;; @ version
+;;;
+
+(defun version-to-list (str)
+  (if (string-match "[0-9]+" str)
+      (let ((dest
+	     (list
+	      (string-to-number
+	       (substring str (match-beginning 0)(match-end 0))
+	       ))))
+	(setq str (substring str (match-end 0)))
+	(while (string-match "^\\.[0-9]+" str)
+	  (setq dest
+		(cons
+		 (string-to-number
+		  (substring str (1+ (match-beginning 0))(match-end 0)))
+		 dest))
+	  (setq str (substring str (match-end 0)))
+	  )
+	(nreverse dest)
+	)))
+
+(defun version< (v1 v2)
+  (or (listp v1)
+      (setq v1 (version-to-list v1))
+      )
+  (or (listp v2)
+      (setq v2 (version-to-list v2))
+      )
+  (catch 'tag
+    (while (and v1 v2)
+      (cond ((< (car v1)(car v2))
+	     (throw 'tag v2)
+	     )
+	    ((> (car v1)(car v2))
+	     (throw 'tag nil)
+	     ))
+      (setq v1 (cdr v1)
+	    v2 (cdr v2))
+      )
+    v2))
+
+(defun version<= (v1 v2)
+  (or (listp v1)
+      (setq v1 (version-to-list v1))
+      )
+  (or (listp v2)
+      (setq v2 (version-to-list v2))
+      )
+  (catch 'tag
+    (while (and v1 v2)
+      (cond ((< (car v1)(car v2))
+	     (throw 'tag v2)
+	     )
+	    ((> (car v1)(car v2))
+	     (throw 'tag nil)
+	     ))
+      (setq v1 (cdr v1)
+	    v2 (cdr v2))
+      )
+    (or v2 (and (null v1)(null v2)))
+    ))
+
+(defun version> (v1 v2)
+  (or (listp v1)
+      (setq v1 (version-to-list v1))
+      )
+  (or (listp v2)
+      (setq v2 (version-to-list v2))
+      )
+  (catch 'tag
+    (while (and v1 v2)
+      (cond ((> (car v1)(car v2))
+	     (throw 'tag v1)
+	     )
+	    ((< (car v1)(car v2))
+	     (throw 'tag nil)
+	     ))
+      (setq v1 (cdr v1)
+	    v2 (cdr v2))
+      )
+    v1))
+
+(defun version>= (v1 v2)
+  (or (listp v1)
+      (setq v1 (version-to-list v1))
+      )
+  (or (listp v2)
+      (setq v2 (version-to-list v2))
+      )
+  (catch 'tag
+    (while (and v1 v2)
+      (cond ((> (car v1)(car v2))
+	     (throw 'tag v1)
+	     )
+	    ((< (car v1)(car v2))
+	     (throw 'tag nil)
+	     ))
+      (setq v1 (cdr v1)
+	    v2 (cdr v2))
+      )
+    (or v1 (and (null v1)(null v2)))
+    ))
+
+
+;;; @ RCS version
+;;;
+
+(defun get-version-string (id)
+  "Return a version-string from RCS ID. [tl-str.el]"
+  (and (string-match ",v \\([0-9][0-9.][0-9.]+\\)" id)
+       (substring id (match-beginning 1)(match-end 1))
+       ))
+
+
+;;; @ file name
+;;;
+
+(defun file-name-non-extension (filename)
+  (if (string-match "\\.[^.]+$" filename)
+      (substring filename 0 (match-beginning 0))
+    filename))
+
+(defvar filename-special-char-range
+  (nconc '((0 . 31))
+	 (string-to-int-list "!\"$")
+	 (list (cons (char-int ?&) (char-int ?*)))
+	 (string-to-int-list "/;<>?")
+	 (list (cons (char-int ?\[) (char-int ?^)))
+	 (string-to-int-list "`")
+	 (list (cons (char-int ?{) (char-int ?})))
+	 '((127 . 159)))
+  "*Range of characters which is not available in file name. [tl-str.el]")
+
+(defvar filename-space-char-range '(9 32 160)
+  "*Range of characters which indicates space. These characters
+are replaced to `_' by function `replace-as-filename' [tl-str.el]")
+
+(defun replace-as-filename (str)
+  "Return safety filename from STR. [tl-str.el]"
+  (let (sf)
+    (mapconcat (function
+		(lambda (chr)
+		  (cond ((member-of-range chr filename-space-char-range)
+			 (if sf
+			     ""
+			   (setq sf t)
+			   "_"))
+			((member-of-range chr filename-special-char-range)
+			 "")
+			(t
+			 (setq sf nil)
+			 (char-to-string chr)
+			 ))
+		  ))
+	       (string-to-char-list str)
+	       "")))
+
+
+;;; @ symbol
+;;;
+
+(defun symbol-concat (&rest args)
+  "Return a symbol whose name is concatenation of arguments ARGS
+which are string or symbol. [tl-str.el]"
+  (intern (apply (function concat)
+		 (mapcar (function
+			  (lambda (s)
+			    (cond ((symbolp s) (symbol-name s))
+				  ((stringp s) s)
+				  )
+			    ))
+			 args)))
+  )
+
+
+;;; @ matching
+;;;
+
+(defun top-string-match (pat str)
+  "Return a list (MATCHED REST) if string PAT is top substring of
+string STR. [tl-str.el]"
+  (if (string-match
+       (concat "^" (regexp-quote pat))
+       str)
+      (list pat (substring str (match-end 0)))
+    ))
+
+(defun middle-string-match (pat str)
+  "Return a list (PREVIOUS MATCHED REST) if string PAT is found in
+string STR. [tl-str.el]"
+  (if (equal pat str)
+      (list nil pat nil)
+    (if (string-match (regexp-quote pat) str)
+	(let ((b (match-beginning 0))
+	      (e (match-end 0)) )
+	  (list (if (not (= b 0))
+		    (substring str 0 b)
+		  )
+		pat
+		(if (> (length str) e)
+		    (substring str e)
+		  )
+		)))))
+
+(defun re-top-string-match (pat str)
+  "Return a list (MATCHED REST) if regexp PAT is matched as top
+substring of string STR. [tl-str.el]"
+  (if (string-match (concat "^" pat) str)
+      (let ((e (match-end 0)))
+	(list (substring str 0 e)(substring str e))
+	)))
+
+
+;;; @ compare
+;;;
+
+(defun string-compare-from-top (str1 str2)
+  (let* ((len1 (length str1))
+	 (len2 (length str2))
+	 (len (min len1 len2))
+	 (p 0)
+	 c1 c2)
+    (while (and (< p len)
+		(progn
+		  (setq c1 (sref str1 p)
+			c2 (sref str2 p))
+		  (eq c1 c2)
+		  ))
+      (setq p (+ p (char-length c1)))
+      )
+    (and (> p 0)
+	 (let ((matched (substring str1 0 p))
+	       (r1 (and (< p len1)(substring str1 p)))
+	       (r2 (and (< p len2)(substring str2 p)))
+	       )
+	   (if (eq r1 r2)
+	       matched
+	     (list 'seq matched (list 'or r1 r2))
+	     )))))
+
+
+;;; @ regexp
+;;;
+
+(defun regexp-* (regexp)
+  (concat regexp "*"))
+
+(defun regexp-or (&rest args)
+  (concat "\\(" (mapconcat (function identity) args "\\|") "\\)"))
+
+
+;;; @ end
+;;;
+
+(provide 'tl-str)
+
+;;; tl-str.el ends here