blob: cd1776ed0522e3eef5cbf0b66d48f3f508f6209e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
;;; buttercup-compat.el --- Compatibility definitions for buttercup
;; Copyright (C) 2015 Jorgen Schaefer
;; Copyright (C) 2015 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <contact@jorgenschaefer.de>
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 3
;; of the License, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file provides compatibility definitions for buttercup. These
;; are primarily backported features of later versions of Emacs that
;; are not available in earlier ones.
;; Most parts of this file are taken from the Emacs source code to
;; provide the same functionality.
;;; Code:
;;;;;;;;;;;;;;;;;;;;;
;; Introduced in 24.4
(when (not (fboundp 'define-error))
(defun define-error (name message &optional parent)
"Define NAME as a new error signal.
MESSAGE is a string that will be output to the echo area if such an error
is signaled without being caught by a `condition-case'.
PARENT is either a signal or a list of signals from which it inherits.
Defaults to `error'."
(unless parent (setq parent 'error))
(let ((conditions
(if (consp parent)
(apply #'append
(mapcar (lambda (parent)
(cons parent
(or (get parent 'error-conditions)
(error "Unknown signal `%s'" parent))))
parent))
(cons parent (get parent 'error-conditions)))))
(put name 'error-conditions
(delete-dups (copy-sequence (cons name conditions))))
(when message (put name 'error-message message)))))
;;;;;;;;;;;;;;;;;;;;;
;; Introduced in 25.1
(when (not (fboundp 'directory-files-recursively))
(defun directory-files-recursively (dir match &optional include-directories)
"Return all files under DIR that have file names matching MATCH (a regexp).
This function works recursively. Files are returned in \"depth first\"
and alphabetical order.
If INCLUDE-DIRECTORIES, also include directories that have matching names."
(let ((result nil)
(files nil)
;; When DIR is "/", remote file names like "/method:" could
;; also be offered. We shall suppress them.
(tramp-mode (and tramp-mode (file-remote-p dir))))
(dolist (file (sort (file-name-all-completions "" dir)
'string<))
(unless (member file '("./" "../"))
(if (directory-name-p file)
(let* ((leaf (substring file 0 (1- (length file))))
(full-file (expand-file-name leaf dir)))
;; Don't follow symlinks to other directories.
(unless (file-symlink-p full-file)
(setq result
(nconc result (directory-files-recursively
full-file match include-directories))))
(when (and include-directories
(string-match match leaf))
(setq result (nconc result (list full-file)))))
(when (string-match match file)
(push (expand-file-name file dir) files)))))
(nconc result (nreverse files)))))
(when (not (fboundp 'directory-name-p))
(defsubst directory-name-p (name)
"Return non-nil if NAME ends with a slash character."
(and (> (length name) 0)
(char-equal (aref name (1- (length name))) ?/))))
(provide 'buttercup-compat)
;;; buttercup-compat.el ends here
|
