tl-str.el

   1 ;;;
   2 ;;; $Id: tl-str.el,v 1.7 1994/09/25 21:33:52 morioka Exp $
   3 ;;;
   4
   5 (provide 'tl-str)
   6
   7 (defun fill-cited-region (beg end)
   8   (interactive "*r")
   9   (save-excursion
  10     (save-restriction
  11       (goto-char end)
  12       (while (not (eolp))
  13         (backward-char)
  14         )
  15       (setq end (point))
  16       (narrow-to-region beg end)
  17       (goto-char (point-min))
  18       (let* ((fill-prefix
  19               (and (re-search-forward "^[^ \t>]*[>|]+[ \t#]*" nil t)
  20                    (re-search-forward "^[^ \t>]*[>|]+[ \t#]*" nil t)
  21                    (buffer-substring (match-beginning 0)
  22                                      (match-end 0)
  23                                      )))
  24              (pat (concat "\n" fill-prefix))
  25              )
  26         (goto-char (point-min))
  27         (while (search-forward pat nil t)
  28           (replace-match "")
  29           )
  30         (goto-char (point-min))
  31         (fill-region (point-min) (point-max))
  32         ))))
  33
  34 (defun replace-top-string (&optional old new)
  35   (interactive)
  36   (if (null old)
  37       (setq old (read-string "old string is ? "))
  38     )
  39   (if (null new)
  40       (setq new (read-string "new string is ? "))
  41     )
  42   (while (re-search-forward (concat "^" (regexp-quote old)) nil t)
  43     (replace-match new)
  44     ))
  45
  46 (defun replace-as-filename (str)
  47   (let ((dest "")
  48         (i 0)(len (length str))
  49         chr)
  50     (while (< i len)
  51       (setq chr (elt str i))
  52       (if (or (and (<= ?+ chr)(<= chr ?.))
  53               (and (<= ?0 chr)(<= chr ?:))
  54               (= chr ?=)
  55               (and (<= ?@ chr)(<= chr ?\[))
  56               (and (<= ?\] chr)(<= chr ?_))
  57               (and (<= ?a chr)(<= chr ?{))
  58               (and (<= ?} chr)(<= chr ?~))
  59               )
  60           (setq dest (concat dest
  61                              (char-to-string chr)))
  62         )
  63       (setq i (+ i 1))
  64       )
  65     dest))
  66
  67 (defun symbol-concat (a b)
  68   (intern (concat
  69            (cond ((symbolp a)
  70                   (symbol-name a)
  71                   )
  72                  ((stringp a) a)
  73                  )
  74            (cond ((symbolp b)
  75                   (symbol-name b)
  76                   )
  77                  ((stringp b) b)
  78                  ))))
  79
  80 (defun top-string-match (pat str)
  81   (if (string-match
  82        (concat "^" (regexp-quote pat))
  83        str)
  84       (list pat (substring str (match-end 0)))
  85     ))
  86
  87 (defun middle-string-match (pat str)
  88   (if (equal pat str)
  89       (list nil pat nil)
  90     (if (string-match (regexp-quote pat) str)
  91         (let ((b (match-beginning 0))
  92               (e (match-end 0)) )
  93           (list (if (not (= b 0))
  94                     (substring str 0 b)
  95                   )
  96                 pat
  97                 (if (> (length str) e)
  98                     (substring str e)
  99                   )
 100                 )))))