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., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
28 (require 'riece-options)
29 (require 'riece-compat)
31 (require 'riece-addon-modules)
34 (defgroup riece-addon-list nil
37 :prefix "riece-addon-list-"
40 (defgroup riece-addon-list-faces nil
41 "Faces for riece-addon-list-mode."
43 :prefix "riece-addon-list-"
44 :group 'riece-addon-list)
46 (defface riece-addon-list-enabled-face
47 '((((class color) (background dark))
48 (:foreground "PaleTurquoise" :bold t))
51 "Face used for displaying the enabled addon."
52 :group 'riece-addon-list-faces)
53 (defvar riece-addon-list-enabled-face 'riece-addon-list-enabled-face)
55 (defface riece-addon-list-disabled-face
56 '((((class color) (background dark))
57 (:foreground "PaleTurquoise" :italic t))
60 "Face used for displaying the disabled addon."
61 :group 'riece-addon-list-faces)
62 (defvar riece-addon-list-disabled-face 'riece-addon-list-disabled-face)
64 (defface riece-addon-list-uninstalled-face
67 "Face used for displaying the uninstalled addon."
68 :group 'riece-addon-list-faces)
69 (defvar riece-addon-list-uninstalled-face 'riece-addon-list-uninstalled-face)
71 (defface riece-addon-list-unloaded-face
73 (:italic t :inverse-video t)))
74 "Face used for displaying the unloaded addon."
75 :group 'riece-addon-list-faces)
76 (defvar riece-addon-list-unloaded-face 'riece-addon-list-unloaded-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-uninstalled-face)
95 (? . riece-addon-list-unloaded-face))
96 "An alist mapping marks on riece-addon-list-buffer to faces."
97 :type '(repeat (cons character symbol))
98 :group 'riece-addon-list)
100 (defcustom riece-addon-list-font-lock-keywords
101 '(("^\\([-+? ] \\S-+\\)\\s-+\\(.*\\)"
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)
110 (autoload 'riece-command-save-variables "riece-commands"))
112 (defvar riece-addon-list-mode-map
113 (let ((keymap (make-sparse-keymap)))
114 (define-key keymap "+" 'riece-command-enable-addon)
115 (define-key keymap "-" 'riece-command-disable-addon)
116 (define-key keymap "i" 'riece-command-insinuate-addon)
117 (define-key keymap "u" 'riece-command-uninstall-addon)
118 (define-key keymap "U" 'riece-command-unload-addon)
119 (define-key keymap "n" 'next-line)
120 (define-key keymap "p" 'previous-line)
121 (define-key keymap " " 'scroll-up)
122 (define-key keymap [delete] 'scroll-down)
123 (define-key keymap "q" 'bury-buffer)
124 (define-key keymap "s" 'riece-command-save-variables)
127 (defun riece-load-and-build-addon-dependencies (addons)
128 (let ((load-path (cons riece-addon-directory load-path))
131 (require (car addons)) ;error will be reported here
132 (let* ((requires-function
134 (concat (symbol-name (car addons)) "-requires")))
136 (if (and requires-function
137 (fboundp requires-function))
138 (funcall requires-function)))
141 ;; Increment succs' pred count.
142 (if (setq entry (assq (car addons) dependencies))
143 (setcar (cdr entry) (+ (length requires) (nth 1 entry)))
144 (setq dependencies (cons (list (car addons) (length requires))
146 ;; Merge pred's succs.
148 (if (setq entry (assq (car pointer) dependencies))
149 (setcdr (cdr entry) (cons (car addons) (nthcdr 2 entry)))
150 (setq dependencies (cons (list (car pointer) 0 (car addons))
152 (setq pointer (cdr pointer))))
153 (setq addons (cdr addons)))
156 (defun riece-sort-addon-dependencies (dependencies)
157 (let ((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)))
165 (setq addons (cons (cons (car (car queue)) (nthcdr 2 (car queue)))
167 pointer (nthcdr 2 (car queue)))
169 (let* ((entry (assq (car pointer) dependencies))
170 (count (1- (nth 1 entry))))
172 (setq dependencies (delq entry dependencies)
173 queue (nconc queue (list entry)))
174 (setcar (cdr entry) count)))
175 (setq pointer (cdr pointer)))
176 (setq queue (cdr queue)))
178 (error "Circular add-on dependency found: %S" dependencies))
181 (defun riece-resolve-addons (addons)
182 ;; Add files in riece-addon-directory to addons.
183 (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 "\\`[^.]")))))
193 (setq addons (sort addons (lambda (symbol1 symbol2)
194 (string-lessp (symbol-name symbol1)
195 (symbol-name symbol2)))))
196 (let ((pointer addons))
198 (if (memq (car pointer) (cdr pointer))
199 (setcar pointer nil))
200 (setq pointer (cdr pointer)))
202 ;; Build & resolve dependencies.
203 (riece-sort-addon-dependencies
204 (riece-load-and-build-addon-dependencies addons)))
206 (defun riece-insinuate-addon-1 (addon verbose)
207 (if (get addon 'riece-addon-insinuated)
209 (message (riece-mcat "Add-on %S is already insinuated") addon))
211 (funcall (intern (concat (symbol-name addon) "-insinuate")))
212 (put addon 'riece-addon-insinuated t)
214 (message (riece-mcat "Add-on %S is insinuated") addon))
215 (unless (get addon 'riece-addon-default-disabled)
216 (riece-enable-addon addon t))))
218 (defun riece-insinuate-addon (addon &optional verbose)
219 (unless (assq addon riece-addon-dependencies)
220 (setq riece-addons (cons addon riece-addons)
221 riece-save-variables-are-dirty t
222 riece-addon-dependencies
223 (riece-resolve-addons
224 (cons addon (mapcar #'car riece-addon-dependencies)))))
225 (let ((pointer riece-addon-dependencies)
228 (unless (get (car (car pointer)) 'riece-addon-insinuated)
229 (setq addons (cons (car (car pointer)) addons)))
230 (if (eq (car (car pointer)) addon)
232 (setq pointer (cdr pointer))))
233 (setq addons (nreverse addons))
234 (if (and (> (length addons) 1)
236 (not (y-or-n-p (format (riece-mcat
237 "%s will be insinuated. Continue? ")
238 (mapconcat #'symbol-name addons ", ")))))
239 (error "Insinuate operation was cancelled"))
241 (riece-insinuate-addon-1 (car addons) verbose)
242 (setq addons (cdr addons)))))
244 (defun riece-uninstall-addon (addon &optional verbose)
245 (if (not (get addon 'riece-addon-insinuated))
247 (message (riece-mcat "Add-on %S is not insinuated") addon))
248 (let ((entry (assq addon riece-addon-dependencies))
249 (uninstall (intern-soft (concat (symbol-name addon) "-uninstall"))))
252 (if (= (length (cdr entry)) 1)
253 (error "%S depends on %S" (car (cdr entry)) addon)
254 (error "%s depend on %S"
255 (mapconcat #'symbol-name (cdr entry) ", ")
257 (riece-disable-addon addon verbose)
261 (setq riece-addon-dependencies
262 (delq entry riece-addon-dependencies))
263 (put addon 'riece-addon-insinuated nil)
264 (setq riece-addons (delq addon riece-addons)
265 riece-save-variables-are-dirty t
266 riece-addon-dependencies
267 (riece-resolve-addons
268 (delq addon (mapcar #'car riece-addon-dependencies))))))
270 (message (riece-mcat "Add-on %S is uninstalled") addon)))))
272 (defun riece-enable-addon (addon &optional verbose)
273 (unless (get addon 'riece-addon-insinuated)
274 (error "Add-on %S is not insinuated" addon))
275 (if (get addon 'riece-addon-enabled)
277 (message (riece-mcat "Add-on %S is already enabled") addon))
278 (let ((enable (intern-soft (concat (symbol-name addon) "-enable"))))
282 (put addon 'riece-addon-enabled t)
284 (message (riece-mcat "Add-on %S enabled") addon)))))
286 (defun riece-disable-addon (addon &optional verbose)
287 (unless (get addon 'riece-addon-insinuated)
288 (error "Add-on %S is not insinuated" addon))
289 (if (not (get addon 'riece-addon-enabled))
291 (message (riece-mcat "Add-on %S is already disabled") addon))
292 (let ((disable (intern-soft (concat (symbol-name addon) "-disable"))))
296 (put addon 'riece-addon-enabled nil)
298 (message (riece-mcat "Add-on %S disabled") addon)))))
300 (put 'riece-addon-list-mode 'font-lock-defaults
301 '(riece-addon-list-font-lock-keywords t))
303 (defun riece-addon-list-mode ()
304 "Major mode for displaying addon list.
305 All normal editing commands are turned off."
306 (kill-all-local-variables)
307 (buffer-disable-undo)
308 (setq major-mode 'riece-addon-list-mode
310 mode-line-buffer-identification
311 (riece-mode-line-buffer-identification '("Riece: %12b"))
314 (use-local-map riece-addon-list-mode-map)
315 (make-local-variable 'font-lock-defaults)
316 (setq font-lock-defaults '(riece-addon-list-font-lock-keywords t))
317 ;; In XEmacs, auto-initialization of font-lock is not effective
318 ;; if buffer-file-name is not set.
319 (font-lock-set-defaults)
320 (run-hooks 'riece-addon-list-mode-hook))
322 (defun riece-command-list-addons ()
324 (set-buffer (riece-get-buffer-create "*AddOn*" 'riece-addon-list-mode))
325 (riece-addon-list-mode)
326 (let ((inhibit-read-only t)
328 (pointer riece-addon-dependencies)
329 module-description-alist
330 description point longest)
332 (setq description (intern-soft (concat (symbol-name (car (car pointer)))
334 module-description-alist
335 (cons (cons (car (car pointer))
337 (boundp description))
338 (riece-mcat (symbol-value description))
339 (riece-mcat "(no description)")))
340 module-description-alist)
341 pointer (cdr pointer)))
342 (setq pointer riece-addon-modules)
344 (unless (assq (car (car pointer))
345 module-description-alist)
346 (setq module-description-alist
347 (cons (cons (car (car pointer)) (riece-mcat (cdr (car pointer))))
348 module-description-alist)))
349 (setq pointer (cdr pointer)))
351 (riece-kill-all-overlays)
352 (setq pointer module-description-alist
355 (if (> (length (symbol-name (car (car pointer))))
357 (setq longest (symbol-name (car (car pointer)))))
358 (setq pointer (cdr pointer)))
359 (setq pointer (sort module-description-alist
360 (lambda (entry1 entry2)
361 (string-lessp (symbol-name (car entry1))
362 (symbol-name (car entry2))))))
365 (insert (format (format "%%c %%-%dS %%s\n" (length longest))
366 (if (not (featurep (car (car pointer))))
368 (if (not (get (car (car pointer))
369 'riece-addon-insinuated))
371 (if (get (car (car pointer)) 'riece-addon-enabled)
375 (cdr (car pointer))))
376 (put-text-property point (point) 'riece-addon (car (car pointer)))
377 (setq pointer (cdr pointer)))
378 (insert (riece-mcat "
379 Symbols in the leftmost column:
381 + The add-on is enabled.
382 - The add-on is disabled.
383 ? The add-on is not insinuated.
384 The add-on is not loaded.
386 (insert (substitute-command-keys (riece-mcat "
389 `\\[riece-command-enable-addon]' to enable the current add-on.
390 `\\[riece-command-disable-addon]' to disable the current add-on.
391 `\\[riece-command-insinuate-addon]' to insinuate the current add-on.
392 `\\[riece-command-uninstall-addon]' to uninstall the current add-on.
393 `\\[riece-command-unload-addon]' to unload the current add-on.
394 `\\[riece-command-save-variables]' to save the current setting.
396 (goto-char (point-min))
397 (pop-to-buffer (current-buffer))
398 (delete-other-windows)))
400 (defun riece-addon-list-set-point (addon)
401 (let ((point (point-min)))
402 (while (and (not (eq (get-text-property point 'riece-addon) addon))
403 (setq point (next-single-property-change point
408 (defun riece-command-enable-addon (addon)
411 (or (if (eq major-mode 'riece-addon-list-mode)
412 (get-text-property (point) 'riece-addon))
414 (completing-read (riece-mcat "Add-on: ")
415 (mapcar (lambda (dependency)
416 (list (symbol-name (car dependency))))
417 riece-addon-dependencies)
420 (intern-soft (concat (car pointer)
423 (null (symbol-value enabled)))))
425 (riece-command-insinuate-addon addon)
426 (riece-enable-addon addon t)
427 (when (eq major-mode 'riece-addon-list-mode)
428 (riece-command-list-addons)
429 (riece-addon-list-set-point addon)))
431 (defun riece-command-disable-addon (addon)
434 (or (if (eq major-mode 'riece-addon-list-mode)
435 (get-text-property (point) 'riece-addon))
437 (completing-read (riece-mcat "Add-on: ")
438 (mapcar (lambda (dependency)
439 (list (symbol-name (car dependency))))
440 riece-addon-dependencies)
443 (intern-soft (concat (car pointer)
446 (symbol-value enabled))))
448 (riece-disable-addon addon t)
449 (when (eq major-mode 'riece-addon-list-mode)
450 (riece-command-list-addons)
451 (riece-addon-list-set-point addon)))
453 (defun riece-command-insinuate-addon (addon)
456 (or (if (eq major-mode 'riece-addon-list-mode)
457 (get-text-property (point) 'riece-addon))
459 (completing-read (riece-mcat "Add-on: ")
460 (mapcar (lambda (dependency)
461 (list (symbol-name (car dependency))))
464 (not (get (car pointer) 'riece-addon-insinuated)))
466 (riece-insinuate-addon addon 'ask)
467 (when (eq major-mode 'riece-addon-list-mode)
468 (riece-command-list-addons)
469 (riece-addon-list-set-point addon)))
471 (defun riece-command-uninstall-addon (addon)
474 (or (if (eq major-mode 'riece-addon-list-mode)
475 (get-text-property (point) 'riece-addon))
477 (completing-read (riece-mcat "Add-on: ")
478 (mapcar (lambda (dependency)
479 (list (symbol-name (car dependency))))
480 riece-addon-dependencies)
482 (get (car pointer) 'riece-addon-insinuated))
484 (riece-uninstall-addon addon t)
485 (when (eq major-mode 'riece-addon-list-mode)
486 (riece-command-list-addons)
487 (riece-addon-list-set-point addon)))
489 (defun riece-command-unload-addon (addon)
492 (or (if (eq major-mode 'riece-addon-list-mode)
493 (get-text-property (point) 'riece-addon))
495 (completing-read (riece-mcat "Add-on: ")
496 (mapcar (lambda (dependency)
497 (list (symbol-name (car dependency))))
498 riece-addon-dependencies)
500 (get (car pointer) 'riece-addon-insinuated))
502 (riece-uninstall-addon addon t)
503 (if (get addon 'riece-addon-not-unloadable)
504 (message (riece-mcat "Add-on %S is not allowed to unload") addon)
505 (unload-feature addon)
506 (message (riece-mcat "Add-on %S is unloaded") addon))
507 (when (eq major-mode 'riece-addon-list-mode)
508 (riece-command-list-addons)
509 (riece-addon-list-set-point addon)))
511 (provide 'riece-addon)
513 ;;; riece-addon.el ends here