* riece.el (riece): Don't override riece-addons setting.

[riece] / lisp / riece-addon.el

diff --git a/lisp/riece-addon.el b/lisp/riece-addon.el
index 092e6a5..7181353 100644 (file)
--- a/lisp/riece-addon.el
+++ b/lisp/riece-addon.el
@@ -30,16 +30,16 @@
 (require 'riece-misc)
 
 (defgroup riece-addon-list nil
 (require 'riece-misc)
 
 (defgroup riece-addon-list nil

-  "Add-on management"
-  :tag "Addon"
-  :prefix "riece-"
+  "Add-on listing."
+  :tag "Addon list"
+  :prefix "riece-addon-list-"

   :group 'riece)
 
 (defgroup riece-addon-list-faces nil
   :group 'riece)
 
 (defgroup riece-addon-list-faces nil

-  "Faces for riece-addon-list-mode"
+  "Faces for riece-addon-list-mode."

   :tag "Faces"
   :tag "Faces"

-  :prefix "riece-addon-list"
-  :group 'riece-addon)
+  :prefix "riece-addon-list-"
+  :group 'riece-addon-list)

 
 (defface riece-addon-list-enabled-face
   '((((class color) (background dark))
 
 (defface riece-addon-list-enabled-face
   '((((class color) (background dark))


@@ -136,66 +136,71 @@
        ;; Merge pred's succs.
        (while pointer
          (if (setq entry (assq (car pointer) dependencies))
        ;; 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))
 
            (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)))
     (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
     (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))
               (count (1- (nth 1 entry))))
          (if (zerop count)
            pointer (nthcdr 2 (car queue)))
       (while pointer
        (let* ((entry (assq (car pointer) dependencies))
               (count (1- (nth 1 entry))))
          (if (zerop count)

-             (progn
-               (setq dependencies (delq entry dependencies)
-                     queue (nconc queue (list entry))))
+             (setq dependencies (delq entry dependencies)
+                   queue (nconc queue (list entry)))

            (setcar (cdr entry) count)))
        (setq pointer (cdr pointer)))
       (setq queue (cdr queue)))
     (if dependencies
            (setcar (cdr entry) count)))
        (setq pointer (cdr pointer)))
       (setq queue (cdr queue)))
     (if dependencies

-       (error "Circular add-on dependency found"))
+       (error "Circular add-on dependency found: %S" dependencies))

     (nreverse addons)))
 
 (defun riece-resolve-addons (addons)
     (nreverse addons)))
 
 (defun riece-resolve-addons (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-resolve-addon-dependencies
   (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)))
+   (riece-load-and-build-addon-dependencies addons)))

 
 (defun riece-insinuate-addon (addon &optional verbose)
 
 (defun riece-insinuate-addon (addon &optional verbose)

-  (require addon)              ;implicit dependency
-  (funcall (intern (concat (symbol-name addon) "-insinuate")))
-  (if verbose
-      (message "Add-on %S is insinuated" addon)))
+  (if (get addon 'riece-addon-insinuated)
+      (if verbose
+         (message "Add-on %S is alread 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-enable-addon (addon &optional verbose)
   (let ((enabled (intern-soft (concat (symbol-name addon) "-enabled"))))
 
 (defun riece-enable-addon (addon &optional verbose)
   (let ((enabled (intern-soft (concat (symbol-name addon) "-enabled"))))


@@ -204,7 +209,7 @@
            (message "Add-on %S doesn't support enable/disable" addon))
       (if (symbol-value enabled)
          (if verbose
            (message "Add-on %S doesn't support enable/disable" addon))
       (if (symbol-value enabled)
          (if verbose

-             (message "Can't enable add-on %S" addon))
+             (message "Add-on %S is already enabled" addon))

        (funcall (intern (concat (symbol-name addon) "-enable")))
        (if verbose
            (message "Add-on %S enabled" addon))))))
        (funcall (intern (concat (symbol-name addon) "-enable")))
        (if verbose
            (message "Add-on %S enabled" addon))))))


@@ -220,7 +225,7 @@
            (if verbose
                (message "Add-on %S disabled" addon)))
        (if verbose
            (if verbose
                (message "Add-on %S disabled" addon)))
        (if verbose

-           (message "Can't disable add-on %S" addon))))))
+           (message "Add-on %S is already enabled" addon))))))

 
 (put 'riece-addon-list-mode 'font-lock-defaults
      '(riece-addon-list-font-lock-keywords t))
 
 (put 'riece-addon-list-mode 'font-lock-defaults
      '(riece-addon-list-font-lock-keywords t))


@@ -239,8 +244,8 @@ All normal editing commands are turned off."
   (use-local-map riece-addon-list-mode-map)
   (make-local-variable 'font-lock-defaults)
   (setq font-lock-defaults '(riece-addon-list-font-lock-keywords t))
   (use-local-map riece-addon-list-mode-map)
   (make-local-variable 'font-lock-defaults)
   (setq font-lock-defaults '(riece-addon-list-font-lock-keywords t))

-  ;; In XEmacs, auto-initialization of font-lock is not affective
-  ;; when buffer-file-name is not set.
+  ;; In XEmacs, auto-initialization of font-lock is not effective
+  ;; if buffer-file-name is not set.

   (font-lock-set-defaults)
   (run-hooks 'riece-addon-list-mode-hook))
 
   (font-lock-set-defaults)
   (run-hooks 'riece-addon-list-mode-hook))
 


@@ -313,18 +318,14 @@ Useful keys:
                                   (null (symbol-value enabled)))))
                          t)))))
   (riece-enable-addon addon t)
                                   (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
 
 (defun riece-command-disable-addon (addon)
   (interactive


@@ -344,18 +345,14 @@ Useful keys:
                                   (symbol-value enabled))))
                          t)))))
   (riece-disable-addon addon t)
                                   (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)
 
 
 (provide 'riece-addon)