From 495493e8e3978d3e178ce15f341b192177dbba88 Mon Sep 17 00:00:00 2001 From: Daiki Ueno Date: Fri, 21 May 2004 05:03:51 +0000 Subject: [PATCH] * riece-mini.el (riece-mini-enabled): New flag. (riece-mini-display-message-function): Check riece-mini-enabled. (riece-mini-enable): New function. (riece-mini-disable): New function. * riece-log.el (riece-log-enabled): New flag. (riece-log-display-message-function): Check riece-log-enabled. (riece-log-insinuate): Don't bind command key. (riece-log-enable): New function. (riece-log-disable): New function. * riece-highlight.el (riece-highlight-enabled): New flag. (riece-highlight-setup-dialogue): Renamed from riece-dialogue-turn-on-font-lock; don't call turn-on-font-lock. (riece-highlight-setup-channel-list): Renamed from riece-channel-list-turn-on-font-lock; don't call turn-on-font-lock. (riece-highlight-hide-prefix): Renamed from riece-dialogue-hide-prefix. (riece-highlight-put-overlay-faces): Renamed from riece-put-overlay-faces; check riece-highlight-enabled. (riece-highlight-format-identity-for-channel-list-indicator): Check riece-highlight-enabled. (riece-highlight-insinuate): Follow the name changes. (riece-highlight-enable): New function. (riece-highlight-disable): New function. * riece-ctcp.el (riece-ctcp-enabled): New flag. (riece-ctcp-insinuate): Don't bind command keys. (riece-ctcp-enable): New function. (riece-ctcp-disable): New function. (riece-handle-ctcp-request): Check riece-ctcp-enabled. (riece-handle-ctcp-response): Ditto. * riece.el: Moved add-on arrangement code to riece-addon.el. (riece-addons-insinuated): New flag. (riece): Don't (re)insinuate add-ons if at least an IRC server is opened; enable add-ons after calling riece-startup-hook. * riece-addon.el: New file. * COMPILE (riece-modules): Add riece-addon. * Makefile.am (EXTRA_DIST): Add riece-addon.el. --- lisp/COMPILE | 1 + lisp/ChangeLog | 45 +++++++++++++++ lisp/Makefile.am | 12 ++-- lisp/riece-addon.el | 122 ++++++++++++++++++++++++++++++++++++++++ lisp/riece-ctcp.el | 52 ++++++++++------- lisp/riece-highlight.el | 95 ++++++++++++++++++------------- lisp/riece-log.el | 33 +++++++---- lisp/riece-mini.el | 34 +++++------ lisp/riece.el | 86 ++++++---------------------- 9 files changed, 318 insertions(+), 162 deletions(-) create mode 100644 lisp/riece-addon.el diff --git a/lisp/COMPILE b/lisp/COMPILE index 866cc44..1cfd0ba 100644 --- a/lisp/COMPILE +++ b/lisp/COMPILE @@ -10,6 +10,7 @@ riece-version riece-coding riece-complete + riece-addon riece-mode ;; riece-identity -+-> riece-channel diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c0d97c2..87d8b4e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,48 @@ +2004-05-21 Daiki Ueno + + * riece-mini.el (riece-mini-enabled): New flag. + (riece-mini-display-message-function): Check riece-mini-enabled. + (riece-mini-enable): New function. + (riece-mini-disable): New function. + + * riece-log.el (riece-log-enabled): New flag. + (riece-log-display-message-function): Check riece-log-enabled. + (riece-log-insinuate): Don't bind command key. + (riece-log-enable): New function. + (riece-log-disable): New function. + + * riece-highlight.el (riece-highlight-enabled): New flag. + (riece-highlight-setup-dialogue): Renamed from + riece-dialogue-turn-on-font-lock; don't call turn-on-font-lock. + (riece-highlight-setup-channel-list): Renamed from + riece-channel-list-turn-on-font-lock; don't call + turn-on-font-lock. + (riece-highlight-hide-prefix): Renamed from + riece-dialogue-hide-prefix. + (riece-highlight-put-overlay-faces): Renamed from + riece-put-overlay-faces; check riece-highlight-enabled. + (riece-highlight-format-identity-for-channel-list-indicator): + Check riece-highlight-enabled. + (riece-highlight-insinuate): Follow the name changes. + (riece-highlight-enable): New function. + (riece-highlight-disable): New function. + + * riece-ctcp.el (riece-ctcp-enabled): New flag. + (riece-ctcp-insinuate): Don't bind command keys. + (riece-ctcp-enable): New function. + (riece-ctcp-disable): New function. + (riece-handle-ctcp-request): Check riece-ctcp-enabled. + (riece-handle-ctcp-response): Ditto. + + * riece.el: Moved add-on arrangement code to riece-addon.el. + (riece-addons-insinuated): New flag. + (riece): Don't (re)insinuate add-ons if at least an IRC server is + opened; enable add-ons after calling riece-startup-hook. + + * riece-addon.el: New file. + * COMPILE (riece-modules): Add riece-addon. + * Makefile.am (EXTRA_DIST): Add riece-addon.el. + 2004-05-20 Daiki Ueno * riece-doctor.el (riece-doctor-buffer-name): Assume that the 1st diff --git a/lisp/Makefile.am b/lisp/Makefile.am index 430a291..5679e50 100644 --- a/lisp/Makefile.am +++ b/lisp/Makefile.am @@ -1,11 +1,11 @@ EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \ riece-000.el riece-200.el riece-300.el riece-400.el riece-500.el \ - riece-channel.el riece-coding.el riece-commands.el riece-compat.el \ - riece-complete.el riece-display.el riece-emacs.el riece-filter.el \ - riece-globals.el riece-handle.el riece-highlight.el riece-identity.el \ - riece-message.el riece-misc.el riece-mode.el riece-naming.el \ - riece-options.el riece-server.el riece-signal.el riece-user.el \ - riece-version.el riece-xemacs.el riece.el \ + riece-addon.el riece-channel.el riece-coding.el riece-commands.el \ + riece-compat.el riece-complete.el riece-display.el riece-emacs.el \ + riece-filter.el riece-globals.el riece-handle.el riece-highlight.el \ + riece-identity.el riece-message.el riece-misc.el riece-mode.el \ + riece-naming.el riece-options.el riece-server.el riece-signal.el \ + riece-user.el riece-version.el riece-xemacs.el riece.el \ riece-ctcp.el riece-url.el riece-unread.el \ riece-ndcc.el riece-rdcc.el riece-log.el riece-mini.el \ riece-doctor.el riece-alias.el riece-layout.el riece-skk-kakutei.el \ diff --git a/lisp/riece-addon.el b/lisp/riece-addon.el new file mode 100644 index 0000000..7c09ec0 --- /dev/null +++ b/lisp/riece-addon.el @@ -0,0 +1,122 @@ +;;; riece-addon.el --- add-on management +;; Copyright (C) 1998-2004 Daiki Ueno + +;; Author: Daiki Ueno +;; Created: 1998-09-28 +;; Keywords: IRC, riece + +;; This file is part of Riece. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(defun riece-load-and-build-addon-dependencies (addons) + (let ((load-path (cons riece-addon-directory load-path)) + dependencies) + (while addons + (require (car addons)) ;error will be reported here + (let* ((requires + (funcall (or (intern-soft + (concat (symbol-name (car addons)) "-requires")) + #'ignore))) + (pointer requires) + entry) + ;; Increment succs' pred count. + (if (setq entry (assq (car addons) dependencies)) + (setcar (cdr entry) (+ (length requires) (nth 1 entry))) + (setq dependencies (cons (list (car addons) (length requires)) + dependencies))) + ;; Merge pred's succs. + (while pointer + (if (setq entry (assq (car pointer) dependencies)) + (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-addons (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. + (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) + 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)))) + (setcar (cdr entry) count))) + (setq pointer (cdr pointer))) + (setq queue (cdr queue))) + (if dependencies + (error "Circular add-on dependency found")) + (nreverse addons))) + +(defun riece-insinuate-addon (addon) + (require addon) ;implicit dependency + (funcall (intern (concat (symbol-name addon) "-insinuate"))) + (if riece-debug + (message "Add-on %S is insinuated" addon))) + +(defun riece-enable-addon (addon) + (let ((enabled (intern (concat (symbol-name addon) "-enabled")))) + (if (not (boundp enabled)) + (if riece-debug + (message "Add-on %S doesn't support enable/disable" addon)) + (if (symbol-value enabled) + (if riece-debug + (message "Can't enable add-on %S" addon)) + (funcall (intern (concat (symbol-name addon) "-enable"))) + (if riece-debug + (message "Add-on %S enabled" addon)))))) + +(defun riece-disable-addon (addon) + (let ((enabled (intern (concat (symbol-name addon) "-enabled")))) + (if (not (boundp enabled)) + (if riece-debug + (message "Add-on %S doesn't support enable/disable" addon)) + (if (symbol-value enabled) + (progn + (funcall (intern (concat (symbol-name (car addons)) "-disable"))) + (if riece-debug + (message "Add-on %S disabled" (car addons)))) + (if riece-debug + (message "Can't disable add-on %S" addon)))))) + +(provide 'riece-addon) + +;;; riece-addon.el ends here diff --git a/lisp/riece-ctcp.el b/lisp/riece-ctcp.el index f1fd937..79d64ba 100644 --- a/lisp/riece-ctcp.el +++ b/lisp/riece-ctcp.el @@ -49,27 +49,10 @@ (defvar riece-dialogue-mode-map) -(defun riece-ctcp-requires () - (if (memq 'riece-highlight riece-addons) - '(riece-highlight))) - -(defun riece-ctcp-insinuate () - (add-hook 'riece-privmsg-hook 'riece-handle-ctcp-request) - (add-hook 'riece-notice-hook 'riece-handle-ctcp-response) - (if (memq 'riece-highlight riece-addons) - (setq riece-dialogue-font-lock-keywords - (cons (list (concat "^" riece-time-prefix-regexp "\\(" - (regexp-quote riece-ctcp-action-prefix) - ".*\\)$") - 1 riece-ctcp-action-face t t) - riece-dialogue-font-lock-keywords))) - (define-key riece-dialogue-mode-map "\C-cv" 'riece-command-ctcp-version) - (define-key riece-dialogue-mode-map "\C-cp" 'riece-command-ctcp-ping) - (define-key riece-dialogue-mode-map "\C-ca" 'riece-command-ctcp-action) - (define-key riece-dialogue-mode-map "\C-cc" 'riece-command-ctcp-clientinfo)) +(defvar riece-ctcp-enabled nil) (defun riece-handle-ctcp-request (prefix string) - (when (and prefix string + (when (and riece-ctcp-enabled prefix string (riece-prefix-nickname prefix)) (let* ((parameters (riece-split-parameters string)) (targets (split-string (car parameters) ",")) @@ -205,7 +188,7 @@ " " string)) "\n")))) (defun riece-handle-ctcp-response (prefix string) - (when (and prefix string + (when (and riece-ctcp-enabled prefix string (riece-prefix-nickname prefix)) (let* ((parameters (riece-split-parameters string)) (targets (split-string (car parameters) ",")) @@ -344,6 +327,35 @@ " (in " (riece-format-identity target t) ")"))) "\n")))) +(defun riece-ctcp-requires () + (if (memq 'riece-highlight riece-addons) + '(riece-highlight))) + +(defun riece-ctcp-insinuate () + (add-hook 'riece-privmsg-hook 'riece-handle-ctcp-request) + (add-hook 'riece-notice-hook 'riece-handle-ctcp-response) + (if (memq 'riece-highlight riece-addons) + (setq riece-dialogue-font-lock-keywords + (cons (list (concat "^" riece-time-prefix-regexp "\\(" + (regexp-quote riece-ctcp-action-prefix) + ".*\\)$") + 1 riece-ctcp-action-face t t) + riece-dialogue-font-lock-keywords)))) + +(defun riece-ctcp-enable () + (define-key riece-dialogue-mode-map "\C-cv" 'riece-command-ctcp-version) + (define-key riece-dialogue-mode-map "\C-cp" 'riece-command-ctcp-ping) + (define-key riece-dialogue-mode-map "\C-ca" 'riece-command-ctcp-action) + (define-key riece-dialogue-mode-map "\C-cc" 'riece-command-ctcp-clientinfo) + (setq riece-ctcp-enable t)) + +(defun riece-ctcp-disable () + (define-key riece-dialogue-mode-map "\C-cv" nil) + (define-key riece-dialogue-mode-map "\C-cp" nil) + (define-key riece-dialogue-mode-map "\C-ca" nil) + (define-key riece-dialogue-mode-map "\C-cc" nil) + (setq riece-ctcp-enabled nil)) + (provide 'riece-ctcp) ;;; riece-ctcp.el ends here diff --git a/lisp/riece-highlight.el b/lisp/riece-highlight.el index b7f3a38..1eb500e 100644 --- a/lisp/riece-highlight.el +++ b/lisp/riece-highlight.el @@ -187,20 +187,10 @@ :type '(repeat (list string)) :group 'riece-highlight) -(defun riece-dialogue-schedule-turn-on-font-lock () - (add-hook 'riece-channel-mode-hook - 'riece-dialogue-turn-on-font-lock) - (add-hook 'riece-others-mode-hook - 'riece-dialogue-turn-on-font-lock) - (add-hook 'riece-dialogue-mode-hook - 'riece-dialogue-turn-on-font-lock)) - -(defun riece-channel-list-schedule-turn-on-font-lock () - (add-hook 'riece-channel-list-mode-hook - 'riece-channel-list-turn-on-font-lock)) +(defvar riece-highlight-enabled nil) (defvar font-lock-support-mode) -(defun riece-dialogue-turn-on-font-lock () +(defun riece-highlight-setup-dialogue () (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(riece-dialogue-font-lock-keywords t)) (make-local-variable 'font-lock-verbose) @@ -210,27 +200,11 @@ (setq font-lock-support-mode nil)) (make-local-hook 'font-lock-mode-hook) (setq font-lock-mode-hook nil) - (turn-on-font-lock) (make-local-hook 'after-change-functions) (add-hook 'after-change-functions - 'riece-dialogue-hide-prefix nil 'local)) - -(defun riece-dialogue-hide-prefix (start end length) - (save-excursion - (goto-char start) - (if (looking-at riece-prefix-regexp) - (put-text-property (match-beginning 1) (match-end 1) 'invisible t)))) - -(defun riece-put-overlay-faces (start end) - (riece-scan-property-region - 'riece-overlay-face - start end - (lambda (start end) - (riece-overlay-put (riece-make-overlay start end) - 'face - (get-text-property start 'riece-overlay-face))))) + 'riece-highlight-hide-prefix nil 'local)) -(defun riece-channel-list-turn-on-font-lock () +(defun riece-highlight-setup-channel-list () (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(riece-channel-list-font-lock-keywords t)) (make-local-variable 'font-lock-verbose) @@ -239,12 +213,28 @@ (make-local-variable 'font-lock-support-mode) (setq font-lock-support-mode nil)) (make-local-hook 'font-lock-mode-hook) - (setq font-lock-mode-hook nil) - (turn-on-font-lock)) + (setq font-lock-mode-hook nil)) + +(defun riece-highlight-hide-prefix (start end length) + (save-excursion + (goto-char start) + (if (looking-at riece-prefix-regexp) + (put-text-property (match-beginning 1) (match-end 1) 'invisible t)))) + +(defun riece-highlight-put-overlay-faces (start end) + (if riece-highlight-enabled + (riece-scan-property-region + 'riece-overlay-face + start end + (lambda (start end) + (riece-overlay-put (riece-make-overlay start end) + 'face + (get-text-property start 'riece-overlay-face)))))) (defun riece-highlight-format-identity-for-channel-list-indicator (index identity) - (if (riece-identity-equal identity riece-current-channel) + (if (and riece-highlight-enabled + (riece-identity-equal identity riece-current-channel)) (let ((string (riece-format-identity identity)) (start 0)) ;; Escape % -> %%. @@ -258,19 +248,48 @@ (defun riece-highlight-insinuate () (put 'riece-channel-mode 'font-lock-defaults '(riece-dialogue-font-lock-keywords t)) + (add-hook 'riece-channel-mode-hook + 'riece-highlight-setup-dialogue) (put 'riece-others-mode 'font-lock-defaults '(riece-dialogue-font-lock-keywords t)) + (add-hook 'riece-others-mode-hook + 'riece-highlight-setup-dialogue) (put 'riece-dialogue-mode 'font-lock-defaults '(riece-dialogue-font-lock-keywords t)) - (add-hook 'riece-after-load-startup-hook - 'riece-dialogue-schedule-turn-on-font-lock) + (add-hook 'riece-dialogue-mode-hook + 'riece-highlight-setup-dialogue) (put 'riece-channel-list-mode 'font-lock-defaults '(riece-channel-list-font-lock-keywords t)) - (add-hook 'riece-after-load-startup-hook - 'riece-channel-list-schedule-turn-on-font-lock) + (add-hook 'riece-channel-list-mode-hook + 'riece-highlight-setup-channel-list) (add-hook 'riece-format-identity-for-channel-list-indicator-functions 'riece-highlight-format-identity-for-channel-list-indicator) - (add-hook 'riece-after-insert-functions 'riece-put-overlay-faces)) + (add-hook 'riece-after-insert-functions + 'riece-highlight-put-overlay-faces)) + +(defun riece-highlight-enable () + (let ((buffers riece-buffer-list)) + (while buffers + (if (memq (derived-mode-class + (with-current-buffer (car buffers) + major-mode)) + '(riece-dialogue-mode riece-channel-list-mode)) + (with-current-buffer (car buffers) + (font-lock-mode 1))) + (setq buffers (cdr buffers)))) + (setq riece-highlight-enabled t)) + +(defun riece-highlight-disable () + (let ((buffers riece-buffer-list)) + (while buffers + (if (memq (derived-mode-class + (with-current-buffer (car buffers) + major-mode)) + '(riece-dialogue-mode riece-channel-list-mode)) + (with-current-buffer (car buffers) + (font-lock-mode -1))) + (setq buffers (cdr buffers)))) + (setq riece-highlight-disable nil)) (provide 'riece-highlight) diff --git a/lisp/riece-log.el b/lisp/riece-log.el index 5b79710..a2573fe 100644 --- a/lisp/riece-log.el +++ b/lisp/riece-log.el @@ -66,14 +66,17 @@ If integer, flash back only this line numbers. t means all lines." :type 'function :group 'riece-log) +(defvar riece-log-enabled nil) + (defun riece-log-display-message-function (message) - (let ((file (riece-log-get-file (riece-message-target message))) - (coding-system-for-write riece-log-coding-system)) - (unless (file-directory-p (file-name-directory file)) - (make-directory (file-name-directory file) t)) - (write-region (concat (format-time-string "%H:%M") " " - (riece-format-message message)) - nil file t 0))) + (if riece-log-enabled + (let ((file (riece-log-get-file (riece-message-target message))) + (coding-system-for-write riece-log-coding-system)) + (unless (file-directory-p (file-name-directory file)) + (make-directory (file-name-directory file) t)) + (write-region (concat (format-time-string "%H:%M") " " + (riece-format-message message)) + nil file t 0)))) (defun riece-log-get-file (identity) (expand-file-name @@ -99,7 +102,7 @@ If integer, flash back only this line numbers. t means all lines." (expand-file-name name riece-log-directory)))) (defun riece-log-flashback (identity) - (when riece-log-flashback + (when (and riece-log-enabled riece-log-flashback) (let ((file (riece-log-get-file identity))) (when (file-exists-p file) (let (string) @@ -139,16 +142,22 @@ If integer, flash back only this line numbers. t means all lines." (if (memq 'riece-button riece-addons) '(riece-button))) -(defvar riece-command-mode-map) (defun riece-log-insinuate () ;; FIXME: Use `riece-after-insert-functions' for trapping change, ;; notice, wallops and so on. But must add argument. (add-hook 'riece-after-display-message-functions 'riece-log-display-message-function) (add-hook 'riece-channel-buffer-create-functions - 'riece-log-flashback) - (define-key riece-command-mode-map - "\C-cd" 'riece-log-open-directory)) + 'riece-log-flashback)) + +(defvar riece-command-mode-map) +(defun riece-log-enable () + (define-key riece-command-mode-map "\C-cd" 'riece-log-open-directory) + (setq riece-log-enabled t)) + +(defun riece-log-disable () + (define-key riece-command-mode-map "\C-cd" nil) + (setq riece-log-enabled nil)) (provide 'riece-log) diff --git a/lisp/riece-mini.el b/lisp/riece-mini.el index 55317b4..d134e84 100644 --- a/lisp/riece-mini.el +++ b/lisp/riece-mini.el @@ -43,6 +43,8 @@ (defvar riece-mini-last-channel nil) +(defvar riece-mini-enabled nil) + (defmacro riece-mini-message-no-log (string &rest args) "Like `message', except that message logging is disabled." (if (featurep 'xemacs) @@ -54,22 +56,16 @@ (defun riece-mini-display-message-function (message) "Show arrival messages to minibuffer." - (unless (or (eq (window-buffer (selected-window)) - (get-buffer riece-command-buffer)) - (riece-message-own-p message) - (active-minibuffer-window)) - (let ((open-bracket - (funcall riece-message-make-open-bracket-function message)) - (close-bracket - (funcall riece-message-make-close-bracket-function message)) - (global-name - (funcall riece-message-make-global-name-function message))) - (unless (riece-message-type message) - (setq riece-mini-last-channel (riece-message-target message))) - (riece-mini-message-no-log - "%s" (concat (format-time-string "%H:%M") " " - open-bracket global-name close-bracket - " " (riece-message-text message)))))) + (when (and riece-mini-enabled + (not (or (eq (window-buffer (selected-window)) + (get-buffer riece-command-buffer)) + (riece-message-own-p message) + (active-minibuffer-window)))) + (unless (riece-message-type message) + (setq riece-mini-last-channel (riece-message-target message))) + (riece-mini-message-no-log + "%s" (concat (format-time-string "%H:%M") " " + (riece-format-message message t))))) (defun riece-mini-send-message (arg) "Send message using minibuffer. @@ -99,6 +95,12 @@ If twice (C-u C-u), then ask the channel." (add-hook 'riece-after-display-message-functions 'riece-mini-display-message-function)) +(defun riece-mini-enable () + (setq riece-mini-enabled t)) + +(defun riece-mini-disable () + (setq riece-mini-enabled nil)) + (provide 'riece-mini) ;;; riece-mini.el ends here diff --git a/lisp/riece.el b/lisp/riece.el index 1b66d48..5aa8b47 100644 --- a/lisp/riece.el +++ b/lisp/riece.el @@ -29,6 +29,7 @@ (require 'riece-server) (require 'riece-compat) (require 'riece-commands) +(require 'riece-addon) (autoload 'derived-mode-class "derived") @@ -62,6 +63,9 @@ (defvar riece-shrink-buffer-idle-timer nil "Timer object to periodically shrink channel buffers.") +(defvar riece-addons-insinuated nil + "Non nil if add-ons are already insinuated.") + (defvar riece-select-keys `("1" riece-command-switch-to-channel-by-number-1 "2" riece-command-switch-to-channel-by-number-2 @@ -262,10 +266,16 @@ If optional argument CONFIRM is non-nil, ask which IRC server to connect." (interactive "P") (riece-read-variables-files (if noninteractive (car command-line-args-left))) - (riece-insinuate-addons riece-addons) (run-hooks 'riece-after-load-startup-hook) (if (riece-server-opened) (riece-command-configure-windows) + (unless riece-addons-insinuated + (setq riece-addons (riece-resolve-addons riece-addons)) + (let ((pointer riece-addons)) + (while pointer + (riece-insinuate-addon (car pointer)) + (setq pointer (cdr pointer)))) + (setq riece-addons-insinuated t)) (if (or confirm (null riece-server)) (setq riece-server (completing-read "Server: " riece-server-alist))) (if (stringp riece-server) @@ -293,6 +303,10 @@ If optional argument CONFIRM is non-nil, ask which IRC server to connect." (riece-command-open-server (car server-list)) (setq server-list (cdr server-list)))) (run-hooks 'riece-startup-hook) + (let ((pointer riece-addons)) + (while pointer + (riece-enable-addon (car pointer)) + (setq pointer (cdr pointer)))) (message "%s" (substitute-command-keys "Type \\[describe-mode] for help")))) @@ -469,75 +483,7 @@ Instead, these commands are available: (eq major-mode (nth 2 (car alist)))) (funcall (nth 2 (car alist)))) (setq alist (cdr alist)))))) - -(defun riece-load-and-build-addon-dependencies (addons) - (let ((load-path (cons riece-addon-directory load-path)) - dependencies) - (while addons - (require (car addons)) ;error will be reported here - (let* ((requires - (funcall (or (intern-soft - (concat (symbol-name (car addons)) "-requires")) - #'ignore))) - (pointer requires) - entry) - ;; Increment succs' pred count. - (if (setq entry (assq (car addons) dependencies)) - (setcar (cdr entry) (+ (length requires) (nth 1 entry))) - (setq dependencies (cons (list (car addons) (length requires)) - dependencies))) - ;; Merge pred's succs. - (while pointer - (if (setq entry (assq (car pointer) dependencies)) - (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-insinuate-addons (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. - (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) - 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)))) - (setcar (cdr entry) count))) - (setq pointer (cdr pointer))) - (setq queue (cdr queue))) - (if dependencies - (error "Circular add-on dependency found")) - (setq addons (nreverse addons)) - (while addons - (require (car addons)) ;implicit dependency - (funcall (intern (concat (symbol-name (car addons)) "-insinuate"))) - (if riece-debug - (message "Add-on %S is loaded" (car addons))) - (setq addons (cdr addons))))) - + (provide 'riece) ;;; riece.el ends here -- 2.25.1