;;;
;;; $Id: tl-str.el,v 3.2 1994/12/19 10:03:57 morioka Exp $
;;;

(provide 'tl-str)


;;; @@ about rightful dividing for multi-octet string
;;;
;; by mol. 1993/9/26
(defun rightful-boundary-short-string (str width)
  (substring str 0 
	     (let ((i 0) (w 0) chr (len (length str)))
	       (catch 'label
		 (while (< i len)
		   (setq chr (elt str i))
		   (setq w (+ w (char-width chr)))
		   (if (> w width)
		       (throw 'label i))
		   (setq i (+ i (char-bytes chr)))
		   )
		 i))
	     ))


;;; @@ RCS version
;;;

(defun get-version-string (id)
  (and (string-match "[0-9][0-9.]*" id)
       (substring id (match-beginning 0)(match-end 0))
       ))


;;; @@ file name
;;;
(defun replace-as-filename (str)
  (let ((dest "")
	(i 0)(len (length str))
	chr)
    (while (< i len)
      (setq chr (elt str i))
      (if (or (and (<= ?+ chr)(<= chr ?.))
	      (and (<= ?0 chr)(<= chr ?:))
	      (= chr ?=)
	      (and (<= ?@ chr)(<= chr ?\[))
	      (and (<= ?\] chr)(<= chr ?_))
	      (and (<= ?a chr)(<= chr ?{))
	      (and (<= ?} chr)(<= chr ?~))
	      )
	  (setq dest (concat dest
			     (char-to-string chr)))
	)
      (setq i (+ i 1))
      )
    dest))


;;; @@ message editing utilities
;;;
(defvar cited-prefix-regexp "^[^ \t>]*[>|]+[ \t#]*")

(defun fill-cited-region (beg end)
  (interactive "*r")
  (save-excursion
    (save-restriction
      (goto-char end)
      (while (not (eolp))
	(backward-char)
	)
      (setq end (point))
      (narrow-to-region beg end)
      (goto-char (point-min))
      (let* ((fill-prefix
	      (and (re-search-forward cited-prefix-regexp nil t)
		   (or (re-search-forward cited-prefix-regexp nil t)
		       t)
		   (buffer-substring (match-beginning 0)
				     (match-end 0)
				     )))
	     (pat (concat "\n" fill-prefix))
	     )
	(goto-char (point-min))
	(while (search-forward pat nil t)
	  (replace-match "")
	  )
	(goto-char (point-min))
	(fill-region (point-min) (point-max))
	))))

(defun replace-top-string (&optional old new)
  (interactive)
  (if (null old)
      (setq old (read-string "old string is ? "))
    )
  (if (null new)
      (setq new (read-string "new string is ? "))
    )
  (while (re-search-forward (concat "^" (regexp-quote old)) nil t)
    (replace-match new)
    ))


;;; @@ jinn compatible functions
;;;

(defun symbol-concat (&rest args)
  (intern (apply (function concat)
		 (mapcar (function
			  (lambda (s)
			    (cond ((symbolp s) (symbol-name s))
				  ((stringp s) s)
				  )
			    ))
			 args)))
  )

(defun top-string-match (pat str)
  (if (string-match
       (concat "^" (regexp-quote pat))
       str)
      (list pat (substring str (match-end 0)))
    ))

(defun middle-string-match (pat str)
  (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)
		  )
		)))))