cgit.sxemacs.org Git - riece/blob - lisp/riece-addon.el

   1 ;;; riece-addon.el --- add-on management
   2 ;; Copyright (C) 1998-2004 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  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)
  13 ;; any later version.
  14
  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.
  19
  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.
  24
  25 ;;; Code:
  26
  27 (defvar riece-addon-list-mode-map
  28   (let ((keymap (make-sparse-keymap)))
  29     (define-key keymap "+" 'riece-command-enable-addon)
  30     (define-key keymap "-" 'riece-command-disable-addon)
  31     keymap))
  32
  33 (defun riece-load-and-build-addon-dependencies (addons)
  34   (let ((load-path (cons riece-addon-directory load-path))
  35         dependencies)
  36     (while addons
  37       (require (car addons))            ;error will be reported here
  38       (let* ((requires
  39               (funcall (or (intern-soft
  40                             (concat (symbol-name (car addons)) "-requires"))
  41                            #'ignore)))
  42              (pointer requires)
  43              entry)
  44         ;; Increment succs' pred count.
  45         (if (setq entry (assq (car addons) dependencies))
  46             (setcar (cdr entry) (+ (length requires) (nth 1 entry)))
  47           (setq dependencies (cons (list (car addons) (length requires))
  48                                    dependencies)))
  49         ;; Merge pred's succs.
  50         (while pointer
  51           (if (setq entry (assq (car pointer) dependencies))
  52               (setcdr (cdr entry)
  53                       (cons (car addons) (nthcdr 2 entry)))
  54             (setq dependencies (cons (list (car pointer) 0 (car addons))
  55                                      dependencies)))
  56           (setq pointer (cdr pointer))))
  57       (setq addons (cdr addons)))
  58     dependencies))
  59
  60 (defun riece-resolve-addons (addons)
  61   (let ((pointer addons)
  62         dependencies queue)
  63     ;; Uniquify, first.
  64     (while pointer
  65       (if (memq (car pointer) (cdr pointer))
  66           (setcar pointer nil))
  67       (setq pointer (cdr pointer)))
  68     (setq dependencies (riece-load-and-build-addon-dependencies
  69                         (delq nil addons))
  70           pointer dependencies)
  71     ;; Sort them.
  72     (while pointer
  73       (if (zerop (nth 1 (car pointer)))
  74           (setq dependencies (delq (car pointer) dependencies)
  75                 queue (cons (car pointer) queue)))
  76       (setq pointer (cdr pointer)))
  77     (setq addons nil)
  78     (while queue
  79       (setq addons (cons (car (car queue)) addons)
  80             pointer (nthcdr 2 (car queue)))
  81       (while pointer
  82         (let* ((entry (assq (car pointer) dependencies))
  83                (count (1- (nth 1 entry))))
  84           (if (zerop count)
  85               (progn
  86                 (setq dependencies (delq entry dependencies)
  87                       queue (nconc queue (list entry))))
  88             (setcar (cdr entry) count)))
  89         (setq pointer (cdr pointer)))
  90       (setq queue (cdr queue)))
  91     (if dependencies
  92         (error "Circular add-on dependency found"))
  93     (nreverse addons)))
  94
  95 (defun riece-insinuate-addon (addon)
  96   (require addon)               ;implicit dependency
  97   (funcall (intern (concat (symbol-name addon) "-insinuate")))
  98   (if riece-debug
  99       (message "Add-on %S is insinuated" addon)))
 100
 101 (defun riece-enable-addon (addon)
 102   (let ((enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
 103     (if (null enabled)
 104         (if riece-debug
 105             (message "Add-on %S doesn't support enable/disable" addon))
 106       (if (symbol-value enabled)
 107           (if riece-debug
 108               (message "Can't enable add-on %S" addon))
 109         (funcall (intern (concat (symbol-name addon) "-enable")))
 110         (if riece-debug
 111             (message "Add-on %S enabled" addon))))))
 112
 113 (defun riece-disable-addon (addon)
 114   (let ((enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
 115     (if (null enabled)
 116         (if riece-debug
 117             (message "Add-on %S doesn't support enable/disable" addon))
 118       (if (symbol-value enabled)
 119           (progn
 120             (funcall (intern (concat (symbol-name addon) "-disable")))
 121             (if riece-debug
 122                 (message "Add-on %S disabled" addon)))
 123         (if riece-debug
 124             (message "Can't disable add-on %S" addon))))))
 125
 126 (defun riece-addon-list-mode ()
 127   "Major mode for displaying addon list.
 128 All normal editing commands are turned off."
 129   (kill-all-local-variables)
 130   (buffer-disable-undo)
 131   (setq major-mode 'riece-addon-list-mode
 132         mode-name "AddOns"
 133         mode-line-buffer-identification
 134         (riece-mode-line-buffer-identification '("Riece: "))
 135         truncate-lines t
 136         buffer-read-only t)
 137   (use-local-map riece-addon-list-mode-map)
 138   (run-hooks 'riece-addon-list-mode-hook))
 139
 140 (defun riece-command-list-addons ()
 141   (interactive)
 142   (save-excursion
 143     (set-buffer (riece-get-buffer-create "*AddOns*" 'riece-addon-list-mode))
 144     (riece-addon-list-mode)
 145     (let ((inhibit-read-only t)
 146           buffer-read-only
 147           (pointer riece-addons)
 148           enabled description point)
 149       (erase-buffer)
 150       (riece-kill-all-overlays)
 151       (while pointer
 152         (setq enabled (intern-soft (concat (symbol-name (car pointer))
 153                                            "-enabled"))
 154               description (intern-soft (concat (symbol-name (car pointer))
 155                                                "-description")))
 156         (setq point (point))
 157         (insert (format "%c %S: %s\n"
 158                         (if (not (featurep (car pointer)))
 159                             ??
 160                           (if (null enabled)
 161                               ?=
 162                             (if (symbol-value enabled)
 163                                 ?+
 164                               ?-)))
 165                         (car pointer)
 166                         (if description
 167                             (symbol-value description)
 168                           "(no description)")))
 169         (put-text-property point (point) 'riece-addon (car pointer))
 170         (setq pointer (cdr pointer)))
 171       (insert "
 172 Symbols in the leftmost column:
 173
 174   +     The add-on is enabled.
 175   -     The add-on is disabled.
 176   =     The add-on doesn't support enable/disable operation.
 177   ?     The add-on status is not known.
 178 "))
 179     (pop-to-buffer (current-buffer))))
 180
 181 (defun riece-command-enable-addon (addon)
 182   (interactive
 183    (list
 184     (or (if (eq major-mode 'riece-addon-list-mode)
 185             (get-text-property (point) 'riece-addon))
 186         (completing-read "Add-on: "
 187                          (mapcar #'list riece-addons)
 188                          (lambda (pointer)
 189                            (setq enabled (intern-soft (concat (car pointer)
 190                                                               "-enabled")))
 191                            (and enabled
 192                                 (null (symbol-value enabled))))
 193                          t))))
 194   (riece-enable-addon addon)
 195   (riece-command-list-addons))
 196
 197 (defun riece-command-disable-addon (addon)
 198   (interactive
 199    (list
 200     (or (if (eq major-mode 'riece-addon-list-mode)
 201             (get-text-property (point) 'riece-addon))
 202         (completing-read "Add-on: "
 203                          (mapcar #'list riece-addons)
 204                          (lambda (pointer)
 205                            (setq enabled (intern-soft (concat (car pointer)
 206                                                               "-enabled")))
 207                            (and enabled
 208                                 (symbol-value enabled)))
 209                          t))))
 210   (riece-disable-addon addon)
 211   (riece-command-list-addons))
 212
 213 (provide 'riece-addon)
 214
 215 ;;; riece-addon.el ends here