;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Code:
"Apply initial ARGUMENT to sequence of FUNCTIONS.
FUNCTIONS is list of functions.
-(poly-funcall '(f1 f2 .. fn) arg) is as same as
-(fn .. (f2 (f1 arg)) ..).
+\(poly-funcall '(f1 f2 .. fn) arg) is as same as
+\(fn .. (f2 (f1 arg)) ..).
For example, (poly-funcall '(car number-to-string) '(100)) returns
\"100\"."
(let ((code (char-int character)))
(or (< code 32)(= code 127))))
+(eval-when-compile
+ (defmacro filename-special-filter-1 (string)
+ (let (sref inc-i)
+ (if (or (not (fboundp 'sref))
+ (>= emacs-major-version 21)
+ (and (= emacs-major-version 20)
+ (>= emacs-minor-version 3)))
+ (setq sref 'aref
+ inc-i '(1+ i))
+ (setq sref 'aref
+ inc-i '(+ i (char-length chr))))
+ (` (let ((len (length (, string)))
+ (b 0)(i 0)
+ (dest ""))
+ (while (< i len)
+ (let ((chr ((, sref) (, string) i))
+ (lst filename-replacement-alist)
+ ret)
+ (while (and lst (not ret))
+ (if (if (functionp (car (car lst)))
+ (setq ret (funcall (car (car lst)) chr))
+ (setq ret (memq chr (car (car lst)))))
+ t ; quit this loop.
+ (setq lst (cdr lst))))
+ (if ret
+ (setq dest (concat dest (substring (, string) b i)
+ (cdr (car lst)))
+ i (, inc-i)
+ b i)
+ (setq i (, inc-i)))))
+ (concat dest (substring (, string) b)))))))
+
(defun filename-special-filter (string)
- (let ((len (length string))
- (b 0)(i 0)
- (dest ""))
- (while (< i len)
- (let ((chr (sref string i))
- (lst filename-replacement-alist)
- ret)
- (while (and lst (not ret))
- (if (if (functionp (car (car lst)))
- (setq ret (funcall (car (car lst)) chr))
- (setq ret (memq chr (car (car lst)))))
- t ; quit this loop.
- (setq lst (cdr lst))))
- (if ret
- (setq dest (concat dest (substring string b i)(cdr (car lst)))
- i (+ i (char-length chr))
- b i)
- (setq i (+ i (char-length chr))))))
- (concat dest (substring string b))))
+ (filename-special-filter-1 string))
(defun filename-eliminate-top-low-lines (string)
(if (string-match "^_+" string)