Fixed.
[riece] / lisp / riece-addon.el
index ef25aa0..eee7d64 100644 (file)
@@ -28,6 +28,7 @@
 (require 'riece-options)
 (require 'riece-compat)
 (require 'riece-misc)
+(require 'riece-addon-modules)
 
 (defgroup riece-addon-list nil
   "Add-on listing."
        ;; Merge pred's succs.
        (while pointer
          (if (setq entry (assq (car pointer) dependencies))
-             (setcdr (cdr entry)
-                     (cons (car addons) (nthcdr 2 entry)))
+             (setcdr (cdr entry) (cons (car addons) (nthcdr 2 entry)))
            (setq dependencies (cons (list (car pointer) 0 (car addons))
                                     dependencies)))
          (setq pointer (cdr pointer))))
       (setq addons (cdr addons)))
     dependencies))
 
-(defun riece-resolve-addon-dependencies (addons)
-  (let ((pointer addons)
-       dependencies queue)
-    ;; Uniquify, first.
-    (while pointer
-      (if (memq (car pointer) (cdr pointer))
-         (setcar pointer nil))
-      (setq pointer (cdr pointer)))
-    (setq dependencies (riece-load-and-build-addon-dependencies
-                       (delq nil addons))
-         pointer dependencies)
-    ;; Sort them.
+(defun riece-sort-addon-dependencies (dependencies)
+  (let ((pointer dependencies)
+       addons queue)
     (while pointer
       (if (zerop (nth 1 (car pointer)))
          (setq dependencies (delq (car pointer) dependencies)
                queue (cons (car pointer) queue)))
       (setq pointer (cdr pointer)))
-    (setq addons nil)
     (while queue
-      (setq addons (cons (car (car queue)) addons)
+      (setq addons (cons (cons (car (car queue)) (nthcdr 2 (car queue)))
+                        addons)
            pointer (nthcdr 2 (car queue)))
       (while pointer
        (let* ((entry (assq (car pointer) dependencies))
     (nreverse addons)))
 
 (defun riece-resolve-addons (addons)
-  (riece-resolve-addon-dependencies
-   (if (file-directory-p riece-addon-directory)
-       (append addons
-              (mapcar
-               (lambda (name)
-                 (unless (file-directory-p
-                          (expand-file-name name riece-addon-directory))
-                   (intern (file-name-sans-extension name))))
-               (directory-files riece-addon-directory nil "\\`[^.]" t)))
-     addons)))
+  ;; Add files in riece-addon-directory to addons.
+  (if (file-directory-p riece-addon-directory)
+      (setq addons (nconc
+                   addons
+                   (mapcar
+                    (lambda (name)
+                      (unless (file-directory-p
+                               (expand-file-name name riece-addon-directory))
+                        (intern (file-name-sans-extension name))))
+                    (directory-files riece-addon-directory nil "\\`[^.]")))))
+  ;; Sort & uniquify.
+  (setq addons (sort addons (lambda (symbol1 symbol2)
+                             (string-lessp (symbol-name symbol1)
+                                           (symbol-name symbol2)))))
+  (let ((pointer addons))
+    (while pointer
+      (if (memq (car pointer) (cdr pointer))
+         (setcar pointer nil))
+      (setq pointer (cdr pointer)))
+    (delq nil addons))
+  ;; Build & resolve dependencies.
+  (riece-sort-addon-dependencies
+   (riece-load-and-build-addon-dependencies addons)))
 
 (defun riece-insinuate-addon (addon &optional verbose)
   (if (get addon 'riece-addon-insinuated)
       (if verbose
-         (message "Add-on %S is alread insinuated" addon))
+         (message "Add-on %S is already insinuated" addon))
     (funcall (intern (concat (symbol-name addon) "-insinuate")))
     (put addon 'riece-addon-insinuated t)
     (if verbose
        (message "Add-on %S is insinuated" addon))))
 
+(defun riece-uninstall-addon (addon &optional verbose)
+  (if (not (get addon 'riece-addon-insinuated))
+      (if verbose
+         (message "Add-on %S is not insinuated" addon))
+    (let ((entry (assq addon riece-addon-dependencies))
+         (enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
+      (if entry
+         (if (cdr entry)
+             (if (= (length (cdr entry)) 1)
+                 (error "%S depends %S" (car (cdr entry)) addon)
+               (error "%s depends %S" (mapconcat #'identity (cdr entry) ",")
+                      addon))
+           (if (and enabled
+                    (symbol-value enabled))
+               (riece-disable-addon addon verbose))
+           (funcall (or (intern-soft (concat (symbol-name addon)
+                                             "-uninstall"))
+                        #'ignore))
+           (setq riece-addon-dependencies
+                 (delq entry riece-addon-dependencies))
+           (put addon 'riece-addon-insinuated nil)))
+      (if verbose
+         (message "Add-on %S is uninstalled" addon)))))
+
 (defun riece-enable-addon (addon &optional verbose)
   (let ((enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
     (if (null enabled)
@@ -252,32 +280,45 @@ All normal editing commands are turned off."
   (riece-addon-list-mode)
   (let ((inhibit-read-only t)
        buffer-read-only
-       (pointer (sort (copy-sequence riece-addons)
-                      (lambda (symbol1 symbol2)
-                                 (string-lessp (symbol-name symbol1)
-                                               (symbol-name symbol2)))))
-       enabled description point)
+       (pointer riece-addon-dependencies)
+       module-description-alist
+       description enabled point)
+    (while pointer
+      
+      (setq description (intern-soft (concat (symbol-name (car (car pointer)))
+                                            "-description"))
+           module-description-alist
+           (cons (cons (car (car pointer))
+                       (if description
+                           (symbol-value description)
+                         "(no description)"))
+                 module-description-alist)
+           pointer (cdr pointer)))
+    (setq pointer riece-addon-modules)
+    (while pointer
+      (unless (assq (car (car pointer))
+                   module-description-alist)
+       (setq module-description-alist
+             (cons (car pointer) module-description-alist)))
+      (setq pointer (cdr pointer)))
     (erase-buffer)
     (riece-kill-all-overlays)
+    (setq pointer module-description-alist)
     (while pointer
-      (setq enabled (intern-soft (concat (symbol-name (car pointer))
-                                        "-enabled"))
-           description (intern-soft (concat (symbol-name (car pointer))
-                                            "-description")))
+      (setq enabled (intern-soft (concat (symbol-name (car (car pointer)))
+                                        "-enabled")))
       (setq point (point))
       (insert (format "%c %S: %s\n"
-                     (if (not (featurep (car pointer)))
+                     (if (not (featurep (car (car pointer))))
                          ??
                        (if (null enabled)
                            ?!
                          (if (symbol-value enabled)
                              ?+
                            ?-)))
-                     (car pointer)
-                     (if description
-                         (symbol-value description)
-                       "(no description)")))
-      (put-text-property point (point) 'riece-addon (car pointer))
+                     (car (car pointer))
+                     (cdr (car pointer))))
+      (put-text-property point (point) 'riece-addon (car (car pointer)))
       (setq pointer (cdr pointer)))
     (insert "
 Symbols in the leftmost column:
@@ -304,9 +345,9 @@ Useful keys:
            (get-text-property (point) 'riece-addon))
        (intern-soft
         (completing-read "Add-on: "
-                         (mapcar (lambda (addon)
-                                   (list (symbol-name addon)))
-                                 riece-addons)
+                         (mapcar (lambda (dependency)
+                                   (list (symbol-name (car dependency))))
+                                 riece-addon-dependencies)
                          (lambda (pointer)
                            (let ((enabled
                                   (intern-soft (concat (car pointer)
@@ -315,18 +356,14 @@ Useful keys:
                                   (null (symbol-value enabled)))))
                          t)))))
   (riece-enable-addon addon t)
-  (let ((enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
-    (if (and (eq major-mode 'riece-addon-list-mode)
-            (get-text-property (point) 'riece-addon)
-            enabled (symbol-value enabled))
-       (save-excursion
-         (beginning-of-line)
-         (let ((point (point))
-               (inhibit-read-only t)
-               buffer-read-only)
-           (delete-char 1)
-           (insert "+")
-           (put-text-property point (point) 'riece-addon addon))))))
+  (when (eq major-mode 'riece-addon-list-mode)
+    (riece-command-list-addons)
+    (let ((point (point-min)))
+      (while (and (not (eq (get-text-property point 'riece-addon) addon))
+                 (setq point (next-single-property-change point
+                                                          'riece-addon))))
+      (if point
+         (goto-char point)))))
 
 (defun riece-command-disable-addon (addon)
   (interactive
@@ -335,9 +372,9 @@ Useful keys:
            (get-text-property (point) 'riece-addon))
        (intern-soft
         (completing-read "Add-on: "
-                         (mapcar (lambda (addon)
-                                   (list (symbol-name addon)))
-                                 riece-addons)
+                         (mapcar (lambda (dependency)
+                                   (list (symbol-name (car dependency))))
+                                 riece-addon-dependencies)
                          (lambda (pointer)
                            (let ((enabled
                                   (intern-soft (concat (car pointer)
@@ -346,18 +383,14 @@ Useful keys:
                                   (symbol-value enabled))))
                          t)))))
   (riece-disable-addon addon t)
-  (let ((enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
-    (if (and (eq major-mode 'riece-addon-list-mode)
-            (get-text-property (point) 'riece-addon)
-            enabled (null (symbol-value enabled)))
-       (save-excursion
-         (beginning-of-line)
-         (let ((point (point))
-               (inhibit-read-only t)
-               buffer-read-only)
-           (delete-char 1)
-           (insert "-")
-           (put-text-property point (point) 'riece-addon addon))))))
+  (when (eq major-mode 'riece-addon-list-mode)
+    (riece-command-list-addons)
+    (let ((point (point-min)))
+      (while (and (not (eq (get-text-property point 'riece-addon) addon))
+                 (setq point (next-single-property-change point
+                                                          'riece-addon))))
+      (if point
+         (goto-char point)))))
 
 (provide 'riece-addon)