tl-str.el

   1 ;;;
   2 ;;; $Id: tl-str.el,v 3.2 1994/12/19 10:03:57 morioka Exp $
   3 ;;;
   4
   5 (provide 'tl-str)
   6
   7
   8 ;;; @@ about rightful dividing for multi-octet string
   9 ;;;
  10 ;; by mol. 1993/9/26
  11 (defun rightful-boundary-short-string (str width)
  12   (substring str 0
  13              (let ((i 0) (w 0) chr (len (length str)))
  14                (catch 'label
  15                  (while (< i len)
  16                    (setq chr (elt str i))
  17                    (setq w (+ w (char-width chr)))
  18                    (if (> w width)
  19                        (throw 'label i))
  20                    (setq i (+ i (char-bytes chr)))
  21                    )
  22                  i))
  23              ))
  24
  25
  26 ;;; @@ RCS version
  27 ;;;
  28
  29 (defun get-version-string (id)
  30   (and (string-match "[0-9][0-9.]*" id)
  31        (substring id (match-beginning 0)(match-end 0))
  32        ))
  33
  34
  35 ;;; @@ file name
  36 ;;;
  37 (defun replace-as-filename (str)
  38   (let ((dest "")
  39         (i 0)(len (length str))
  40         chr)
  41     (while (< i len)
  42       (setq chr (elt str i))
  43       (if (or (and (<= ?+ chr)(<= chr ?.))
  44               (and (<= ?0 chr)(<= chr ?:))
  45               (= chr ?=)
  46               (and (<= ?@ chr)(<= chr ?\[))
  47               (and (<= ?\] chr)(<= chr ?_))
  48               (and (<= ?a chr)(<= chr ?{))
  49               (and (<= ?} chr)(<= chr ?~))
  50               )
  51           (setq dest (concat dest
  52                              (char-to-string chr)))
  53         )
  54       (setq i (+ i 1))
  55       )
  56     dest))
  57
  58
  59 ;;; @@ message editing utilities
  60 ;;;
  61 (defvar cited-prefix-regexp "^[^ \t>]*[>|]+[ \t#]*")
  62
  63 (defun fill-cited-region (beg end)
  64   (interactive "*r")
  65   (save-excursion
  66     (save-restriction
  67       (goto-char end)
  68       (while (not (eolp))
  69         (backward-char)
  70         )
  71       (setq end (point))
  72       (narrow-to-region beg end)
  73       (goto-char (point-min))
  74       (let* ((fill-prefix
  75               (and (re-search-forward cited-prefix-regexp nil t)
  76                    (or (re-search-forward cited-prefix-regexp nil t)
  77                        t)
  78                    (buffer-substring (match-beginning 0)
  79                                      (match-end 0)
  80                                      )))
  81              (pat (concat "\n" fill-prefix))
  82              )
  83         (goto-char (point-min))
  84         (while (search-forward pat nil t)
  85           (replace-match "")
  86           )
  87         (goto-char (point-min))
  88         (fill-region (point-min) (point-max))
  89         ))))
  90
  91 (defun replace-top-string (&optional old new)
  92   (interactive)
  93   (if (null old)
  94       (setq old (read-string "old string is ? "))
  95     )
  96   (if (null new)
  97       (setq new (read-string "new string is ? "))
  98     )
  99   (while (re-search-forward (concat "^" (regexp-quote old)) nil t)
 100     (replace-match new)
 101     ))
 102
 103
 104 ;;; @@ jinn compatible functions
 105 ;;;
 106
 107 (defun symbol-concat (&rest args)
 108   (intern (apply (function concat)
 109                  (mapcar (function
 110                           (lambda (s)
 111                             (cond ((symbolp s) (symbol-name s))
 112                                   ((stringp s) s)
 113                                   )
 114                             ))
 115                          args)))
 116   )
 117
 118 (defun top-string-match (pat str)
 119   (if (string-match
 120        (concat "^" (regexp-quote pat))
 121        str)
 122       (list pat (substring str (match-end 0)))
 123     ))
 124
 125 (defun middle-string-match (pat str)
 126   (if (equal pat str)
 127       (list nil pat nil)
 128     (if (string-match (regexp-quote pat) str)
 129         (let ((b (match-beginning 0))
 130               (e (match-end 0)) )
 131           (list (if (not (= b 0))
 132                     (substring str 0 b)
 133                   )
 134                 pat
 135                 (if (> (length str) e)
 136                     (substring str e)
 137                   )
 138                 )))))