Fixed.

[riece] / lisp / riece-addon.el

diff --git a/lisp/riece-addon.el b/lisp/riece-addon.el
index a455516..b2dfe75 100644 (file)
--- a/lisp/riece-addon.el
+++ b/lisp/riece-addon.el
@@ -24,10 +24,97 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(require 'font-lock)
+(require 'riece-options)
+(require 'riece-compat)
+(require 'riece-misc)
+
+(defgroup riece-addon-list nil
+  "Add-on listing."
+  :tag "Addon list"
+  :prefix "riece-addon-list-"
+  :group 'riece)
+
+(defgroup riece-addon-list-faces nil
+  "Faces for riece-addon-list-mode."
+  :tag "Faces"
+  :prefix "riece-addon-list-"
+  :group 'riece-addon-list)
+
+(defface riece-addon-list-enabled-face
+  '((((class color) (background dark))
+     (:foreground "PaleTurquoise" :bold t))
+    (t
+     (:bold t)))
+  "Face used for displaying the enabled addon."
+  :group 'riece-addon-list-faces)
+(defvar riece-addon-list-enabled-face 'riece-addon-list-enabled-face)
+
+(defface riece-addon-list-disabled-face
+  '((((class color) (background dark))
+     (:foreground "PaleTurquoise" :italic t))
+    (t
+     (:italic t)))
+  "Face used for displaying the disabled addon."
+  :group 'riece-addon-list-faces)
+(defvar riece-addon-list-disabled-face 'riece-addon-list-disabled-face)
+
+(defface riece-addon-list-unsupported-face
+  '((((class color) (background dark))
+     (:foreground "PaleTurquoise"))
+    (t
+     ()))
+  "Face used for displaying the unsupported addon."
+  :group 'riece-addon-list-faces)
+(defvar riece-addon-list-unsupported-face 'riece-addon-list-unsupported-face)
+
+(defface riece-addon-list-unknown-face
+  '((t
+     (:foreground "red")))
+  "Face used for displaying the unknown addon."
+  :group 'riece-addon-list-faces)
+(defvar riece-addon-list-unknown-face 'riece-addon-list-unknown-face)
+
+(defface riece-addon-list-description-face
+  '((((class color)
+      (background dark))
+     (:foreground "lightyellow"))
+    (((class color)
+      (background light))
+     (:foreground "blue4"))
+    (t
+     ()))
+  "Face used for displaying the description addon."
+  :group 'riece-addon-list-faces)
+(defvar riece-addon-list-description-face 'riece-addon-list-description-face)
+
+(defcustom riece-addon-list-mark-face-alist
+  '((?+ . riece-addon-list-enabled-face)
+    (?- . riece-addon-list-disabled-face)
+    (?! . riece-addon-list-unsupported-face)
+    (?? . riece-addon-list-unknown-face))
+  "An alist mapping marks on riece-addon-list-buffer to faces."
+  :type 'list
+  :group 'riece-addon-list)
+
+(defcustom riece-addon-list-font-lock-keywords
+  '(("^\\([-+!?] [^:]+\\): \\(.*\\)"
+     (1 (cdr (assq (aref (match-string 1) 0)
+                  riece-addon-list-mark-face-alist)))
+     (2 riece-addon-list-description-face)))
+  "Default expressions to addon in riece-addon-list-mode."
+  :type '(repeat (list string))
+  :group 'riece-addon-list)
+

 (defvar riece-addon-list-mode-map
   (let ((keymap (make-sparse-keymap)))
     (define-key keymap "+" 'riece-command-enable-addon)
     (define-key keymap "-" 'riece-command-disable-addon)
 (defvar riece-addon-list-mode-map
   (let ((keymap (make-sparse-keymap)))
     (define-key keymap "+" 'riece-command-enable-addon)
     (define-key keymap "-" 'riece-command-disable-addon)

+    (define-key keymap "n" 'next-line)
+    (define-key keymap "p" 'previous-line)
+    (define-key keymap " " 'scroll-up)
+    (define-key keymap [delete] 'scroll-down)
+    (define-key keymap "q" 'bury-buffer)

     keymap))
 
 (defun riece-load-and-build-addon-dependencies (addons)
     keymap))
 
 (defun riece-load-and-build-addon-dependencies (addons)


@@ -57,7 +144,7 @@
       (setq addons (cdr addons)))
     dependencies))
 
       (setq addons (cdr addons)))
     dependencies))
 

-(defun riece-resolve-addons (addons)
+(defun riece-resolve-addon-dependencies (addons)

   (let ((pointer addons)
        dependencies queue)
     ;; Uniquify, first.
   (let ((pointer addons)
        dependencies queue)
     ;; Uniquify, first.


@@ -82,21 +169,35 @@
        (let* ((entry (assq (car pointer) dependencies))
               (count (1- (nth 1 entry))))
          (if (zerop count)
        (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" dependency))

     (nreverse addons)))
 
     (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)))
+

 (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"))))


@@ -105,7 +206,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))))))


@@ -121,7 +222,10 @@
            (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))

 
 (defun riece-addon-list-mode ()
   "Major mode for displaying addon list.
 
 (defun riece-addon-list-mode ()
   "Major mode for displaying addon list.


@@ -129,93 +233,132 @@ All normal editing commands are turned off."
   (kill-all-local-variables)
   (buffer-disable-undo)
   (setq major-mode 'riece-addon-list-mode
   (kill-all-local-variables)
   (buffer-disable-undo)
   (setq major-mode 'riece-addon-list-mode

-        mode-name "AddOns"
+       mode-name "AddOns"

        mode-line-buffer-identification
        mode-line-buffer-identification

-       (riece-mode-line-buffer-identification '("Riece: "))
+       (riece-mode-line-buffer-identification '("Riece: %12b"))

        truncate-lines t
        buffer-read-only t)
   (use-local-map riece-addon-list-mode-map)
        truncate-lines t
        buffer-read-only 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 effective
+  ;; if buffer-file-name is not set.
+  (font-lock-set-defaults)

   (run-hooks 'riece-addon-list-mode-hook))
 
 (defun riece-command-list-addons ()
   (interactive)
   (run-hooks 'riece-addon-list-mode-hook))
 
 (defun riece-command-list-addons ()
   (interactive)

-  (save-excursion
-    (set-buffer (riece-get-buffer-create "*AddOns*" 'riece-addon-list-mode))
-    (riece-addon-list-mode)
-    (let ((inhibit-read-only t)
-         buffer-read-only
-         (pointer riece-addons)
-         enabled description point)
-      (erase-buffer)
-      (riece-kill-all-overlays)
-      (while pointer
-       (setq enabled (intern-soft (concat (symbol-name (car pointer))
-                                          "-enabled"))
-             description (intern-soft (concat (symbol-name (car pointer))
-                                              "-description")))
-       (setq point (point))
-       (insert (format "%c %S: %s\n"
-                       (if (not (featurep (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))
-       (setq pointer (cdr pointer)))
-      (insert "
+  (set-buffer (riece-get-buffer-create "*AddOns*" 'riece-addon-list-mode))
+  (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)
+    (erase-buffer)
+    (riece-kill-all-overlays)
+    (while pointer
+      (setq enabled (intern-soft (concat (symbol-name (car pointer))
+                                        "-enabled"))
+           description (intern-soft (concat (symbol-name (car pointer))
+                                            "-description")))
+      (setq point (point))
+      (insert (format "%c %S: %s\n"
+                     (if (not (featurep (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))
+      (setq pointer (cdr pointer)))
+    (insert "

 Symbols in the leftmost column:
 
   +     The add-on is enabled.
   -     The add-on is disabled.
 Symbols in the leftmost column:
 
   +     The add-on is enabled.
   -     The add-on is disabled.

-  =    The add-on doesn't support enable/disable operation.
-  ?    The add-on status is not known.
+  !    The add-on doesn't support enable/disable operation.
+  ?    The add-on status is unknown.

 ")
 ")

-      (insert (substitute-command-keys "
+    (insert (substitute-command-keys "

 Useful keys:
 
   `\\[riece-command-enable-addon]' to enable the current add-on.
   `\\[riece-command-disable-addon]' to disable the current add-on.
 Useful keys:
 
   `\\[riece-command-enable-addon]' to enable the current add-on.
   `\\[riece-command-disable-addon]' to disable the current add-on.

-")))
-    (pop-to-buffer (current-buffer))))
+"))
+    (goto-char (point-min))
+    (pop-to-buffer (current-buffer))
+    (delete-other-windows)))

 
 (defun riece-command-enable-addon (addon)
   (interactive
    (list
     (or (if (eq major-mode 'riece-addon-list-mode)
            (get-text-property (point) 'riece-addon))
 
 (defun riece-command-enable-addon (addon)
   (interactive
    (list
     (or (if (eq major-mode 'riece-addon-list-mode)
            (get-text-property (point) 'riece-addon))

-       (completing-read "Add-on: "
-                        (mapcar #'list riece-addons)
-                        (lambda (pointer)
-                          (setq enabled (intern-soft (concat (car pointer)
-                                                             "-enabled")))
-                          (and enabled
-                               (null (symbol-value enabled))))
-                        t))))
+       (intern-soft
+        (completing-read "Add-on: "
+                         (mapcar (lambda (addon)
+                                   (list (symbol-name addon)))
+                                 riece-addons)
+                         (lambda (pointer)
+                           (let ((enabled
+                                  (intern-soft (concat (car pointer)
+                                                       "-enabled"))))
+                             (and enabled
+                                  (null (symbol-value enabled)))))
+                         t)))))

   (riece-enable-addon addon t)
   (riece-enable-addon addon t)

-  (riece-command-list-addons))
+  (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))))))

 
 (defun riece-command-disable-addon (addon)
   (interactive
    (list
     (or (if (eq major-mode 'riece-addon-list-mode)
            (get-text-property (point) 'riece-addon))
 
 (defun riece-command-disable-addon (addon)
   (interactive
    (list
     (or (if (eq major-mode 'riece-addon-list-mode)
            (get-text-property (point) 'riece-addon))

-       (completing-read "Add-on: "
-                        (mapcar #'list riece-addons)
-                        (lambda (pointer)
-                          (setq enabled (intern-soft (concat (car pointer)
-                                                             "-enabled")))
-                          (and enabled
-                               (symbol-value enabled)))
-                        t))))
+       (intern-soft
+        (completing-read "Add-on: "
+                         (mapcar (lambda (addon)
+                                   (list (symbol-name addon)))
+                                 riece-addons)
+                         (lambda (pointer)
+                           (let ((enabled
+                                  (intern-soft (concat (car pointer)
+                                                       "-enabled"))))
+                             (and enabled
+                                  (symbol-value enabled))))
+                         t)))))

   (riece-disable-addon addon t)
   (riece-disable-addon addon t)

-  (riece-command-list-addons))
-      
+  (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))))))
+

 (provide 'riece-addon)
 
 ;;; riece-addon.el ends here
 (provide 'riece-addon)
 
 ;;; riece-addon.el ends here