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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
;;; emms-compat.el --- Compatibility routines for EMMS
;; Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Michael Olson <mwolson@gnu.org>
;; This file is part of EMMS.
;; EMMS 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, or (at your option)
;; any later version.
;;
;; EMMS 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 EMMS; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; These are functions and macros that EMMS needs in order to be
;; compatible with various Emacs and XEmacs versions.
;;; Code:
;;; Miscellaneous
(defun emms-propertize (string &rest properties)
(if (fboundp 'propertize)
(apply #'propertize string properties)
(set-text-properties 0 (length string) properties string)
string))
;; Emacs accepts three arguments to `make-obsolete', but the XEmacs
;; version only takes two arguments
(defun emms-make-obsolete (old-name new-name when)
"Make the byte-compiler warn that OLD-NAME is obsolete.
The warning will say that NEW-NAME should be used instead.
WHEN should be a string indicating when the function was
first made obsolete, either the file's revision number or an
EMMS release version number."
(condition-case nil
(make-obsolete old-name new-name when)
(wrong-number-of-arguments (make-obsolete old-name new-name))))
;;; Time and timers
(defun emms-cancel-timer (timer)
"Cancel the given TIMER."
(when timer
(cond ((fboundp 'cancel-timer)
(cancel-timer timer))
((fboundp 'delete-itimer)
(delete-itimer timer)))))
(defun emms-time-less-p (t1 t2)
"Say whether time T1 is less than time T2."
(or (< (car t1) (car t2))
(and (= (car t1) (car t2))
(< (nth 1 t1) (nth 1 t2)))))
;;; Movement and position
(defun emms-move-beginning-of-line (arg)
"Move point to beginning of current line as displayed.
If there's an image in the line, this disregards newlines
which are part of the text that the image rests on."
(if (fboundp 'move-beginning-of-line)
(move-beginning-of-line arg)
(if (numberp arg)
(forward-line (1- arg))
(forward-line 0))))
(defun emms-line-number-at-pos (&optional pos)
"Return (narrowed) buffer line number at position POS.
If POS is nil, use current buffer location."
(if (fboundp 'line-number-at-pos)
(line-number-at-pos pos)
(let ((opoint (or pos (point))) start)
(save-excursion
(goto-char (point-min))
(setq start (point))
(goto-char opoint)
(forward-line 0)
(1+ (count-lines start (point)))))))
;;; Regular expression matching
(defun emms-replace-regexp-in-string (regexp replacement text
&optional fixedcase literal)
"Replace REGEXP with REPLACEMENT in TEXT.
If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text.
If fifth arg LITERAL is non-nil, insert REPLACEMENT literally."
(cond
((fboundp 'replace-regexp-in-string)
(replace-regexp-in-string regexp replacement text fixedcase literal))
((and (featurep 'xemacs) (fboundp 'replace-in-string))
(replace-in-string text regexp replacement literal))
(t (let ((repl-len (length replacement))
start)
(save-match-data
(while (setq start (string-match regexp text start))
(setq start (+ start repl-len)
text (replace-match replacement fixedcase literal text)))))
text)))
(defun emms-match-string-no-properties (num &optional string)
(if (fboundp 'match-string-no-properties)
(match-string-no-properties num string)
(match-string num string)))
;;; Common Lisp
(defun emms-delete-if (predicate seq)
"Remove all items satisfying PREDICATE in SEQ.
This is a destructive function: it reuses the storage of SEQ
whenever possible."
;; remove from car
(while (when (funcall predicate (car seq))
(setq seq (cdr seq))))
;; remove from cdr
(let ((ptr seq)
(next (cdr seq)))
(while next
(when (funcall predicate (car next))
(setcdr ptr (if (consp next)
(cdr next)
nil)))
(setq ptr (cdr ptr))
(setq next (cdr ptr))))
seq)
(defun emms-find-if (predicate seq)
"Find the first item satisfying PREDICATE in SEQ.
Return the matching item, or nil if not found."
(catch 'found
(dolist (el seq)
(when (funcall predicate el)
(throw 'found el)))))
(defun emms-remove-if-not (predicate seq)
"Remove all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ to
avoid corrupting the original SEQ."
(let (newseq)
(dolist (el seq)
(when (funcall predicate el)
(setq newseq (cons el newseq))))
(nreverse newseq)))
(provide 'emms-compat)
;;; emms-compat.el ends here
|
