1 ;;; riece-addon.el --- add-on management
2 ;; Copyright (C) 1998-2004 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Keywords: IRC, riece
8 ;; This file is part of Riece.
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
28 (require 'riece-options)
29 (require 'riece-compat)
32 (defgroup riece-addon-list nil
38 (defgroup riece-addon-list-faces nil
39 "Faces for riece-addon-list-mode"
41 :prefix "riece-addon-list"
44 (defface riece-addon-list-enabled-face
45 '((((class color) (background dark))
46 (:foreground "PaleTurquoise" :bold t))
49 "Face used for displaying the enabled addon."
50 :group 'riece-addon-list-faces)
51 (defvar riece-addon-list-enabled-face 'riece-addon-list-enabled-face)
53 (defface riece-addon-list-disabled-face
54 '((((class color) (background dark))
55 (:foreground "PaleTurquoise" :italic t))
58 "Face used for displaying the disabled addon."
59 :group 'riece-addon-list-faces)
60 (defvar riece-addon-list-disabled-face 'riece-addon-list-disabled-face)
62 (defface riece-addon-list-unsupported-face
63 '((((class color) (background dark))
64 (:foreground "PaleTurquoise"))
67 "Face used for displaying the unsupported addon."
68 :group 'riece-addon-list-faces)
69 (defvar riece-addon-list-unsupported-face 'riece-addon-list-unsupported-face)
71 (defface riece-addon-list-unknown-face
74 "Face used for displaying the unknown addon."
75 :group 'riece-addon-list-faces)
76 (defvar riece-addon-list-unknown-face 'riece-addon-list-unknown-face)
78 (defface riece-addon-list-description-face
81 (:foreground "lightyellow"))
84 (:foreground "blue4"))
87 "Face used for displaying the description addon."
88 :group 'riece-addon-list-faces)
89 (defvar riece-addon-list-description-face 'riece-addon-list-description-face)
91 (defcustom riece-addon-list-mark-face-alist
92 '((?+ . riece-addon-list-enabled-face)
93 (?- . riece-addon-list-disabled-face)
94 (?! . riece-addon-list-unsupported-face)
95 (?? . riece-addon-list-unknown-face))
96 "An alist mapping marks on riece-addon-list-buffer to faces."
98 :group 'riece-addon-list)
100 (defcustom riece-addon-list-font-lock-keywords
101 '(("^\\([-+!?] [^:]+\\): \\(.*\\)"
102 (1 (cdr (assq (aref (match-string 1) 0)
103 riece-addon-list-mark-face-alist)))
104 (2 riece-addon-list-description-face)))
105 "Default expressions to addon in riece-addon-list-mode."
106 :type '(repeat (list string))
107 :group 'riece-addon-list)
109 (defvar riece-addon-list-mode-map
110 (let ((keymap (make-sparse-keymap)))
111 (define-key keymap "+" 'riece-command-enable-addon)
112 (define-key keymap "-" 'riece-command-disable-addon)
113 (define-key keymap "n" 'next-line)
114 (define-key keymap "p" 'previous-line)
115 (define-key keymap " " 'scroll-up)
116 (define-key keymap [delete] 'scroll-down)
117 (define-key keymap "q" 'bury-buffer)
120 (defun riece-load-and-build-addon-dependencies (addons)
121 (let ((load-path (cons riece-addon-directory load-path))
124 (require (car addons)) ;error will be reported here
126 (funcall (or (intern-soft
127 (concat (symbol-name (car addons)) "-requires"))
131 ;; Increment succs' pred count.
132 (if (setq entry (assq (car addons) dependencies))
133 (setcar (cdr entry) (+ (length requires) (nth 1 entry)))
134 (setq dependencies (cons (list (car addons) (length requires))
136 ;; Merge pred's succs.
138 (if (setq entry (assq (car pointer) dependencies))
140 (cons (car addons) (nthcdr 2 entry)))
141 (setq dependencies (cons (list (car pointer) 0 (car addons))
143 (setq pointer (cdr pointer))))
144 (setq addons (cdr addons)))
147 (defun riece-resolve-addon-dependencies (addons)
148 (let ((pointer addons)
152 (if (memq (car pointer) (cdr pointer))
153 (setcar pointer nil))
154 (setq pointer (cdr pointer)))
155 (setq dependencies (riece-load-and-build-addon-dependencies
157 pointer dependencies)
160 (if (zerop (nth 1 (car pointer)))
161 (setq dependencies (delq (car pointer) dependencies)
162 queue (cons (car pointer) queue)))
163 (setq pointer (cdr pointer)))
166 (setq addons (cons (car (car queue)) addons)
167 pointer (nthcdr 2 (car queue)))
169 (let* ((entry (assq (car pointer) dependencies))
170 (count (1- (nth 1 entry))))
173 (setq dependencies (delq entry dependencies)
174 queue (nconc queue (list entry))))
175 (setcar (cdr entry) count)))
176 (setq pointer (cdr pointer)))
177 (setq queue (cdr queue)))
179 (error "Circular add-on dependency found"))
182 (defun riece-resolve-addons (addons)
183 (riece-resolve-addon-dependencies
184 (if (file-directory-p riece-addon-directory)
188 (unless (file-directory-p
189 (expand-file-name name riece-addon-directory))
190 (intern (file-name-sans-extension name))))
191 (directory-files riece-addon-directory nil "\\`[^.]" t)))
194 (defun riece-insinuate-addon (addon &optional verbose)
195 (require addon) ;implicit dependency
196 (funcall (intern (concat (symbol-name addon) "-insinuate")))
198 (message "Add-on %S is insinuated" addon)))
200 (defun riece-enable-addon (addon &optional verbose)
201 (let ((enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
204 (message "Add-on %S doesn't support enable/disable" addon))
205 (if (symbol-value enabled)
207 (message "Can't enable add-on %S" addon))
208 (funcall (intern (concat (symbol-name addon) "-enable")))
210 (message "Add-on %S enabled" addon))))))
212 (defun riece-disable-addon (addon &optional verbose)
213 (let ((enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
216 (message "Add-on %S doesn't support enable/disable" addon))
217 (if (symbol-value enabled)
219 (funcall (intern (concat (symbol-name addon) "-disable")))
221 (message "Add-on %S disabled" addon)))
223 (message "Can't disable add-on %S" addon))))))
225 (put 'riece-addon-list-mode 'font-lock-defaults
226 '(riece-addon-list-font-lock-keywords t))
228 (defun riece-addon-list-mode ()
229 "Major mode for displaying addon list.
230 All normal editing commands are turned off."
231 (kill-all-local-variables)
232 (buffer-disable-undo)
233 (setq major-mode 'riece-addon-list-mode
235 mode-line-buffer-identification
236 (riece-mode-line-buffer-identification '("Riece: %12b"))
239 (use-local-map riece-addon-list-mode-map)
240 (make-local-variable 'font-lock-defaults)
241 (setq font-lock-defaults '(riece-addon-list-font-lock-keywords t))
242 ;; In XEmacs, auto-initialization of font-lock is not affective
243 ;; when buffer-file-name is not set.
244 (font-lock-set-defaults)
245 (run-hooks 'riece-addon-list-mode-hook))
247 (defun riece-command-list-addons ()
249 (set-buffer (riece-get-buffer-create "*AddOns*" 'riece-addon-list-mode))
250 (riece-addon-list-mode)
251 (let ((inhibit-read-only t)
253 (pointer (sort (copy-sequence riece-addons)
254 (lambda (symbol1 symbol2)
255 (string-lessp (symbol-name symbol1)
256 (symbol-name symbol2)))))
257 enabled description point)
259 (riece-kill-all-overlays)
261 (setq enabled (intern-soft (concat (symbol-name (car pointer))
263 description (intern-soft (concat (symbol-name (car pointer))
266 (insert (format "%c %S: %s\n"
267 (if (not (featurep (car pointer)))
271 (if (symbol-value enabled)
276 (symbol-value description)
277 "(no description)")))
278 (put-text-property point (point) 'riece-addon (car pointer))
279 (setq pointer (cdr pointer)))
281 Symbols in the leftmost column:
283 + The add-on is enabled.
284 - The add-on is disabled.
285 ! The add-on doesn't support enable/disable operation.
286 ? The add-on status is unknown.
288 (insert (substitute-command-keys "
291 `\\[riece-command-enable-addon]' to enable the current add-on.
292 `\\[riece-command-disable-addon]' to disable the current add-on.
294 (goto-char (point-min))
295 (pop-to-buffer (current-buffer))
296 (delete-other-windows)))
298 (defun riece-command-enable-addon (addon)
301 (or (if (eq major-mode 'riece-addon-list-mode)
302 (get-text-property (point) 'riece-addon))
304 (completing-read "Add-on: "
305 (mapcar (lambda (addon)
306 (list (symbol-name addon)))
310 (intern-soft (concat (car pointer)
313 (null (symbol-value enabled)))))
315 (riece-enable-addon addon t)
316 (let ((enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
317 (if (and (eq major-mode 'riece-addon-list-mode)
318 (get-text-property (point) 'riece-addon)
319 enabled (symbol-value enabled))
322 (let ((point (point))
323 (inhibit-read-only t)
327 (put-text-property point (point) 'riece-addon addon))))))
329 (defun riece-command-disable-addon (addon)
332 (or (if (eq major-mode 'riece-addon-list-mode)
333 (get-text-property (point) 'riece-addon))
335 (completing-read "Add-on: "
336 (mapcar (lambda (addon)
337 (list (symbol-name addon)))
341 (intern-soft (concat (car pointer)
344 (symbol-value enabled))))
346 (riece-disable-addon addon t)
347 (let ((enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
348 (if (and (eq major-mode 'riece-addon-list-mode)
349 (get-text-property (point) 'riece-addon)
350 enabled (null (symbol-value enabled)))
353 (let ((point (point))
354 (inhibit-read-only t)
358 (put-text-property point (point) 'riece-addon addon))))))
360 (provide 'riece-addon)
362 ;;; riece-addon.el ends here