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)
31 (require 'riece-addon-modules)
33 (defgroup riece-addon-list nil
36 :prefix "riece-addon-list-"
39 (defgroup riece-addon-list-faces nil
40 "Faces for riece-addon-list-mode."
42 :prefix "riece-addon-list-"
43 :group 'riece-addon-list)
45 (defface riece-addon-list-enabled-face
46 '((((class color) (background dark))
47 (:foreground "PaleTurquoise" :bold t))
50 "Face used for displaying the enabled addon."
51 :group 'riece-addon-list-faces)
52 (defvar riece-addon-list-enabled-face 'riece-addon-list-enabled-face)
54 (defface riece-addon-list-disabled-face
55 '((((class color) (background dark))
56 (:foreground "PaleTurquoise" :italic t))
59 "Face used for displaying the disabled addon."
60 :group 'riece-addon-list-faces)
61 (defvar riece-addon-list-disabled-face 'riece-addon-list-disabled-face)
63 (defface riece-addon-list-unsupported-face
64 '((((class color) (background dark))
65 (:foreground "PaleTurquoise"))
68 "Face used for displaying the unsupported addon."
69 :group 'riece-addon-list-faces)
70 (defvar riece-addon-list-unsupported-face 'riece-addon-list-unsupported-face)
72 (defface riece-addon-list-uninstalled-face
75 "Face used for displaying the uninstalled addon."
76 :group 'riece-addon-list-faces)
77 (defvar riece-addon-list-uninstalled-face 'riece-addon-list-uninstalled-face)
79 (defface riece-addon-list-description-face
82 (:foreground "lightyellow"))
85 (:foreground "blue4"))
88 "Face used for displaying the description addon."
89 :group 'riece-addon-list-faces)
90 (defvar riece-addon-list-description-face 'riece-addon-list-description-face)
92 (defcustom riece-addon-list-mark-face-alist
93 '((?+ . riece-addon-list-enabled-face)
94 (?- . riece-addon-list-disabled-face)
95 (?! . riece-addon-list-unsupported-face)
96 (? . riece-addon-list-uninstalled-face))
97 "An alist mapping marks on riece-addon-list-buffer to faces."
99 :group 'riece-addon-list)
101 (defcustom riece-addon-list-font-lock-keywords
102 '(("^\\([-+! ] [^:]+\\): \\(.*\\)"
103 (1 (cdr (assq (aref (match-string 1) 0)
104 riece-addon-list-mark-face-alist)))
105 (2 riece-addon-list-description-face)))
106 "Default expressions to addon in riece-addon-list-mode."
107 :type '(repeat (list string))
108 :group 'riece-addon-list)
110 (defvar riece-addon-list-mode-map
111 (let ((keymap (make-sparse-keymap)))
112 (define-key keymap "+" 'riece-command-enable-addon)
113 (define-key keymap "-" 'riece-command-disable-addon)
114 (define-key keymap "I" 'riece-command-insinuate-addon)
115 (define-key keymap "D" 'riece-command-uninstall-addon)
116 (define-key keymap "n" 'next-line)
117 (define-key keymap "p" 'previous-line)
118 (define-key keymap " " 'scroll-up)
119 (define-key keymap [delete] 'scroll-down)
120 (define-key keymap "q" 'bury-buffer)
123 (defun riece-load-and-build-addon-dependencies (addons)
124 (let ((load-path (cons riece-addon-directory load-path))
127 (require (car addons)) ;error will be reported here
129 (funcall (or (intern-soft
130 (concat (symbol-name (car addons)) "-requires"))
134 ;; Increment succs' pred count.
135 (if (setq entry (assq (car addons) dependencies))
136 (setcar (cdr entry) (+ (length requires) (nth 1 entry)))
137 (setq dependencies (cons (list (car addons) (length requires))
139 ;; Merge pred's succs.
141 (if (setq entry (assq (car pointer) dependencies))
142 (setcdr (cdr entry) (cons (car addons) (nthcdr 2 entry)))
143 (setq dependencies (cons (list (car pointer) 0 (car addons))
145 (setq pointer (cdr pointer))))
146 (setq addons (cdr addons)))
149 (defun riece-sort-addon-dependencies (dependencies)
150 (let ((pointer dependencies)
153 (if (zerop (nth 1 (car pointer)))
154 (setq dependencies (delq (car pointer) dependencies)
155 queue (cons (car pointer) queue)))
156 (setq pointer (cdr pointer)))
158 (setq addons (cons (cons (car (car queue)) (nthcdr 2 (car queue)))
160 pointer (nthcdr 2 (car queue)))
162 (let* ((entry (assq (car pointer) dependencies))
163 (count (1- (nth 1 entry))))
165 (setq dependencies (delq entry dependencies)
166 queue (nconc queue (list entry)))
167 (setcar (cdr entry) count)))
168 (setq pointer (cdr pointer)))
169 (setq queue (cdr queue)))
171 (error "Circular add-on dependency found: %S" dependencies))
174 (defun riece-resolve-addons (addons)
175 ;; Add files in riece-addon-directory to addons.
176 (if (file-directory-p riece-addon-directory)
181 (unless (file-directory-p
182 (expand-file-name name riece-addon-directory))
183 (intern (file-name-sans-extension name))))
184 (directory-files riece-addon-directory nil "\\`[^.]")))))
186 (setq addons (sort addons (lambda (symbol1 symbol2)
187 (string-lessp (symbol-name symbol1)
188 (symbol-name symbol2)))))
189 (let ((pointer addons))
191 (if (memq (car pointer) (cdr pointer))
192 (setcar pointer nil))
193 (setq pointer (cdr pointer)))
195 ;; Build & resolve dependencies.
196 (riece-sort-addon-dependencies
197 (riece-load-and-build-addon-dependencies addons)))
199 (defun riece-insinuate-addon (addon &optional verbose)
200 (unless (assq addon riece-addon-dependencies)
201 (setq riece-addons (cons addon riece-addons)
202 riece-addon-dependencies (riece-resolve-addons
203 (copy-sequence riece-addons))))
204 (if (get addon 'riece-addon-insinuated)
206 (message "Add-on %S is already insinuated" addon))
207 (funcall (intern (concat (symbol-name addon) "-insinuate")))
208 (put addon 'riece-addon-insinuated t)
210 (message "Add-on %S is insinuated" addon))
211 (unless (get addon 'riece-addon-default-disabled)
212 (riece-enable-addon addon t))))
214 (defun riece-uninstall-addon (addon &optional verbose)
215 (if (not (get addon 'riece-addon-insinuated))
217 (message "Add-on %S is not insinuated" addon))
218 (let ((entry (assq addon riece-addon-dependencies))
219 (enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
222 (if (= (length (cdr entry)) 1)
223 (error "%S depends %S" (car (cdr entry)) addon)
224 (error "%s depends %S" (mapconcat #'identity (cdr entry) ",")
227 (symbol-value enabled))
228 (riece-disable-addon addon verbose))
229 (funcall (or (intern-soft (concat (symbol-name addon)
232 (setq riece-addon-dependencies
233 (delq entry riece-addon-dependencies))
234 (remprop addon 'riece-addon-insinuated)
235 (setq riece-addons (delq addon riece-addons)
236 riece-addon-dependencies (riece-resolve-addons
237 (copy-sequence riece-addons)))))
239 (message "Add-on %S is uninstalled" addon)))))
241 (defun riece-enable-addon (addon &optional verbose)
242 (unless (get addon 'riece-addon-insinuated)
243 (error "Add-on %S is not insinuated" addon))
244 (let ((enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
247 (message "Add-on %S doesn't support enable/disable" addon))
248 (if (symbol-value enabled)
250 (message "Add-on %S is already enabled" addon))
251 (funcall (intern (concat (symbol-name addon) "-enable")))
253 (message "Add-on %S enabled" addon))))))
255 (defun riece-disable-addon (addon &optional verbose)
256 (unless (get addon 'riece-addon-insinuated)
257 (error "Add-on %S is not insinuated" addon))
258 (let ((enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
261 (message "Add-on %S doesn't support enable/disable" addon))
262 (if (symbol-value enabled)
264 (funcall (intern (concat (symbol-name addon) "-disable")))
266 (message "Add-on %S disabled" addon)))
268 (message "Add-on %S is already enabled" addon))))))
270 (put 'riece-addon-list-mode 'font-lock-defaults
271 '(riece-addon-list-font-lock-keywords t))
273 (defun riece-addon-list-mode ()
274 "Major mode for displaying addon list.
275 All normal editing commands are turned off."
276 (kill-all-local-variables)
277 (buffer-disable-undo)
278 (setq major-mode 'riece-addon-list-mode
280 mode-line-buffer-identification
281 (riece-mode-line-buffer-identification '("Riece: %12b"))
284 (use-local-map riece-addon-list-mode-map)
285 (make-local-variable 'font-lock-defaults)
286 (setq font-lock-defaults '(riece-addon-list-font-lock-keywords t))
287 ;; In XEmacs, auto-initialization of font-lock is not effective
288 ;; if buffer-file-name is not set.
289 (font-lock-set-defaults)
290 (run-hooks 'riece-addon-list-mode-hook))
292 (defun riece-command-list-addons ()
294 (set-buffer (riece-get-buffer-create "*AddOns*" 'riece-addon-list-mode))
295 (riece-addon-list-mode)
296 (let ((inhibit-read-only t)
298 (pointer riece-addon-dependencies)
299 module-description-alist
300 description enabled point)
303 (setq description (intern-soft (concat (symbol-name (car (car pointer)))
305 module-description-alist
306 (cons (cons (car (car pointer))
308 (symbol-value description)
310 module-description-alist)
311 pointer (cdr pointer)))
312 (setq pointer riece-addon-modules)
314 (unless (assq (car (car pointer))
315 module-description-alist)
316 (setq module-description-alist
317 (cons (car pointer) module-description-alist)))
318 (setq pointer (cdr pointer)))
320 (riece-kill-all-overlays)
321 (setq pointer (sort module-description-alist
322 (lambda (entry1 entry2)
323 (string-lessp (symbol-name (car entry1))
324 (symbol-name (car entry2))))))
326 (setq enabled (intern-soft (concat (symbol-name (car (car pointer)))
329 (insert (format "%c %S: %s\n"
330 (if (not (get (car (car pointer))
331 'riece-addon-insinuated))
335 (if (symbol-value enabled)
339 (cdr (car pointer))))
340 (put-text-property point (point) 'riece-addon (car (car pointer)))
341 (setq pointer (cdr pointer)))
343 Symbols in the leftmost column:
345 + The add-on is enabled.
346 - The add-on is disabled.
347 ! The add-on doesn't support enable/disable operation.
348 The add-on is not insinuated.
350 (insert (substitute-command-keys "
353 `\\[riece-command-enable-addon]' to enable the current add-on.
354 `\\[riece-command-disable-addon]' to disable the current add-on.
356 (goto-char (point-min))
357 (pop-to-buffer (current-buffer))
358 (delete-other-windows)))
360 (defun riece-command-enable-addon (addon)
363 (or (if (eq major-mode 'riece-addon-list-mode)
364 (get-text-property (point) 'riece-addon))
366 (completing-read "Add-on: "
367 (mapcar (lambda (dependency)
368 (list (symbol-name (car dependency))))
369 riece-addon-dependencies)
372 (intern-soft (concat (car pointer)
375 (null (symbol-value enabled)))))
377 (riece-enable-addon addon t)
378 (when (eq major-mode 'riece-addon-list-mode)
379 (riece-command-list-addons)
380 (let ((point (point-min)))
381 (while (and (not (eq (get-text-property point 'riece-addon) addon))
382 (setq point (next-single-property-change point
385 (goto-char point)))))
387 (defun riece-command-disable-addon (addon)
390 (or (if (eq major-mode 'riece-addon-list-mode)
391 (get-text-property (point) 'riece-addon))
393 (completing-read "Add-on: "
394 (mapcar (lambda (dependency)
395 (list (symbol-name (car dependency))))
396 riece-addon-dependencies)
399 (intern-soft (concat (car pointer)
402 (symbol-value enabled))))
404 (riece-disable-addon addon t)
405 (when (eq major-mode 'riece-addon-list-mode)
406 (riece-command-list-addons)
407 (let ((point (point-min)))
408 (while (and (not (eq (get-text-property point 'riece-addon) addon))
409 (setq point (next-single-property-change point
412 (goto-char point)))))
414 (defun riece-command-insinuate-addon (addon)
417 (or (if (eq major-mode 'riece-addon-list-mode)
418 (get-text-property (point) 'riece-addon))
420 (completing-read "Add-on: "
421 (mapcar (lambda (dependency)
422 (list (symbol-name (car dependency))))
425 (get (car pointer) 'riece-addon-insinuated))
427 (riece-insinuate-addon addon t)
428 (when (eq major-mode 'riece-addon-list-mode)
429 (riece-command-list-addons)
430 (let ((point (point-min)))
431 (while (and (not (eq (get-text-property point 'riece-addon) addon))
432 (setq point (next-single-property-change point
435 (goto-char point)))))
437 (defun riece-command-uninstall-addon (addon)
440 (or (if (eq major-mode 'riece-addon-list-mode)
441 (get-text-property (point) 'riece-addon))
443 (completing-read "Add-on: "
444 (mapcar (lambda (dependency)
445 (list (symbol-name (car dependency))))
446 riece-addon-dependencies)
448 (riece-uninstall-addon addon t)
449 (when (eq major-mode 'riece-addon-list-mode)
450 (riece-command-list-addons)
451 (let ((point (point-min)))
452 (while (and (not (eq (get-text-property point 'riece-addon) addon))
453 (setq point (next-single-property-change point
456 (goto-char point)))))
458 (provide 'riece-addon)
460 ;;; riece-addon.el ends here