| 1 | ;;; emms-compat.el --- Compatibility routines for EMMS -*- lexical-binding: t; -*- |
| 2 | |
| 3 | ;; Copyright (C) 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Michael Olson <mwolson@gnu.org> |
| 6 | |
| 7 | ;; This file is part of EMMS. |
| 8 | |
| 9 | ;; EMMS is free software; you can redistribute it and/or modify |
| 10 | ;; it under the terms of the GNU General Public License as published by |
| 11 | ;; the Free Software Foundation; either version 3, or (at your option) |
| 12 | ;; any later version. |
| 13 | ;; |
| 14 | ;; EMMS is distributed in the hope that it will be useful, |
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 17 | ;; GNU General Public License for more details. |
| 18 | ;; |
| 19 | ;; You should have received a copy of the GNU General Public License |
| 20 | ;; along with EMMS; see the file COPYING. If not, write to the |
| 21 | ;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, |
| 22 | ;; Boston, MA 02110-1301, USA. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; These are functions and macros that EMMS needs in order to be |
| 27 | ;; compatible with various Emacs and XEmacs versions. |
| 28 | |
| 29 | ;;; Code: |
| 30 | |
| 31 | |
| 32 | ;;; Miscellaneous |
| 33 | |
| 34 | (defun emms-propertize (string &rest properties) |
| 35 | (if (fboundp 'propertize) |
| 36 | (apply #'propertize string properties) |
| 37 | (set-text-properties 0 (length string) properties string) |
| 38 | string)) |
| 39 | |
| 40 | ;; Emacs accepts three arguments to `make-obsolete', but the XEmacs |
| 41 | ;; version only takes two arguments |
| 42 | (defun emms-make-obsolete (old-name new-name when) |
| 43 | "Make the byte-compiler warn that OLD-NAME is obsolete. |
| 44 | The warning will say that NEW-NAME should be used instead. |
| 45 | WHEN should be a string indicating when the function was |
| 46 | first made obsolete, either the file's revision number or an |
| 47 | EMMS release version number." |
| 48 | (if (featurep 'xemacs) |
| 49 | (make-obsolete old-name new-name) |
| 50 | (make-obsolete old-name new-name when))) |
| 51 | |
| 52 | |
| 53 | ;;; Time and timers |
| 54 | |
| 55 | (defun emms-cancel-timer (timer) |
| 56 | "Cancel the given TIMER." |
| 57 | (when timer |
| 58 | (cond ((fboundp 'cancel-timer) |
| 59 | (cancel-timer timer)) |
| 60 | ((fboundp 'delete-itimer) |
| 61 | (delete-itimer timer))))) |
| 62 | |
| 63 | (defun emms-time-less-p (t1 t2) |
| 64 | "Say whether time T1 is less than time T2." |
| 65 | (or (< (car t1) (car t2)) |
| 66 | (and (= (car t1) (car t2)) |
| 67 | (< (nth 1 t1) (nth 1 t2))))) |
| 68 | |
| 69 | |
| 70 | ;;; Highline |
| 71 | |
| 72 | (defun emms-activate-highlighting-mode () |
| 73 | "Activate highline mode." |
| 74 | (if (featurep 'xemacs) |
| 75 | (progn |
| 76 | (require 'highline) |
| 77 | (highline-local-mode 1)) |
| 78 | (progn |
| 79 | (require 'hl-line) |
| 80 | (hl-line-mode 1)))) |
| 81 | |
| 82 | (declare-function hl-line-highlight "" nil) |
| 83 | |
| 84 | ;; called from emms-lyrics |
| 85 | (defun emms-line-highlight () |
| 86 | "Highlight the current line. You must call |
| 87 | emms-activate-highlighting-mode beforehand." |
| 88 | (if (featurep 'xemacs) |
| 89 | (highline-highlight-current-line) |
| 90 | (hl-line-highlight))) |
| 91 | |
| 92 | |
| 93 | ;;; Movement and position |
| 94 | |
| 95 | (defun emms-move-beginning-of-line (arg) |
| 96 | "Move point to beginning of current line as displayed. |
| 97 | If there's an image in the line, this disregards newlines |
| 98 | which are part of the text that the image rests on." |
| 99 | (if (fboundp 'move-beginning-of-line) |
| 100 | (move-beginning-of-line arg) |
| 101 | (if (numberp arg) |
| 102 | (forward-line (1- arg)) |
| 103 | (forward-line 0)))) |
| 104 | |
| 105 | (defun emms-line-number-at-pos (&optional pos) |
| 106 | "Return (narrowed) buffer line number at position POS. |
| 107 | If POS is nil, use current buffer location." |
| 108 | (if (fboundp 'line-number-at-pos) |
| 109 | (line-number-at-pos pos) |
| 110 | (let ((opoint (or pos (point))) start) |
| 111 | (save-excursion |
| 112 | (goto-char (point-min)) |
| 113 | (setq start (point)) |
| 114 | (goto-char opoint) |
| 115 | (forward-line 0) |
| 116 | (1+ (count-lines start (point))))))) |
| 117 | |
| 118 | |
| 119 | ;;; Regular expression matching |
| 120 | |
| 121 | (defun emms-replace-regexp-in-string (regexp replacement text |
| 122 | &optional fixedcase literal) |
| 123 | "Replace REGEXP with REPLACEMENT in TEXT. |
| 124 | If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text. |
| 125 | If fifth arg LITERAL is non-nil, insert REPLACEMENT literally." |
| 126 | (cond |
| 127 | ((fboundp 'replace-regexp-in-string) |
| 128 | (replace-regexp-in-string regexp replacement text fixedcase literal)) |
| 129 | ((and (featurep 'xemacs) (fboundp 'replace-in-string)) |
| 130 | (replace-in-string text regexp replacement literal)) |
| 131 | (t (let ((repl-len (length replacement)) |
| 132 | start) |
| 133 | (save-match-data |
| 134 | (while (setq start (string-match regexp text start)) |
| 135 | (setq start (+ start repl-len) |
| 136 | text (replace-match replacement fixedcase literal text))))) |
| 137 | text))) |
| 138 | |
| 139 | (defun emms-match-string-no-properties (num &optional string) |
| 140 | (if (fboundp 'match-string-no-properties) |
| 141 | (match-string-no-properties num string) |
| 142 | (match-string num string))) |
| 143 | |
| 144 | |
| 145 | ;;; Common Lisp |
| 146 | |
| 147 | (defun emms-delete-if (predicate seq) |
| 148 | "Remove all items satisfying PREDICATE in SEQ. |
| 149 | This is a destructive function: it reuses the storage of SEQ |
| 150 | whenever possible." |
| 151 | ;; remove from car |
| 152 | (while (when (funcall predicate (car seq)) |
| 153 | (setq seq (cdr seq)))) |
| 154 | ;; remove from cdr |
| 155 | (let ((ptr seq) |
| 156 | (next (cdr seq))) |
| 157 | (while next |
| 158 | (when (funcall predicate (car next)) |
| 159 | (setcdr ptr (if (consp next) |
| 160 | (cdr next) |
| 161 | nil))) |
| 162 | (setq ptr (cdr ptr)) |
| 163 | (setq next (cdr ptr)))) |
| 164 | seq) |
| 165 | |
| 166 | (defun emms-find-if (predicate seq) |
| 167 | "Find the first item satisfying PREDICATE in SEQ. |
| 168 | Return the matching item, or nil if not found." |
| 169 | (catch 'found |
| 170 | (dolist (el seq) |
| 171 | (when (funcall predicate el) |
| 172 | (throw 'found el))))) |
| 173 | |
| 174 | (defun emms-remove-if-not (predicate seq) |
| 175 | "Remove all items not satisfying PREDICATE in SEQ. |
| 176 | This is a non-destructive function; it makes a copy of SEQ to |
| 177 | avoid corrupting the original SEQ." |
| 178 | (let (newseq) |
| 179 | (dolist (el seq) |
| 180 | (when (funcall predicate el) |
| 181 | (setq newseq (cons el newseq)))) |
| 182 | (nreverse newseq))) |
| 183 | |
| 184 | (provide 'emms-compat) |
| 185 | ;;; emms-compat.el ends here |