Mercurial > hg > xemacs-beta
comparison lisp/pcl-cvs/string.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | 131b0175ea99 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:376386a54a3c |
---|---|
1 ;;;; $Id: string.el,v 1.1.1.1 1996/12/18 03:32:28 steve Exp $ | |
2 ;;;; This file contains some miscellaneous string functions | |
3 | |
4 ;; Copyright (C) 1991-1995 Free Software Foundation | |
5 | |
6 ;; Author: Sebastian Kremer <sk@thp.Uni-Koeln.DE> | |
7 ;; Per Cederqvist <ceder@lysator.liu.se> | |
8 ;; Inge Wallin <inge@lysator.liu.se> | |
9 ;; Maintainer: elib-maintainers@lysator.liu.se | |
10 ;; Created: before 9 May 1991 | |
11 ;; Keywords: extensions, lisp | |
12 | |
13 ;;;; This file is part of the GNU Emacs lisp library, Elib. | |
14 ;;;; | |
15 ;;;; GNU Elib is free software; you can redistribute it and/or modify | |
16 ;;;; it under the terms of the GNU General Public License as published by | |
17 ;;;; the Free Software Foundation; either version 2, or (at your option) | |
18 ;;;; any later version. | |
19 ;;;; | |
20 ;;;; GNU Elib is distributed in the hope that it will be useful, | |
21 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
22 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
23 ;;;; GNU General Public License for more details. | |
24 ;;;; | |
25 ;;;; You should have received a copy of the GNU General Public License | |
26 ;;;; along with GNU Elib; see the file COPYING. If not, write to | |
27 ;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
28 ;;;; Boston, MA 02111-1307, USA | |
29 ;;;; | |
30 ;;;; Author: Sebastian Kremer | |
31 ;;;; sk@thp.Uni-Koeln.DE | |
32 ;;;; | |
33 | |
34 | |
35 ;;; Commentary: | |
36 | |
37 ;;; | |
38 ;;; This file is part of the elisp library Elib. | |
39 ;;; It implements simple generic string functions for use in other | |
40 ;;; elisp code: replace regexps in strings, split strings on regexps. | |
41 ;;; | |
42 | |
43 | |
44 ;;; Code: | |
45 | |
46 (provide 'string) | |
47 | |
48 | |
49 ;; This function is a near-equivalent of the elisp function replace-match | |
50 ;; which work on strings instead of a buffer. The FIXEDCASE parameter | |
51 ;; of replace-match is not implemented. | |
52 | |
53 (defun string-replace-match (regexp string newtext &optional literal global) | |
54 "Replace first match of REGEXP in STRING with NEWTEXT. | |
55 If no match is found, nil is returned instead of the new string. | |
56 | |
57 Optional arg LITERAL non-nil means to take NEWTEXT literally. If LITERAL is | |
58 nil, character `\\' is the start of one of the following sequences: | |
59 \\\\ will be replaced by a single \\. | |
60 \\& will be replaced by the text which matched the regexp. | |
61 \\N where N is a number and 1 <= N <= 9, will be replaced | |
62 by the Nth subexpression in REGEXP. Subexpressions are grouped | |
63 inside \\( \\). | |
64 | |
65 Optional arg GLOBAL means to replace all matches instead of only the first." | |
66 | |
67 (let ((data (match-data))) | |
68 (unwind-protect | |
69 | |
70 (if global | |
71 (let ((result "") | |
72 (start 0) | |
73 matchbeginning | |
74 matchend) | |
75 (while (string-match regexp string start) | |
76 (setq matchbeginning (match-beginning 0) | |
77 matchend (match-end 0) | |
78 result (concat result | |
79 (substring string start matchbeginning) | |
80 (if literal | |
81 newtext | |
82 (elib-string-expand-newtext))) | |
83 start matchend)) | |
84 | |
85 (if matchbeginning ; matched at least once | |
86 (concat result (substring string start)) | |
87 nil)) | |
88 | |
89 ;; not GLOBAL | |
90 (if (not (string-match regexp string 0)) | |
91 nil | |
92 (concat (substring string 0 (match-beginning 0)) | |
93 (if literal newtext (elib-string-expand-newtext)) | |
94 (substring string (match-end 0))))) | |
95 (store-match-data data)))) | |
96 | |
97 | |
98 (defun elib-string-expand-newtext () | |
99 ;; Expand \& and \1..\9 (referring to STRING) in NEWTEXT. | |
100 ;; Uses match data and fluid vars `newtext', `string'. | |
101 ;; Note that in Emacs 18 match data are clipped to current buffer | |
102 ;; size...so the buffer should better not be smaller than STRING. | |
103 (let ((pos 0) | |
104 (len (length newtext)) | |
105 (expanded-newtext "")) | |
106 (while (< pos len) | |
107 (setq expanded-newtext | |
108 (concat expanded-newtext | |
109 (let ((c (aref newtext pos))) | |
110 (if (= ?\\ c) | |
111 (cond ((= ?\& (setq c (aref newtext | |
112 (setq pos (1+ pos))))) | |
113 (substring string | |
114 (match-beginning 0) | |
115 (match-end 0))) | |
116 ((and (>= c ?1) | |
117 (<= c ?9)) | |
118 ;; return empty string if N'th | |
119 ;; sub-regexp did not match: | |
120 (let ((n (- c ?0))) | |
121 (if (match-beginning n) | |
122 (substring string | |
123 (match-beginning n) | |
124 (match-end n)) | |
125 ""))) | |
126 (t (char-to-string c))) | |
127 (char-to-string c))))) | |
128 (setq pos (1+ pos))) | |
129 expanded-newtext)) | |
130 | |
131 | |
132 (defun string-split (pattern string &optional limit) | |
133 "Splitting on regexp PATTERN, turn string STRING into a list of substrings. | |
134 Optional third arg LIMIT (>= 1) is a limit to the length of the | |
135 resulting list." | |
136 | |
137 (let ((data (match-data))) | |
138 (unwind-protect | |
139 (let* ((start (string-match pattern string)) | |
140 (result (list (substring string 0 start))) | |
141 (count 1) | |
142 (end (if start (match-end 0)))) | |
143 (if end ; else nothing left | |
144 (while (and (or (not (integerp limit)) | |
145 (< count limit)) | |
146 (string-match pattern string end)) | |
147 (setq start (match-beginning 0) | |
148 count (1+ count) | |
149 result (cons (substring string end start) result) | |
150 end (match-end 0) | |
151 start end))) | |
152 (if (and (or (not (integerp limit)) | |
153 (< count limit)) | |
154 end) ; else nothing left | |
155 (setq result | |
156 (cons (substring string end) result))) | |
157 (nreverse result)) | |
158 (store-match-data data)))) | |
159 | |
160 ;;; string.el ends here |