comparison lisp/tl/tl-str.el @ 74:54cc21c15cbb r20-0b32

Import from CVS: tag r20-0b32
author cvs
date Mon, 13 Aug 2007 09:04:33 +0200
parents 131b0175ea99
children 6a378aca36af
comparison
equal deleted inserted replaced
73:e2d7a37b7c8d 74:54cc21c15cbb
2 2
3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
4 4
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> 5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Version: 6 ;; Version:
7 ;; $Id: tl-str.el,v 1.1.1.1 1996/12/18 22:43:38 steve Exp $ 7 ;; $Id: tl-str.el,v 1.1.1.2 1996/12/21 20:50:49 steve Exp $
8 ;; Keywords: string 8 ;; Keywords: string
9 9
10 ;; This file is part of tl (Tiny Library). 10 ;; This file is part of tl (Tiny Library).
11 11
12 ;; This program is free software; you can redistribute it and/or 12 ;; This program is free software; you can redistribute it and/or
204 (defun file-name-non-extension (filename) 204 (defun file-name-non-extension (filename)
205 (if (string-match "\\.[^.]+$" filename) 205 (if (string-match "\\.[^.]+$" filename)
206 (substring filename 0 (match-beginning 0)) 206 (substring filename 0 (match-beginning 0))
207 filename)) 207 filename))
208 208
209 (defvar filename-special-char-range 209 (autoload 'replace-as-filename "filename")
210 (nconc '((0 . 31))
211 (string-to-int-list "!\"$")
212 (list (cons (char-int ?&) (char-int ?*)))
213 (string-to-int-list "/;<>?")
214 (list (cons (char-int ?\[) (char-int ?^)))
215 (string-to-int-list "`")
216 (list (cons (char-int ?{) (char-int ?})))
217 '((127 . 159)))
218 "*Range of characters which is not available in file name. [tl-str.el]")
219
220 (defvar filename-space-char-range '(9 32 160)
221 "*Range of characters which indicates space. These characters
222 are replaced to `_' by function `replace-as-filename' [tl-str.el]")
223
224 (defun replace-as-filename (str)
225 "Return safety filename from STR. [tl-str.el]"
226 (let (sf)
227 (mapconcat (function
228 (lambda (chr)
229 (cond ((member-of-range chr filename-space-char-range)
230 (if sf
231 ""
232 (setq sf t)
233 "_"))
234 ((member-of-range chr filename-special-char-range)
235 "")
236 (t
237 (setq sf nil)
238 (char-to-string chr)
239 ))
240 ))
241 (string-to-char-list str)
242 "")))
243 210
244 211
245 ;;; @ symbol 212 ;;; @ symbol
246 ;;; 213 ;;;
247 214