[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Mldonkey-commits] mldonkey .cvsignore config/Makefile.in config/c...
|
From: |
mldonkey-commits |
|
Subject: |
[Mldonkey-commits] mldonkey .cvsignore config/Makefile.in config/c... |
|
Date: |
Tue, 27 Jun 2006 10:38:38 +0000 |
CVSROOT: /sources/mldonkey
Module name: mldonkey
Changes by: spiralvoice <spiralvoice> 06/06/27 10:38:37
Modified files:
. : .cvsignore
config : Makefile.in configure.in
packages/rpm : mldonkey.spec.in
src/daemon/common: commonInteractive.ml commonOptions.ml
src/daemon/driver: driverCommands.ml driverControlers.ml
driverControlers.mli driverMain.ml
src/gtk/gui : gui_config.ml gui_main.ml
src/gtk/newgui : gui_main.ml gui_messages.ml gui_options.ml
gui_window_base.ml
src/gtk2/gui : guiArt.ml guiConfig.ml guiMain.ml
guiMessages.ml guiNetworks.ml guiTypes2.ml
guiWindow.ml
src/networks/donkey: donkeyInteractive.ml
Removed files:
icons/rsvg : menu_im.svg menu_mlchat.svg
icons/tux : im.xpm
src/daemon/chat: .cvsignore chat_args.ml chat_config.ml
chat_data.ml chat_icons.ml chat_messages.ml
chat_misc.ml chat_options.ml chat_options.mli
chat_proto.ml chat_types.ml mlchat.ml
mlchat.mli
src/daemon/common: commonChat.ml
src/gtk/chat : .cvsignore chat_app.ml chat_gui.ml
chat_gui_base.ml chat_main.ml
src/gtk2/chat : .cvsignore chat_app.ml chat_art.ml
chat_configwin.ml chat_gui.ml chat_gui_base.ml
chat_main.ml
src/gtk2/im : .cvsignore guiIm.ml guiImAccounts.ml
guiImChat.ml guiImMain.ml guiImRooms.ml
src/im : .cvsignore gui_im.ml gui_im_base.ml
gui_im_main.ml gui_im_rooms.ml imAccount.ml
imChat.ml imEvent.ml imIdentity.ml imMain.ml
imOptions.ml imProtocol.ml imRoom.ml imTypes.ml
src/im/icq : icq.ml
src/im/irc : .cvsignore irc.ml
src/im/msn : msn.ml
src/im/toc : toc.ml
src/im/yahoo : yahoo.ml
Log message:
patch #5202
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/.cvsignore?cvsroot=mldonkey&r1=1.26&r2=1.27
http://cvs.savannah.gnu.org/viewcvs/mldonkey/config/Makefile.in?cvsroot=mldonkey&r1=1.161&r2=1.162
http://cvs.savannah.gnu.org/viewcvs/mldonkey/config/configure.in?cvsroot=mldonkey&r1=1.270&r2=1.271
http://cvs.savannah.gnu.org/viewcvs/mldonkey/icons/rsvg/menu_im.svg?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/icons/rsvg/menu_mlchat.svg?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/icons/tux/im.xpm?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/packages/rpm/mldonkey.spec.in?cvsroot=mldonkey&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/chat/.cvsignore?cvsroot=mldonkey&r1=1.2&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/chat/chat_args.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/chat/chat_config.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/chat/chat_data.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/chat/chat_icons.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/chat/chat_messages.ml?cvsroot=mldonkey&r1=1.3&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/chat/chat_misc.ml?cvsroot=mldonkey&r1=1.2&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/chat/chat_options.ml?cvsroot=mldonkey&r1=1.4&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/chat/chat_options.mli?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/chat/chat_proto.ml?cvsroot=mldonkey&r1=1.2&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/chat/chat_types.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/chat/mlchat.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/chat/mlchat.mli?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonInteractive.ml?cvsroot=mldonkey&r1=1.71&r2=1.72
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonOptions.ml?cvsroot=mldonkey&r1=1.155&r2=1.156
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonChat.ml?cvsroot=mldonkey&r1=1.9&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverCommands.ml?cvsroot=mldonkey&r1=1.157&r2=1.158
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverControlers.ml?cvsroot=mldonkey&r1=1.73&r2=1.74
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverControlers.mli?cvsroot=mldonkey&r1=1.1&r2=1.2
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverMain.ml?cvsroot=mldonkey&r1=1.113&r2=1.114
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk/chat/.cvsignore?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk/chat/chat_app.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk/chat/chat_gui.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk/chat/chat_gui_base.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk/chat/chat_main.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk/gui/gui_config.ml?cvsroot=mldonkey&r1=1.6&r2=1.7
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk/gui/gui_main.ml?cvsroot=mldonkey&r1=1.13&r2=1.14
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk/newgui/gui_main.ml?cvsroot=mldonkey&r1=1.17&r2=1.18
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk/newgui/gui_messages.ml?cvsroot=mldonkey&r1=1.11&r2=1.12
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk/newgui/gui_options.ml?cvsroot=mldonkey&r1=1.13&r2=1.14
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk/newgui/gui_window_base.ml?cvsroot=mldonkey&r1=1.3&r2=1.4
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/chat/.cvsignore?cvsroot=mldonkey&r1=1.2&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/chat/chat_app.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/chat/chat_art.ml?cvsroot=mldonkey&r1=1.2&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/chat/chat_configwin.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/chat/chat_gui.ml?cvsroot=mldonkey&r1=1.2&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/chat/chat_gui_base.ml?cvsroot=mldonkey&r1=1.2&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/chat/chat_main.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/gui/guiArt.ml?cvsroot=mldonkey&r1=1.8&r2=1.9
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/gui/guiConfig.ml?cvsroot=mldonkey&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/gui/guiMain.ml?cvsroot=mldonkey&r1=1.7&r2=1.8
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/gui/guiMessages.ml?cvsroot=mldonkey&r1=1.10&r2=1.11
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/gui/guiNetworks.ml?cvsroot=mldonkey&r1=1.2&r2=1.3
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/gui/guiTypes2.ml?cvsroot=mldonkey&r1=1.9&r2=1.10
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/gui/guiWindow.ml?cvsroot=mldonkey&r1=1.3&r2=1.4
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/im/.cvsignore?cvsroot=mldonkey&r1=1.2&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/im/guiIm.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/im/guiImAccounts.ml?cvsroot=mldonkey&r1=1.3&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/im/guiImChat.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/im/guiImMain.ml?cvsroot=mldonkey&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/im/guiImRooms.ml?cvsroot=mldonkey&r1=1.3&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/.cvsignore?cvsroot=mldonkey&r1=1.3&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/gui_im.ml?cvsroot=mldonkey&r1=1.5&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/gui_im_base.ml?cvsroot=mldonkey&r1=1.4&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/gui_im_main.ml?cvsroot=mldonkey&r1=1.3&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/gui_im_rooms.ml?cvsroot=mldonkey&r1=1.3&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/imAccount.ml?cvsroot=mldonkey&r1=1.4&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/imChat.ml?cvsroot=mldonkey&r1=1.4&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/imEvent.ml?cvsroot=mldonkey&r1=1.3&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/imIdentity.ml?cvsroot=mldonkey&r1=1.4&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/imMain.ml?cvsroot=mldonkey&r1=1.3&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/imOptions.ml?cvsroot=mldonkey&r1=1.7&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/imProtocol.ml?cvsroot=mldonkey&r1=1.5&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/imRoom.ml?cvsroot=mldonkey&r1=1.4&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/imTypes.ml?cvsroot=mldonkey&r1=1.3&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/icq/icq.ml?cvsroot=mldonkey&r1=1.3&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/irc/.cvsignore?cvsroot=mldonkey&r1=1.3&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/irc/irc.ml?cvsroot=mldonkey&r1=1.7&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/msn/msn.ml?cvsroot=mldonkey&r1=1.3&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/toc/toc.ml?cvsroot=mldonkey&r1=1.3&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/im/yahoo/yahoo.ml?cvsroot=mldonkey&r1=1.4&r2=0
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/donkey/donkeyInteractive.ml?cvsroot=mldonkey&r1=1.109&r2=1.110
Patches:
Index: .cvsignore
===================================================================
RCS file: /sources/mldonkey/mldonkey/.cvsignore,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -b -r1.26 -r1.27
--- .cvsignore 30 Oct 2005 21:13:31 -0000 1.26
+++ .cvsignore 27 Jun 2006 10:38:34 -0000 1.27
@@ -14,8 +14,6 @@
contribs
use_tags*
.depend
-mlchat
-mlchat.byte
test_*
ocamlopt-*
*.static
Index: config/Makefile.in
===================================================================
RCS file: /sources/mldonkey/mldonkey/config/Makefile.in,v
retrieving revision 1.161
retrieving revision 1.162
diff -u -b -r1.161 -r1.162
--- config/Makefile.in 11 Jun 2006 17:37:38 -0000 1.161
+++ config/Makefile.in 27 Jun 2006 10:38:34 -0000 1.162
@@ -48,15 +48,11 @@
ICONS_CHOICE=icons/rsvg
SRC_GUI=src/gtk2/gui
GUI_CODE=GTK2GUI
- IM_GUI=src/gtk2/im
- CHAT_GUI=src/gtk2/chat
GTK=gtk2
else
CONFIGWIN=src/gtk/configwin
GPATTERN=src/gtk/gpattern
OKEY=src/gtk/okey
- IM_GUI=src/im
- CHAT_GUI=src/gtk/chat
GTK=gtk
ifeq ("$(GUI)", "newgui1")
SRC_PROGRESS=src/gtk/progress
@@ -77,7 +73,6 @@
RSS=src/utils/ocamlrss
XML=src/utils/xml-light
-CHAT=src/daemon/chat
COMMON=src/daemon/common
DRIVER=src/daemon/driver
MP3=src/utils/mp3tagui
@@ -93,9 +88,7 @@
SRC_DIRECTCONNECT=src/networks/direct_connect
SRC_FILETP=src/networks/fileTP
-IM=src/im
-
-SUBDIRS=$(CDK) $(CHAT) $(CHAT_GUI) $(LIB) $(RSS) $(XML) $(NET) tools \
+SUBDIRS=$(CDK) $(LIB) $(RSS) $(XML) $(NET) tools \
$(COMMON) $(DRIVER) $(MP3) src/config/$(OS_FILES)
INCLUDES += $(foreach file, $(SUBDIRS), -I $(file))
@@ -215,13 +208,6 @@
# $(NET)/tcpClientSocket.ml
-CHAT_SRCS = $(CHAT)/chat_messages.ml\
- $(CHAT)/chat_misc.ml\
- $(CHAT)/chat_proto.ml\
- $(CHAT)/chat_types.ml\
- $(CHAT)/chat_options.ml\
- $(CHAT)/chat_config.ml
-
XML_SRCS= \
$(XML)/xml_types.ml $(XML)/xml_parser.mly $(XML)/xml_lexer.mll \
$(XML)/xml_dtd.ml $(XML)/xmlParser.ml $(XML)/xml.ml
@@ -246,7 +232,6 @@
$(COMMON)/giftParser.mly \
$(COMMON)/giftEncoding.ml \
$(COMMON)/giftDecoding.ml \
- $(COMMON)/commonChat.ml \
$(COMMON)/commonHasher.ml \
$(COMMON)/commonHosts.ml \
$(COMMON)/commonIndexing.ml \
@@ -507,12 +492,11 @@
OBSERVER_SRCS = \
$(CDK_SRCS) $(LIB_SRCS) $(NET_SRCS) $(MP3TAG_SRCS) \
- $(CHAT_SRCS) $(COMMON_SRCS) $(COMMON_CLIENT_SRCS) $(DONKEY_SRCS) \
+ $(COMMON_SRCS) $(COMMON_CLIENT_SRCS) $(DONKEY_SRCS) \
tools/observer.ml
MLD_HASH_SRCS = \
$(CDK_SRCS) $(LIB_SRCS) $(NET_SRCS) $(MP3TAG_SRCS) \
- $(CHAT_SRCS) \
tools/mld_hash.ml
OCAMLPP_SRCS = \
@@ -529,12 +513,12 @@
MAKE_TORRENT_SRCS = \
$(MAGIC_SRCS) $(CDK_SRCS) $(LIB_SRCS) $(NET_SRCS) $(MP3TAG_SRCS) \
- $(CHAT_SRCS) $(COMMON_SRCS) $(COMMON_CLIENT_SRCS) $(BITTORRENT_SRCS) \
+ $(COMMON_SRCS) $(COMMON_CLIENT_SRCS) $(BITTORRENT_SRCS) \
tools/make_torrent.ml
GET_RANGE_SRCS = \
$(CDK_SRCS) $(LIB_SRCS) $(NET_SRCS) $(MP3TAG_SRCS) \
- $(CHAT_SRCS) tools/get_range.ml
+ tools/get_range.ml
KDE_APPLET=yes
@@ -805,9 +789,6 @@
rm -f $(DESTDIR)$(prefix)/bin/$$link; ln -s mlnet+gui
$(DESTDIR)$(prefix)/bin/$$link; \
done; \
fi
- if test -f mlim; then \
- rm -f $(DESTDIR)$(prefix)/bin/mlim; cp -f mlim
$(DESTDIR)$(prefix)/bin/mlim; \
- fi
ifneq ("$(GUI)" , "no")
@@ -853,7 +834,6 @@
$(ICONS_CHOICE)/menu_uploads.svg \
$(ICONS_CHOICE)/menu_console.svg \
$(ICONS_CHOICE)/menu_graph.svg \
- $(ICONS_CHOICE)/menu_im.svg \
$(ICONS_CHOICE)/menu_settings.svg \
$(ICONS_CHOICE)/menu_quit.svg \
$(ICONS_CHOICE)/menu_help.svg \
@@ -869,7 +849,6 @@
$(ICONS_CHOICE)/menu_search_complex.svg \
$(ICONS_CHOICE)/menu_search_freedb.svg \
$(ICONS_CHOICE)/menu_search_imdb.svg \
- $(ICONS_CHOICE)/menu_mlchat.svg \
$(ICONS_CHOICE)/menu_interfaces.svg \
$(ICONS_CHOICE)/menu_tools.svg \
$(ICONS_CHOICE)/menu_others.svg \
@@ -1025,7 +1004,6 @@
$(ICONS_CHOICE)/nbk_graphs_on.xpm \
$(ICONS_CHOICE)/nbk_graphs_menu.xpm \
$(ICONS_CHOICE)/about.xpm \
- $(ICONS_CHOICE)/im.xpm \
$(ICONS_CHOICE)/settings.xpm \
$(ICONS_CHOICE)/exit.xpm \
$(ICONS_CHOICE)/gui.xpm \
@@ -1188,7 +1166,6 @@
$(SRC_GUI)/guiFriends.ml \
$(SRC_GUI)/guiUploads.ml \
$(SRC_GUI)/guiNetworks.ml \
- $(IM_GUI_CORE) \
$(SRC_GUI)/guiConfig.ml \
$(SRC_GUI)/guiWindow.ml
@@ -1220,7 +1197,6 @@
$(SRC_GUI)/gui_downloads_base.ml $(SRC_GUI)/gui_downloads.ml \
$(SRC_GUI)/gui_networks.ml \
$(SRC_GUI)/gui_window_base.ml $(SRC_GUI)/gui_window.ml \
- $(IM_GUI_CORE) \
$(SRC_GUI)/gui_config.ml \
$(SRC_GUI)/gui_main.ml
@@ -1245,7 +1221,6 @@
$(SRC_GUI)/gui_servers_base.zog $(SRC_GUI)/gui_servers.ml \
$(SRC_GUI)/gui_downloads_base.zog $(SRC_GUI)/gui_downloads.ml \
$(SRC_GUI)/gui_window_base.zog $(SRC_GUI)/gui_window.ml \
- $(IM_GUI_CORE) \
$(SRC_GUI)/gui_config.ml \
$(SRC_GUI)/gui_main.ml
@@ -1260,18 +1235,6 @@
MLDONKEYGUI_SRCS= $(MAIN_SRCS)
ifeq ("$(GUI)", "newgui2")
- MLDONKEY_IM_CMXA= cdk.cmxa common.cmxa icons.cmxa guibase.cmxa
-else
- MLDONKEY_IM_CMXA= cdk.cmxa gmisc.cmxa common.cmxa icons.cmxa guibase.cmxa
-endif
-
-ifeq ("$(GUI)", "newgui2")
- MLDONKEY_IM_SRCS= $(IM_GUI_CORE) $(IM_GUI)/guiImMain.ml $(MAIN_SRCS)
-else
- MLDONKEY_IM_SRCS= $(IM_GUI_CORE) $(IM_GUI)/gui_im_main.ml $(MAIN_SRCS)
-endif
-
-ifeq ("$(GUI)", "newgui2")
STARTER_CMXA=cdk.cmxa common.cmxa icons.cmxa guibase.cmxa
STARTER_SRCS= $(SRC_GUI)/guiStarter.ml
else
@@ -1298,74 +1261,13 @@
MLPROGRESS_SRCS = \
$(PROGRESS_SRCS) $(MAIN_SRCS)
-
-#######################################################################
-
-# Objects files for "mlchat"
-
-#######################################################################
-
-CHAT_EXE_SRCS= \
- $(CHAT)/chat_data.ml \
- $(CHAT)/chat_args.ml
-
-ifeq ("$(GUI)", "newgui2")
- CHAT_EXE_SRCS += $(CHAT_GUI)/chat_art.ml $(CHAT_GUI)/chat_configwin.ml
-endif
-
-CHAT_EXE_SRCS += \
- $(CHAT)/chat_icons.ml \
- $(CHAT_GUI)/chat_gui_base.ml \
- $(CHAT_GUI)/chat_gui.ml \
- $(CHAT_GUI)/chat_app.ml \
- $(CHAT)/mlchat.ml \
- $(CHAT_GUI)/chat_main.ml
-
-ifeq ("$(GUI)", "newgui2")
- MLCHAT_CMXA= cdk.cmxa icons.cmxa
-else
- MLCHAT_CMXA= cdk.cmxa gmisc.cmxa
-endif
-
-MLCHAT_SRCS= $(CHAT_SRCS) $(CHAT_EXE_SRCS)
-
-
-TARGETS += mlgui$(EXE) mlchat$(EXE) mlguistarter$(EXE)
+TARGETS += mlgui$(EXE) mlguistarter$(EXE)
ifeq ("$(GUI)", "newgui")
TARGETS += mlprogress$(EXE)
endif
TARGETS += mlnet+gui$(EXE)
-
-#### IM stuff is now automatically included in the GUI
-
-SUBDIRS += $(IM) $(IM)/yahoo $(IM)/irc $(IM_GUI)
-
-IM_CORE += $(IM)/imTypes.ml $(IM)/imEvent.ml \
- $(IM)/imProtocol.ml $(IM)/imIdentity.ml $(IM)/imAccount.ml \
- $(IM)/imChat.ml $(IM)/imRoom.ml \
- $(IM)/imOptions.ml
-
-IM_CORE += $(IM)/irc/irc.ml
-
-ifeq ("$(GUI)", "newgui2")
- IM_GUI_CORE += $(IM_GUI)/guiImAccounts.ml $(IM_GUI)/guiImChat.ml \
- $(IM_GUI)/guiImRooms.ml $(IM_GUI)/guiIm.ml
-else
- IM_GUI_CORE += $(IM_GUI)/gui_im_base.ml $(IM_GUI)/gui_im.ml
-endif
-
-TARGETS += mlim
-
-#ifeq ("$(DEVEL)", "yes")
-# SUBDIRS += $(IM)/msn
-#
-# IM_CORE += $(IM)/yahoo/yahoo.ml $(IM)/msn/msn.ml
-#endif
-
-IM_CORE += $(IM)/imMain.ml
-
endif
top: mldonkeytop
@@ -1449,14 +1351,14 @@
libcdk_SRCS= $(CDK_SRCS) $(LIB_SRCS) $(NET_SRCS) $(MP3TAG_SRCS)
libmagic_SRCS= $(MAGIC_SRCS)
-libcommon_SRCS= $(CHAT_SRCS) $(COMMON_SRCS)
+libcommon_SRCS= $(COMMON_SRCS)
libclient_SRCS= $(COMMON_CLIENT_SRCS)
ifeq ("$(GUI)", "newgui2")
libgmisc_SRCS=
else
libgmisc_SRCS= $(CONFIGWIN_SRCS) $(MP3TAGUI_SRCS) $(OKEY_SRCS)
$(GPATTERN_SRCS)
endif
-libguibase_SRCS= $(IM_CORE) $(GUI_BASE_SRCS)
+libguibase_SRCS= $(GUI_BASE_SRCS)
libgui_SRCS= $(GUI_SRCS)
libgui3_SRCS= $(GUI3_SRCS)
libicons_SRCS= $(ALL_ICONS_SRCS)
@@ -1580,9 +1482,7 @@
EXPAND(mlfileTP+gui,mlfiletp+gui,GTK,mlfileTP+gui,GD,NO,MAGIC)
EXPAND(mlslsk,mlslsk,NO,mlslsk,GD,NO,MAGIC)
EXPAND(mlslsk+gui,mlslsk+gui,GTK,mlslsk+gui,GD,NO,MAGIC)
-EXPAND(MLDONKEY_IM,mlim,GTK,MLDONKEY_IM)
EXPAND(STARTER,mlguistarter,GTK)
-EXPAND(MLCHAT,mlchat,GTK,MLCHAT)
EXPAND(OBSERVER,observer)
EXPAND(MLD_HASH,mld_hash)
EXPAND(OCAMLPP,ocamlpp)
@@ -1833,7 +1733,7 @@
RELEASE_TARGETS=mlnet
ifneq ("$(GUI)" , "no")
-RELEASE_TARGETS += mlgui mlnet+gui mlguistarter mlchat
+RELEASE_TARGETS += mlgui mlnet+gui mlguistarter
endif
release.shared: opt
Index: config/configure.in
===================================================================
RCS file: /sources/mldonkey/mldonkey/config/configure.in,v
retrieving revision 1.270
retrieving revision 1.271
diff -u -b -r1.270 -r1.271
--- config/configure.in 19 Jun 2006 21:24:54 -0000 1.270
+++ config/configure.in 27 Jun 2006 10:38:34 -0000 1.271
@@ -306,8 +306,6 @@
MAGIC=yes
AC_ARG_ENABLE(magic, [ --disable-magic disable the use of
libmagic (GNU file)], [MAGIC="$enableval"])
-IM=yes
-
if test "$FORCE_MINGW" = "yes"; then
CC="$CC -mno-cygwin"
CPP="$CPP -mno-cygwin"
@@ -1191,12 +1189,11 @@
GTKLLIBS="`pkg-config --libs-only-L gtk+-2.0`"
GTKLFLAGS="`pkg-config --libs-only-l gtk+-2.0`"
else
- GUIS="mldonkey_gui\$(EXE) mldonkey_gui2\$(EXE) mlchat\$(EXE)"
+ GUIS="mldonkey_gui\$(EXE) mldonkey_gui2\$(EXE)"
fi
if test "$LABLGTK_CONFIG" = "no"; then
GUI="no"
- IM=no
else
MORE_TARGETS="$MORE_TARGETS $GUIS"
AC_MSG_CHECKING(GToolbox.popup_menu args)
@@ -1210,17 +1207,6 @@
GTOOLBOX_POPUPMENU=' ~x: button ~y: time '
AC_MSG_RESULT(old)
fi
- if test "$IM" = "yes" ; then
- AC_MSG_CHECKING(IM)
- if test -d ../src/im; then
- AC_MSG_RESULT(yes)
- IM=yes
- else
- IM=no
- fi
- else
- IM=no
- fi
echo "---------------------------------------------------------"
echo "End of GTK GUI configuration."
echo "---------------------------------------------------------"
Index: packages/rpm/mldonkey.spec.in
===================================================================
RCS file: /sources/mldonkey/mldonkey/packages/rpm/mldonkey.spec.in,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- packages/rpm/mldonkey.spec.in 20 Jun 2005 18:52:57 -0000 1.4
+++ packages/rpm/mldonkey.spec.in 27 Jun 2006 10:38:34 -0000 1.5
@@ -79,7 +79,6 @@
install -m 755 mlgui %{buildroot}%{_bindir}/mlgui
install -m 755 mlnet+gui %{buildroot}%{_bindir}/mlnet+gui
install -m 755 mlguistarter %{buildroot}%{_bindir}/mlguistarter
-install -m 755 mlchat %{buildroot}%{_bindir}/mlchat
install -m 755 distrib/mldonkey_previewer
%{buildroot}%{_bindir}/mldonkey_previewer
# init
@@ -125,7 +124,6 @@
%files gui
%defattr(-,root,root)
%doc COPYING
-%{_bindir}/mlchat
%{_bindir}/mlgui
%{_bindir}/mlnet+gui
%{_bindir}/mlguistarter
Index: src/daemon/common/commonInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonInteractive.ml,v
retrieving revision 1.71
retrieving revision 1.72
diff -u -b -r1.71 -r1.72
--- src/daemon/common/commonInteractive.ml 6 Jun 2006 23:50:51 -0000
1.71
+++ src/daemon/common/commonInteractive.ml 27 Jun 2006 10:38:35 -0000
1.72
@@ -349,9 +349,6 @@
} in
M.sendmail !!smtp_server !!smtp_port !!add_mail_brackets mail
-let chat_for_completed_file file =
- CommonChat.send_warning_for_downloaded_file (file_best_name file)
-
let file_completed (file : file) =
try
let impl = as_file_impl file in
@@ -362,9 +359,6 @@
(try mail_for_completed_file file with e ->
lprintf_nl "Exception %s in sendmail" (Printexc2.to_string e);
);
- if !!CommonOptions.chat_warning_for_downloaded then
- chat_for_completed_file file;
-
end
with e ->
lprintf_nl "Exception in file_completed: %s" (Printexc2.to_string e)
Index: src/daemon/common/commonOptions.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonOptions.ml,v
retrieving revision 1.155
retrieving revision 1.156
diff -u -b -r1.155 -r1.156
--- src/daemon/common/commonOptions.ml 19 Jun 2006 20:26:08 -0000 1.155
+++ src/daemon/common/commonOptions.ml 27 Jun 2006 10:38:35 -0000 1.156
@@ -354,8 +354,6 @@
"Mail options"
let path_section = file_section downloads_ini ["Paths"]
"Paths options"
-let mlchat_section = file_section downloads_ini ["MLChat"]
- "MLChat options"
let security_section = file_section downloads_ini ["Security"]
"Security options"
let other_section = file_section downloads_ini ["Other"]
@@ -1209,50 +1207,6 @@
"Regexp of messages to filter out, example: string1|string2|string3"
string_option "Your client is connecting too fast"
-
-
-(*************************************************************************)
-(* *)
-(* MLchat section *)
-(* *)
-(*************************************************************************)
-
-let current_section = mlchat_section
-
-(** {2 Chat} *)
-
-let chat_app_port =
- define_expert_option current_section ["chat_app_port"]
- "port of the external chat application"
- int_option 5036
-
-let chat_app_host =
- define_expert_option current_section ["chat_app_host"]
- "hostname of the external chat application"
- string_option "localhost"
-
-let chat_port =
- define_expert_option current_section ["chat_port"]
- "port used by the external chat application to use the core as a proxy"
- int_option 4002
-
-let chat_bind_addr = define_expert_option current_section ["chat_bind_addr"]
- "The IP address used to bind the chat server"
- Ip.option (Ip.of_inet_addr Unix.inet_addr_any)
-
-let chat_console_id =
- define_expert_option current_section ["chat_console_id"]
- "the id to use for communicating with the core console through chat
interface"
- string_option "donkey console"
-
-let chat_warning_for_downloaded = define_expert_option current_section
- ["chat_warning_for_downloaded"]
- "use the chat to indicate when a file has been downloaded"
- bool_option true
-
-
-
-
(*************************************************************************)
(* *)
(* Other section *)
Index: src/daemon/driver/driverCommands.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverCommands.ml,v
retrieving revision 1.157
retrieving revision 1.158
diff -u -b -r1.157 -r1.158
--- src/daemon/driver/driverCommands.ml 27 Jun 2006 10:26:48 -0000 1.157
+++ src/daemon/driver/driverCommands.ml 27 Jun 2006 10:38:35 -0000 1.158
@@ -1545,12 +1545,10 @@
strings_of_option gui_bind_addr;
strings_of_option telnet_bind_addr;
strings_of_option http_bind_addr;
- strings_of_option chat_bind_addr;
strings_of_option client_bind_addr;
strings_of_option gui_port;
strings_of_option telnet_port;
strings_of_option http_port;
- strings_of_option chat_port;
strings_of_option http_realm;
strings_of_option allowed_ips;
]
Index: src/daemon/driver/driverControlers.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverControlers.ml,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -b -r1.73 -r1.74
--- src/daemon/driver/driverControlers.ml 27 Jun 2006 10:26:48 -0000
1.73
+++ src/daemon/driver/driverControlers.ml 27 Jun 2006 10:38:35 -0000
1.74
@@ -628,82 +628,6 @@
(*************************************************************
- The Chat Server
-
-**************************************************************)
-
-let chat_handler t event =
- match event with
- TcpServerSocket.CONNECTION (s, Unix.ADDR_INET (from_ip, from_port)) ->
- (
- try
- let o = {
- conn_buf = Buffer.create 1000;
- conn_output = TEXT;
- conn_sortvd = NotSorted;
- conn_filter = (fun _ -> ());
- conn_user = default_user;
- conn_width = 80; conn_height = 0;
- } in
-
- let from_ip = Ip.of_inet_addr from_ip in
- if Ip.matches from_ip !!allowed_ips then
- (
- let chanin = Unix.in_channel_of_descr s in
- let chanout = Unix.out_channel_of_descr s in
- let paq = Chat_proto.read_packet_channel chanin in
- let ret =
- match paq with
- ((v,id,(host,port)),iddest,pro) ->
- if v <> CommonChat.version then
- None
- else
- Some paq
- in
- close_out chanout;
- (match ret with
- None -> ()
- | Some ((v,id,(host,port)),iddest,pro) ->
- match pro with
- Chat_proto.Hello ->
- CommonChat.send_hello_ok ()
- | Chat_proto.HelloOk -> ()
- | Chat_proto.AddOpen _ -> ()
- | Chat_proto.Byebye -> ()
- | Chat_proto.RoomMessage _ ->
- (* A VOIR *)
- ()
- | Chat_proto.Message s ->
- if iddest = !!CommonOptions.chat_console_id then
- (* we must eval the string as a command *)
- (
- let buf = o.conn_buf in
- Buffer.reset buf;
- let auth = ref true in
- eval auth s o;
- CommonChat.send_text !!CommonOptions.chat_console_id
None
- (dollar_escape o false (Buffer.contents buf));
- Buffer.reset buf
- )
- else
- (* we must forward the message *)
- (networks_iter (fun r ->
- network_private_message r iddest s)
- )
- )
- )
- else
- Unix.close s
- with
- Failure mess ->
- lprintf_nl "%s" mess;
- Unix.close s
- )
- | _ ->
- ()
-
-(*************************************************************
-
The HTTP Server
**************************************************************)
Index: src/daemon/driver/driverControlers.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverControlers.mli,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -b -r1.1 -r1.2
--- src/daemon/driver/driverControlers.mli 22 Apr 2003 22:33:39 -0000
1.1
+++ src/daemon/driver/driverControlers.mli 27 Jun 2006 10:38:35 -0000
1.2
@@ -22,7 +22,6 @@
val telnet_handler : TcpServerSocket.t -> TcpServerSocket.event -> unit
-val chat_handler : TcpServerSocket.t -> TcpServerSocket.event -> unit
val create_http_handler : unit -> unit
val check_calendar : unit -> unit
Index: src/daemon/driver/driverMain.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverMain.ml,v
retrieving revision 1.113
retrieving revision 1.114
diff -u -b -r1.113 -r1.114
--- src/daemon/driver/driverMain.ml 18 Jun 2006 20:24:21 -0000 1.113
+++ src/daemon/driver/driverMain.ml 27 Jun 2006 10:38:35 -0000 1.114
@@ -121,14 +121,6 @@
Dp500.start ();
- if !!chat_port <> 0 then begin
- ignore (find_port "chat server" !!chat_bind_addr
- chat_port DriverControlers.chat_handler);
- try
- CommonChat.send_hello ()
- with _ -> if !verbose then lprintf (_b "CommonChat.send_hello failed");
- end;
-
gui_server_sock := find_port "gui server" !!gui_bind_addr
gui_port gui_handler;
if !!gift_port <> 0 then
Index: src/gtk/gui/gui_config.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk/gui/gui_config.ml,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- src/gtk/gui/gui_config.ml 2 Feb 2004 10:34:08 -0000 1.6
+++ src/gtk/gui/gui_config.ml 27 Jun 2006 10:38:35 -0000 1.7
@@ -331,7 +331,6 @@
Section (name,
List.fold_left (fun list (message, optype, option) ->
try
- lprintf "Find %s in section %s\n" option name;
(match optype with
| GuiTypes.StringEntry ->
create_string_option message
@@ -344,7 +343,6 @@
(Hashtbl.find options_values option).option_value
) :: list
with Not_found ->
- lprintf "No option %s\n" option;
list
) [] !options)
) sections
Index: src/gtk/gui/gui_main.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk/gui/gui_main.ml,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -b -r1.13 -r1.14
--- src/gtk/gui/gui_main.ml 20 Mar 2005 01:41:29 -0000 1.13
+++ src/gtk/gui/gui_main.ml 27 Jun 2006 10:38:35 -0000 1.14
@@ -549,16 +549,6 @@
CommonGlobals.exit_properly 0
in
Gui_config.update_toolbars_style gui;
- Gui_global.top_menus := ("IM", (fun menu ->
-
- let menu_item =
- GMenu.menu_item ~label: "IM Window"
- ~packing:menu#add ()
- in
- ignore (menu_item#connect#activate ~callback:(fun _ ->
- Gui_im.main_window#window#show ()));
-
- )) :: !Gui_global.top_menus;
List.iter (fun (menu, init) ->
let _Menu = GMenu.menu_item ~label:menu ~packing:(gui#menubar#add) ()
in
Index: src/gtk/newgui/gui_main.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk/newgui/gui_main.ml,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -b -r1.17 -r1.18
--- src/gtk/newgui/gui_main.ml 5 Aug 2005 00:56:13 -0000 1.17
+++ src/gtk/newgui/gui_main.ml 27 Jun 2006 10:38:35 -0000 1.18
@@ -602,9 +602,6 @@
ignore (gui#buttonAbout#connect#clicked
(fun () -> ignore (window_about ())));
- ignore (gui#buttonIm#connect#clicked
- (fun () -> Gui_im.main_window#window#show ()));
-
(************ Some hooks ***************)
option_hook Gui_options.notebook_tab
Index: src/gtk/newgui/gui_messages.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk/newgui/gui_messages.ml,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- src/gtk/newgui/gui_messages.ml 5 Aug 2005 00:56:13 -0000 1.11
+++ src/gtk/newgui/gui_messages.ml 27 Jun 2006 10:38:35 -0000 1.12
@@ -800,9 +800,6 @@
let mW_ti_about =
_s
"About"
-let mW_ti_im =
- _s
- "Im"
let mW_ti_settings =
_s
"Settings"
@@ -1537,7 +1534,6 @@
let o_xpm_nbk_graphs_menu = "nbk_graphs_mini"
let o_xpm_about = "about"
-let o_xpm_im = "im"
let o_xpm_settings = "settings"
let o_xpm_exit = "exit"
let o_xpm_gui = "gui"
Index: src/gtk/newgui/gui_options.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk/newgui/gui_options.ml,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -b -r1.13 -r1.14
--- src/gtk/newgui/gui_options.ml 6 Oct 2005 10:21:08 -0000 1.13
+++ src/gtk/newgui/gui_options.ml 27 Jun 2006 10:38:35 -0000 1.14
@@ -376,8 +376,6 @@
let xpm_about = define_option mldonkey_gui_section (xpm_label M.o_xpm_about)
"" filename_option ""
-let xpm_im = define_option mldonkey_gui_section (xpm_label M.o_xpm_im)
- "" filename_option ""
let xpm_settings = define_option mldonkey_gui_section (xpm_label
M.o_xpm_settings)
"" filename_option ""
let xpm_exit = define_option mldonkey_gui_section (xpm_label M.o_xpm_exit)
@@ -1043,7 +1041,6 @@
M.o_xpm_nbk_graphs_menu, (Nbk_graphs_menu_xpm.t, xpm_nbk_graphs_menu);
M.o_xpm_about, (About_xpm.t, xpm_about);
- M.o_xpm_im, (Im_xpm.t, xpm_im);
M.o_xpm_settings, (Settings_xpm.t, xpm_settings);
M.o_xpm_exit, (Exit_xpm.t, xpm_exit);
M.o_xpm_gui, (Gui_xpm.t, xpm_gui);
Index: src/gtk/newgui/gui_window_base.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk/newgui/gui_window_base.ml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- src/gtk/newgui/gui_window_base.ml 2 Feb 2004 19:55:20 -0000 1.3
+++ src/gtk/newgui/gui_window_base.ml 27 Jun 2006 10:38:35 -0000 1.4
@@ -123,11 +123,6 @@
~icon: (Gui_options.pixmap
Gui_messages.o_xpm_about)#coerce
();
in
- let buttonIm = wtool1#insert_button
- ~tooltip:(Gui_messages.mW_ti_im)
- ~icon: (Gui_options.pixmap Gui_messages.o_xpm_im)#coerce
- ();
- in
let buttonOptions = wtool1#insert_button
~tooltip:(Gui_messages.mW_ti_settings)
~icon: (Gui_options.pixmap
Gui_messages.o_xpm_settings)#coerce
@@ -162,7 +157,6 @@
val box = box
val notebook = notebook
val buttonAbout = buttonAbout
- val buttonIm = buttonIm
val buttonOptions = buttonOptions
val buttonQuit = buttonQuit
val buttonGui = buttonGui
@@ -183,7 +177,6 @@
method notebook = notebook
method buttonAbout = buttonAbout
- method buttonIm = buttonIm
method buttonOptions = buttonOptions
method buttonQuit = buttonQuit
method buttonGui = buttonGui
Index: src/gtk2/gui/guiArt.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiArt.ml,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -b -r1.8 -r1.9
--- src/gtk2/gui/guiArt.ml 11 Jun 2006 17:37:38 -0000 1.8
+++ src/gtk2/gui/guiArt.ml 27 Jun 2006 10:38:36 -0000 1.9
@@ -77,7 +77,6 @@
M.icon_menu_uploads, (Menu_uploads_svg.t, from_icons_dir
M.icon_menu_uploads);
M.icon_menu_console, (Menu_console_svg.t, from_icons_dir
M.icon_menu_console);
M.icon_menu_graph, (Menu_graph_svg.t, from_icons_dir M.icon_menu_graph);
- M.icon_menu_im, (Menu_im_svg.t, from_icons_dir M.icon_menu_im);
M.icon_menu_settings, (Menu_settings_svg.t, from_icons_dir
M.icon_menu_settings);
M.icon_menu_quit, (Menu_quit_svg.t, from_icons_dir M.icon_menu_quit);
M.icon_menu_help, (Menu_help_svg.t, from_icons_dir M.icon_menu_help);
@@ -94,7 +93,6 @@
M.icon_menu_search_freedb, (Menu_search_freedb_svg.t, from_icons_dir
M.icon_menu_search_freedb);
M.icon_menu_search_imdb, (Menu_search_imdb_svg.t, from_icons_dir
M.icon_menu_search_imdb);
M.icon_menu_interfaces, (Menu_interfaces_svg.t, from_icons_dir
M.icon_menu_interfaces);
- M.icon_menu_mlchat, (Menu_mlchat_svg.t, from_icons_dir M.icon_menu_mlchat);
M.icon_menu_tools, (Menu_tools_svg.t, from_icons_dir M.icon_menu_tools);
M.icon_menu_others, (Menu_others_svg.t, from_icons_dir M.icon_menu_others);
Index: src/gtk2/gui/guiConfig.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiConfig.ml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- src/gtk2/gui/guiConfig.ml 19 Nov 2005 17:19:45 -0000 1.5
+++ src/gtk2/gui/guiConfig.ml 27 Jun 2006 10:38:36 -0000 1.6
@@ -97,7 +97,6 @@
| "HTML mods" -> Some Interfaces
| "MLgui" -> Some Interfaces
| "MLguiDebug" -> Some Interfaces
- | "MLChat" -> Some Mlchat
| "Other" -> Some Other
| "Paths" -> Some Tools
| "Startup" -> Some Tools
@@ -131,7 +130,6 @@
| "HTML mods" -> Some Html_mods
| "MLgui" -> Some Mlgui
| "MLguiDebug" -> Some Debug
- | "MLChat" -> None
| "Other" -> None
| "Paths" -> Some Paths
| "Startup" -> Some Startup
@@ -169,13 +167,11 @@
let peer_reg = Str.regexp_case_fold ".*peer.*"
let server_reg = Str.regexp_case_fold ".*server.*"
let mail_reg = Str.regexp_case_fold ".*smtp.*\\|mail"
-let mlchat_server_reg = Str.regexp_case_fold ".*app.*"
let tracker_reg = Str.regexp_case_fold ".*tracker.*"
let overnet_reg = Str.regexp_case_fold ".*overnet.*"
let shared_reg = Str.regexp_case_fold ".*shared.*"
let display_reg = Str.regexp_case_fold ".*vd.*\\|.*show.*\\|.*availability.*"
let look_reg = Str.regexp_case_fold
".*theme.*\\|.*style.*\\|.*checkbox.*\\|.*human_readable.*\\|html_mods"
-let mlchat_client_reg = Str.regexp_case_fold ".*addr.*\\|.*port.*"
let dc_client_reg = Str.regexp_case_fold
".*login.*\\|.*firewalled.*\\|.*client.*"
let dc_server_reg = Str.regexp_case_fold ".*hub.*\\|.*server*."
let ed2k_client_reg = Str.regexp_case_fold
".*md4.*\\|.*login.*\\|.*high_id.*\\|.*port.*\\|.*max_xs.*\\|.*max_udp.*"
@@ -217,9 +213,6 @@
[(Some gui_reg, Some Gui); (None, Some User)];
(Some Tools, Some Mail),
[(Some mail_reg, Some Mail_setup); (None, Some Others)];
- (Some Mlchat, None),
- [(Some mlchat_server_reg, Some Server); (Some mlchat_client_reg, Some
Client);
- (None, Some General_)];
(Some Bittorrent, None),
[(Some client_reg, Some Client); (Some tracker_reg, Some Tracker);
(None, Some Others)];
@@ -420,7 +413,6 @@
Some Main -> !M.cW_lb_main
| Some Interfaces -> !M.cW_lb_interfaces
| Some Tools -> !M.cW_lb_tools
- | Some Mlchat -> !M.cW_lb_mlchat
| Some Other -> !M.cW_lb_other
| Some Bittorrent -> !M.cW_lb_bittorrent
| Some Direct_connect -> !M.cW_lb_direct_connect
@@ -501,7 +493,6 @@
match section with
Some Main -> A.get_icon ~icon:M.icon_type_source_normal ~size:A.LARGE ()
| Some Interfaces -> A.get_icon ~icon:M.icon_menu_interfaces ~size:A.LARGE
()
- | Some Mlchat -> A.get_icon ~icon:M.icon_menu_mlchat ~size:A.LARGE ()
| Some Other -> A.get_icon ~icon:M.icon_menu_others ~size:A.LARGE ()
| Some Tools -> A.get_icon ~icon:M.icon_menu_tools ~size:A.LARGE ()
| Some Bittorrent -> A.get_icon ~icon:M.icon_net_bittorrent ~size:A.LARGE
()
Index: src/gtk2/gui/guiMain.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiMain.ml,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -b -r1.7 -r1.8
--- src/gtk2/gui/guiMain.ml 12 Nov 2005 11:16:36 -0000 1.7
+++ src/gtk2/gui/guiMain.ml 27 Jun 2006 10:38:36 -0000 1.8
@@ -540,11 +540,6 @@
kill_core#add_accelerator ~group:accel_menu
~modi:[`CONTROL] ~flags:[`VISIBLE] GdkKeysyms._k;
end;
- let im =
- GMenu.image_menu_item ~label:!M.mW_me_im ~use_mnemonic:true
- ~image:(GMisc.image ~pixbuf:(A.get_icon ~icon:M.icon_menu_im
~size:A.SMALL ()) ())
- ~packing:menu#add ()
- in
let settings =
GMenu.image_menu_item ~label:!M.mW_me_settings ~use_mnemonic:true
~image:(GMisc.image ~pixbuf:(A.get_icon ~icon:M.icon_menu_settings
~size:A.SMALL ()) ())
@@ -555,17 +550,12 @@
~image:(GMisc.image ~pixbuf:(A.get_icon ~icon:M.icon_menu_quit
~size:A.SMALL ()) ())
~packing:menu#add ()
in
- ignore (im#connect#activate
- (fun _ -> GuiWindow.display_im gui ()
- ));
ignore (settings#connect#activate
(fun _ -> GuiWindow.display_settings gui value_reader ()
));
ignore (quit#connect#activate
(fun _ -> on_quit ()
));
- im#add_accelerator ~group:accel_menu
- ~modi:[`CONTROL] ~flags:[`VISIBLE] GdkKeysyms._i;
settings#add_accelerator ~group:accel_menu
~modi:[`CONTROL] ~flags:[`VISIBLE] GdkKeysyms._o;
quit#add_accelerator ~group:accel_menu
@@ -628,11 +618,6 @@
~image:(GMisc.image ~pixbuf:(A.get_icon ~icon:M.icon_menu_interfaces
~size:A.SMALL ()) ())
~packing:menu#add ()
in
- let im =
- GMenu.image_menu_item ~label:!M.mW_me_im ~use_mnemonic:true
- ~image:(GMisc.image ~pixbuf:(A.get_icon ~icon:M.icon_menu_im
~size:A.SMALL ()) ())
- ~packing:menu#add ()
- in
let settings =
GMenu.image_menu_item ~label:!M.mW_me_settings ~use_mnemonic:true
~image:(GMisc.image ~pixbuf:(A.get_icon ~icon:M.icon_menu_settings
~size:A.SMALL ()) ())
@@ -648,9 +633,6 @@
gui.window#show ();
G.tray.destroy_tray ();
));
- ignore (im#connect#activate
- (fun _ -> GuiWindow.display_im gui ()
- ));
ignore (settings#connect#activate
(fun _ -> GuiWindow.display_settings gui value_reader ()
));
Index: src/gtk2/gui/guiMessages.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiMessages.ml,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -b -r1.10 -r1.11
--- src/gtk2/gui/guiMessages.ml 27 Nov 2005 14:04:33 -0000 1.10
+++ src/gtk2/gui/guiMessages.ml 27 Jun 2006 10:38:36 -0000 1.11
@@ -434,7 +434,6 @@
let mW_lb_uploads = ref ""
let mW_lb_console = ref ""
let mW_lb_graph = ref ""
-let mW_lb_im = ref ""
let mW_lb_settings = ref ""
let mW_lb_initializing = ref ""
let mW_lb_warning = ref ""
@@ -446,7 +445,6 @@
let mW_me_reconnect_to = ref ""
let mW_me_settings = ref ""
let mW_me_main_menu = ref ""
-let mW_me_im = ref ""
let mW_me_restore = ref ""
(* Settings Window *)
@@ -454,7 +452,6 @@
let cW_lb_main = ref ""
let cW_lb_interfaces = ref ""
let cW_lb_tools = ref ""
-let cW_lb_mlchat = ref ""
let cW_lb_other = ref ""
let cW_lb_bittorrent = ref ""
let cW_lb_direct_connect = ref ""
@@ -904,7 +901,6 @@
mW_lb_uploads := _s "_Uploads";
mW_lb_console := _s "_Console";
mW_lb_graph := _s "_Graph";
- mW_lb_im := _s "_Im";
mW_lb_settings := _s "Se_ttings";
mW_lb_initializing := _s "Initializing";
mW_lb_warning := _s "Warning!";
@@ -916,7 +912,6 @@
mW_me_reconnect_to := _s "Reconnect t_o";
mW_me_settings := !mW_lb_settings;
mW_me_main_menu := _s "Main me_nu";
- mW_me_im := _s "_Im";
mW_me_restore := _s "R_estore";
(* Settings Window *)
@@ -924,7 +919,6 @@
cW_lb_main := _s "_Main";
cW_lb_interfaces := _s "_Interfaces";
cW_lb_tools := _s "_Tools";
- cW_lb_mlchat := _s "M_Lchat";
cW_lb_other := _s "_Others";
cW_lb_bittorrent := _s "_BitTorrent";
cW_lb_direct_connect := _s "Di_rect Connect";
@@ -1111,7 +1105,6 @@
let icon_menu_uploads = "menu_uploads"
let icon_menu_console = "menu_console"
let icon_menu_graph = "menu_graph"
-let icon_menu_im = "menu_im"
let icon_menu_settings = "menu_settings"
let icon_menu_quit = "menu_quit"
let icon_menu_help = "menu_help"
@@ -1128,7 +1121,6 @@
let icon_menu_search_freedb = "menu_search_freedb"
let icon_menu_search_imdb = "menu_search_imdb"
let icon_menu_interfaces = "menu_interfaces"
-let icon_menu_mlchat = "menu_mlchat"
let icon_menu_tools = "menu_tools"
let icon_menu_others = "menu_others"
let icon_net_bittorrent = "net_bittorrent"
Index: src/gtk2/gui/guiNetworks.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiNetworks.ml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- src/gtk2/gui/guiNetworks.ml 31 Oct 2005 18:34:02 -0000 1.2
+++ src/gtk2/gui/guiNetworks.ml 27 Jun 2006 10:38:36 -0000 1.3
@@ -169,7 +169,6 @@
NetworkHasRooms, M.icon_menu_rooms;
NetworkHasMultinet, M.icon_net_globalshare;
NetworkHasSearch, M.icon_menu_searches;
- NetworkHasChat, M.icon_menu_mlchat;
NetworkHasSupernodes, M.icon_net_supernode;
NetworkHasUpload, M.icon_menu_uploads;
]
Index: src/gtk2/gui/guiTypes2.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiTypes2.ml,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -b -r1.9 -r1.10
--- src/gtk2/gui/guiTypes2.ml 11 Jun 2006 17:37:38 -0000 1.9
+++ src/gtk2/gui/guiTypes2.ml 27 Jun 2006 10:38:36 -0000 1.10
@@ -90,7 +90,6 @@
Main
| Interfaces
| Tools
-| Mlchat
| Other
| Bittorrent
| Direct_connect
Index: src/gtk2/gui/guiWindow.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiWindow.ml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- src/gtk2/gui/guiWindow.ml 31 Oct 2005 18:34:02 -0000 1.3
+++ src/gtk2/gui/guiWindow.ml 27 Jun 2006 10:38:36 -0000 1.4
@@ -152,15 +152,6 @@
(*************************************************************************)
(* *)
-(* display_im *)
-(* *)
-(*************************************************************************)
-
-let display_im gui () =
- GuiIm.main_window ()
-
-(*************************************************************************)
-(* *)
(* display_settings *)
(* *)
(*************************************************************************)
Index: src/networks/donkey/donkeyInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyInteractive.ml,v
retrieving revision 1.109
retrieving revision 1.110
diff -u -b -r1.109 -r1.110
--- src/networks/donkey/donkeyInteractive.ml 11 Jun 2006 17:37:39 -0000
1.109
+++ src/networks/donkey/donkeyInteractive.ml 27 Jun 2006 10:38:37 -0000
1.110
@@ -997,9 +997,7 @@
| Connection sock ->
client_send c (DonkeyProtoClient.SayReq s)
with
- Not_found ->
- CommonChat.send_text !!CommonOptions.chat_console_id None
- (Printf.sprintf "client %s unknown" iddest)
+ Not_found -> ()
);
network.op_network_download <- (fun r ->
result_download r r.result_names r.result_force
Index: icons/rsvg/menu_im.svg
===================================================================
RCS file: icons/rsvg/menu_im.svg
diff -N icons/rsvg/menu_im.svg
--- icons/rsvg/menu_im.svg 20 Mar 2005 01:26:55 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,220 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 20010904//EN"
-"http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd";>
-<!-- Created with Sodipodi ("http://www.sodipodi.com/";) -->
-<svg
- xmlns:x="http://ns.adobe.com/Extensibility/1.0/";
- xmlns:i="http://ns.adobe.com/AdobeIllustrator/10.0/";
- xmlns:graph="http://ns.adobe.com/Graphs/1.0/";
- xmlns="http://www.w3.org/2000/svg";
- xmlns:xlink="http://www.w3.org/1999/xlink";
- xmlns:a="http://ns.adobe.com/AdobeSVGViewerExtensions/3.0/";
- xml:space="preserve"
- i:viewOrigin="281.5 420.5"
- i:rulerOrigin="0 0"
- i:pageBounds="0 792 612 0"
- width="48"
- height="48"
- viewBox="0 0 48 48"
- overflow="visible"
- enable-background="new 0 0 48 48"
- xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd";
- id="svg602"
- sodipodi:version="0.34"
-
sodipodi:docname="C:\msys\home\su_blanc\mldonkey-2.5.12\src\gtk2\rsvg\menu_im.svg"><defs
- id="defs663" /><sodipodi:namedview
- id="base" /><g
- id="Layer_3"
- i:knockout="Off"
- i:layer="yes"
- i:dimmedPercent="50"
- i:rgbTrio="#4F00FFFF4F00"><rect
- id="path550"
- i:knockout="Off"
- fill="none"
- width="48"
- height="48" /><path
- id="path553"
- fill="#8D0000"
- d="M3.4,34.6c0,0,4.8-2.5,7.9-9.3l8.3,3.6C19.6,28.8,17.4,34.6,3.4,34.6z"
/><ellipse
- id="path554"
- fill="#8D0000"
- cx="20.8"
- cy="18.6"
- rx="20.1"
- ry="14.3" /><linearGradient
- id="path567_1_"
- gradientUnits="userSpaceOnUse"
- x1="-260.6499"
- y1="415.75"
- x2="-260.6499"
- y2="380.5"
- gradientTransform="matrix(1 0 0 -1 281.5 420.5)"><stop
- offset="0"
- style="stop-color:#FFFF00"
- id="stop610" /><stop
- offset="0.6539"
- style="stop-color:#FF9C00"
- id="stop611" /><stop
- offset="1"
- style="stop-color:#FF6D00"
- id="stop612" /><a:midPointStop
- offset="0"
- style="stop-color:#FFFF00"
- id="midPointStop613" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFF00"
- id="midPointStop614" /><a:midPointStop
- offset="0.6539"
- style="stop-color:#FF9C00"
- id="midPointStop615" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FF9C00"
- id="midPointStop616" /><a:midPointStop
- offset="1"
- style="stop-color:#FF6D00"
- id="midPointStop617" /></linearGradient><path
- id="path567"
- fill="url(#path567_1_)"
- d="M20.8,5.1c-10.6,0-19.3,6.1-19.3,13.5c0,4.5,3.2,8.6,8.2,11
C8.4,31.4,7,32.8,6,33.7c4.5-0.3,7.5-1.2,9.4-2.1c1.7,0.4,3.6,0.6,5.5,0.6c10.6,0,19.3-6.1,19.3-13.5
C40.1,11.2,31.4,5.1,20.8,5.1z" /><linearGradient
- id="path574_1_"
- gradientUnits="userSpaceOnUse"
- x1="-790.9678"
- y1="403.0313"
- x2="-790.9678"
- y2="362.8643"
- gradientTransform="matrix(0.4688 0 0 -0.4688 391.3557 191.6404)"><stop
- offset="0"
- style="stop-color:#FFFFFF"
- id="stop620" /><stop
- offset="1"
- style="stop-color:#FFD400"
- id="stop621" /><a:midPointStop
- offset="0"
- style="stop-color:#FFFFFF"
- id="midPointStop622" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFFFF"
- id="midPointStop623" /><a:midPointStop
- offset="1"
- style="stop-color:#FFD400"
- id="midPointStop624" /></linearGradient><path
- id="path574"
- fill="url(#path574_1_)"
- d="M4.9,13.2c6.4,3.6,13.7,4.5,21.1,2.5c1.5-0.4,3.1-0.9,4.6-1.4
c1.8-0.6,3.7-1.2,5.6-1.7c-3-3.9-8.9-6.3-15.4-6.3C13.9,6.3,7.6,9,4.9,13.2z"
/><path
- id="path575"
- fill="#A43200"
-
d="M15.9,30.8c0,6.3,6.9,11.4,15.5,11.4c1.2,0,2.4-0.1,3.6-0.3c1.8,0.8,4.1,1.3,6.8,1.5
l5.5,0.3l-4.2-3.5c-0.3-0.2-0.7-0.6-1.1-1c3.1-2.1,4.9-5.1,4.9-8.2c0-6.3-6.9-11.4-15.5-11.4C22.8,19.5,15.9,24.6,15.9,30.8z"
/><linearGradient
- id="path588_1_"
- gradientUnits="userSpaceOnUse"
- x1="-768.0366"
- y1="313.3711"
- x2="-768.0366"
- y2="375.2255"
- gradientTransform="matrix(0.4688 0 0 -0.4688 391.3557 191.6404)"><stop
- offset="0"
- style="stop-color:#FF6D00"
- id="stop628" /><stop
- offset="6.085050e-002"
- style="stop-color:#FF8100"
- id="stop629" /><stop
- offset="0.1979"
- style="stop-color:#FFA700"
- id="stop630" /><stop
- offset="0.3404"
- style="stop-color:#FFC700"
- id="stop631" /><stop
- offset="0.4874"
- style="stop-color:#FFE000"
- id="stop632" /><stop
- offset="0.6411"
- style="stop-color:#FFF100"
- id="stop633" /><stop
- offset="0.8057"
- style="stop-color:#FFFC00"
- id="stop634" /><stop
- offset="1"
- style="stop-color:#FFFF00"
- id="stop635" /><a:midPointStop
- offset="0"
- style="stop-color:#FF6D00"
- id="midPointStop636" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FF6D00"
- id="midPointStop637" /><a:midPointStop
- offset="6.085050e-002"
- style="stop-color:#FF8100"
- id="midPointStop638" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FF8100"
- id="midPointStop639" /><a:midPointStop
- offset="0.1979"
- style="stop-color:#FFA700"
- id="midPointStop640" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFA700"
- id="midPointStop641" /><a:midPointStop
- offset="0.3404"
- style="stop-color:#FFC700"
- id="midPointStop642" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFC700"
- id="midPointStop643" /><a:midPointStop
- offset="0.4874"
- style="stop-color:#FFE000"
- id="midPointStop644" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFE000"
- id="midPointStop645" /><a:midPointStop
- offset="0.6411"
- style="stop-color:#FFF100"
- id="midPointStop646" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFF100"
- id="midPointStop647" /><a:midPointStop
- offset="0.8057"
- style="stop-color:#FFFC00"
- id="midPointStop648" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFC00"
- id="midPointStop649" /><a:midPointStop
- offset="1"
- style="stop-color:#FFFF00"
- id="midPointStop650" /></linearGradient><path
- id="path588"
- fill="url(#path588_1_)"
-
d="M16.8,30.8c0,5.8,6.5,10.5,14.6,10.5c1.3,0,2.5-0.1,3.7-0.4c1.8,0.8,4,1.3,6.7,1.5
l2.7,0.2l-2.1-1.8c-0.5-0.4-1.2-1-1.9-1.9c3.3-2,5.3-4.9,5.3-8.1c0-5.8-6.5-10.5-14.6-10.5C23.3,20.4,16.8,25.1,16.8,30.8z"
/><linearGradient
- id="path595_1_"
- gradientUnits="userSpaceOnUse"
- x1="-574.3643"
- y1="366.2373"
- x2="-574.3643"
- y2="343.2821"
- gradientTransform="matrix(-0.4688 0 0 -0.4688 -237.7619 191.6404)"><stop
- offset="0"
- style="stop-color:#FFFFFF"
- id="stop653" /><stop
- offset="1"
- style="stop-color:#FFED00"
- id="stop654" /><a:midPointStop
- offset="0"
- style="stop-color:#FFFFFF"
- id="midPointStop655" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFFFF"
- id="midPointStop656" /><a:midPointStop
- offset="1"
- style="stop-color:#FFED00"
- id="midPointStop657" /></linearGradient><path
- id="path595"
- fill="url(#path595_1_)"
- d="M31.4,21.6c5.5,0,10.2,1.9,12,4.6c-4.8,2.3-10.3,2.9-15.8,1.7
c-2.7-0.6-5.3-1.5-8-2C21.5,23.3,26.1,21.6,31.4,21.6z" /><path
- id="path597"
- fill="#FFFFFF"
- d="M25.1,33.8c-0.8,0-1.4-0.6-1.4-1.5c0-0.9,0.6-1.5,1.4-1.5s1.4,0.6,1.4,1.5
C26.5,33.2,26,33.8,25.1,33.8L25.1,33.8L25.1,33.8z" /><path
- id="path598"
- fill="#FFFFFF"
-
d="M32.4,33.8c-0.8,0-1.4-0.6-1.4-1.5c0-0.9,0.6-1.5,1.4-1.5c0.8,0,1.4,0.6,1.4,1.5
C33.9,33.2,33.3,33.8,32.4,33.8L32.4,33.8L32.4,33.8z" /><path
- id="path599"
- fill="#FFFFFF"
- d="M39.7,33.8c-0.8,0-1.4-0.6-1.4-1.5c0-0.9,0.6-1.5,1.4-1.5s1.4,0.6,1.4,1.5
C41.2,33.2,40.6,33.8,39.7,33.8L39.7,33.8L39.7,33.8z" /></g></svg>
Index: icons/rsvg/menu_mlchat.svg
===================================================================
RCS file: icons/rsvg/menu_mlchat.svg
diff -N icons/rsvg/menu_mlchat.svg
--- icons/rsvg/menu_mlchat.svg 20 Mar 2005 01:26:55 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,428 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 20010904//EN"
-"http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd";>
-<!-- Created with Sodipodi ("http://www.sodipodi.com/";) -->
-<svg
- xmlns:x="http://ns.adobe.com/Extensibility/1.0/";
- xmlns:i="http://ns.adobe.com/AdobeIllustrator/10.0/";
- xmlns:graph="http://ns.adobe.com/Graphs/1.0/";
- xmlns="http://www.w3.org/2000/svg";
- xmlns:xlink="http://www.w3.org/1999/xlink";
- xmlns:a="http://ns.adobe.com/AdobeSVGViewerExtensions/3.0/";
- xml:space="preserve"
- i:viewOrigin="282.5 419.4995"
- i:rulerOrigin="0 0"
- i:pageBounds="0 792 612 0"
- width="48"
- height="48"
- viewBox="0 0 48 48"
- overflow="visible"
- enable-background="new 0 0 48 48"
- xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd";
- id="svg602"
- sodipodi:version="0.34"
-
sodipodi:docname="C:\msys\home\su_blanc\mldonkey-2.5.12\src\gtk2\rsvg\menu_mlchat.svg"><defs
- id="defs727" /><sodipodi:namedview
- id="base" /><g
- id="Layer_1_2_"
- i:knockout="Off"
- i:layer="yes"
- i:dimmedPercent="50"
- i:rgbTrio="#4F008000FFFF"><polygon
- fill="#FFFFFF"
- points="40.6,32.5 34.4,35.6 35.3,37.8 41.9,34.5 "
- id="polygon605" /><g
- i:knockout="Off"
- id="g606"><linearGradient
- id="XMLID_9_"
- gradientUnits="userSpaceOnUse"
- x1="-212.4727"
- y1="353.1108"
- x2="-252.6512"
- y2="387.9236"
- gradientTransform="matrix(1 0 0 -1 245.1592 380.5811)"><stop
- offset="0"
- style="stop-color:#0032A4"
- id="stop608" /><stop
- offset="1"
- style="stop-color:#3995E5"
- id="stop609" /><a:midPointStop
- offset="0"
- style="stop-color:#0032A4"
- id="midPointStop610" /><a:midPointStop
- offset="0.5"
- style="stop-color:#0032A4"
- id="midPointStop611" /><a:midPointStop
- offset="1"
- style="stop-color:#3995E5"
- id="midPointStop612" /></linearGradient><path
- fill="url(#XMLID_9_)"
-
d="M24,0C10.8,0,0,7.1,0,15.8C0,22,5.4,27.6,13.8,30.2c-0.5,1.1-3.2,7.8-3.2,7.8c0,0.1,0,0.2,0,0.2
c0,0.2,0.1,0.4,0.2,0.5c0.2,0.2,0.5,0.2,0.8,0.1c0,0,11.7-6.9,12-7.1c0.2,0,0.4,0,0.4,0c13.2,0,24-7.1,24-15.8
C48,7.1,37.2,0,24,0z
M24,30.7c-0.2,0-0.4,0-0.5,0l-11.8,7l3.4-8.2C7,27.2,1.3,22,1.3,16C1.3,7.8,11.5,1.2,24,1.2
c12.5,0,22.7,6.6,22.7,14.8C46.7,24.1,36.5,30.7,24,30.7z"
- id="path613" /><radialGradient
- id="XMLID_10_"
- cx="-733.9282"
- cy="332.0093"
- r="152.4193"
- fx="-733.9282"
- fy="332.0093"
- gradientTransform="matrix(0.3913 0 0 -0.3814 309.7274 160.0153)"
- gradientUnits="userSpaceOnUse"><stop
- offset="5.600000e-003"
- style="stop-color:#FFFFFF"
- id="stop615" /><stop
- offset="0.4438"
- style="stop-color:#A9E6FF"
- id="stop616" /><stop
- offset="1"
- style="stop-color:#034CFE"
- id="stop617" /><a:midPointStop
- offset="5.600000e-003"
- style="stop-color:#FFFFFF"
- id="midPointStop618" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFFFF"
- id="midPointStop619" /><a:midPointStop
- offset="0.4438"
- style="stop-color:#A9E6FF"
- id="midPointStop620" /><a:midPointStop
- offset="0.5"
- style="stop-color:#A9E6FF"
- id="midPointStop621" /><a:midPointStop
- offset="1"
- style="stop-color:#034CFE"
- id="midPointStop622" /></radialGradient><path
- fill="url(#XMLID_10_)"
-
d="M24,0.9c-12.7,0-23,6.7-23,15c0,6.2,5.7,11.5,13.9,13.8L11.5,38l12-7.1c0.2,0,0.4,0,0.6,0
c12.7,0,23-6.7,23-15C47,7.6,36.7,0.9,24,0.9z"
- id="path623" /><radialGradient
- id="XMLID_11_"
- cx="-733.7383"
- cy="338.0591"
- r="144.2432"
- fx="-733.7383"
- fy="338.0591"
- gradientTransform="matrix(0.3913 0 0 -0.3814 309.7274 160.0153)"
- gradientUnits="userSpaceOnUse"><stop
- offset="5.600000e-003"
- style="stop-color:#FFFFFF"
- id="stop625" /><stop
- offset="0.2584"
- style="stop-color:#A9E6FF"
- id="stop626" /><stop
- offset="1"
- style="stop-color:#034CFE"
- id="stop627" /><a:midPointStop
- offset="5.600000e-003"
- style="stop-color:#FFFFFF"
- id="midPointStop628" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFFFF"
- id="midPointStop629" /><a:midPointStop
- offset="0.2584"
- style="stop-color:#A9E6FF"
- id="midPointStop630" /><a:midPointStop
- offset="0.5"
- style="stop-color:#A9E6FF"
- id="midPointStop631" /><a:midPointStop
- offset="1"
- style="stop-color:#034CFE"
- id="midPointStop632" /></radialGradient><path
- fill="url(#XMLID_11_)"
-
d="M24,2.1C12,2.1,2.2,8.3,2.2,15.9c0,5.5,5.1,10.4,13,12.6c0.3,0.1,0.6,0.3,0.7,0.6
c0.1,0.2,0.1,0.3,0.1,0.5c0,0.1,0,0.3-0.1,0.4c0,0-1.1,2.7-2.1,5.1c3.4-2,8.9-5.3,8.9-5.3c0.2-0.1,0.4-0.2,0.6-0.2l0.5,0
c12,0,21.8-6.2,21.8-13.8S36,2.1,24,2.1z"
- id="path633" /><linearGradient
- id="XMLID_12_"
- gradientUnits="userSpaceOnUse"
- x1="-307.5845"
- y1="378.5103"
- x2="-307.5845"
- y2="358.8861"
- gradientTransform="matrix(1 0 0 -1 330.7627 380.5811)"><stop
- offset="5.747130e-002"
- style="stop-color:#FFFFFF"
- id="stop635" /><stop
- offset="1"
- style="stop-color:#FFFFFF"
- id="stop636" /><a:midPointStop
- offset="5.747130e-002"
- style="stop-color:#FFFFFF"
- id="midPointStop637" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFFFF"
- id="midPointStop638" /><a:midPointStop
- offset="1"
- style="stop-color:#FFFFFF"
- id="midPointStop639" /></linearGradient><path
- i:isolated="yes"
- i:knockout="Off"
- fill="url(#XMLID_12_)"
- a:adobe-blending-mode="screen"
- enable-background="new "
- d="
M24.9,17.2c7.6-4.1,14.8-6,19.2-6.8c-3.2-5.2-11-8.9-20.1-8.9C12,1.6,2.3,7.9,2.3,15.6c0,2.1,0.7,4.1,1.9,5.8
C8.7,21.9,16.7,21.7,24.9,17.2z"
- id="path640" /></g><g
- i:knockout="Off"
- id="g641"><linearGradient
- id="XMLID_13_"
- gradientUnits="userSpaceOnUse"
- x1="-205.1274"
- y1="359.146"
- x2="-205.4577"
- y2="325.0212"
- gradientTransform="matrix(0.9999 -1.380000e-002 -1.380000e-002 -0.9999
241.558 384.1864)"><stop
- offset="0"
- style="stop-color:#FFA700"
- id="stop643" /><stop
- offset="0.691"
- style="stop-color:#FFFF00"
- id="stop644" /><stop
- offset="0.792"
- style="stop-color:#FFFC00"
- id="stop645" /><stop
- offset="0.8546"
- style="stop-color:#FFF400"
- id="stop646" /><stop
- offset="0.9067"
- style="stop-color:#FFE500"
- id="stop647" /><stop
- offset="0.953"
- style="stop-color:#FFD100"
- id="stop648" /><stop
- offset="0.9952"
- style="stop-color:#FFB700"
- id="stop649" /><stop
- offset="1"
- style="stop-color:#FFB300"
- id="stop650" /><a:midPointStop
- offset="0"
- style="stop-color:#FFA700"
- id="midPointStop651" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFA700"
- id="midPointStop652" /><a:midPointStop
- offset="0.691"
- style="stop-color:#FFFF00"
- id="midPointStop653" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFF00"
- id="midPointStop654" /><a:midPointStop
- offset="0.792"
- style="stop-color:#FFFC00"
- id="midPointStop655" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFC00"
- id="midPointStop656" /><a:midPointStop
- offset="0.8546"
- style="stop-color:#FFF400"
- id="midPointStop657" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFF400"
- id="midPointStop658" /><a:midPointStop
- offset="0.9067"
- style="stop-color:#FFE500"
- id="midPointStop659" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFE500"
- id="midPointStop660" /><a:midPointStop
- offset="0.953"
- style="stop-color:#FFD100"
- id="midPointStop661" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFD100"
- id="midPointStop662" /><a:midPointStop
- offset="0.9952"
- style="stop-color:#FFB700"
- id="midPointStop663" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFB700"
- id="midPointStop664" /><a:midPointStop
- offset="1"
- style="stop-color:#FFB300"
- id="midPointStop665" /></linearGradient><path
- fill="url(#XMLID_13_)"
-
d="M39.9,36.5c-1.5-1.4-4.5-3.1-4.5-3.1c0.1,0,2.9-0.1,4.3-0.3c2.1-0.3,4.4-1.7,4.4-1.7L42.3,26
c0,0-3.5,1-5.7,1.2c-0.9,0.1-2.2-1-2.9-1.7c-1.1-1.2-2.6-1.3-3.9-0.2c-0.6,0.5-2.4,2.6-2.9,5c-0.2,0.9-0.3,1.9-0.3,2.8
c0,1.2,0.2,2.2,0.3,2.7c-0.5,0.7-2.1,2.5-3.9,3.6c-1.2,0.7-5.2,1.7-5.2,1.7l3.1,6.2c0,0,3.4-0.6,6.3-2.7c1.2-0.9,3-2.4,5.4-4.9
c0.6,0.2,2,1.1,3.5,2.5c1.5,1.5,3.5,4.4,3.5,4.4c0,0,5.8-3.5,5.8-3.5S42.7,39.2,39.9,36.5z"
- id="path666" /><path
-
d="M29.3,24.7c-0.6,0.5-2.6,2.8-3.2,5.4c-0.2,0.9-0.3,1.9-0.3,3c0,1,0.1,1.9,0.2,2.5c-0.6,0.7-2,2.3-3.5,3.1
c-0.9,0.6-3.9,1.3-5,1.6c-0.2,0.1-0.4,0.2-0.5,0.4c0,0.1-0.1,0.2-0.1,0.3c0,0.1,0,0.2,0.1,0.3l3.1,6.2c0.1,0.3,0.5,0.5,0.8,0.4
c0.1,0,3.7-0.7,6.6-2.8c1.1-0.8,2.9-2.3,5.1-4.5c0.6,0.3,1.7,1,2.8,2.1c1.5,1.4,3.4,4.3,3.4,4.3c0.2,0.3,0.5,0.4,0.9,0.3
c0.1,0,0.1,0,5.9-3.6c0.2-0.1,0.3-0.3,0.3-0.5c0-0.1,0-0.1,0-0.2c0-0.1,0-0.3-0.1-0.4c-0.1-0.2-2.7-4-5.5-6.7
c-0.7-0.7-1.7-1.4-2.6-2c0.7,0,1.4-0.1,1.9-0.2c2.3-0.3,4.6-1.7,4.7-1.8c0.2-0.1,0.4-0.4,0.3-0.6c0-0.1,0-0.1,0-0.2L43,25.8
c-0.1-0.4-0.5-0.6-0.9-0.5c0,0-3.5,1-5.6,1.2c-0.4,0-1.5-0.7-2.2-1.5C32.9,23.6,30.9,23.4,29.3,24.7z
M23.4,40
c1.8-1.1,3.4-3,4.1-3.7c0.1-0.1,0.2-0.3,0.2-0.5c0,0,0-0.1,0-0.1c-0.1-0.5-0.2-1.5-0.3-2.6c0-1,0.1-1.8,0.2-2.6
c0.5-2.3,2.2-4.3,2.7-4.6c1-0.8,2-0.7,2.9,0.2c0.1,0.1,1.9,2.1,3.5,2c1.7-0.1,4-0.7,5.2-1c0.3,0.9,1.1,3.4,1.3,4.2
c-0.7,0.4-2.2,1.1-3.6,1.3c-1.3,0.2-3.9,0.3-4.2,0.3c-0.3,0-0.6,0.2-0.7,0.6c0,0.1,0,0.1,0,0.2c0,0.3,0.1,0.5,0.4,0.6
c0.1,0.1,3,1.6,4.4,3c2,2,4,4.6,4.8,5.8c-1.6,1-3.5,2.2-4.5,2.8c-0.7-0.9-2.1-2.8-3.2-3.9c-1.5-1.5-3-2.3-3.7-2.6
c-0.3-0.1-0.6-0.1-0.8,0.2c-2.3,2.4-4.1,3.9-5.3,4.8c-2,1.5-4.4,2.2-5.4,2.4c-0.4-0.7-1.9-3.8-2.4-4.9
C20.2,41.2,22.5,40.6,23.4,40z"
- id="path667" /><linearGradient
- id="XMLID_14_"
- gradientUnits="userSpaceOnUse"
- x1="-205.2573"
- y1="361.7974"
- x2="-205.2573"
- y2="343.3758"
- gradientTransform="matrix(0.9999 -1.380000e-002 -1.380000e-002 -0.9999
241.558 384.1864)"><stop
- offset="5.600000e-003"
- style="stop-color:#FFFFFF"
- id="stop669" /><stop
- offset="0.1471"
- style="stop-color:#FFFAE1"
- id="stop670" /><stop
- offset="0.4562"
- style="stop-color:#FFEE94"
- id="stop671" /><stop
- offset="0.9069"
- style="stop-color:#FFDB1A"
- id="stop672" /><stop
- offset="1"
- style="stop-color:#FFD700"
- id="stop673" /><a:midPointStop
- offset="5.600000e-003"
- style="stop-color:#FFFFFF"
- id="midPointStop674" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFFFF"
- id="midPointStop675" /><a:midPointStop
- offset="0.1471"
- style="stop-color:#FFFAE1"
- id="midPointStop676" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFAE1"
- id="midPointStop677" /><a:midPointStop
- offset="0.4562"
- style="stop-color:#FFEE94"
- id="midPointStop678" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFEE94"
- id="midPointStop679" /><a:midPointStop
- offset="0.9069"
- style="stop-color:#FFDB1A"
- id="midPointStop680" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFDB1A"
- id="midPointStop681" /><a:midPointStop
- offset="1"
- style="stop-color:#FFD700"
- id="midPointStop682" /></linearGradient><path
- fill="url(#XMLID_14_)"
-
d="M34.6,34.7c-0.5-0.3-0.8-0.8-0.8-1.3c0-0.1,0-0.3,0-0.4c0.2-0.7,0.8-1.2,1.5-1.2
c0.3,0,2.8-0.1,4.1-0.3c1-0.1,2-0.6,2.7-0.9c-0.3-1-0.5-1.7-0.9-2.8c-1.3,0.3-3.1,0.7-4.6,0.9c-1.9,0.1-3.8-1.8-4.2-2.2
c-0.6-0.7-1.3-0.4-1.7-0.1c-0.4,0.3-2,2.2-2.4,4.2c-0.2,0.7-0.2,1.5-0.2,2.4c0,1.1,0.2,2,0.2,2.5c0,0.1,0,0.2,0,0.3
c0,0.4-0.1,0.7-0.3,1c-0.6,0.8-2.4,2.8-4.3,3.9c-0.8,0.5-2.4,1-3.8,1.4c0.7,1.3,1.2,2.4,1.7,3.4c1.1-0.3,2.9-1,4.4-2.1
c1.1-0.8,2.9-2.3,5.2-4.7c0.5-0.5,1.2-0.6,1.8-0.4c0.7,0.3,2.3,1.2,4,2.8c1,0.9,2.1,2.4,2.9,3.4c0.8-0.5,2-1.2,3.1-1.9
c-1-1.3-2.6-3.4-4.2-5C37.8,36.5,35.6,35.2,34.6,34.7z"
- id="path683" /><linearGradient
- id="XMLID_15_"
- gradientUnits="userSpaceOnUse"
- x1="-201.3325"
- y1="371.9438"
- x2="-201.3325"
- y2="361.9052"
- gradientTransform="matrix(0.9999 -1.380000e-002 -1.380000e-002 -0.9999
241.558 384.1864)"><stop
- offset="0"
- style="stop-color:#FFA700"
- id="stop685" /><stop
- offset="0.691"
- style="stop-color:#FFFF00"
- id="stop686" /><stop
- offset="0.792"
- style="stop-color:#FFFC00"
- id="stop687" /><stop
- offset="0.8546"
- style="stop-color:#FFF400"
- id="stop688" /><stop
- offset="0.9067"
- style="stop-color:#FFE500"
- id="stop689" /><stop
- offset="0.953"
- style="stop-color:#FFD100"
- id="stop690" /><stop
- offset="0.9952"
- style="stop-color:#FFB700"
- id="stop691" /><stop
- offset="1"
- style="stop-color:#FFB300"
- id="stop692" /><a:midPointStop
- offset="0"
- style="stop-color:#FFA700"
- id="midPointStop693" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFA700"
- id="midPointStop694" /><a:midPointStop
- offset="0.691"
- style="stop-color:#FFFF00"
- id="midPointStop695" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFF00"
- id="midPointStop696" /><a:midPointStop
- offset="0.792"
- style="stop-color:#FFFC00"
- id="midPointStop697" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFC00"
- id="midPointStop698" /><a:midPointStop
- offset="0.8546"
- style="stop-color:#FFF400"
- id="midPointStop699" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFF400"
- id="midPointStop700" /><a:midPointStop
- offset="0.9067"
- style="stop-color:#FFE500"
- id="midPointStop701" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFE500"
- id="midPointStop702" /><a:midPointStop
- offset="0.953"
- style="stop-color:#FFD100"
- id="midPointStop703" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFD100"
- id="midPointStop704" /><a:midPointStop
- offset="0.9952"
- style="stop-color:#FFB700"
- id="midPointStop705" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFB700"
- id="midPointStop706" /><a:midPointStop
- offset="1"
- style="stop-color:#FFB300"
- id="midPointStop707" /></linearGradient><path
- fill="url(#XMLID_15_)"
-
d="M35.1,12c-3.2,0-5.8,2.6-5.8,5.8c0,3.1,2.7,5.7,5.9,5.6c3.2,0,5.8-2.6,5.8-5.8
C41,14.5,38.3,11.9,35.1,12z"
- id="path708" /><path
-
d="M28.6,17.8c0,3.5,3,6.4,6.7,6.3c3.6,0,6.6-3,6.5-6.5c-0.1-3.5-3-6.4-6.7-6.3C31.4,11.3,28.5,14.2,28.6,17.8z
M30,17.8
c0-2.7,2.2-5,5-5c2.8,0,5.1,2.2,5.2,4.9c0,2.7-2.2,5-5,5.1C32.4,22.7,30.1,20.5,30,17.8z"
- id="path709" /><linearGradient
- id="XMLID_16_"
- gradientUnits="userSpaceOnUse"
- x1="-201.3677"
- y1="373.7534"
- x2="-201.3677"
- y2="368.4451"
- gradientTransform="matrix(0.9999 -1.380000e-002 -1.380000e-002 -0.9999
241.558 384.1864)"><stop
- offset="5.600000e-003"
- style="stop-color:#FFFFFF"
- id="stop711" /><stop
- offset="0.1471"
- style="stop-color:#FFFAE1"
- id="stop712" /><stop
- offset="0.4562"
- style="stop-color:#FFEE94"
- id="stop713" /><stop
- offset="0.9069"
- style="stop-color:#FFDB1A"
- id="stop714" /><stop
- offset="1"
- style="stop-color:#FFD700"
- id="stop715" /><a:midPointStop
- offset="5.600000e-003"
- style="stop-color:#FFFFFF"
- id="midPointStop716" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFFFF"
- id="midPointStop717" /><a:midPointStop
- offset="0.1471"
- style="stop-color:#FFFAE1"
- id="midPointStop718" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFFAE1"
- id="midPointStop719" /><a:midPointStop
- offset="0.4562"
- style="stop-color:#FFEE94"
- id="midPointStop720" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFEE94"
- id="midPointStop721" /><a:midPointStop
- offset="0.9069"
- style="stop-color:#FFDB1A"
- id="midPointStop722" /><a:midPointStop
- offset="0.5"
- style="stop-color:#FFDB1A"
- id="midPointStop723" /><a:midPointStop
- offset="1"
- style="stop-color:#FFD700"
- id="midPointStop724" /></linearGradient><path
- fill="url(#XMLID_16_)"
-
d="M35.3,17.9c1.8-1.3,3.4-1.8,4.1-1.9c-0.7-1.5-2.3-2.6-4.2-2.6c-2.5,0-4.5,2-4.5,4.5
c0,0.4,0.1,0.8,0.2,1.1C31.7,19.2,33.5,19.3,35.3,17.9z"
- id="path725" /></g></g></svg>
Index: icons/tux/im.xpm
===================================================================
RCS file: icons/tux/im.xpm
diff -N icons/tux/im.xpm
--- icons/tux/im.xpm 18 Nov 2003 10:42:01 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,1251 +0,0 @@
-/* XPM */
-static char * im_xpm[] = {
-"64 64 1184 2",
-" c None",
-". c #FFFFFF",
-"+ c #FDFDFD",
-"@ c #FBFBFB",
-"# c #F9F9F9",
-"$ c #F7F6F7",
-"% c #F5F5F5",
-"& c #F3F3F3",
-"* c #F1F1F1",
-"= c #EFEFEE",
-"- c #ECEDED",
-"; c #EAEAEA",
-"> c #E8E8E8",
-", c #E6E6E6",
-"' c #E4E4E5",
-") c #E2E3E2",
-"! c #E0E0E0",
-"~ c #DEDEDE",
-"{ c #DCDCDC",
-"] c #DADADA",
-"^ c #D8D8D8",
-"/ c #D6D6D6",
-"( c #D4D4D4",
-"_ c #D2D2D2",
-": c #CECECF",
-"< c #CCCCCB",
-"[ c #CAC9C9",
-"} c #C8C8C7",
-"| c #C5C6C6",
-"1 c #C4C3C3",
-"2 c #C2C1C2",
-"3 c #BFC0BF",
-"4 c #BDBDBD",
-"5 c #BCBBBB",
-"6 c #B9B9B9",
-"7 c #B8B8B8",
-"8 c #B7B7B7",
-"9 c #B5B5B5",
-"0 c #B3B3B3",
-"a c #B1B1B1",
-"b c #AFAFAF",
-"c c #ACACAC",
-"d c #ABABAB",
-"e c #A9A9A9",
-"f c #A7A7A6",
-"g c #A4A4A4",
-"h c #A2A3A3",
-"i c #A0A0A0",
-"j c #9E9F9F",
-"k c #9C9C9D",
-"l c #9A9A9B",
-"m c #989898",
-"n c #969697",
-"o c #949494",
-"p c #929292",
-"q c #909090",
-"r c #8E8E8E",
-"s c #8C8C8C",
-"t c #8A8A8A",
-"u c #888788",
-"v c #868685",
-"w c #848384",
-"x c #818181",
-"y c #7F7F80",
-"z c #F9F8F9",
-"A c #F7F7F6",
-"B c #F5F4F5",
-"C c #F1F0F1",
-"D c #EFEFEF",
-"E c #EDEDEC",
-"F c #EAEBEA",
-"G c #E9E8E8",
-"H c #E6E6E7",
-"I c #E5E4E5",
-"J c #E2E2E2",
-"K c #DEDFDE",
-"L c #D8D8D7",
-"M c #D5D5D4",
-"N c #CECECE",
-"O c #9D9C9D",
-"P c #757475",
-"Q c #515151",
-"R c #1E1E1E",
-"S c #101010",
-"T c #1C1C1C",
-"U c #0E0E0E",
-"V c #1B1B1B",
-"W c #373737",
-"X c #555555",
-"Y c #7D7D7D",
-"Z c #A5A5A5",
-"` c #ADADAC",
-" . c #ADACAD",
-".. c #AAABAA",
-"+. c #A8A9A9",
-"@. c #A6A7A6",
-"#. c #A5A4A5",
-"$. c #A3A2A3",
-"%. c #A0A0A1",
-"&. c #9E9E9E",
-"*. c #9D9C9C",
-"=. c #9A9A9A",
-"-. c #969696",
-";. c #858686",
-">. c #848483",
-",. c #818282",
-"'. c #80807F",
-"). c #7D7E7D",
-"!. c #FBFAFB",
-"~. c #F6F7F7",
-"{. c #F2F2F2",
-"]. c #F1F1F0",
-"^. c #EEEEEE",
-"/. c #EBEAEA",
-"(. c #E4E4E4",
-"_. c #DCDCDB",
-":. c #BFC0C0",
-"<. c #7B7C7C",
-"[. c #393939",
-"}. c #050505",
-"|. c #151515",
-"1. c #545454",
-"2. c #828282",
-"3. c #B6B6B6",
-"4. c #C4C4C4",
-"5. c #666666",
-"6. c #202020",
-"7. c #020202",
-"8. c #2E2E2E",
-"9. c #676767",
-"0. c #9E9D9D",
-"a. c #A4A5A5",
-"b. c #A3A2A2",
-"c. c #A1A1A0",
-"d. c #9F9F9F",
-"e. c #9C9C9C",
-"f. c #898A8A",
-"g. c #878787",
-"h. c #838384",
-"i. c #828181",
-"j. c #807F7F",
-"k. c #7B7B7B",
-"l. c #F4F5F4",
-"m. c #F2F3F2",
-"n. c #F0F0F1",
-"o. c #EFEEEE",
-"p. c #ECEDEC",
-"q. c #DDDDDD",
-"r. c #919292",
-"s. c #414040",
-"t. c #030303",
-"u. c #111111",
-"v. c #5E5E5E",
-"w. c #A7A7A7",
-"x. c #DBDBDB",
-"y. c #AAAAAA",
-"z. c #585858",
-"A. c #070707",
-"B. c #0C0C0C",
-"C. c #484848",
-"D. c #8A8A8B",
-"E. c #9E9E9F",
-"F. c #929291",
-"G. c #908F90",
-"H. c #8E8D8D",
-"I. c #8A8A89",
-"J. c #888888",
-"K. c #858585",
-"L. c #848484",
-"M. c #7E7D7D",
-"N. c #7A7979",
-"O. c #F7F7F7",
-"P. c #F2F3F3",
-"Q. c #F0F1F0",
-"R. c #ECECEC",
-"S. c #DFDFDF",
-"T. c #DAD9DA",
-"U. c #262626",
-"V. c #000000",
-"W. c #1A1A1A",
-"X. c #CACACA",
-"Y. c #D1D1D1",
-"Z. c #BABABA",
-"`. c #040404",
-" + c #505050",
-".+ c #999999",
-"++ c #8F9090",
-"@+ c #8B8B8B",
-"#+ c #898989",
-"$+ c #818281",
-"%+ c #7F7F7F",
-"&+ c #797979",
-"*+ c #777777",
-"=+ c #F6F6F7",
-"-+ c #F2F2F3",
-";+ c #F0F0F0",
-">+ c #EFEEEF",
-",+ c #373838",
-"'+ c #010101",
-")+ c #0B0B0B",
-"!+ c #C1C1C1",
-"~+ c #C8C8C8",
-"{+ c #C9C9C9",
-"]+ c #949393",
-"^+ c #8F908F",
-"/+ c #8E8E8D",
-"(+ c #878887",
-"_+ c #868586",
-":+ c #848383",
-"<+ c #757474",
-"[+ c #F4F4F4",
-"}+ c #E1E1E1",
-"|+ c #DBDADB",
-"1+ c #787878",
-"2+ c #060606",
-"3+ c #313131",
-"4+ c #A3A3A3",
-"5+ c #BEBEBE",
-"6+ c #BFBFBF",
-"7+ c #C0C0C0",
-"8+ c #454545",
-"9+ c #0A0A0A",
-"0+ c #080708",
-"a+ c #8E8F8F",
-"b+ c #8E8F8E",
-"c+ c #8E8D8E",
-"d+ c #8B8C8C",
-"e+ c #898A89",
-"f+ c #878788",
-"g+ c #747574",
-"h+ c #727373",
-"i+ c #F1F0F0",
-"j+ c #E5E6E6",
-"k+ c #E1E1E0",
-"l+ c #CECFCF",
-"m+ c #090909",
-"n+ c #B2B2B2",
-"o+ c #181818",
-"p+ c #080808",
-"q+ c #363737",
-"r+ c #8A8B8A",
-"s+ c #888787",
-"t+ c #838483",
-"u+ c #797879",
-"v+ c #757575",
-"w+ c #737373",
-"x+ c #707171",
-"y+ c #DFE0E0",
-"z+ c #C3C3C4",
-"A+ c #2C2C2C",
-"B+ c #656565",
-"C+ c #ADADAD",
-"D+ c #AEAEAE",
-"E+ c #F8F8F8",
-"F+ c #F6F6F6",
-"G+ c #E7E7E7",
-"H+ c #C2C2C2",
-"I+ c #B0B0B0",
-"J+ c #727272",
-"K+ c #838383",
-"L+ c #878686",
-"M+ c #787979",
-"N+ c #737372",
-"O+ c #717170",
-"P+ c #6E6F6F",
-"Q+ c #EAEAE9",
-"R+ c #E7E8E8",
-"S+ c #E4E3E4",
-"T+ c #DFDFE0",
-"U+ c #C3C2C3",
-"V+ c #292929",
-"W+ c #0D0D0D",
-"X+ c #626262",
-"Y+ c #A2A2A2",
-"Z+ c #A6A6A6",
-"`+ c #FCFCFC",
-" @ c #A8A8A8",
-".@ c #616161",
-"+@ c #363636",
-"@@ c #3B3B3B",
-"#@ c #7B7A7B",
-"$@ c #747475",
-"%@ c #737273",
-"&@ c #6F6F6E",
-"*@ c #6C6D6D",
-"=@ c #EBEBEB",
-"-@ c #E8E7E7",
-";@ c #E6E5E6",
-">@ c #E0DFDF",
-",@ c #CDCDCD",
-"'@ c #131313",
-")@ c #9D9D9D",
-"!@ c #FAFAFA",
-"~@ c #CFCFCF",
-"{@ c #D0D0D0",
-"]@ c #C6C6C6",
-"^@ c #4E4E4E",
-"/@ c #434343",
-"(@ c #525252",
-"_@ c #7E7E7E",
-":@ c #777677",
-"<@ c #727372",
-"[@ c #717071",
-"}@ c #6D6D6C",
-"|@ c #6A6A6B",
-"1@ c #E9EAEA",
-"2@ c #E4E4E3",
-"3@ c #4A4A4B",
-"4@ c #121212",
-"5@ c #161616",
-"6@ c #383838",
-"7@ c #959595",
-"8@ c #FEFEFE",
-"9@ c #D5D5D5",
-"0@ c #9B9B9B",
-"a@ c #979797",
-"b@ c #404040",
-"c@ c #191919",
-"d@ c #6A6A69",
-"e@ c #7B7B7A",
-"f@ c #7B7A7A",
-"g@ c #787978",
-"h@ c #767676",
-"i@ c #717070",
-"j@ c #6C6D6C",
-"k@ c #6B6A6A",
-"l@ c #686868",
-"m@ c #E6E6E5",
-"n@ c #E3E3E3",
-"o@ c #D9D9D9",
-"p@ c #6F6F6F",
-"q@ c #141414",
-"r@ c #272727",
-"s@ c #8D8D8D",
-"t@ c #8F8F8F",
-"u@ c #E9E9E9",
-"v@ c #B4B4B4",
-"w@ c #919191",
-"x@ c #4A4A4A",
-"y@ c #373637",
-"z@ c #777676",
-"A@ c #747474",
-"B@ c #727273",
-"C@ c #6F6E6E",
-"D@ c #6A6A6A",
-"E@ c #686968",
-"F@ c #E5E6E5",
-"G@ c #DCDBDC",
-"H@ c #1D1D1D",
-"I@ c #868686",
-"J@ c #E5E5E5",
-"K@ c #D7D7D7",
-"L@ c #D3D3D3",
-"M@ c #EDEDED",
-"N@ c #494949",
-"O@ c #6C6C6C",
-"P@ c #757574",
-"Q@ c #6F6E6F",
-"R@ c #6C6C6D",
-"S@ c #646464",
-"T@ c #E3E3E4",
-"U@ c #E1E2E2",
-"V@ c #DDDEDD",
-"W@ c #323232",
-"X@ c #1F1F1F",
-"Y@ c #3E3E3E",
-"Z@ c #808080",
-"`@ c #606060",
-" # c #717171",
-".# c #707070",
-"+# c #6E6E6F",
-"@# c #6D6C6C",
-"## c #636463",
-"$# c #626162",
-"%# c #E2E2E1",
-"&# c #D6D7D6",
-"*# c #252525",
-"=# c #7A7A7A",
-"-# c #A1A1A1",
-";# c #7C7C7C",
-"># c #535353",
-",# c #6E6E6E",
-"'# c #616261",
-")# c #605F5F",
-"!# c #303030",
-"~# c #212121",
-"{# c #565656",
-"]# c #636464",
-"^# c #605F60",
-"/# c #5D5E5E",
-"(# c #222222",
-"_# c #2A2A2A",
-":# c #5A5A5A",
-"<# c #4C4C4C",
-"[# c #575757",
-"}# c #4F4F4F",
-"|# c #CCCCCC",
-"1# c #5D5D5D",
-"2# c #474747",
-"3# c #696969",
-"4# c #686867",
-"5# c #646364",
-"6# c #5F5F60",
-"7# c #5C5B5B",
-"8# c #CDCDCC",
-"9# c #595959",
-"0# c #333333",
-"a# c #636363",
-"b# c #6D6D6D",
-"c# c #BBBBBB",
-"d# c #414141",
-"e# c #676766",
-"f# c #5F605F",
-"g# c #5B5B5B",
-"h# c #C2C2C1",
-"i# c #2F2F2F",
-"j# c #5F5F5F",
-"k# c #CBCBCB",
-"l# c #C3C3C3",
-"m# c #6B6B6B",
-"n# c #646465",
-"o# c #626161",
-"p# c #5D5D5E",
-"q# c #5C5C5B",
-"r# c #59595A",
-"s# c #575857",
-"t# c #D0D0D1",
-"u# c #343434",
-"v# c #BCBCBC",
-"w# c #C7C7C7",
-"x# c #D8D7D7",
-"y# c #CBCAC6",
-"z# c #A4A3A2",
-"A# c #6F6E6D",
-"B# c #676765",
-"C# c #959493",
-"D# c #9D9D9B",
-"E# c #A6A6A4",
-"F# c #AEAEAD",
-"G# c #B6B5B2",
-"H# c #BAB9B7",
-"I# c #3D3D3D",
-"J# c #616162",
-"K# c #60605F",
-"L# c #595A59",
-"M# c #555656",
-"N# c #CACBCA",
-"O# c #929191",
-"P# c #2D2D2D",
-"Q# c #5C5C5C",
-"R# c #C2C2C4",
-"S# c #DEC358",
-"T# c #F4D864",
-"U# c #F2E39C",
-"V# c #EFE2A1",
-"W# c #EDE0A0",
-"X# c #F0E2A2",
-"Y# c #EADD9E",
-"Z# c #F0E3A3",
-"`# c #F1E29E",
-" $ c #F2DA6E",
-".$ c #DCBE43",
-"+$ c #9C9C9A",
-"@$ c #3F3F3F",
-"#$ c #585757",
-"$$ c #C5C5C6",
-"%$ c #989691",
-"&$ c #D6A617",
-"*$ c #F8C612",
-"=$ c #FED52F",
-"-$ c #FFD738",
-";$ c #FFD632",
-">$ c #FAC918",
-",$ c #DFA909",
-"'$ c #77715E",
-")$ c #787879",
-"!$ c #232323",
-"~$ c #414242",
-"{$ c #555454",
-"]$ c #5D5E5D",
-"^$ c #424242",
-"/$ c #706B5E",
-"($ c #D49C09",
-"_$ c #F4BD00",
-":$ c #FECA00",
-"<$ c #FFCC00",
-"[$ c #FECB00",
-"}$ c #F7C100",
-"|$ c #E2A605",
-"1$ c #7A6C4C",
-"2$ c #2B2B2B",
-"3$ c #545353",
-"4$ c #4E4F4F",
-"5$ c #BDBDBE",
-"6$ c #464646",
-"7$ c #4B4B4B",
-"8$ c #81765A",
-"9$ c #DFA407",
-"0$ c #F6C000",
-"a$ c #F9C300",
-"b$ c #E8AB02",
-"c$ c #9E8853",
-"d$ c #88898B",
-"e$ c #423F0B",
-"f$ c #A5991A",
-"g$ c #C0A81C",
-"h$ c #C09A1C",
-"i$ c #816214",
-"j$ c #171105",
-"k$ c #565756",
-"l$ c #505151",
-"m$ c #4D4C4D",
-"n$ c #4D4D4D",
-"o$ c #979899",
-"p$ c #A39060",
-"q$ c #E8AA02",
-"r$ c #F8C200",
-"s$ c #FAC600",
-"t$ c #ECB000",
-"u$ c #B59546",
-"v$ c #9C9DA0",
-"w$ c #5A560F",
-"x$ c #FFF926",
-"y$ c #FFF626",
-"z$ c #FFEA26",
-"A$ c #FFDA26",
-"B$ c #FABE24",
-"C$ c #D0941B",
-"D$ c #130E04",
-"E$ c #575756",
-"F$ c #525352",
-"G$ c #4E4F4E",
-"H$ c #BABBBB",
-"I$ c #939393",
-"J$ c #A8A8AB",
-"K$ c #B49854",
-"L$ c #E8AA00",
-"M$ c #EBAE00",
-"N$ c #C69C35",
-"O$ c #A4A5A6",
-"P$ c #BFBFBE",
-"Q$ c #231F06",
-"R$ c #FBEE26",
-"S$ c #FFDF26",
-"T$ c #FFD026",
-"U$ c #FFCC26",
-"V$ c #FDC325",
-"W$ c #EBA81E",
-"X$ c #926212",
-"Y$ c #383738",
-"Z$ c #4F4E4F",
-"`$ c #4C4C4D",
-" % c #4B4A4B",
-".% c #484949",
-"+% c #BDBDBC",
-"@% c #484748",
-"#% c #AFAFB1",
-"$% c #C29C44",
-"%% c #CE9A24",
-"&% c #ACABA8",
-"*% c #746211",
-"=% c #FFE726",
-"-% c #FFE026",
-";% c #FFC826",
-">% c #FFC426",
-",% c #FEC226",
-"'% c #EEAC20",
-")% c #D18815",
-"!% c #1A1815",
-"~% c #535352",
-"{% c #555455",
-"]% c #515051",
-"^% c #4D4C4C",
-"/% c #4B4B4A",
-"(% c #A3A3A2",
-"_% c #C1BFBC",
-":% c #C1BCB1",
-"<% c #7F6413",
-"[% c #FFD626",
-"}% c #FFD326",
-"|% c #EBA91E",
-"1% c #CD8113",
-"2% c #3D3730",
-"3% c #525353",
-"4% c #515050",
-"5% c #4F4E4E",
-"6% c #4A4B4A",
-"7% c #444444",
-"8% c #705410",
-"9% c #FCC225",
-"0% c #FFC926",
-"a% c #FABD24",
-"b% c #E09A1A",
-"c% c #C07110",
-"d% c #4D4B49",
-"e% c #515251",
-"f% c #494848",
-"g% c #464647",
-"h% c #BEBEBF",
-"i% c #1E1604",
-"j% c #E6A71E",
-"k% c #F4B622",
-"l% c #FCBF24",
-"m% c #F8BA24",
-"n% c #E8A61D",
-"o% c #C97C11",
-"p% c #A7743F",
-"q% c #3F403F",
-"r% c #515150",
-"s% c #B2B3B2",
-"t% c #463009",
-"u% c #D49018",
-"v% c #E19B1A",
-"w% c #E19C1B",
-"x% c #DA9118",
-"y% c #C67710",
-"z% c #AE6E2D",
-"A% c #64605C",
-"B% c #3D3E3D",
-"C% c #808181",
-"D% c #C5C5C5",
-"E% c #2B1C05",
-"F% c #965E0F",
-"G% c #AD660E",
-"H% c #A76215",
-"I% c #A0764A",
-"J% c #5A5958",
-"K% c #404140",
-"L% c #4E4E4F",
-"M% c #454546",
-"N% c #3C3B3C",
-"O% c #B7B6B7",
-"P% c #0F0F0F",
-"Q% c #424241",
-"R% c #3D3E3E",
-"S% c #3C3C3C",
-"T% c #3A3A39",
-"U% c #B9B8B9",
-"V% c #9E9D9E",
-"W% c #232108",
-"X% c #827016",
-"Y% c #171204",
-"Z% c #424243",
-"`% c #403F3F",
-" & c #3D3D3E",
-".& c #3B3B3C",
-"+& c #393A39",
-"@& c #B4B5B5",
-"#& c #43400E",
-"$& c #F3EB24",
-"%& c #FED426",
-"&& c #A67817",
-"*& c #656465",
-"=& c #242424",
-"-& c #3F4040",
-";& c #373738",
-">& c #353535",
-",& c #B4B5B4",
-"'& c #ABACAC",
-")& c #9FA0A0",
-"!& c #6F706F",
-"~& c #5F5E5E",
-"{& c #42400E",
-"]& c #FBF526",
-"^& c #FFF826",
-"/& c #FED026",
-"(& c #E9A61E",
-"_& c #261A05",
-":& c #3A3A3A",
-"<& c #3E3D3E",
-"[& c #333433",
-"}& c #AEAFAE",
-"|& c #201E06",
-"1& c #EFE624",
-"2& c #FFF726",
-"3& c #FEC626",
-"4& c #F3B422",
-"5& c #BB8518",
-"6& c #090601",
-"7& c #0E0B02",
-"8& c #181918",
-"9& c #3B3C3C",
-"0& c #343333",
-"a& c #B1B0B0",
-"b& c #ADACAC",
-"c& c #B3A81C",
-"d& c #FFE226",
-"e& c #FFCA26",
-"f& c #FDC125",
-"g& c #F7BA23",
-"h& c #D49F1E",
-"i& c #644D0F",
-"j& c #40340A",
-"k& c #40360A",
-"l& c #4C440B",
-"m& c #827713",
-"n& c #D8BF20",
-"o& c #FBC024",
-"p& c #3D2B08",
-"q& c #AEAEAF",
-"r& c #ACADAC",
-"s& c #9D9E9E",
-"t& c #302B09",
-"u& c #FFEE26",
-"v& c #FFEB26",
-"w& c #FFCE26",
-"x& c #FFC726",
-"y& c #FFD426",
-"z& c #FFDE26",
-"A& c #FFE626",
-"B& c #FFEC26",
-"C& c #FFF026",
-"D& c #F8BC23",
-"E& c #B57C15",
-"F& c #020100",
-"G& c #2F2E2F",
-"H& c #AAAAAB",
-"I& c #7D7C7C",
-"J& c #8F7F18",
-"K& c #FFDB26",
-"L& c #FFC626",
-"M& c #FEC326",
-"N& c #FEC426",
-"O& c #FEC826",
-"P& c #FFD526",
-"Q& c #FFD826",
-"R& c #FDCE25",
-"S& c #F8BE23",
-"T& c #E6A21C",
-"U& c #CE8213",
-"V& c #684921",
-"W& c #252524",
-"X& c #2A2B2B",
-"Y& c #A6A5A6",
-"Z& c #A3A4A4",
-"`& c #A1A2A2",
-" * c #9C9B9B",
-".* c #969797",
-"+* c #888989",
-"@* c #706F70",
-"#* c #D4B720",
-"$* c #FFCF26",
-"%* c #FCC025",
-"&* c #F5B622",
-"** c #ECAA1F",
-"=* c #E8A51D",
-"-* c #E7A41D",
-";* c #E8A41D",
-">* c #E7A41C",
-",* c #E4A01C",
-"'* c #DE981A",
-")* c #D38815",
-"!* c #C4730F",
-"~* c #AF6E2A",
-"{* c #756859",
-"]* c #2F2F2E",
-"^* c #2B2A2A",
-"/* c #A5A6A6",
-"(* c #A3A3A4",
-"_* c #A2A1A2",
-":* c #A0A09F",
-"<* c #9B9C9C",
-"[* c #99999A",
-"}* c #979696",
-"|* c #8D8C8D",
-"1* c #FFE126",
-"2* c #E29D1B",
-"3* c #BC7A16",
-"4* c #C27610",
-"5* c #C77810",
-"6* c #C67610",
-"7* c #C3730F",
-"8* c #AB6614",
-"9* c #9E6D3A",
-"0* c #7F6B59",
-"a* c #2D2C2C",
-"b* c #282829",
-"c* c #A4A4A3",
-"d* c #A2A1A1",
-"e* c #9D9D9E",
-"f* c #9A9A99",
-"g* c #666667",
-"h* c #161105",
-"i* c #FFDC26",
-"j* c #F1B020",
-"k* c #B68026",
-"l* c #171617",
-"m* c #2D2E2E",
-"n* c #2C2D2C",
-"o* c #292828",
-"p* c #272627",
-"q* c #9F9FA0",
-"r* c #9D9E9D",
-"s* c #989897",
-"t* c #4C4D4D",
-"u* c #343535",
-"v* c #1A1406",
-"w* c #FFD226",
-"x* c #A57414",
-"y* c #161516",
-"z* c #292829",
-"A* c #2E2F2E",
-"B* c #282828",
-"C* c #262627",
-"D* c #242425",
-"E* c #A09FA0",
-"F* c #999A9A",
-"G* c #979897",
-"H* c #646363",
-"I* c #626362",
-"J* c #585758",
-"K* c #545354",
-"L* c #474848",
-"M* c #0C0902",
-"N* c #FCBF25",
-"O* c #B68519",
-"P* c #281D06",
-"Q* c #302F30",
-"R* c #30302F",
-"S* c #323233",
-"T* c #303131",
-"U* c #9B9B9C",
-"V* c #9A9999",
-"W* c #989797",
-"X* c #8C8D8D",
-"Y* c #838382",
-"Z* c #666566",
-"`* c #5E5E5D",
-" = c #5C5C5D",
-".= c #141103",
-"+= c #FFE326",
-"@= c #FFC526",
-"#= c #FDC225",
-"$= c #F3B622",
-"%= c #906A14",
-"&= c #0D0A02",
-"*= c #2E2D2D",
-"== c #313031",
-"-= c #2E2E2F",
-";= c #2C2D2D",
-">= c #2A2B2A",
-",= c #8D8D8C",
-"'= c #4F504F",
-")= c #5D5D5C",
-"!= c #686767",
-"~= c #6E6E6D",
-"{= c #686768",
-"]= c #656665",
-"^= c #616262",
-"/= c #5F6060",
-"(= c #5E5D5D",
-"_= c #404041",
-":= c #7A6F12",
-"<= c #FBBE24",
-"[= c #D49D1D",
-"}= c #3D2D08",
-"|= c #232324",
-"1= c #2D2C2D",
-"2= c #1C1C1B",
-"3= c #898889",
-"4= c #838282",
-"5= c #4B4C4B",
-"6= c #505150",
-"7= c #6F7070",
-"8= c #6D6E6E",
-"9= c #6C6B6C",
-"0= c #666665",
-"a= c #5A5B5B",
-"b= c #545554",
-"c= c #171503",
-"d= c #EFE324",
-"e= c #FFED26",
-"f= c #F9BC24",
-"g= c #825E11",
-"h= c #020200",
-"i= c #1D1C1C",
-"j= c #1F2020",
-"k= c #1D1E1E",
-"l= c #1C1B1C",
-"m= c #1A1919",
-"n= c #959495",
-"o= c #929392",
-"p= c #7F7E7E",
-"q= c #707170",
-"r= c #606161",
-"s= c #565556",
-"t= c #6B6C6C",
-"u= c #676868",
-"v= c #666565",
-"w= c #646463",
-"x= c #AEA71A",
-"y= c #FFDD26",
-"z= c #F6B823",
-"A= c #EAA61E",
-"B= c #DE9819",
-"C= c #DE9619",
-"D= c #F2B221",
-"E= c #A77816",
-"F= c #212222",
-"G= c #1B1C1B",
-"H= c #181718",
-"I= c #959594",
-"J= c #939292",
-"K= c #8B8A8B",
-"L= c #656566",
-"M= c #686869",
-"N= c #6C6C6B",
-"O= c #727171",
-"P= c #6A6969",
-"Q= c #5B5A5A",
-"R= c #575656",
-"S= c #7A7512",
-"T= c #FFE926",
-"U= c #F7B923",
-"V= c #C27A17",
-"W= c #936732",
-"X= c #724813",
-"Y= c #905B0E",
-"Z= c #D68E17",
-"`= c #F6B722",
-" - c #F4B522",
-".- c #B07D16",
-"+- c #1D1D1C",
-"@- c #1B1B1C",
-"#- c #151516",
-"$- c #959494",
-"%- c #919190",
-"&- c #89898A",
-"*- c #868585",
-"=- c #818080",
-"-- c #777776",
-";- c #737474",
-">- c #555556",
-",- c #6C6810",
-"'- c #FFFA26",
-")- c #FFEF26",
-"!- c #E5A11C",
-"~- c #C57610",
-"{- c #938271",
-"]- c #1F1403",
-"^- c #95610F",
-"/- c #E09B1A",
-"(- c #F0B020",
-"_- c #FBBF25",
-":- c #F1B220",
-"<- c #AB7815",
-"[- c #060607",
-"}- c #1D1C1D",
-"|- c #1B1C1C",
-"1- c #19191A",
-"2- c #171717",
-"3- c #161515",
-"4- c #131413",
-"5- c #919091",
-"6- c #8B8A8A",
-"7- c #898888",
-"8- c #808081",
-"9- c #777878",
-"0- c #767575",
-"a- c #727172",
-"b- c #70706F",
-"c- c #6B6B6C",
-"d- c #5D5C5C",
-"e- c #060501",
-"f- c #9C9717",
-"g- c #FFFB26",
-"h- c #FFF126",
-"i- c #CC7E12",
-"j- c #A4784A",
-"k- c #432D07",
-"l- c #CC8B17",
-"m- c #EBAA1F",
-"n- c #82590F",
-"o- c #141313",
-"p- c #111112",
-"q- c #8F8F8E",
-"r- c #8C8C8D",
-"s- c #878786",
-"t- c #848485",
-"u- c #747473",
-"v- c #717272",
-"w- c #696A69",
-"x- c #504D0D",
-"y- c #DCD621",
-"z- c #FDC226",
-"A- c #D28715",
-"B- c #AD6C28",
-"C- c #5E5D5B",
-"D- c #050605",
-"E- c #1B1203",
-"F- c #AD7614",
-"G- c #EEAC1F",
-"H- c #FBBE25",
-"I- c #FFC326",
-"J- c #322106",
-"K- c #020201",
-"L- c #868687",
-"M- c #797A7A",
-"N- c #767675",
-"O- c #6E6D6D",
-"P- c #6C6B6B",
-"Q- c #1E1D07",
-"R- c #747012",
-"S- c #D8CF21",
-"T- c #F0AF20",
-"U- c #D48A15",
-"V- c #B2691B",
-"W- c #7A746D",
-"X- c #2E2E2D",
-"Y- c #242324",
-"Z- c #0A0601",
-"`- c #AA7614",
-" ; c #A76D11",
-".; c #0C0D0C",
-"+; c #0F0E0F",
-"@; c #888988",
-"#; c #7A797A",
-"$; c #757675",
-"%; c #747374",
-"&; c #6E6D6E",
-"*; c #676867",
-"=; c #A69519",
-"-; c #FFF426",
-";; c #FABC24",
-">; c #D08514",
-",; c #B1691B",
-"'; c #837970",
-"); c #232424",
-"!; c #0A0701",
-"~; c #BD8517",
-"{; c #F3B321",
-"]; c #F2B321",
-"^; c #DC9519",
-"/; c #C77811",
-"(; c #443829",
-"_; c #101111",
-":; c #69696A",
-"<; c #5A5A59",
-"[; c #434444",
-"}; c #46350A",
-"|; c #FECC26",
-"1; c #FFD726",
-"2; c #F1B121",
-"3; c #E0991A",
-"4; c #C87911",
-"5; c #AC6A27",
-"6; c #79726C",
-"7; c #262625",
-"8; c #1F1F1E",
-"9; c #241A04",
-"0; c #D89419",
-"a; c #D58B16",
-"b; c #BD6D0F",
-"c; c #A67949",
-"d; c #474442",
-"e; c #0C0D0D",
-"f; c #0D0D0C",
-"g; c #0A0B0A",
-"h; c #090908",
-"i; c #7F807F",
-"j; c #7E7D7E",
-"k; c #717172",
-"l; c #6D6D6E",
-"m; c #6B6C6B",
-"n; c #5B5B5A",
-"o; c #595958",
-"p; c #D79E1D",
-"q; c #DF981A",
-"r; c #BA6A0E",
-"s; c #A0764D",
-"t; c #323333",
-"u; c #2C2B2B",
-"v; c #2A292A",
-"w; c #262727",
-"x; c #5C3B09",
-"y; c #B0732A",
-"z; c #867869",
-"A; c #0B0B0A",
-"B; c #060706",
-"C; c #828281",
-"D; c #807F80",
-"E; c #7C7C7B",
-"F; c #7A7A79",
-"G; c #737374",
-"H; c #595859",
-"I; c #4B4A4A",
-"J; c #77530F",
-"K; c #DA9218",
-"L; c #CA7C12",
-"M; c #B46813",
-"N; c #A17344",
-"O; c #716A63",
-"P; c #191918",
-"Q; c #343433",
-"R; c #323132",
-"S; c #2F2F30",
-"T; c #2C2B2C",
-"U; c #2A2A29",
-"V; c #0A0909",
-"W; c #0D0C0D",
-"X; c #080908",
-"Y; c #050504",
-"Z; c #777778",
-"`; c #737473",
-" > c #5D5C5D",
-".> c #585958",
-"+> c #856130",
-"@> c #72604C",
-"#> c #525150",
-"$> c #343334",
-"%> c #313231",
-"&> c #2B2C2C",
-"*> c #2A2929",
-"=> c #252625",
-"-> c #0D0D0E",
-";> c #0D0C0C",
-">> c #050404",
-",> c #7B7B7C",
-"'> c #787777",
-")> c #706F6F",
-"!> c #5A5A5B",
-"~> c #595858",
-"{> c #525253",
-"]> c #4D4D4E",
-"^> c #333434",
-"/> c #2F302F",
-"(> c #2B2C2B",
-"_> c #29292A",
-":> c #272728",
-"<> c #0B0A0A",
-"[> c #040504",
-"}> c #030203",
-"|> c #7F8080",
-"1> c #7C7B7B",
-"2> c #79797A",
-"3> c #656464",
-"4> c #5E5F5F",
-"5> c #373736",
-"6> c #353636",
-"7> c #313232",
-"8> c #2D2E2D",
-"9> c #262525",
-"0> c #1B1A1A",
-"a> c #100F0F",
-"b> c #0E0D0E",
-"c> c #101011",
-"d> c #0A0A0B",
-"e> c #080909",
-"f> c #070706",
-"g> c #7C7B7C",
-"h> c #646565",
-"i> c #626363",
-"j> c #606160",
-"k> c #5E5E5F",
-"l> c #5B5A5B",
-"m> c #484747",
-"n> c #3A393A",
-"o> c #363536",
-"p> c #333334",
-"q> c #313132",
-"r> c #1E1F1F",
-"s> c #1A1A1B",
-"t> c #141515",
-"u> c #121213",
-"v> c #0F0F0E",
-"w> c #0C0C0D",
-"x> c #080809",
-"y> c #040405",
-"z> c #7B7C7B",
-"A> c #666767",
-"B> c #616060",
-"C> c #5E5F5E",
-"D> c #545455",
-"E> c #454646",
-"F> c #3C3B3B",
-"G> c #39393A",
-"H> c #252425",
-"I> c #1B1A1B",
-"J> c #191819",
-"K> c #151514",
-"L> c #101110",
-"M> c #0E0E0F",
-"N> c #070606",
-"O> c #000100",
-". . + @ # $ % & * = - ; > , ' ) ! ~ { ] ^ / ( _ : < [ } | 1 2 3 4 5 6 7 8 9 0
a b c d e f g h i j k l m n o p q r s t u v w x y ",
-". + @ z A B & C D E F G H I J ! K { ] L M N O P Q R S T T T T T T U V W X Y Z
` address@hidden&.*.=.m -.o p q r s t u ;.>.,.'.).",
-"+ !.# ~.% {.].^.- /.> , (.J ! ~ _.^ :.<.[.}.|.1.2.3.! ! ! ! ! ! ! !
4.=.5.6.7.8.9.0.a.g b.c.d.e.=.m -.o p q r s f.g.;.h.i.j.Y k.",
-"@ # A l.m.n.o.p.; > , (.J ! q.^ r.s.t.u.v.w.x.x.x.{ { { { { { { { {
x.x.x.x.y.z.A.B.C.D.E.&.e.=.m -.o F.G.H.s I.J.K.L.i.y M.<.N.",
-"z O.l.P.Q.= R.; > , (.J S.T.p U.V.W.k.X.Y._ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
Y.Z.1.t.`. +-..+m -.o p ++r @+#+J.;.w $+%+M.k.&+*+",
-"=+l.-+;+>+R.; > , (.J ~ 9
,+'+)+9.!+~+~+~+~+X.X.X.X.X.X.X.X.X.X.X.X.X.X.X.{+~+~+~+~+i V 7.V *+o ]+p ^+/+s
t (+_+:+x j.Y k.&+*+<+",
-"[+{.Q.o.R.; > ,
(.}+|+1+2+}.3+4+5+5+6+6+6+7+7+7+7+!+!+!+!+!+!+!+!+!+!+7+7+7+7+6+6+6+6+9 8+9+0+
+a+b+c+d+e+f+K.:+$+%+).k.&+*+g+h+",
-"{.i+^.R.; > j+(.k+l+C.2+m+ +n+9 3.3.8 7 ~+X.X.7+6 Z.Z.Z.Z.Z.Z.Z.Z.Z.6 6 6 7 7
7 8 3.3.3.8 5.o+p+q+g.r+#+s+v t+x %+M.k.u+*+v+w+x+",
-";+^.R.; > , (.y+z+A+9+B.B+d c C+D+n+/ [+E+E+E+F+G+H+n+n+n+n+n+n+n+n+n+n+a a
I+I+b b D+D+D+D+J+U.u.3+K+L+K.K+x %+Y k.M+*+g+N+O+P+",
-"^.R.Q+R+, S+T+U+V+W+S X+Y+g g Z+C+(.% # @ `+@ # F+* ~+c c c c c c c c d d
y.y.e @ @w.Z+Z Z address@hidden@o+@@x 2.x %+Y #@&address@hidden@O+&@*@",
-"address@hidden@;@(.>@,@W S '@1.=.e.)@&.d.^ & E+`++ + address@hidden R.7
Z+Z+Z+Z+Z+c address@hidden@address@hidden@D+Y+Y+i i &.&.)@e.^@/@T
(@address@hidden k.M+:@v+<@[@&@}@|@",
-"1@> address@hidden address@hidden@address@hidden@q o address@hidden 7 D %
address@hidden@address@hidden@`+E+[+^.> ~ Y+Y+Y+w.( ;+& F+E+E+F+%
address@hidden address@hidden@-.-.t
address@hidden@address@hidden@address@hidden@address@hidden@address@hidden@&@address@hidden@l@",
-"address@hidden@address@hidden address@hidden@address@hidden@x
@address@hidden@q p ~ D F+@ address@hidden@address@hidden D address@hidden
address@hidden; ;+F+# @ address@hidden d.o p address@hidden@r r 5.
address@hidden@address@hidden@address@hidden@address@hidden@address@hidden@address@hidden",
-"address@hidden@Z address@hidden@address@hidden &address@hidden
address@hidden@`+O.{.; J { address@hidden address@hidden ; ;address@hidden
address@hidden address@hidden@] p address@hidden t
address@hidden@A+X+<address@hidden@address@hidden@|@address@hidden@",
-"address@hidden@address@hidden address@hidden address@hidden@k.Y
address@hidden J address@hidden@address@hidden address@hidden C+X.0 / ~ G+^.%
address@hidden@address@hidden@@ address@hidden@address@hidden x
address@hidden@address@hidden@ address@hidden@address@hidden",
-"%#T+&#x T address@hidden address@hidden@ address@hidden@address@hidden ^./
address@hidden@+ address@hidden # & ; ~
address@hidden@;#=#J+>address@hidden@,address@hidden@address@hidden@'#)#",
-"S.x.X.!#~#*#b@,address@hidden > {.E++ + address@hidden ^.i .+s
address@hidden@.+o 9.D ;+F+# address@hidden@n@/
7+;#_@;address@hidden@address@hidden@address@hidden'#^#/#",
-"q.( w@(address@hidden@,address@hidden@address@hidden _ address@hidden@
address@hidden -.`@:#<#[#S@ address@hidden; ;+{.{.;address@hidden@^
|address@hidden",
-"] address@hidden@b#.#J+J+s {+K@(.D address@hidden@address@hidden@S.(., ,
address@hidden@address@hidden@*+A@ #,address@hidden@&address@hidden",
-"M address@hidden@.#,#,#5+k#o@(.R.* {.D > }+4+:#,#=.L.a 4 6+~+~@( / / _
|#l#Z.e address@hidden@ #,address@hidden@v.n#5#o#f#p#q#r#s#",
-"t#C+_#i#u#C.{#:address@hidden@m address@hidden J (.! x#y#v#`
z#A#B#4#C#D#E#F#G#H#Z.6 9 I+g
address@hidden@J+J+,address@hidden@address@hidden",
-"address@hidden@(@{#:address@hidden@Q#:#Y+I+5+~+N Y.N R#S#T#U#V#W#X#W#Y#Z#`#
$.$+$i &address@hidden@p@,address@hidden >#",
-"$$x address@hidden@address@hidden 1.X z.:#v.X+.@:address@hidden y.0 6 c#6 c
%$&$*$=$-$-$-$-$;$>$,$'$)$;address@hidden@@A+!$U V +K+6+~${$Q#]$g#9#[#X >#Q ",
-"address@hidden/@C.<#Q {#:address@hidden@5.:address@hidden g
e.#+/$($_$:$<$<$[$}$|$1$l@,#,address@hidden@address@hidden@K.2$'+V.V.V.V.V.t.m#7
8+3$g#g#9#[#X >#Q 4$",
-"address@hidden address@hidden@ address@hidden@1#&address@hidden@r
address@hidden@8$9$0$[$[$a$b$c$d$-.m address@hidden s
address@hidden@;address@hidden>#9#9#k$X >#l$}#m$",
-"v#v address@hidden@(@address@hidden@w+*+*+v+b#p@,#J+*+x q
e.o$p$q$r$s$t$u$v$n+Z.8 I+w.p address@hidden 6$>#z.E$X F$ +G$n$3@",
-"address@hidden@X+>address@hidden address@hidden@,address@hidden@L.p
address@hidden i d 6
l#5+J$K$L$M$N$O$P$|#|address@hidden@,address@hidden'+V.Y$>#{#X >#Q Z$`$ %.%",
-"+%j @address@hidden(@address@hidden@ #h@&address@hidden -#y.n+Z.!+X._ ^ /
X.#%$%%%&address@hidden x.^ _ address@hidden
,#C.V.*%=%-%;%>%>%,%'%)%!%V._#~%{%>#]%4$^%/%.%6$",
-"5+(address@hidden:address@hidden@address@hidden;#x p i c 8 7+X.Y.^ ~ J
(.}+Y._%:%N ! G+, J { ( v#I$J+i#V.<%[%}%>%>%>%,%|address@hidden",
-"5+ @v+X+&+.@:address@hidden@=#_@@+d.y.3.!+X.( { J > R.^.D ; address@hidden
address@hidden ;+^.; (.{ ]@&.=#*#V.8%9%0%>%>%>%a%b%c%d%V.P#e%
+^@<address@hidden",
-"h%C+s@(@@address@hidden@l@,#J+*+;#K+=. @address@hidden( ~ (.; D {.%
F+F+F+F+O.E+F+[+* R., address@hidden<address@hidden@",
-"address@hidden@address@hidden@address@hidden@1+Y p g I+4 {+( {
address@hidden@* % E+!@@ `++ + + address@hidden
address@hidden'address@hidden@B%",
-"4 address@hidden@1+K.d.c 6 D%Y.] (.R.* F+# @ +
address@hidden@address@hidden@address@hidden@address@hidden@address@hidden Q
2+V.E%F%G%H%I%J%}.t.K%L%<#x@@address@hidden",
-"c#O%y.q address@hidden #,#.#A@&address@hidden@!+N ^ J ; * % # `++
address@hidden@. . . . . address@hidden `+# % address@hidden address@hidden
address@hidden'+P%_#u#W.V.2+I#n$<address@hidden",
-"U%O%I+V%x address@hidden address@hidden@v+L.-#D+c#~+( ~ > D %
address@hidden@. . . . . . . . address@hidden@@
address@hidden'+W.^$<#<#x@@@Z%7%Q%`% &.&+&W ",
-"8 @&I+w.p address@hidden ;#&+-. @9 address@hidden (address@hidden
address@hidden@. . . . . . . .
address@hidden@E+(address@hidden&$&%&&&address@hidden<#<#*&X+V
=&~$-&I#.&[.;&>&",
-",&0 I+'&)&I.!&~&g address@hidden@@+4+b address@hidden> ;+%
address@hidden@address@hidden . . . . . . . . . `+;
~+4+<#V.{&]&^&/&(&_&address@hidden:&<&N%T%Y$>&[&",
-"0 I+}&c Z+.+L.m#v.d.D+Z+c address@hidden (.M@& E+`++ address@hidden . . . . .
. . . . address@hidden|&1&2&S$3&4&5&6&V.7.7.V.V.V.7&V.V.8&9&[.W >&0&3+",
-"a&D+b&address@hidden address@hidden 4 {+( S.> ;address@hidden address@hidden
. . . . . . . . . . address@hidden p
u#V.c&y$d&e&>%f&g&h&i&j&k&l&m&n&o&p&V.V.!#W >&0#3+i#",
-"q&r&.. @Z+$.s&p address@hidden address@hidden (address@hidden@. . . . . . . .
. . address@hidden @;#2+t&u&v&w&>%>%>%x&U$y&z&A&B&C&=%D&E&F&V.P%>&0#3+G&P#",
-" .H& @Z+g Y+d.=.q I&,#9 4.{+( ~ > ;address@hidden address@hidden . . . . . .
. . . . + > 4 &.(@V.J&B&K&L&>%>%M&N&O&w&P&Q&[%R&S&T&U&V&2+V.W&3+i#P#X&",
-"y. @Y&Z&`&i V% address@hidden ^ J address@hidden@address@hidden . . . . . . .
. . . address@hidden
n+2.:&V.#*=%$*>%>%%*&***=*-*;*>*,*'*)*!*~*{*}.V.u.]*P#^*V+",
-" @/*(*_*:*V%<*[*}*|**+d.~+_ { , ^.F+@ address@hidden@. . . . . . . . . . .
address@hidden address@hidden&1*0%>%M&&*2*3*4*5*5*6*7*8*9*0*7$p+V.B.2$a*2$b*r@",
-"/*c*d*:address@hidden@address@hidden)@w#( S.> *
address@hidden&+[#,address@hidden
address@hidden@address@hidden(@b@:&:&0#^*8.|.h*P&i*x&>%,%j*k*v.=&address@hidden@}.V.V.l*m*n*X&o*p*=&",
-"address@hidden@address@hidden@address@hidden@address@hidden@<#
address@hidden@address@hidden@address@hidden@v*w*A$L&>%M&k%x*V.V.V.V.V.V.V.V.}.y*z*A*A+_#B*C*D*(#",
-"address@hidden@t address@hidden { address@hidden {.N
address@hidden)#H*I*j#1#g#:#9#z.z.J*z.K*L*[.(@)+M*[%A$L&>%>%N*&address@hidden&(#6.",
-"address@hidden@X*Y*d.k#~ address@hidden q
address@hidden@address@hidden@address@hidden@`*
address@hidden&>%>%>address@hidden&=V.V.P%*===-=;=>=B*C*=&(#6.R ",
-"address@hidden@address@hidden@,=L.p ~+G+~ ( l##+'=
+)=!=,address@hidden@{=]=5#^=/=(address@hidden:=u&Q&@=>%>%>%L&0%;%<=[=}=V.V.`.|=1=_#B*U.=&(#6.R
2=",
-"address@hidden@address@hidden@3=x i Z+ @o 4=H*5=6=:#a#m#p@
address@hidden@address@hidden@7.c=d=e=$*M&%*f=f=N*M&L&;%#=k%g=h=V.'+i=B*U.=&(#j=k=l=m=",
-"address@hidden@,=#+p=q=r=s= +(@s#/address@hidden@J+
address@hidden@u=v=w=^=j#1#g#X
address@hidden&z=A=B=C=T&D=B$N&x&M&&*E=6&V.V.2==&F=6.k=G=m=H=",
-"address@hidden@address@hidden
I&address@hidden@address@hidden@P=!=v=a#$#6#]$Q=R=<address@hidden&@=,%
-.-6&V.'++-6.H@@address@hidden",
-"$-I$%-a+|*&address@hidden@address@hidden@P@;address@hidden,#t=P=u=v=w=J#K#1#:#>-
+ address@hidden,-'-)-w*B$!-~-{-V+B.2+]-^-/-(-_->%#=:-<-F&V.[-}-|-1-2-3-4-",
-"I$5-a+s address@hidden
address@hidden@!=Z*##'#j#d->address@hidden(@'@V.e-f-g-h-[%9%**i-j-u#V.V.V.V.V.k-l-'%B$>%_-m-n-V.V.S
address@hidden|.o-p-",
-"address@hidden
address@hidden@;address@hidden@address@hidden&P&z-(-A-B-C-'+D-_#2-'+V.V.E-F-G-H-I-z=2*J-V.K-5@|.'@u.P%",
-"address@hidden@;#M-1+N-;-a-7=O-P-w-u=L=a#J#v.z.^@'@t.V.Q-R-S-x$y$A&T$9%T-U-V-W-p+V.*#0#X-Y-9+V.V.Z-`-(-f&N*;*
;t.V..;o-u.+;W+",
-"address@hidden@;address@hidden@_@;##;1+$;%;
#!&&;P-3#*;address@hidden>#7%*#t.V.=;-;2&T=Q&O&;;W$>;,;';U
address@hidden@i#2$);P%V.V.!;~;{;];^;/;(;'+`._;P%W+)+",
-"t
address@hidden@_@;##;address@hidden@address@hidden:;address@hidden<;3%[;>&2+V.};|;1;O&B$2;3;4;5;6;U
V.'@address@hidden;8;S V.V.9;0;a;b;c;d;'+V.e;f;g;h;",
-"J.v L.2.i;j;<.=#9-N-;-k;7=l;m;address@hidden;o;1.L*W
'@`.h=p;&***q;U&r;s;q#p+V.u.t;address@hidden;v;w;F=|-W+V.V.x;y;z;8.V.V.}.B.A;h;B;",
-";.L.C;D;M.E;F;*+v+G;J+!&O-P-:;address@hidden)=n;H;k$>#I;address@hidden;K;L;M;N;O;address@hidden;Q;R;S;X-T;U;address@hidden;V
A.V.V;^*p+V.7.)+W;A;X;[-Y;",
-">.,address@hidden;#N.Z;$;`; address@hidden;m#P=9.*&I*r=~& >a=.>k$b=Q
m$/@@@m+'+E-+>@>#>6.7.V.A.U.$>%>!#X-&>*>address@hidden>!$6.R T
2-'+V.V.'+m+->;>9+m+B;>>7.",
-",.j.).,>F;'>v+w+
#)>l;address@hidden>~>{#{%{>4%]>address@hidden(#7.7.2+7.V.V.2+R
u#^>%>/>P#(>_>:>address@hidden@V address@hidden U f;<>p+B;[>}>V.",
-"|>Y 1>2>'>v+w+
address@hidden>address@hidden>1#g#.>{#{$(@6=L%<address@hidden>6>Q;7>S;8>&>_>address@hidden>address@hidden>address@hidden>b>c>P%W;d>e>f>>>7.V.7.",
-"Y g>&+*+v+G; address@hidden>i>j>k>)=l>z.[#{$(@6=5%<address@hidden>6$[;n>W
S%.&T%W
o>p>q>/>address@hidden>address@hidden>address@hidden>u>c>v>w>9+x>2+y>7.V.7.y>",
-"z>&+*+v+w+ address@hidden>n#a#B>C>d-:#z.R=D>(@
+L%<address@hidden>7%^$-&B%F>G>address@hidden;3+!#P#2$*>address@hidden>!$~#8;address@hidden>J>l*K>address@hidden>M>B.d>p+N>`.7.O>7.`.N>"};
Index: src/daemon/chat/.cvsignore
===================================================================
RCS file: src/daemon/chat/.cvsignore
diff -N src/daemon/chat/.cvsignore
--- src/daemon/chat/.cvsignore 30 May 2006 11:23:48 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,2 +0,0 @@
-*.cm*
-*.annot
Index: src/daemon/chat/chat_args.ml
===================================================================
RCS file: src/daemon/chat/chat_args.ml
diff -N src/daemon/chat/chat_args.ml
--- src/daemon/chat/chat_args.ml 22 Apr 2003 22:33:39 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,57 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** Command line arguments. *)
-
-(** The list of options.*)
-let options_list = [
- "-v", Arg.Set Chat_messages.verbose_mode, Chat_messages.op_verbose ;
- "-c", Arg.String (fun _ -> ()), Chat_messages.op_config ;
-]
-
-(** Parse of the command line arguments. *)
-let parse () =
- (* we check if we must use a different config file,
- given on the command line *)
- let arg_list = Array.to_list Sys.argv in
- let rec iter = function
- [] | _ :: [] -> None
- | "-c" :: file :: q ->
- Some file
- | _ :: q ->
- iter q
- in
- let rc_file =
- match iter arg_list with
- None -> Filename.concat Chat_messages.home ".mlchatrc"
- | Some f -> f
- in
- let config = new Chat_config.config rc_file in
- let complete_options =
- options_list @
- config#args_spec
- in
- Arg.parse complete_options
- (fun s -> ())
- Chat_messages.usage;
-
- config
Index: src/daemon/chat/chat_config.ml
===================================================================
RCS file: src/daemon/chat/chat_config.ml
diff -N src/daemon/chat/chat_config.ml
--- src/daemon/chat/chat_config.ml 22 Apr 2003 22:33:39 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,107 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** Config options. *)
-
-open Chat_options
-
-module M = Chat_messages
-
-class config rcfile =
- let op_file = create_options_file rcfile in
- object (self)
- (** The options *)
- method args_spec = Chat_options.simple_args op_file
-
- (** {2 Connection options} *)
-
- val id = define_option op_file ["id"]
- M.h_id string_option "mlchat"
- method id = !!id
- method set_id i = id =:= i
-
- val hostname = define_option op_file ["hostname"]
- M.h_id string_option (Unix.gethostname ())
- method hostname = !!id
- method set_hostname i = hostname =:= i
-
- val port = define_option op_file ["port"]
- M.h_port int_option 5036
- method port = !!port
- method set_port p = port =:= p
-
- val timeout = define_option op_file ["timeout"]
- M.h_timeout int_option 100
- method timeout = !!timeout
- method set_timeout t = timeout =:= t
-
- val popup_all = define_option op_file ["popup_all"]
- M.h_popup_all bool_option true
- method popup_all = !!popup_all
- method set_popup_all b = popup_all =:= b
-
- (** {2 Colors} *)
-
- val color_connected = define_option op_file ["colors" ; "connected"]
- M.h_color_connected string_option "DarkGreen"
- method color_connected = !!color_connected
- method set_color_connected c = color_connected =:= c
-
- val color_connected_temp = define_option op_file
- ["colors" ; "connected_temp"]
- M.h_color_connected_temp string_option "Red"
- method color_connected_temp = !!color_connected_temp
- method set_color_connected_temp c = color_connected_temp =:= c
-
- val color_not_connected = define_option op_file ["colors" ;
"not_connected"]
- M.h_color_not_connected string_option "Black"
- method color_not_connected = !!color_not_connected
- method set_color_not_connected c = color_not_connected =:= c
-
- val color_myself = define_option op_file ["colors" ; "myself"]
- M.h_color_myself string_option "Blue"
- method color_myself = !!color_myself
- method set_color_myself c = color_myself =:= c
-
- (** {2 People} *)
-
- val people = define_option op_file
- ["people"]
- M.h_people
- (list_option (tuple3_option
- (
- string_option,
- string_option,
- int_option))
- )
- []
- method people = !!people
- method set_people l = people =:= l
-
- (** {2 Saving options} *)
-
- method save = save op_file
-
- initializer
- load op_file;
- save op_file
- end
Index: src/daemon/chat/chat_data.ml
===================================================================
RCS file: src/daemon/chat/chat_data.ml
diff -N src/daemon/chat/chat_data.ml
--- src/daemon/chat/chat_data.ml 22 Apr 2003 22:33:39 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,149 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** A class for the state. *)
-
-open Printf2
-open Chat_types
-open Chat_proto
-
-let (!!) = Chat_options.(!!)
-
-
-class data pred (conf : Chat_config.config) (com : Chat_proto.com) =
- object(self)
- val mutable people = ([] : (id * host * port * state * bool) list)
- (** list of known people :
- id * host * port * connected/not_connected * temporary or friend *)
-
- method people = people
-
- val mutable rooms = ([] : (id * ((id * host * port) list) * bool) list)
- (** list of known rooms : id * temporary or not *)
-
- method rooms = rooms
-
- method pred = pred
-
- (** merge current people list with [conf#people].*)
- method update_people =
- let l = conf#people in
- let rec iter = function
- [] -> []
- | (id,host,port,s,t) :: q ->
- let b = List.exists (pred (id,host,port)) l in
- (id,host,port,s,not b) :: (iter q)
- in
- let l2 = iter people in
- let rec iter2 = function
- [] -> []
- | (id,host,port) :: q ->
- if List.exists
- (fun(i,h,p,_,_) -> pred (id,host,port) (i,h,p))
- l2
- then iter2 q
- else (id,host,port,Not_connected,false) :: (iter2 q)
- in
- people <- l2 @ (iter2 l)
-
- method set_connected id host port =
- let rec iter = function
- [] -> [id, host, port, Connected, true]
- | ((i,h,p,s,t) as a) :: q ->
- if pred (id,host,port) (i,h,p) then
- (id,h,port,Connected,t) :: q
- else
- a :: (iter q)
- in
- people <- iter people
-
- method set_not_connected id host port =
- let rec iter = function
- [] -> []
- | ((i,h,p,s,t) as a) :: q ->
- if pred (id,host,port) (i,h,p) then
- (id,h,port,Not_connected,t) :: q
- else
- a :: (iter q)
- in
- people <- iter people
-
- method print_people =
- List.iter
- (fun (i,h,p,_,_) ->
- lprintf "address@hidden:%d\n" i h p)
- people
-
-
- method add_people id host port =
- if List.exists (pred (id,host,port)) conf#people
- then
- ()
- else
- (
- let rec iter = function
- [] -> [id,host,port,Not_connected,false]
- | ((i,h,p,s,t) as a) :: q ->
- if pred (id,host,port) (i,h,p) then
- (id,h,port,s,false) :: q
- else
- a :: (iter q)
- in
- people <- iter people;
- conf#set_people (conf#people @ [id,host,port]);
- conf#save
- )
-
- method remove_people ?(kill=false) id host port =
- let rec iter = function
- [] -> []
- | ((i,h,p,s,t) as a) :: q ->
- if pred (id,host,port) (i,h,p) then
- if kill then
- iter q
- else
- (id,h,port,s,true) :: (iter q)
- else
- a :: (iter q)
- in
- people <- iter people;
- conf#set_people
- (List.filter (fun (i,h,p) -> not (pred (i, h, p) (id, host, port)))
conf#people);
- conf#save
-
- (** get all information on the given people. *)
- method get_complete_people id host port =
- try
- List.find
- (fun (i,h,p,_,_) ->
- pred (id,host,port) (i,h,p))
- people
- with Not_found -> (id,host,port,Not_connected,true)
-
-
- method com = com
- method conf = conf
-
- initializer
- people <- List.map (fun (i,h,p) -> (i,h,p,Not_connected,false))
- conf#people
- end
Index: src/daemon/chat/chat_icons.ml
===================================================================
RCS file: src/daemon/chat/chat_icons.ml
diff -N src/daemon/chat/chat_icons.ml
--- src/daemon/chat/chat_icons.ml 22 Apr 2003 22:33:39 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,81 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** Gui icons. *)
-
-let connected = [|
-"14 14 9 1";
-" c None";
-". c #C0C0C0";
-"+ c #808000";
-"@ c #808080";
-"# c #FFFF00";
-"$ c #FFFFFF";
-"% c #000080";
-"& c #800000";
-"* c #FF0000";
-" ...... ";
-" ..++@@.. ";
-" address@hidden@@. ";
-" address@hidden@. ";
-"address@hidden";
-"address@hidden@.";
-"address@hidden@address@hidden";
-"address@hidden";
-".+##&address@hidden";
-"..+##&**&address@hidden";
-" address@hidden ";
-" .++#$$#@@. ";
-" address@hidden ";
-" ...... "|]
-
-
-let not_connected = [|
-"12 12 4 1";
-" c None";
-". c #808080";
-"+ c #C0C0C0";
-"@ c #FFFFFF";
-" .... ";
-" address@hidden@.. ";
-" address@hidden@address@hidden@+. ";
-" address@hidden@address@hidden@. ";
-"address@hidden@address@hidden@address@hidden";
-"address@hidden@@address@hidden";
-"address@hidden@address@hidden@address@hidden";
-"address@hidden@address@hidden@address@hidden";
-" address@hidden@address@hidden ";
-" address@hidden@address@hidden@. ";
-" address@hidden@+.. ";
-" .... "|]
-
-let create_gdk_pixmap i =
- let gdk_pix = GDraw.pixmap_from_xpm_d ~data: i
- ~colormap: (Gdk.Color.get_system_colormap ())
- ()
- in
- gdk_pix
-
-let create_pixmap i =
- let gdk_pix = create_gdk_pixmap i in
- let pix = GMisc.pixmap gdk_pix () in
- pix
Index: src/daemon/chat/chat_messages.ml
===================================================================
RCS file: src/daemon/chat/chat_messages.ml
diff -N src/daemon/chat/chat_messages.ml
--- src/daemon/chat/chat_messages.ml 22 Jul 2005 10:58:54 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,102 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-open Printf2
-
-(** Messages and string constants. *)
-
-let software = "MLChat"
-let software_version = "1.1"
-let software_author = "Maxence Guesdon"
-let software_author_mail = "address@hidden"
-let software_copyright =
- "Copyright 2002 Institut National de Recherche en \n"^
- "Informatique et en Automatique. All rights reserved.\n"^
- "This software is distributed under the terms of the\n"^
- "GPL Public License version 2.0.\n"^
- "(see file LICENSE in the distribution)"
-
-let software_about =
- software^" version "^software_version^"\n\n"^
- software_author^"\n"^
- software_author_mail^"\n\n"^
- software_copyright
-
-let home =
- try Sys.getenv "HOME"
- with Not_found -> ""
-
-let verbose_mode = ref false
-
-(** {2 Command line messages} *)
-
-let usage = "Usage : "^Sys.argv.(0)^" [options] \nwhere options are :"
-let op_verbose = " verbose mode"
-let op_config = "<file> use <file> as configuration file instead of default
~/.mlchatrc"
-
-(** Print the given string if we are in verbose mode.*)
-let verbose s =
- if !verbose_mode then
- (lprint_string s ; lprint_newline ())
-
-(** {2 Help messages} *)
-
-let h_color_connected = "Color for connected people"
-let h_color_connected_temp = "Color for connected temporary people"
-let h_color_not_connected = "Color for not connected people"
-let h_people = "People you know, list of (id, host, port)"
-let h_port = "The port to listen to"
-let h_timeout = "Timeout for listening on port (in ms)"
-let h_id = "Your id"
-let h_color_myself = "My color in dialog boxes"
-let h_popup_all = "Popup for all incoming messages (true) or "^
- "for only people in your personal list"
-let h_rooms = "The rooms you know, list of (name, list of (id, host, port))"
-
-(** {2 Messages} *)
-
-let people = "People"
-let id = "Id"
-let host = "Host"
-let port = "Port"
-let temporary = "Temporary"
-let yes_or_no b = if b then "yes" else "no"
-let incompatible_version = "Incompatible versions"
-let dest_is_source = "Destination = source"
-let options = "Options"
-let connection = "Connection"
-let colors = "Colors"
-let popup_all = "Popup all"
-let rooms = "Rooms"
-let room_name = "Room name"
-let show_hide_people = "Show/hide people"
-
-(** {2 Menu labels} *)
-
-let m_quit = "Quit"
-let m_open_dialog_for_selected_people = "Open dialog"
-let m_options = "Options"
-let m_add_people = "Add people"
-let m_toggle_temp = "Toggle temp flag for selected people"
-let m_about = "About ..."
-let m_remove_people = "Remove selected people"
-let m_rooms = "Rooms"
Index: src/daemon/chat/chat_misc.ml
===================================================================
RCS file: src/daemon/chat/chat_misc.ml
diff -N src/daemon/chat/chat_misc.ml
--- src/daemon/chat/chat_misc.ml 6 Sep 2005 11:24:59 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,73 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** Misc functions. *)
-
-
-let remove_blanks str =
- let len = String.length str in
- let buf = Buffer.create len in
- for i = 0 to len - 1 do
- match str.[i] with
- '\000' | ' ' | '\t' | '\r' | '\n' -> ()
- | c -> Buffer.add_char buf c
- done;
- Buffer.contents buf
-
-let remove_newlines str =
- let len = String.length str in
- let buf = Buffer.create len in
- for i = 0 to len - 1 do
- match str.[i] with
- '\r' | '\n' -> ()
- | c -> Buffer.add_char buf c
- done;
- Buffer.contents buf
-
-let buf_get_line buf =
- let s = Buffer.contents buf in
- try
- let n = String.index s '\n' in
- let s1 = String.sub s 0 n in
- let s2 = String.sub s n ((String.length s) - n) in
- Buffer.reset buf;
- Buffer.add_string buf s2;
- match s1 with
- "" -> raise End_of_file
- | _ -> s1
- with
- Not_found ->
- Buffer.reset buf;
- s
-
-let buf_input buf str pos len =
- let s = Buffer.contents buf in
- Buffer.reset buf;
- let s1 =
- try String.sub s 0 len
- with _ -> raise End_of_file
- in
- let s2 = String.sub s len ((String.length s) - len) in
- Buffer.add_string buf s2;
- for i = 0 to len - 1 do
- str.[pos+i] <- s1.[i]
- done
Index: src/daemon/chat/chat_options.ml
===================================================================
RCS file: src/daemon/chat/chat_options.ml
diff -N src/daemon/chat/chat_options.ml
--- src/daemon/chat/chat_options.ml 5 Apr 2006 00:16:29 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,743 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-
-open Printf2
-
-(** Simple options:
- This will enable very simple configuration, by a mouse-based configurator.
- Options will be defined by a special function, which will also check
- if a value has been provided by the user in its .gwmlrc file.
- The .gwmlrc will be created by a dedicated tool, which could be used
- to generate both .gwmlrc and .efunsrc files.
-
-Note: this is redundant, since such options could also be better set
-in the .Xdefaults file (using Xrm to load them). Maybe we should merge
-both approaches in a latter release.
-
- Code from Fabrice Le Fessant.
-
- *)
-
-type option_value =
- Module of option_module
- | StringValue of string
- | IntValue of int
- | FloatValue of float
- | List of option_value list
- | SmallList of option_value list
-and option_module = (string * option_value) list
-;;
-
-
-
-type 'a option_class =
- { class_name : string;
- from_value : option_value -> 'a;
- to_value : 'a -> option_value;
- mutable class_hooks : ('a option_record -> unit) list }
-
-and 'a option_record =
- { option_name : string list;
- option_class : 'a option_class;
- mutable option_value : 'a;
- option_help : string;
- mutable option_hooks : (unit -> unit) list;
- mutable string_wrappers : (('a -> string) * (string -> 'a)) option;
- option_file : options_file;
- }
-
-and options_file = {
- mutable file_name : string;
- mutable file_options : Obj.t option_record list;
- mutable file_rc : option_module;
- mutable file_pruned : bool;
- }
-;;
-
-let create_options_file name =
- if not (Sys.file_exists name) then
- Unix2.tryopen_write name ignore; (* should we catch exceptions here ? *)
- {
- file_name = name;
- file_options =[];
- file_rc = [];
- file_pruned = false;
- }
-
-let set_options_file opfile name = opfile.file_name <- name
-
-let
- define_option_class
- (class_name : string)
- (from_value : option_value -> 'a)
- (to_value : 'a -> option_value) =
- let c =
- {class_name = class_name;
- from_value = from_value;
- to_value = to_value;
- class_hooks = []}
- in
- c
-;;
-
-(*
-let filename =
- ref
- (Filename.concat Sysenv.home
- ("." ^ Filename.basename Sys.argv.(0) ^ "rc"))
-;;
-let gwmlrc = ref [];;
-
-let options = ref [];;
-*)
-
-let rec find_value list m =
- match list with
- [] -> raise Not_found
- | name :: tail ->
- let m = List.assoc name m in
- match m, tail with
- _, [] -> m
- | Module m, _ :: _ -> find_value tail m
- | _ -> raise Not_found
-;;
-
-let prune_file file =
- file.file_pruned <- true
-
-let
- define_option
- (opfile : options_file)
- (option_name : string list)
- (option_help : string)
- (option_class : 'a option_class)
- (default_value : 'a) =
- let o =
- {option_name = option_name;
- option_help = option_help;
- option_class = option_class;
- option_value = default_value;
- string_wrappers = None;
- option_hooks = [];
- option_file = opfile; }
- in
- opfile.file_options <- (Obj.magic o : Obj.t option_record) ::
- opfile.file_options;
- o.option_value <-
- begin try o.option_class.from_value (find_value option_name
- opfile.file_rc) with
- Not_found -> default_value
- | e ->
- lprintf "Options.define_option, for option %s: "
- (match option_name with
- [] -> "???"
- | name :: _ -> name);
- lprintf_nl "%s" (Printexc2.to_string e);
- default_value
- end;
- o
-;;
-
-
-open Genlex;;
-
-let lexer = make_lexer ["="; "{"; "}"; "["; "]"; ";"; "("; ")"; ","; "."];;
-
-let rec parse_gwmlrc (strm__ : _ Stream.t) =
- match
- try Some (parse_id strm__) with
- Stream.Failure -> None
- with
- Some id ->
- begin match Stream.peek strm__ with
- Some (Kwd "=") ->
- Stream.junk strm__;
- let v =
- try parse_option strm__ with
- Stream.Failure -> raise (Stream.Error "")
- in
- let eof =
- try parse_gwmlrc strm__ with
- Stream.Failure -> raise (Stream.Error "")
- in
- (id, v) :: eof
- | _ -> raise (Stream.Error "")
- end
- | _ -> []
-and parse_option (strm__ : _ Stream.t) =
- match Stream.peek strm__ with
- Some (Kwd "{") ->
- Stream.junk strm__;
- let v =
- try parse_gwmlrc strm__ with
- Stream.Failure -> raise (Stream.Error "")
- in
- begin match Stream.peek strm__ with
- Some (Kwd "}") -> Stream.junk strm__; Module v
- | _ -> raise (Stream.Error "")
- end
- | Some (Ident s) -> Stream.junk strm__; StringValue s
- | Some (String s) -> Stream.junk strm__; StringValue s
- | Some (Int i) -> Stream.junk strm__; IntValue i
- | Some (Float f) -> Stream.junk strm__; FloatValue f
- | Some (Char c) ->
- Stream.junk strm__;
- StringValue (let s = String.create 1 in s.[0] <- c; s)
- | Some (Kwd "[") ->
- Stream.junk strm__;
- let v =
- try parse_list strm__ with
- Stream.Failure -> raise (Stream.Error "")
- in
- List v
- | Some (Kwd "(") ->
- Stream.junk strm__;
- let v =
- try parse_list strm__ with
- Stream.Failure -> raise (Stream.Error "")
- in
- List v
- | _ -> raise Stream.Failure
-and parse_id (strm__ : _ Stream.t) =
- match Stream.peek strm__ with
- Some (Ident s) -> Stream.junk strm__; s
- | Some (String s) -> Stream.junk strm__; s
- | _ -> raise Stream.Failure
-and parse_list (strm__ : _ Stream.t) =
- match Stream.peek strm__ with
- Some (Kwd ";") ->
- Stream.junk strm__;
- begin try parse_list strm__ with
- Stream.Failure -> raise (Stream.Error "")
- end
- | Some (Kwd ",") ->
- Stream.junk strm__;
- begin try parse_list strm__ with
- Stream.Failure -> raise (Stream.Error "")
- end
- | Some (Kwd ".") ->
- Stream.junk strm__;
- begin try parse_list strm__ with
- Stream.Failure -> raise (Stream.Error "")
- end
- | _ ->
- match
- try Some (parse_option strm__) with
- Stream.Failure -> None
- with
- Some v ->
- let t =
- try parse_list strm__ with
- Stream.Failure -> raise (Stream.Error "")
- in
- v :: t
- | _ ->
- match Stream.peek strm__ with
- Some (Kwd "]") -> Stream.junk strm__; []
- | Some (Kwd ")") -> Stream.junk strm__; []
- | _ -> raise Stream.Failure
-;;
-
-let exec_hooks o =
- List.iter
- (fun f ->
- try f () with
- _ -> ())
- o.option_hooks
-;;
-
-let exec_chooks o =
- List.iter
- (fun f ->
- try f o with
- _ -> ())
- o.option_class.class_hooks
-;;
-
-let really_load filename options =
- let temp_file = filename ^ ".tmp" in
- if Sys.file_exists temp_file then begin
- let buf = Buffer.create 150 in
- Printf.bprintf buf "File %s exists\n" temp_file;
- Printf.bprintf buf
- "An error may have occurred during previous configuration save.\n";
- Printf.bprintf buf
- "Please, check your configurations files, and rename/remove this file\n";
- Printf.bprintf buf "before restarting.";
- raise (Failure (Buffer.contents buf))
- end
- else
- try
- let list =
- Unix2.tryopen_read filename (fun ic ->
- let s = Stream.of_channel ic in
- let stream = lexer s in
- try parse_gwmlrc stream with
- e ->
- lprintf_nl "At pos %d/%d" (Stream.count s) (Stream.count
stream);
- raise e) in
- List.iter
- (fun o ->
- try
- o.option_value <-
- o.option_class.from_value (find_value o.option_name list);
- exec_chooks o;
- exec_hooks o
- with
- e ->
- lprintf_nl "Exc %s" (Printexc2.to_string e))
- options;
- list
- with
- e ->
- lprintf_nl "Error %s in %s" (Printexc2.to_string e) filename;
- []
-;;
-
-let load opfile =
- try opfile.file_rc <- really_load opfile.file_name opfile.file_options with
- Not_found ->
- lprintf_nl "No %s found" opfile.file_name
-;;
-
-let append opfile filename =
- try opfile.file_rc <-
- really_load filename opfile.file_options @ opfile.file_rc with
- Not_found ->
- lprintf_nl "No %s found" filename
-;;
-
-let ( !! ) o = o.option_value;;
-let ( =:= ) o v = o.option_value <- v; exec_chooks o; exec_hooks o;;
-
-let value_to_string v =
- match v with
- StringValue s -> s
- | IntValue i -> string_of_int i
- | FloatValue f -> string_of_float f
- | _ -> failwith "Options: not a string option"
-;;
-
-let string_to_value s = StringValue s;;
-
-let value_to_int v =
- match v with
- StringValue s -> int_of_string s
- | IntValue i -> i
- | _ -> failwith "Options: not an int option"
-;;
-
-let int_to_value i = IntValue i;;
-
-(* The Pervasives version is too restrictive *)
-let bool_of_string s =
- match String.lowercase s with
- "true" -> true
- | "false" -> false
- | "yes" -> true
- | "no" -> false
- | "y" -> true
- | "n" -> false
- | _ -> invalid_arg "bool_of_string"
-;;
-
-let value_to_bool v =
- match v with
- StringValue s -> bool_of_string s
- | IntValue v when v = 0 -> false
- | IntValue v when v = 1 -> true
- | _ -> failwith "Options: not a bool option"
-;;
-let bool_to_value i = StringValue (string_of_bool i);;
-
-let value_to_float v =
- match v with
- StringValue s -> float_of_string s
- | FloatValue f -> f
- | _ -> failwith "Options: not a float option"
-;;
-
-let float_to_value i = FloatValue i;;
-
-let value_to_string2 v =
- match v with
- List [s1; s2] | SmallList [s1;s2] ->
- value_to_string s1, value_to_string s2
- | _ -> failwith "Options: not a string2 option"
-;;
-
-let string2_to_value (s1, s2) = SmallList [StringValue s1; StringValue s2];;
-
-let value_to_list v2c v =
- match v with
- List l | SmallList l -> List.rev (List.rev_map v2c l)
- | StringValue s -> failwith (Printf.sprintf
- "Options: not a list option (StringValue [%s])" s)
- | FloatValue _ -> failwith "Options: not a list option (FloatValue)"
- | IntValue _ -> failwith "Options: not a list option (IntValue)"
- | Module _ -> failwith "Options: not a list option (Module)"
-;;
-
-let list_to_value c2v l =
- List
- (List.fold_right
- (fun v list ->
- try c2v v :: list with
- _ -> list)
- l [])
-;;
-
-let smalllist_to_value c2v l =
- SmallList
- (List.fold_right
- (fun v list ->
- try c2v v :: list with
- _ -> list)
- l [])
-;;
-
-let string_option =
- define_option_class "String" value_to_string string_to_value
-;;
-let color_option =
- define_option_class "Color" value_to_string string_to_value
-;;
-let font_option = define_option_class "Font" value_to_string string_to_value;;
-
-let int_option = define_option_class "Int" value_to_int int_to_value;;
-
-let bool_option = define_option_class "Bool" value_to_bool bool_to_value;;
-let float_option = define_option_class "Float" value_to_float float_to_value;;
-
-let string2_option =
- define_option_class "String2" value_to_string2 string2_to_value
-;;
-
-let list_option cl =
- define_option_class (cl.class_name ^ " List") (value_to_list cl.from_value)
- (list_to_value cl.to_value)
-;;
-
-let smalllist_option cl =
- define_option_class (cl.class_name ^ " List") (value_to_list cl.from_value)
- (smalllist_to_value cl.to_value)
-;;
-
-let to_value cl = cl.to_value;;
-let from_value cl = cl.from_value;;
-
-let value_to_sum l v =
- match v with
- StringValue s -> List.assoc s l
- | _ -> failwith "Options: not a sum option"
-;;
-
-let sum_to_value l v = StringValue (List.assq v l);;
-
-let sum_option l =
- let ll = List.map (fun (a1, a2) -> a2, a1) l in
- define_option_class "Sum" (value_to_sum l) (sum_to_value ll)
-;;
-
-let exit_exn = Exit;;
-let safe_string s =
- if s = "" then "\"\""
- else
- try
- match s.[0] with
- 'a'..'z' | 'A'..'Z' ->
- for i = 1 to String.length s - 1 do
- match s.[i] with
- 'a'..'z' | 'A'..'Z' | '_' | '0'..'9' -> ()
- | _ -> raise exit_exn
- done;
- s
- | _ ->
- if string_of_int (int_of_string s) = s ||
- string_of_float (float_of_string s) = s then
- s
- else raise exit_exn
- with
- _ -> Printf.sprintf "\"%s\"" (String.escaped s)
-;;
-
-let with_help = ref false;;
-
-let rec save_module indent oc list =
- let subm = ref [] in
- List.iter
- (fun (name, help, value) ->
- match name with
- [] -> assert false
- | [name] ->
- if !with_help && help <> "" then
- Printf.fprintf oc "(* %s *)\n" help;
- Printf.fprintf oc "%s %s = " indent (safe_string name);
- save_value indent oc value;
- Printf.fprintf oc "\n"
- | m :: tail ->
- let p =
- try List.assoc m !subm with
- _ -> let p = ref [] in subm := (m, p) :: !subm; p
- in
- p := (tail, help, value) :: !p)
- list;
- List.iter
- (fun (m, p) ->
- Printf.fprintf oc "%s %s = {\n" indent (safe_string m);
- save_module (indent ^ " ") oc !p;
- Printf.fprintf oc "%s}\n" indent)
- !subm
-and save_list indent oc list =
- match list with
- [] -> ()
- | [v] -> save_value indent oc v
- | v :: tail ->
- save_value indent oc v; Printf.fprintf oc ", "; save_list indent oc tail
-and save_list_nl indent oc list =
- match list with
- [] -> ()
- | [v] -> Printf.fprintf oc "\n%s" indent; save_value indent oc v
- | v :: tail ->
- Printf.fprintf oc "\n%s" indent;
- save_value indent oc v;
- Printf.fprintf oc ";";
- save_list_nl indent oc tail
-and save_value indent oc v =
- match v with
- StringValue s -> Printf.fprintf oc "%s" (safe_string s)
- | IntValue i -> Printf.fprintf oc "%d" i
- | FloatValue f -> Printf.fprintf oc "%f" f
- | List l ->
- Printf.fprintf oc "[";
- save_list_nl (indent ^ " ") oc l;
- Printf.fprintf oc "]"
- | SmallList l ->
- Printf.fprintf oc "(";
- save_list (indent ^ " ") oc l;
- Printf.fprintf oc ")"
- | Module m ->
- Printf.fprintf oc "{";
- save_module_fields (indent ^ " ") oc m;
- Printf.fprintf oc "}"
-
-and save_module_fields indent oc m =
- match m with
- [] -> ()
- | (name, v) :: tail ->
- Printf.fprintf oc "%s %s = " indent (safe_string name);
- save_value indent oc v;
- Printf.fprintf oc "\n";
- save_module_fields indent oc tail
-;;
-
-let save opfile =
- let filename = opfile.file_name in
- let temp_file = filename ^ ".tmp" in
- let old_file = filename ^ ".old" in
- Unix2.tryopen_write temp_file (fun oc ->
- save_module "" oc
- (List.map
- (fun o ->
- o.option_name, o.option_help,
- (try
- o.option_class.to_value o.option_value
- with
- e ->
- lprintf_nl "Error while saving option \"%s\": %s"
- (try List.hd o.option_name with
- _ -> "???")
- (Printexc2.to_string e);
- StringValue ""))
- (List.rev opfile.file_options));
- if not opfile.file_pruned then begin
- Printf.fprintf oc
- "\n(*\n The following options are not used (errors, obsolete, ...)
\n*)\n";
- List.iter
- (fun (name, value) ->
- try
- List.iter
- (fun o ->
- match o.option_name with
- n :: _ -> if n = name then raise Exit
- | _ -> ())
- opfile.file_options;
- Printf.fprintf oc "%s = " (safe_string name);
- save_value " " oc value;
- Printf.fprintf oc "\n"
- with
- _ -> ())
- opfile.file_rc;
- end);
- (try Sys.rename filename old_file with _ -> ());
- (try Sys.rename temp_file filename with _ -> ())
-;;
-
-let save_with_help opfile =
- with_help := true;
- begin try save opfile with
- _ -> ()
- end;
- with_help := false
-;;
-
-let option_hook option f = option.option_hooks <- f :: option.option_hooks;;
-
-let class_hook option_class f =
- option_class.class_hooks <- f :: option_class.class_hooks
-;;
-
-let rec iter_order f list =
- match list with
- [] -> ()
- | v :: tail -> f v; iter_order f tail
-;;
-
-let help oc opfile =
- List.iter
- (fun o ->
- Printf.fprintf oc "OPTION \"";
- begin match o.option_name with
- [] -> Printf.fprintf oc "???"
- | [name] -> Printf.fprintf oc "%s" name
- | name :: tail ->
- Printf.fprintf oc "%s" name;
- iter_order (fun name -> Printf.fprintf oc ":%s" name) o.option_name
- end;
- Printf.fprintf oc "\" (TYPE \"%s\"): %s\n CURRENT: \n"
- o.option_class.class_name o.option_help;
- begin try
- save_value "" oc (o.option_class.to_value o.option_value)
- with
- _ -> ()
- end;
- Printf.fprintf oc "\n")
- opfile.file_options;
- flush oc
-;;
-
-
-let tuple2_to_value (c1, c2) (a1, a2) =
- SmallList [to_value c1 a1; to_value c2 a2]
-;;
-
-let value_to_tuple2 (c1, c2) v =
- match v with
- List [v1; v2] -> from_value c1 v1, from_value c2 v2
- | SmallList [v1; v2] -> from_value c1 v1, from_value c2 v2
- | List l | SmallList l ->
- lprintf_nl "list of %d" (List.length l);
- failwith "Options: not a tuple2 list option"
- | _ -> failwith "Options: not a tuple2 option"
-;;
-
-let tuple2_option p =
- define_option_class "tuple2_option" (value_to_tuple2 p) (tuple2_to_value p)
-;;
-
-let tuple3_to_value (c1, c2, c3) (a1, a2, a3) =
- SmallList [to_value c1 a1; to_value c2 a2; to_value c3 a3]
-;;
-let value_to_tuple3 (c1, c2, c3) v =
- match v with
- List [v1; v2; v3] -> from_value c1 v1, from_value c2 v2, from_value c3 v3
- | SmallList [v1; v2; v3] ->
- from_value c1 v1, from_value c2 v2, from_value c3 v3
- | _ -> failwith "Options: not a tuple3 option"
-;;
-
-let tuple3_option p =
- define_option_class "tuple3_option" (value_to_tuple3 p) (tuple3_to_value p)
-;;
-
-let shortname o = String.concat ":" o.option_name;;
-let get_class o = o.option_class;;
-let get_help o =
- let help = o.option_help in if help = "" then "No Help Available" else help
-;;
-
-
-let simple_options opfile =
- let list = ref [] in
- List.iter (fun o ->
- match o.option_name with
- [] | _ :: _ :: _ -> ()
- | [name] ->
- match o.option_class.to_value o.option_value with
- Module _ | SmallList _ | List _ ->
- begin
- match o.string_wrappers with
- None -> ()
- | Some (to_string, from_string) ->
- list := (name, to_string o.option_value) :: !list
- end
- | v ->
- list := (name, value_to_string v) :: !list
- ) opfile.file_options;
- !list
-
-let get_option opfile name =
- let rec iter name list =
- match list with
- [] -> raise Not_found
- | o :: list ->
- if o.option_name = name then o
- else iter name list
- in
- iter [name] opfile.file_options
-
-
-let set_simple_option opfile name v =
- let o = get_option opfile name in
- begin
- match o.string_wrappers with
- None ->
- o.option_value <- o.option_class.from_value (string_to_value v);
- | Some (_, from_string) ->
- o.option_value <- from_string v
- end;
- exec_chooks o; exec_hooks o;;
-
-let get_simple_option opfile name =
- let o = get_option opfile name in
- match o.string_wrappers with
- None ->
- value_to_string (o.option_class.to_value o.option_value)
- | Some (to_string, _) ->
- to_string o.option_value
-
-let set_option_hook opfile name hook =
- let o = get_option opfile name in
- o.option_hooks <- hook :: o.option_hooks
-
-let set_string_wrappers o to_string from_string =
- o.string_wrappers <- Some (to_string, from_string)
-
-let simple_args opfile =
- List.map (fun (name, v) ->
- ("-" ^ name),
- Arg.String (set_simple_option opfile name),
- (Printf.sprintf "<string> : \t%s (current: %s)"
- (get_option opfile name).option_help
- v)
- ) (simple_options opfile)
Index: src/daemon/chat/chat_options.mli
===================================================================
RCS file: src/daemon/chat/chat_options.mli
diff -N src/daemon/chat/chat_options.mli
--- src/daemon/chat/chat_options.mli 22 Apr 2003 22:33:39 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,140 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(**
- This module implements a simple mechanism to handle program options files.
- An options file is defined as a set of [variable = value] lines,
- where value can be a simple string, a list of values (between brackets
-or parentheses) or a set of [variable = value] lines between braces.
-The option file is automatically loaded and saved, and options are
-manipulated inside the program as easily as references.
-
- Code from Fabrice Le Fessant.
-*)
-
-type 'a option_class
-(** The abstract type for a class of options. A class is a set of options
-which use the same conversion functions from loading and saving.*)
-
-type 'a option_record
-(** The abstract type for an option *)
-
-type options_file
-
-val create_options_file : string -> options_file
-val set_options_file : options_file -> string -> unit
-val prune_file : options_file -> unit
-
-(** {2 Operations on option files} *)
-
-val load : options_file -> unit
-(** [load file] loads the option file. All options whose value is specified
- in the option file are updated. *)
-
-val append : options_file -> string -> unit
-(** [append filename] loads the specified option file. All options whose
-value is specified in this file are updated. *)
-
-val save : options_file -> unit
-(** [save file] saves all the options values to the option file. *)
-
-val save_with_help : options_file -> unit
-(** [save_with_help ()] saves all the options values to the option file,
- with the help provided for each option. *)
-
-(** {2 Creating options} *)
-val define_option : options_file ->
- string list -> string -> 'a option_class -> 'a -> 'a option_record
-val option_hook : 'a option_record -> (unit -> unit) -> unit
-
-val string_option : string option_class
-val color_option : string option_class
-val font_option : string option_class
-val int_option : int option_class
-val bool_option : bool option_class
-val float_option : float option_class
-val string2_option : (string * string) option_class
-
- (* parameterized options *)
-val list_option : 'a option_class -> 'a list option_class
-val smalllist_option : 'a option_class -> 'a list option_class
-val sum_option : (string * 'a) list -> 'a option_class
-val tuple2_option :
- 'a option_class * 'b option_class -> ('a * 'b) option_class
-val tuple3_option : 'a option_class * 'b option_class * 'c option_class ->
- ('a * 'b * 'c) option_class
-
-(** {2 Using options} *)
-
-val ( !! ) : 'a option_record -> 'a
-val ( =:= ) : 'a option_record -> 'a -> unit
-
-val shortname : 'a option_record -> string
-val get_help : 'a option_record -> string
-
-(** {2 Creating new option classes} *)
-
-val get_class : 'a option_record -> 'a option_class
-
-val class_hook : 'a option_class -> ('a option_record -> unit) -> unit
-
-type option_value =
- Module of option_module
-| StringValue of string
-| IntValue of int
-| FloatValue of float
-| List of option_value list
-| SmallList of option_value list
-
-and option_module =
- (string * option_value) list
-
-val define_option_class :
- string -> (option_value -> 'a) -> ('a -> option_value) -> 'a option_class
-
-val to_value : 'a option_class -> 'a -> option_value
-val from_value : 'a option_class -> option_value -> 'a
-
-val value_to_string : option_value -> string
-val string_to_value : string -> option_value
-val value_to_int : option_value -> int
-val int_to_value : int -> option_value
-val bool_of_string : string -> bool
-val value_to_bool : option_value -> bool
-val bool_to_value : bool -> option_value
-val value_to_float : option_value -> float
-val float_to_value : float -> option_value
-val value_to_string2 : option_value -> string * string
-val string2_to_value : string * string -> option_value
-val value_to_list : (option_value -> 'a) -> option_value -> 'a list
-val list_to_value : ('a -> option_value) -> 'a list -> option_value
-val smalllist_to_value : ('a -> option_value) -> 'a list -> option_value
-
-val set_simple_option : options_file -> string -> string -> unit
-val simple_options : options_file -> (string * string) list
-val get_simple_option : options_file -> string -> string
-val set_option_hook : options_file -> string -> (unit -> unit) -> unit
-
-val set_string_wrappers : 'a option_record ->
- ('a -> string) -> (string -> 'a) -> unit
-
-val simple_args : options_file -> (string * Arg.spec * string) list
Index: src/daemon/chat/chat_proto.ml
===================================================================
RCS file: src/daemon/chat/chat_proto.ml
diff -N src/daemon/chat/chat_proto.ml
--- src/daemon/chat/chat_proto.ml 14 Dec 2005 21:17:46 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,456 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** Protocol for communicating, a class
- implementing send and receive with
- Unix unconnected sockets and a class to implement it with connected sockets.
-
- The protocol is the following. A message is:
- <version>\n
- <source_id>\n
- <source_hidden_id>\n
- <source_host>\n
- <source_port>\n
- <dest_id>\n
- <dest_hidden_id>\n
- <message_type>\n
- [<message_room_name>]\n
- [<message_room_people_number>]\n
- [(<message_room_people_id>\n
- <message_room_people_host>\n
- <message_room_people_port>\n)+]
- [<message_body_length>]\n
- [<message_body>]
- [<id>\n
- <hidden_id>\n
- <host>\n
- <port>]
-
- where <message_type> can be
- - HELLO_OK
- - HELLO
- - BYEBYE
- - MESSAGE
- - ADD_OPEN
- - ROOM_MESSAGE
-
- <message_body_length> appears only when the <message_type> is MESSAGE or
ROOM_MESSAGE.
- <message_body> appears only after the <message_body_length>.
- [<id>\n
- <hidden_id>\n
- <host>\n
- <port>] appears only for a ADD_OPEN <message_type>
- *)
-
-type port = int
-type host = string
-type address = host * port
-
-type message = string
-type version = string
-type id = string
-
-type source = version * id * address
-type dest = id
-
-
-type proto =
- | HelloOk (** Reply to an ok message *)
- | Hello (** to signal that we are connected *)
- | Byebye (** to signal that we are disconnecting *)
- | Message of message
- | AddOpen of id * address (** to remotely add a user *)
- | RoomMessage of id * (id * host * port) list * message
- (** id of the room, people in the room and message *)
-
-
-type packet = source * dest * proto (** source, destination, proto *)
-
-let version = Chat_messages.software_version
-
-let il input =
- let l = input () in
- Chat_misc.remove_blanks l
-
-(** read a packet with the given functions.
- @raise Failure if an error occurs (bad format, enf of file, ...). *)
-let read_packet getline input =
- try
- let v = il getline in
- let source_id = getline () in
- let source_host = getline () in
- let source_port = int_of_string (il getline) in
- let dest_id = getline () in
- let message_type = il getline in
- let proto =
- match String.uppercase message_type with
- "HELLO_OK" -> HelloOk
- | "HELLO" -> Hello
- | "BYEBYE" -> Byebye
- | "MESSAGE" ->
- let length = int_of_string (il getline) in
- let s = String.create length in
- Message s
- | "ROOM_MESSAGE" ->
- let name = getline () in
- let n = int_of_string (il getline) in
- let rec iter acc m =
- if m < n then
- iter
- (
- let source_id = getline () in
- let source_host = getline () in
- let source_port = int_of_string (il getline) in
- (source_id, source_host, source_port) :: acc
- )
- (m+1)
- else
- List.rev acc
- in
- let people = iter [] 0 in
- let length = int_of_string (il getline) in
- let s = String.create length in
- RoomMessage (name, people, s)
-
- | "ADD_OPEN" ->
- let id = il getline in
- let host = il getline in
- let port = int_of_string (il getline) in
- AddOpen (id, (host, port))
- | _ ->
- raise (Failure "Bad message type")
- in
- let source = (v, source_id, (source_host, source_port)) in
- (source, dest_id, proto)
- with
- End_of_file -> raise (Failure "End_of_file")
- | Invalid_argument "int_of_string" -> raise (Failure "Bad format")
-
-let read_packet_channel inch =
- read_packet (fun () -> input_line inch) (input inch)
-
-let read_packet_buffer buf =
- read_packet (fun () -> Chat_misc.buf_get_line buf) (Chat_misc.buf_input buf)
-
-
-let ol buf s = Printf.bprintf buf "%s\n" s
-
-(** write the given paquet to the given buffer. *)
-let write_packet buf packet =
- let (source, dest_id, proto) = packet in
- let (v, source_id, (source_host, source_port)) = source in
- let p = ol buf in
- let p2 s = p (Chat_misc.remove_newlines s) in
- p2 v;
- p2 source_id ;
- p2 source_host ;
- p2 (string_of_int source_port) ;
- p2 dest_id ;
- match proto with
- HelloOk -> p "HELLO_OK"
- | Hello -> p "HELLO"
- | Byebye -> p "BYEBYE"
- | Message s ->
- p "MESSAGE";
- let l = String.length s in
- p (string_of_int l);
- p s
- | AddOpen (id, (h, port)) ->
- p "ADD_OPEN";
- p2 id ;
- p2 h ;
- p2 (string_of_int port)
- | RoomMessage (name, people, s) ->
- p "ROOM_MESSAGE";
- p name ;
- p (string_of_int (List.length people));
- List.iter
- (fun (i,h,port) ->
- p2 i ;
- p2 h ;
- p2 (string_of_int port)
- )
- people;
- let l = String.length s in
- p (string_of_int l);
- p s
-
-(** write the given paquet to the given channel. *)
-let write_packet_channel ouch packet =
- let buf = Buffer.create 256 in
- write_packet buf packet;
- output_string ouch (Buffer.contents buf)
-
-(** The classes used to send and receive messages. *)
-class type com =
- object
- (** Free all what must be freed when the app is closed. *)
- method close : unit
-
- (** [send adr mes] sends the message [mes] to the
- application at address [adr].
- Should raise Failure with an error message if an
- error occurs.*)
- method send : id -> address -> proto -> unit
-
- (** [receive] returns an optional message, if
- one was pending.
- Should raise Failure with an error message if an
- error occurs.*)
- method receive : packet option
- end
-
-(** This class implements the com interface,
- with Unix unconnected sockets.
- It needs a {!Chat_config.config} class to
- access config options.*)
-class udp conf =
- let localhost = conf#hostname in
- let h = Unix.gethostbyname localhost in
- let inet_addr = h.Unix.h_addr_list.(0) in
- let sock_addr = Unix.ADDR_INET (inet_addr, conf#port) in
- let iptable = Hashtbl.create 13 in
- object (self)
- val sock = Unix.socket Unix.PF_INET Unix.SOCK_DGRAM 0
-
- method private source =
- (version, conf#id, (localhost, conf#port))
-
- method close = Unix.close sock
-
- method send id adr mes =
- let (host, port) = adr in
- if host = localhost && port = conf#port then
- raise (Failure Chat_messages.dest_is_source)
- else
- (
- let domain = Unix.PF_INET in
- let sock = Unix.socket domain Unix.SOCK_DGRAM 0 in
- let ip_opt =
- try
- Some (Hashtbl.find iptable host)
- with Not_found ->
- try
- let h = Unix.gethostbyname host in
- Some (h.Unix.h_addr_list.(0))
- with
- Not_found -> None
- in
- match ip_opt with
- None -> ()
- | Some ip ->
- let sockaddr = Unix.ADDR_INET (ip, port) in
- try
- let buf = Buffer.create 256 in
- write_packet buf (self#source, id, mes);
- let s = Buffer.contents buf in
- ignore (Unix.sendto sock s 0 (String.length s) [] sockaddr)
- with
- | Unix.Unix_error (e,s1,s2) ->
- let s = (Unix.error_message e)^" :"^s1^" "^s2 in
- raise (Failure s)
- )
-
- method receive =
- try
- let s_buf = String.create 66000 in
- let (len, addr) = Unix.recvfrom sock s_buf 0 66000 [] in
- (match addr with
- Unix.ADDR_INET (a,_) -> Chat_messages.verbose ("receive from
"^(Unix.string_of_inet_addr a))
- | _ -> ()
- );
- let s = String.sub s_buf 0 len in
- let buf = Buffer.create len in
- Buffer.add_string buf s;
- let paq = read_packet_buffer buf in
- match paq with
- ((v,id,(host,port)),iddest,pro) ->
- if v <> version then
- (
- Chat_messages.verbose Chat_messages.incompatible_version ;
- None
- )
- else
- (
- match addr with
- Unix.ADDR_INET (a,_) ->
- (
- try
- let old_a = Hashtbl.find iptable host in
- if old_a = a then
- ()
- else
- (
- Hashtbl.remove iptable host ;
- raise Not_found
- )
- with
- Not_found ->
- Hashtbl.add iptable host a
- );
- Some paq
- | _ ->
- None
- )
- with
- Unix.Unix_error (Unix.EWOULDBLOCK,_,_)
- | Unix.Unix_error (Unix.EAGAIN,_,_) ->
- None
- | Unix.Unix_error (e,s1,s2) ->
- let s = (Unix.error_message e)^" :"^s1^" "^s2 in
- raise (Failure s)
-
- initializer
- Unix.setsockopt sock Unix.SO_REUSEADDR true ;
- MlUnix.set_nonblock sock ;
- try
- Unix.bind sock sock_addr
- with
- | Unix.Unix_error (e,s1,s2) ->
- let s = (Unix.error_message e)^" :"^s1^" "^s2 in
- raise (Failure s)
- end
-
-let cpt = ref 1
-
-(** This class implements the com interface,
- with Unix connected sockets.
- It needs a {!Chat_config.config} class to
- access config options.*)
-class tcp conf =
- let localhost = conf#hostname in
-(* let h = Unix.gethostbyname localhost in*)
- let inet_addr = Unix.inet_addr_of_string "0.0.0.0"
(*h.Unix.h_addr_list.(0)*) in
- let sock_addr = Unix.ADDR_INET (inet_addr, conf#port) in
- let iptable = Hashtbl.create 13 in
- object (self)
- val instance = (incr cpt; !cpt)
-
- val sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0
-
- method private source =
- (version, conf#id, (localhost, conf#port))
-
- method close = Unix.close sock
-
- method send id adr mes =
- let (host, port) = adr in
- if host = localhost && port = conf#port then
- raise (Failure Chat_messages.dest_is_source)
- else
- (
- let domain = Unix.PF_INET in
- let sock = Unix.socket domain Unix.SOCK_STREAM 0 in
- let ip_opt =
- try
- Some (Hashtbl.find iptable host)
- with Not_found ->
- try
- let h = Unix.gethostbyname host in
- Some (h.Unix.h_addr_list.(0))
- with
- Not_found -> None
- in
- match ip_opt with
- None -> ()
- | Some ip ->
- let sockaddr = Unix.ADDR_INET (ip, port) in
- try
- let chanout = Unix.out_channel_of_descr sock in
- let paq = (self#source, id, mes) in
- Unix.connect sock sockaddr;
- write_packet_channel chanout paq;
- flush chanout;
- close_out chanout
- with
- | Unix.Unix_error (e,s1,s2) ->
- let s = s1^" "^s2^" : "^(Unix.error_message e) in
- raise (Failure s)
- )
-
- method receive =
- try
- let (desc, addr) = Unix.accept sock in
- (match addr with
- Unix.ADDR_INET (a,_) -> Chat_messages.verbose ("receive from
"^(Unix.string_of_inet_addr a))
- | _ -> ()
- );
- let chanin = Unix.in_channel_of_descr desc in
- let chanout = Unix.out_channel_of_descr desc in
- let paq = read_packet_channel chanin in
- let ret =
- match paq with
- ((v,id,(host,port)),iddest,pro) ->
- if v <> version then
- (
- Chat_messages.verbose Chat_messages.incompatible_version ;
- None
- )
- else
- (
- match addr with
- Unix.ADDR_INET (a,_) ->
- (
- try
- let old_a = Hashtbl.find iptable host in
- if old_a = a then
- ()
- else
- (
- Hashtbl.remove iptable host ;
- raise Not_found
- )
- with
- Not_found ->
- Hashtbl.add iptable host a
- );
- Some paq
- | _ ->
- None
- )
- in
- close_out chanout;
- ret
- with
- Unix.Unix_error (Unix.EWOULDBLOCK,_,_)
- | Unix.Unix_error (Unix.EAGAIN,_,_) ->
- None
- | Unix.Unix_error (e,s1,s2) ->
- let s = (Unix.error_message e)^" :"^s1^" "^s2 in
- raise (Failure s)
- | Failure s ->
- raise (Failure s)
- | e ->
- let s = Printexc2.to_string e in
- raise (Failure s)
-
- initializer
- Unix.setsockopt sock Unix.SO_REUSEADDR true ;
- MlUnix.set_nonblock sock ;
- try
- Unix.bind sock sock_addr ;
- Unix.listen sock 15;
- with
- | Unix.Unix_error (e,s1,s2) ->
- let s = (Unix.error_message e)^" :"^s1^" "^s2 in
- raise (Failure s)
- end
Index: src/daemon/chat/chat_types.ml
===================================================================
RCS file: src/daemon/chat/chat_types.ml
diff -N src/daemon/chat/chat_types.ml
--- src/daemon/chat/chat_types.ml 22 Apr 2003 22:33:39 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,27 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** Common types. *)
-
-type state =
- Connected
- | Not_connected
Index: src/daemon/chat/mlchat.ml
===================================================================
RCS file: src/daemon/chat/mlchat.ml
diff -N src/daemon/chat/mlchat.ml
--- src/daemon/chat/mlchat.ml 22 Apr 2003 22:33:39 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,66 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-class type config = Chat_config.config
-
-class file_config = Chat_config.config
-
-type port = int
-type host = string
-type address = host * port
-type message = string
-type version = Chat_proto.version
-type id = string
-type source = version * id * address
-type proto = Chat_proto.proto =
- HelloOk | Hello | Byebye | Message of message
- | AddOpen of id * address
- | RoomMessage of id * (id * host * port) list * message
-type packet = source * id * proto
-
-let version () = Chat_messages.software_version
-
-class type com = Chat_proto.com
-
-let read_packet = Chat_proto.read_packet_buffer
-let read_packet_channel = Chat_proto.read_packet_channel
-
-let write_packet = Chat_proto.write_packet
-let write_packet_channel = Chat_proto.write_packet_channel
-
-class udp (conf : config) = Chat_proto.udp conf
-class tcp (conf : config) = Chat_proto.tcp conf
-
-let default_pred (i1,h1,p1) (i2,h2,p2) =
- h1=h2 && p1=p2
-
-class app
- ?(no_quit=false)
- ?(pred=default_pred)
- (conf : config) (com : com) =
- let chat = new Chat_app.app pred ~no_quit conf com in
- object
- method box = chat#box
- method coerce = chat#coerce
- method init_window (w : GWindow.window) =
- w#add_accel_group chat#accelgroup
- end
Index: src/daemon/chat/mlchat.mli
===================================================================
RCS file: src/daemon/chat/mlchat.mli
diff -N src/daemon/chat/mlchat.mli
--- src/daemon/chat/mlchat.mli 22 Apr 2003 22:33:39 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,118 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** The MLChat library. You can use it to add chat in your apps.*)
-
-type port = int
-type host = string
-type id = string
-
-(** {2 Configuration}*)
-
-(** The type of the class to use as the st of options. *)
-class type config =
- object
- method args_spec : (string * Arg.spec * string) list
- method color_connected : string
- method color_connected_temp : string
- method color_myself : string
- method color_not_connected : string
- method id : string
- method hostname : string
- method people : (string * string * int) list
- method popup_all : bool
- method port : int
- method save : unit
- method set_color_connected : string -> unit
- method set_color_connected_temp : string -> unit
- method set_color_myself : string -> unit
- method set_color_not_connected : string -> unit
- method set_id : string -> unit
- method set_hostname : string -> unit
- method set_people : (id * host * port) list -> unit
- method set_popup_all : bool -> unit
- method set_port : int -> unit
- method set_timeout : int -> unit
- method timeout : int
-
- end
-
-(** Create a config object from a config file name.
- Options are saved in this file. *)
-class file_config : string -> config
-
-
-(** {2 Communication} *)
-
-type address = host * port
-type message = string
-type version
-type source = version * id * address
-type proto =
- HelloOk | Hello | Byebye | Message of message
- | AddOpen of id * address
- | RoomMessage of id * (id * host * port) list * message
-type packet = source * id * proto
-
-val version : unit -> version
-
-(** The type of the class to use to send and receive messages.*)
-class type com =
- object
- method close : unit
- method receive : packet option
- method send : id -> address -> proto -> unit
- end
-
-(** Read a packet from the given buffer. *)
-val read_packet : Buffer.t -> packet
-
-(** Read a packet from the given channel. *)
-val read_packet_channel : in_channel -> packet
-
-(** Write the given packet to the given buffer. *)
-val write_packet : Buffer.t -> packet -> unit
-
-(** Write the given packet to the given channel. *)
-val write_packet_channel : out_channel -> packet -> unit
-
-(** A class implementing the protocol with UDP sockets. *)
-class udp : config -> com
-
-(** A class implementing the protocol with TCP sockets. *)
-class tcp : config -> com
-
-(** {2 Application} *)
-
-(** The application class. *)
-class app :
- ?no_quit: bool ->
- ?pred: ((id*host*port) -> (id*host*port) -> bool) ->
- config -> com ->
- object
- method box : GPack.box
- method coerce : GObj.widget
-
- (** Call this method with the window the box has
- been packed in.*)
- method init_window : GWindow.window -> unit
- end
Index: src/daemon/common/commonChat.ml
===================================================================
RCS file: src/daemon/common/commonChat.ml
diff -N src/daemon/common/commonChat.ml
--- src/daemon/common/commonChat.ml 15 Dec 2005 18:48:36 -0000 1.9
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,106 +0,0 @@
-(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-(* $Id: commonChat.ml,v 1.9 2005/12/15 18:48:36 spiralvoice Exp $ *)
-
-open Printf2
-(** Chat functions. *)
-
-let version = Chat_proto.version
-
-module C = Chat_proto
-module O = CommonOptions
-
-let (!!) = Options.(!!)
-
-let send_paquet_to_mlchat (p : C.packet) =
- let domain = Unix.PF_INET in
- let sock = Unix.socket domain Unix.SOCK_STREAM 0 in
- let inet_addr =
- let host = !!O.chat_app_host in
- try Unix.inet_addr_of_string host
- with _ ->
- let h = Unix.gethostbyname host in
- h.Unix.h_addr_list.(0)
- in
- let sockaddr = Unix.ADDR_INET (inet_addr, !!O.chat_app_port) in
- let chanout = Unix.out_channel_of_descr sock in
- try
- Unix.connect sock sockaddr;
- Chat_proto.write_packet_channel chanout p;
- flush chanout;
- close_out chanout
- with
- | Unix.Unix_error (e,s1,s2) -> if !CommonOptions.verbose then begin
- let s = (Unix.error_message e)^" : "^s1^" "^s2 in
- lprintf_nl "Error %s with chat on IP %s, port %d" s
- !!O.chat_app_host !!O.chat_app_port;
- close_out chanout
- end
- | e -> if !CommonOptions.verbose then begin
- lprintf_nl "Error %s with chat on IP %s, port %d"
- (Printexc2.to_string e)
- !!O.chat_app_host !!O.chat_app_port;
- close_out chanout
- end
-
-
-let send_chat_proto name ad_opt m =
- let ad =
- match ad_opt with
- None ->
- (* utiliser le port de chat et l'hostname du core donkey *)
- (Unix.gethostname (), !!O.chat_port)
- | Some ad -> ad
- in
- let source = (version, name, ad) in
- let paquet = (source, name, m) in
- send_paquet_to_mlchat paquet
-
-let send_text name ad_opt s =
- send_chat_proto name ad_opt (C.Message s)
-
-let send_add_open name ad_opt =
- let ad =
- match ad_opt with
- None -> (Unix.gethostname (), !!O.chat_port)
- | Some ad -> ad
- in
- let source = (version, name, ad) in
- let paquet = (source, name, (C.AddOpen (name, ad))) in
- send_paquet_to_mlchat paquet
-
-let send_simple proto =
- let name = !!O.chat_console_id in
- let source = (version, name, (Unix.gethostname (), !!O.chat_port)) in
- let paquet = (source, name, proto) in
- send_paquet_to_mlchat paquet
-
-let send_hello_ok () = send_simple C.HelloOk
-
-let send_hello () = send_simple C.Hello
-
-let send_console_message s =
- send_simple (C.Message s)
-
-let send_warning_for_downloaded_file file =
- if !!CommonOptions.chat_warning_for_downloaded then
- let s = Printf.sprintf "I just completed the download of file %s" file in
- send_console_message s
-
Index: src/gtk/chat/.cvsignore
===================================================================
RCS file: src/gtk/chat/.cvsignore
diff -N src/gtk/chat/.cvsignore
--- src/gtk/chat/.cvsignore 29 Jul 2004 10:25:33 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1 +0,0 @@
-*.cm?
Index: src/gtk/chat/chat_app.ml
===================================================================
RCS file: src/gtk/chat/chat_app.ml
diff -N src/gtk/chat/chat_app.ml
--- src/gtk/chat/chat_app.ml 2 Mar 2005 20:17:06 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,274 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** The application class. *)
-
-open Chat_types
-open Chat_proto
-
-module M = Chat_messages
-module C = Configwin
-
-let safe_int_param h label f v =
- C.string ~help: h ~f: (fun s -> try f (int_of_string s) with _ -> ())
- label (string_of_int v)
-
-let input_people () =
- let id = ref "" in
- let p_id = C.string ~help: M.h_id ~f: (fun s -> id := s) M.id !id in
- let host = ref "" in
- let p_host = C.string ~f: (fun s -> host := s) M.host !host in
- let port = ref 5036 in
- let p_port = safe_int_param M.h_port M.port
- (fun n -> port := n)
- !port
- in
- match C.simple_get M.people [p_id ; p_host ; p_port] with
- C.Return_cancel -> None
- | C.Return_apply | C.Return_ok ->
- Some (!id, !host, !port)
-
-(** Return true if conf was modified. In this case,
- the conf has already been saved.*)
-let edit_conf conf =
- let p_id = C.string
- ~help: M.h_id
- ~f: conf#set_id M.id conf#id
- in
- let p_port = safe_int_param M.h_port M.port conf#set_port conf#port in
- let p_timeout = safe_int_param M.h_timeout M.h_timeout
- conf#set_timeout conf#timeout
- in
- let p_popup = C.bool ~help: M.h_popup_all
- ~f: conf#set_popup_all
- M.popup_all
- conf#popup_all
- in
-
- let p_col_connected = C.color
- ~help: M.h_color_connected
- ~f: conf#set_color_connected
- M.h_color_connected conf#color_connected
- in
- let p_col_connected_temp = C.color
- ~help: M.h_color_connected_temp
- ~f: conf#set_color_connected_temp
- M.h_color_connected_temp conf#color_connected_temp
- in
- let p_col_not_connected = C.color
- ~help: M.h_color_not_connected
- ~f: conf#set_color_not_connected
- M.h_color_not_connected conf#color_not_connected
- in
- let p_col_myself = C.color
- ~help: M.h_color_myself
- ~f: conf#set_color_myself
- M.h_color_myself conf#color_myself
- in
- let add_people () =
- match input_people () with
- None -> []
- | Some p -> [p]
- in
- let p_people = C.list ~f: conf#set_people
- ~add: add_people
- ~titles: [M.id ; M.host ; M.port]
- M.people
- (fun (i,h,p) -> [i ; h ; string_of_int p])
- conf#people
- in
- let structure = [
- C.Section (M.connection,
- [p_id ; p_port ; p_timeout ; p_popup]) ;
- C.Section (M.colors,
- [ p_col_connected ;
- p_col_connected_temp ;
- p_col_not_connected ;
- p_col_myself ] ) ;
- C.Section (M.people,
- [ p_people ]) ;
- ]
- in
- match C.get M.options structure with
- C.Return_cancel -> false
- | C.Return_apply | C.Return_ok ->
- conf#save;
- true
-
-class app
- ?(no_quit=false)
- pred conf com =
- let data = new Chat_data.data pred conf com in
-
- object (self)
- val mutable working = false
- val mutable closed = false
-
- inherit Chat_gui.gui no_quit data as gui
-
- method handle_paquet p =
- let ((version,id,(host,port)), iddest, proto) = p in
- let reply =
- if version <> Chat_proto.version then
- None
- else
- (
- match proto with
- | HelloOk ->
- data#set_connected id host port;
- gui#update;
- None
-
- | Hello ->
- data#set_connected id host port;
- gui#update;
- Some HelloOk
-
- | Byebye ->
- data#set_not_connected id host port;
- gui#update;
- None
-
- | Message mes ->
- let l = data#people in
- data#set_connected id host port;
- if l <> data#people then gui#update;
- let show =
- conf#popup_all or
- (List.exists (pred (id,host,port)) conf#people)
- in
- let dial = Chat_gui.get_dialog ~show data (Chat_gui.Single (id,
host, port)) in
- dial#handle_message id mes;
- None
-
- | AddOpen (i, (h, p)) ->
- Chat_messages.verbose (Printf.sprintf "received AddOpen i=%s
h=%s p=%d" i h p);
- self#handle_paquet ((version,i,(h,p)), iddest, Message "");
- None
-
- | RoomMessage (name, people, mes) ->
- let dial = Chat_gui.get_dialog ~show: true data (Chat_gui.Room
(name, people)) in
- List.iter
- (fun (i,h,p) ->
- if List.exists (data#pred (i,h,p)) conf#people then
- data#set_connected i h p)
- people;
- gui#update;
- dial#handle_message id mes;
- None
- )
- in
- match reply with
- None -> ()
- | Some r ->
- try data#com#send id (host,port) r
- with Failure s -> Chat_messages.verbose s
-
- method accept =
- try
- match data#com#receive with
- None -> ()
- | Some p -> self#handle_paquet p
- with
- Failure s ->
- Chat_messages.verbose s;
- ()
-
-
- method work () =
- if working then not closed
- else
- (
- self#accept;
- if not closed then
- ignore (GMain.Timeout.add ~ms: conf#timeout ~callback: self#work);
- working <- false;
- false
- )
-
- method say_hello (id, host, port, state, temp) =
- if temp then ()
- else
- try data#com#send id (host, port) Hello
- with Failure s ->
- data#set_not_connected id host port;
- Chat_messages.verbose s
-
- method say_byebye (id, host, port, state, temp) =
- try data#com#send id (host, port) Byebye
- with _ -> ()
-
- method edit_conf =
- if edit_conf conf then
- (
- data#update_people ;
- List.iter self#say_hello data#people;
- gui#update
- )
- else
- ()
-
- method toggle_temp_selected =
- List.iter
- (fun (i,h,p,_,t) ->
- if t then data#add_people i h p
- else data#remove_people i h p)
- selected_people;
- gui#update
-
- method kill_people_selected =
- List.iter
- (fun (i,h,p,_,t) ->
- data#remove_people ~kill: true i h p)
- selected_people;
- gui#update
-
- method add_people =
- match input_people () with
- None -> ()
- | Some (id,host,port) ->
- let l = data#people in
- data#add_people id host port;
- let l2 = data#people in
- self#say_hello (data#get_complete_people id host port);
- gui#update
-
- initializer
- ignore (itemOptions#connect#activate (fun () -> self#edit_conf));
- ignore (itemToggleTemp#connect#activate
- (fun () -> self#toggle_temp_selected));
- ignore (itemAddPeople#connect#activate (fun () -> self#add_people));
- ignore (itemRemovePeople#connect#activate (fun () ->
self#kill_people_selected));
-
- ignore (GMain.Timeout.add ~ms: conf#timeout ~callback: self#work) ;
- List.iter self#say_hello data#people;
- gui#update;
-
- ignore (self#box#connect#destroy
- (fun () ->
- List.iter self#say_byebye data#people ;
- closed <- true;
- com#close
- )
- )
-
- end
Index: src/gtk/chat/chat_gui.ml
===================================================================
RCS file: src/gtk/chat/chat_gui.ml
diff -N src/gtk/chat/chat_gui.ml
--- src/gtk/chat/chat_gui.ml 29 Jul 2004 10:25:33 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,290 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** Graphical interface. *)
-
-open Chat_types
-open Chat_proto
-
-type dialog_type =
- Single of id * host * port
-| Room of id * (id * host * port) list
-
-class dialog (data : Chat_data.data) typ_dial =
- let id, host, port =
- match typ_dial with
- Single (i,h,p) -> (i,h,p)
- | Room (n,_) -> n,"",0
- in
- object (self)
- inherit Chat_gui_base.dialog ()
-
- val mutable name =
- match typ_dial with
- Single (id, h, p) -> Printf.sprintf "%s @ %s:%d" id h p
- | Room (name, _) -> name
-
- method name = name
- method id = id
- method host = host
- method port = port
-
- method send s =
- match typ_dial with
- Single (i,h,p) ->
- (
- try data#com#send i (h, p) (Message s)
- with Failure s -> Chat_messages.verbose s
- )
- | Room (name, people) ->
- List.iter
- (fun (i,h,p) ->
- try data#com#send i (h, p) (RoomMessage (self#name, people, s))
- with Failure s -> Chat_messages.verbose s
- )
- people
-
- method handle_message source_id mes =
- wt_dialog#insert ~foreground: (`NAME data#conf#color_connected)
source_id;
- wt_dialog#insert (" : "^mes^"\n");
- wt_dialog#set_position (wt_dialog#length - 1);
- ()
-
- initializer
- let return () =
- let s = wt_input#get_chars 0 wt_input#length in
- let len = String.length s in
- let s2 =
- if len <= 0 then s
- else
- match s.[0] with
- '\n' -> String.sub s 1 (len - 1)
- | _ -> s
- in
- self#send s2;
- wt_dialog#insert ~foreground: (`NAME data#conf#color_myself)
- data#conf#id;
- wt_dialog#insert (" : "^s2^"\n") ;
- wt_input#delete_text ~start: 0 ~stop: wt_input#length
-
- in
- Okey.add wt_input ~mods: [] GdkKeysyms._Return return;
- Okey.add_list wt_input ~mods: [`CONTROL]
- [GdkKeysyms._c; GdkKeysyms._C]
- box#destroy;
- Okey.add_list wt_dialog ~mods: [`CONTROL]
- [GdkKeysyms._c; GdkKeysyms._C]
- box#destroy;
- Okey.add_list wt_input ~mods: [`CONTROL]
- [GdkKeysyms._l; GdkKeysyms._L]
- wb_show_hide#clicked;
- Okey.add_list wt_dialog ~mods: [`CONTROL]
- [GdkKeysyms._l; GdkKeysyms._L]
- wb_show_hide#clicked;
-
- match typ_dial with
- Single _ ->
- wb_show_hide#misc#hide ();
- wscroll_people#misc#hide ()
- | Room (name, people) ->
- wscroll_people#misc#hide ();
- let show = ref false in
- ignore (wb_show_hide#connect#clicked
- (fun () ->
- show := not !show;
- if !show then
- wscroll_people#misc#show ()
- else
- wscroll_people#misc#hide ()));
- List.iter
- (fun (i,h,p) ->
- ignore (wlist_people#append
- [i ; h ; string_of_int p]))
- people;
- GToolbox.autosize_clist wlist_people
- end
-
-(** Liste des dialogs ouverts *)
-let dialogs = ref ([] : (GWindow.window * dialog) list)
-
-(** Liste des rooms ouvertes *)
-let room_dialogs = ref ([] : (GWindow.window * dialog) list)
-
-(** Remove the dialog with the given id from the list of dialogs. *)
-let remove_dialog data typ_dial =
- match typ_dial with
- Single (id,host,port) ->
- dialogs := List.filter
- (fun (_,d) -> not (data#pred (id,host,port) (d#id, d#host, d#port)))
- !dialogs
- | Room (name, people) ->
- room_dialogs := List.filter
- (fun (_,d) -> d#name <> name)
- !room_dialogs
-
-
-(** Find the window and dialog with the given id. It
- it was not found, create it and add it to the list of dialogs.*)
-let get_dialog ?(show=true) data typ_dial =
- try
- match typ_dial with
- Single (id,host,port) ->
- let (w,d) = List.find
- (fun (w,d) -> data#pred (id,host,port) (d#id, d#host, d#port))
- !dialogs
- in
- d#wt_input#misc#grab_focus ();
- if show then w#show () ;
- d
- | Room (name, people) ->
- let (w,d) = List.find (fun (_,d) -> d#name = name) !room_dialogs in
- d#wt_input#misc#grab_focus ();
- if show then w#show () ;
- d
- with
- Not_found ->
- let window = GWindow.window
- ~kind: `POPUP ~width: 300 ~height: 200 ~title: "" () in
- ignore (window#connect#destroy (fun () -> remove_dialog data typ_dial));
- let dialog = new dialog data typ_dial in
- window#set_title dialog#name;
- ignore (dialog#box#connect#destroy window#destroy);
- window#add dialog#box#coerce;
- if show then window#show ();
- (
- match typ_dial with
- Single _ -> dialogs := (window, dialog) :: ! dialogs
- | Room _ -> room_dialogs := (window, dialog) :: ! room_dialogs
- );
- dialog#wt_input#misc#grab_focus ();
- dialog
-
-class gui no_quit (data : Chat_data.data) =
- object (self)
- inherit Chat_gui_base.gui ()
-
- val mutable people = data#people
-
- val mutable selected_people = []
-
- method update =
- wlist#clear ();
- people <- data#people ;
- List.iter
- (fun (id,host,port,state,temp) ->
- ignore (wlist#append ["" ; id ; host ; (string_of_int port) ;
- Chat_messages.yes_or_no temp]
- );
- let color,pix =
- match state, temp with
- Connected, true ->
- (data#conf#color_connected_temp,
- Chat_icons.create_gdk_pixmap Chat_icons.connected)
- | Connected, false ->
- (data#conf#color_connected,
- Chat_icons.create_gdk_pixmap Chat_icons.connected)
- | Not_connected, _ ->
- (data#conf#color_not_connected,
- Chat_icons.create_gdk_pixmap Chat_icons.not_connected)
- in
- wlist#set_cell ~pixmap: pix (wlist#rows - 1) 0 ;
- wlist#set_row ~foreground: (`NAME color) (wlist#rows - 1)
- )
- data#people;
- GToolbox.autosize_clist wlist;
- selected_people <- []
-
- method open_dialog (id, host, port, _, _) =
- ignore (get_dialog data (Single (id, host, port)))
-
- method open_room room_name people =
- let l = List.map (fun (i,h,p,_,_) -> (i,h,p)) people in
- ignore (get_dialog data (Room (room_name, l)))
-
- method open_dialog_for_selected_people =
- match selected_people with
- [] -> ()
- | [p] -> self#open_dialog p
- | l ->
- match GToolbox.input_string
- ~title: Chat_messages.m_open_dialog_for_selected_people
- (Chat_messages.room_name^": ")
- with
- None -> ()
- | Some name ->
- let c = data#conf in
- self#open_room name ((c#id, c#hostname, c#port, Connected, false)
:: l)
-
- initializer
- if no_quit then
- itemQuit#misc#hide ()
- else
- ignore (itemQuit#connect#activate box#destroy);
- ignore (itemOpenDialog#connect#activate
- (fun () -> self#open_dialog_for_selected_people));
- ignore (itemAbout#connect#activate
- (fun () ->
- GToolbox.message_box
- Chat_messages.m_about
- Chat_messages.software_about)
- );
-
-
- let maybe_double_click (ev : GdkEvent.Button.t) =
- let t = GdkEvent.get_type ev in
- match t with
- `TWO_BUTTON_PRESS -> itemOpenDialog#activate ()
- | _ -> ()
- in
-
- let f_select ~row ~column ~event =
- try
- let (id,host,port,_,_) as p = List.nth people row in
- if List.exists
- (fun (i,h,p,_,_) -> data#pred (id,host,port) (i,h,p))
- selected_people
- then
- ()
- else
- selected_people <- p :: selected_people ;
- match event with
- None -> ()
- | Some ev -> maybe_double_click ev
- with _ -> ()
- in
- let f_unselect ~row ~column ~event =
- try
- let (id, host, port, _, _) = List.nth people row in
- selected_people <- List.filter
- (fun (i,h,p,_,_) -> not (data#pred (id,host,port) (i,h,p)))
- selected_people;
- match event with
- None -> ()
- | Some ev -> maybe_double_click ev
- with _ -> ()
- in
- (* connect the select and deselect events *)
- ignore (wlist#connect#select_row f_select) ;
- ignore (wlist#connect#unselect_row f_unselect) ;
-
-
- end
Index: src/gtk/chat/chat_gui_base.ml
===================================================================
RCS file: src/gtk/chat/chat_gui_base.ml
diff -N src/gtk/chat/chat_gui_base.ml
--- src/gtk/chat/chat_gui_base.ml 29 Jul 2004 10:25:33 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,188 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-class gui () =
- let box = GPack.vbox ~homogeneous:false () in
- let menubar =
- GMenu.menu_bar ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let itemfile = GMenu.menu_item ~label:"File" ~packing:(menubar#add) () in
- let menuFile = GMenu.menu ~packing:(itemfile#set_submenu) () in
- let itemOptions =
- GMenu.menu_item ~label:(Chat_messages.m_options) ~packing:(menuFile#add)
- ()
- in
- let itemAddPeople =
- GMenu.menu_item ~label:(Chat_messages.m_add_people)
- ~packing:(menuFile#add) ()
- in
- let itemToggleTemp =
- GMenu.menu_item ~label:(Chat_messages.m_toggle_temp)
- ~packing:(menuFile#add) ()
- in
- let itemOpenDialog =
- GMenu.menu_item ~label:(Chat_messages.m_open_dialog_for_selected_people)
- ~packing:(menuFile#add) ()
- in
- let _ = GMenu.menu_item ~packing:(menuFile#add) () in
- let itemRemovePeople =
- GMenu.menu_item ~label:(Chat_messages.m_remove_people)
- ~packing:(menuFile#add) ()
- in
- let _ = GMenu.menu_item ~packing:(menuFile#add) () in
- let itemQuit =
- GMenu.menu_item ~label:(Chat_messages.m_quit) ~packing:(menuFile#add) ()
- in
- let itemHelp = GMenu.menu_item ~label:"?" ~packing:(menubar#add) () in
- let menuHelp = GMenu.menu ~packing:(itemHelp#set_submenu) () in
- let itemAbout =
- GMenu.menu_item ~label:(Chat_messages.m_about) ~packing:(menuHelp#add) ()
- in
- let accelgroup = GtkData.AccelGroup.create () in
- let _ = menuFile#set_accel_group accelgroup in
- let _ =
- itemOptions#add_accelerator ~group:accelgroup ~modi:([`CONTROL])
- ~flags:([`VISIBLE; `LOCKED]) GdkKeysyms._O
- in
- let _ =
- itemAddPeople#add_accelerator ~group:accelgroup ~modi:([`CONTROL])
- ~flags:([`VISIBLE; `LOCKED]) GdkKeysyms._A
- in
- let _ =
- itemToggleTemp#add_accelerator ~group:accelgroup ~modi:([`CONTROL])
- ~flags:([`VISIBLE; `LOCKED]) GdkKeysyms._T
- in
- let _ =
- itemOpenDialog#add_accelerator ~group:accelgroup ~modi:([`CONTROL])
- ~flags:([`VISIBLE; `LOCKED]) GdkKeysyms._D
- in
- let _ =
- itemRemovePeople#add_accelerator ~group:accelgroup ~modi:([`CONTROL])
- ~flags:([`VISIBLE; `LOCKED]) GdkKeysyms._K
- in
- let _ =
- itemQuit#add_accelerator ~group:accelgroup ~modi:([`CONTROL])
- ~flags:([`VISIBLE; `LOCKED]) GdkKeysyms._Q
- in
- let _ = menuHelp#set_accel_group accelgroup in
- let _anonymous_container_1 =
- GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC
- ~placement:`TOP_LEFT ~packing:(box#pack ~expand:true ~fill:true) ()
- in
- let wlist =
- GList.clist
- ~titles:(
- [""; Chat_messages.id; Chat_messages.host; Chat_messages.port;
- Chat_messages.temporary])
- ~shadow_type:`NONE ~selection_mode:`MULTIPLE ~titles_show:true
- ~packing:(_anonymous_container_1#add) ()
- in
- object
- val box = box
- val menubar = menubar
- val accelgroup = accelgroup
- val itemfile = itemfile
- val menuFile = menuFile
- val itemOptions = itemOptions
- val itemAddPeople = itemAddPeople
- val itemToggleTemp = itemToggleTemp
- val itemOpenDialog = itemOpenDialog
- val itemRemovePeople = itemRemovePeople
- val itemQuit = itemQuit
- val itemHelp = itemHelp
- val menuHelp = menuHelp
- val itemAbout = itemAbout
- val wlist = wlist
- method box = box
- method menubar = menubar
- method accelgroup = accelgroup
- method itemfile = itemfile
- method menuFile = menuFile
- method itemOptions = itemOptions
- method itemAddPeople = itemAddPeople
- method itemToggleTemp = itemToggleTemp
- method itemOpenDialog = itemOpenDialog
- method itemRemovePeople = itemRemovePeople
- method itemQuit = itemQuit
- method itemHelp = itemHelp
- method menuHelp = menuHelp
- method itemAbout = itemAbout
- method wlist = wlist
- method coerce = box#coerce
- end
-class dialog () =
- let box = GPack.vbox ~homogeneous:false () in
- let wscroll =
- GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC
- ~placement:`TOP_LEFT ~packing:(box#pack ~expand:true ~fill:true) ()
- in
- let wt_dialog =
- GEdit.text ~editable:false ~word_wrap:true ~line_wrap:true
- ~packing:(wscroll#add) ()
- in
- let wtool =
- GButton.toolbar ~orientation:`HORIZONTAL ~style:`ICONS
- ~space_style:`EMPTY
- ~tooltips:true
- ~button_relief:`NORMAL
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let wt_input =
- GEdit.text ~height:50 ~editable:true ~word_wrap:true ~line_wrap:true
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let wb_show_hide =
- GButton.button ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let _65 =
- GMisc.label ~text:(Chat_messages.show_hide_people) ~justify:`LEFT
- ~line_wrap:true ~packing:(wb_show_hide#add) ()
- in
- let wscroll_people =
- GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC
- ~placement:`TOP_LEFT ~packing:(box#pack ~expand:true ~fill:true) ()
- in
- let wlist_people =
- GList.clist
- ~titles:([Chat_messages.id; Chat_messages.host; Chat_messages.port])
- ~shadow_type:`NONE ~selection_mode:`SINGLE ~titles_show:true
- ~packing:(wscroll_people#add) ()
- in
- object
- val box = box
- val wscroll = wscroll
- val wt_dialog = wt_dialog
- val wtool = wtool
- val wt_input = wt_input
- val wb_show_hide = wb_show_hide
- val wscroll_people = wscroll_people
- val wlist_people = wlist_people
- method box = box
- method wscroll = wscroll
- method wt_dialog = wt_dialog
- method wtool = wtool
- method wt_input = wt_input
- method wb_show_hide = wb_show_hide
- method wscroll_people = wscroll_people
- method wlist_people = wlist_people
- method coerce = box#coerce
- end
Index: src/gtk/chat/chat_main.ml
===================================================================
RCS file: src/gtk/chat/chat_main.ml
diff -N src/gtk/chat/chat_main.ml
--- src/gtk/chat/chat_main.ml 2 Mar 2005 20:17:06 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,48 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** Main module of the standalone tool. *)
-
-ignore (GMain.Main.init ());;
-
-let pred (i1,h1,p1) (i2,h2,p2) =
- i1 = i2 && h1 = h2 && p1 = p2
-
-let main () =
- let _ = GMain.Main.init () in
- let config = Chat_args.parse () in
- let com = new Mlchat.tcp config in
- let app = new Mlchat.app ~pred: pred config com in
- let window = GWindow.window
- ~allow_shrink: true
- ~allow_grow: true
- ~width: 330 ~height: 240
- ~title: Chat_messages.software ()
- in
- window#add app#coerce ;
- ignore (app#box#connect#destroy window#destroy);
- ignore (window#connect#destroy GMain.Main.quit);
- app#init_window window ;
- window#show () ;
- GMain.Main.main ()
-
-let _ = main ()
Index: src/gtk2/chat/.cvsignore
===================================================================
RCS file: src/gtk2/chat/.cvsignore
diff -N src/gtk2/chat/.cvsignore
--- src/gtk2/chat/.cvsignore 30 May 2006 11:23:48 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,2 +0,0 @@
-*.cm?
-*.annot
Index: src/gtk2/chat/chat_app.ml
===================================================================
RCS file: src/gtk2/chat/chat_app.ml
diff -N src/gtk2/chat/chat_app.ml
--- src/gtk2/chat/chat_app.ml 2 Mar 2005 20:01:07 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,241 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** The application class. *)
-
-open Chat_types
-open Chat_proto
-open Chat_configwin
-
-module M = Chat_messages
-
-class app
- ?(no_quit=false)
- pred conf com =
- let data = new Chat_data.data pred conf com in
-
- object (self)
- val mutable working = false
- val mutable closed = false
-
- inherit Chat_gui.gui no_quit data as gui
-
- method handle_paquet p =
- let ((version,id,(host,port)), iddest, proto) = p in
- let reply =
- if version <> Chat_proto.version then
- None
- else
- (
- match proto with
- | HelloOk ->
- data#set_connected id host port;
- gui#update;
- None
-
- | Hello ->
- data#set_connected id host port;
- gui#update;
- Some HelloOk
-
- | Byebye ->
- data#set_not_connected id host port;
- gui#update;
- None
-
- | Message mes ->
- let l = data#people in
- data#set_connected id host port;
- if l <> data#people then gui#update;
- let show =
- conf#popup_all or
- (List.exists (pred (id,host,port)) conf#people)
- in
- let dial = Chat_gui.get_dialog ~show data (Chat_gui.Single (id,
host, port)) in
- dial#handle_message id mes;
- None
-
- | AddOpen (i, (h, p)) ->
- Chat_messages.verbose (Printf.sprintf "received AddOpen i=%s
h=%s p=%d" i h p);
- self#handle_paquet ((version,i,(h,p)), iddest, Message "");
- None
-
- | RoomMessage (name, people, mes) ->
- let dial = Chat_gui.get_dialog ~show: true data (Chat_gui.Room
(name, people)) in
- List.iter
- (fun (i,h,p) ->
- if List.exists (data#pred (i,h,p)) conf#people then
- data#set_connected i h p)
- people;
- gui#update;
- dial#handle_message id mes;
- None
- )
- in
- match reply with
- None -> ()
- | Some r ->
- try data#com#send id (host,port) r
- with Failure s -> Chat_messages.verbose s
-
- method accept =
- try
- match data#com#receive with
- None -> ()
- | Some p -> self#handle_paquet p
- with
- Failure s ->
- Chat_messages.verbose s;
- ()
-
-
- method work () =
- if working then not closed
- else
- (
- self#accept;
- if not closed then
- ignore (GMain.Timeout.add ~ms: conf#timeout ~callback: self#work);
- working <- false;
- false
- )
-
- method say_hello (id, host, port, state, temp) =
- if temp then ()
- else
- try data#com#send id (host, port) Hello
- with Failure s ->
- data#set_not_connected id host port;
- Chat_messages.verbose s
-
- method say_byebye (id, host, port, state, temp) =
- try data#com#send id (host, port) Byebye
- with _ -> ()
-
- method edit_conf =
- let p_id = preference ~help: M.h_id M.id conf#id BString () in
- let p_port = preference ~help:M.h_port M.port (string_of_int conf#port)
BInt () in
- let p_timeout = preference ~help:M.h_timeout M.h_timeout (string_of_int
conf#timeout) BInt () in
- let p_popup = preference ~help:M.h_popup_all M.popup_all (string_of_bool
conf#popup_all) BBool () in
- let p_col_connected = preference ~help:M.h_color_connected
- M.h_color_connected conf#color_connected BColor () in
- let p_col_connected_temp = preference ~help:M.h_color_connected_temp
- M.h_color_connected_temp conf#color_connected_temp BColor () in
- let p_col_not_connected = preference ~help:M.h_color_not_connected
- M.h_color_not_connected conf#color_not_connected BColor () in
- let p_col_myself = preference ~help:M.h_color_myself
- M.h_color_myself conf#color_myself BColor () in
- let on_ok () =
- let id = p_id.pref_new_value in
- let port = int_of_float (safe_int p_port.pref_new_value) in
- let timeout = int_of_float (safe_int p_timeout.pref_new_value) in
- let popup = safe_bool p_popup.pref_new_value in
- let col_connected = p_col_connected.pref_new_value in
- let col_connected_temp = p_col_connected_temp.pref_new_value in
- let col_not_connected = p_col_not_connected.pref_new_value in
- let col_myself = p_col_myself.pref_new_value in
- conf#set_id id;
- conf#set_port port;
- conf#set_timeout timeout;
- conf#set_popup_all popup;
- conf#set_color_connected col_connected;
- conf#set_color_connected_temp col_connected_temp;
- conf#set_color_not_connected col_not_connected;
- conf#set_color_myself col_myself;
- conf#save;
- data#update_people ;
- List.iter self#say_hello data#people;
- gui#update
- in
- let structure =
- [M.connection,
- [p_id;
- p_port;
- p_timeout;
- p_popup;
- ];
- M.colors,
- [p_col_connected;
- p_col_connected_temp;
- p_col_not_connected;
- p_col_myself;
- ]
- ]
- in
- panel ~structure ~on_ok ()
-
- method toggle_temp_selected =
- List.iter
- (fun (i,h,p,_,t) ->
- if t then data#add_people i h p
- else data#remove_people i h p)
- selected_people;
- gui#update
-
- method kill_people_selected =
- List.iter
- (fun (i,h,p,_,t) ->
- data#remove_people ~kill: true i h p)
- selected_people;
- gui#update
-
- method add_people =
- let p_id = preference ~help:M.h_id M.id "" BString () in
- let p_host = preference M.host "" BString () in
- let p_port = preference ~help:M.h_port M.port "5036" BInt () in
- let on_ok () =
- let id = p_id.pref_new_value in
- let host = p_host.pref_new_value in
- let port = int_of_float (safe_int p_port.pref_new_value) in
- match (id, host, port) with
- ("", _, p)
- | (_, "", p)
- | (_, _, p) when p < 1024 -> ()
- | _ ->
- begin
- data#add_people id host port;
- self#say_hello (data#get_complete_people id host port);
- gui#update
- end
- in
- simple_panel ~prefs:[p_id; p_host; p_port] ~on_ok ()
-
- initializer
- ignore (itemOptions#connect#activate (fun () -> self#edit_conf));
- ignore (itemToggleTemp#connect#activate
- (fun () -> self#toggle_temp_selected));
- ignore (itemAddPeople#connect#activate (fun () -> self#add_people));
- ignore (itemRemovePeople#connect#activate (fun () ->
self#kill_people_selected));
-
- ignore (GMain.Timeout.add ~ms: conf#timeout ~callback: self#work) ;
- List.iter self#say_hello data#people;
- gui#update;
-
- ignore (self#box#connect#destroy
- (fun () ->
- List.iter self#say_byebye data#people ;
- closed <- true;
- com#close
- )
- )
-
- end
Index: src/gtk2/chat/chat_art.ml
===================================================================
RCS file: src/gtk2/chat/chat_art.ml
diff -N src/gtk2/chat/chat_art.ml
--- src/gtk2/chat/chat_art.ml 5 Aug 2005 12:46:37 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,103 +0,0 @@
-(* Copyright 2004 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-(**********************************************************************************)
-(*
*)
-(* Icons ressources of mlchat
*)
-(*
*)
-(**********************************************************************************)
-
-open CommonGlobals
-
-let table = [
- "icon_settings", (Menu_settings_svg.t, "");
- "icon_help", (Menu_help_svg.t, "");
- "icon_mlchat", (Menu_mlchat_svg.t, "");
-
- "icon_directory", (Stock_directory_svg.t, "");
- "icon_color", (Stock_color_svg.t, "");
- "icon_font", (Stock_font_svg.t, "");
- "icon_password", (Stock_password_svg.t, "");
- "icon_close", (Stock_close_svg.t, "");
- "icon_ok", (Stock_ok_svg.t, "");
-
- "icon_unknown", (Mime_unknown_svg.t, "");
-
-]
-
-(**********************************************************************************)
-(*
*)
-(* Loading functions
*)
-(*
*)
-(**********************************************************************************)
-
-open Zlib
-
-(* Convenient function to load an icon set to customize the GUI *)
-(* TODO :
- - Allow to load an icon set from a given directory
- - Allow all formats possible : png, gif, jpeg, ico, etc...
- - Maybe use an index.theme file like gnome to indicate the
- directories available (16x16, 32x32, 48x48, etc...) to
- allow different sizes to be displayed in a pretty manner.
-*)
-
-(* Return a pixbuf for a given svg data *)
-let pixb icon_name pixel_size =
- let svg = uncompress_string icon_name in
- let z = float_of_int pixel_size /. 48. in
- let size_cb = (Rsvg.at_zoom z z) in
- let pb = Rsvg.render_from_string ~size_cb svg in
- GdkPixbuf.saturate_and_pixelate ~saturation:1. ~dest:pb ~pixelate:false pb;
- pb
-
-(* function to desaturate icons *)
-let saturate pb desat =
- if desat then
- GdkPixbuf.saturate_and_pixelate
- ~dest:pb
- ~saturation:0.
- ~pixelate:true
- pb;
- pb
-
-
-
-let pix_buf icon_name pixel_size ?(desat=false) () =
- try
- let (default, o) = List.assoc icon_name table in
- match o with
- "" ->
- let pb = pixb default pixel_size in
- saturate pb desat
- | f ->
- try
- let pb = GdkPixbuf.from_file f in
- saturate pb desat
- with
- _ ->
- let pb = pixb default pixel_size in
- saturate pb desat
- with
- Not_found ->
- let pb = pixb Mime_unknown_svg.t pixel_size in
- saturate pb desat
-
-let get_icon ~(icon : string) ?(desat=false) () =
- pix_buf icon 16 ~desat ()
Index: src/gtk2/chat/chat_configwin.ml
===================================================================
RCS file: src/gtk2/chat/chat_configwin.ml
diff -N src/gtk2/chat/chat_configwin.ml
--- src/gtk2/chat/chat_configwin.ml 2 Mar 2005 20:01:07 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,850 +0,0 @@
-(* Copyright 2004 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-(* preference settings of MLchat. *)
-
-module A = Chat_art
-
-type pref_box =
- BFilename
-| BPath
-| BPassword
-| BString
-| BCombo
-| BTime
-| BColor
-| BFont
-| BFloat
-| BInt
-| BInt32
-| BInt64
-| BAdvanced
-| BBool
-
-type preference =
- {
- pref_help : string;
- pref_advanced : bool;
- pref_default : string;
-
- mutable pref_name : string;
- mutable pref_label : string;
- mutable pref_option_list : string list; (* Used for combo_box *)
- mutable pref_value : string;
- mutable pref_new_value : string; (* Internally used *)
- mutable pref_type : pref_box;
- mutable pref_apply : unit -> unit; (* Becarefull overwritten *)
- mutable pref_apply_default : unit -> unit; (* Becarefull overwritten *)
- }
-
-let preference ?(help="") label v box_type () =
- {
- pref_help = help;
- pref_advanced = false;
- pref_default = v;
-
- pref_name = label;
- pref_label = label;
- pref_option_list = [];
- pref_value = v;
- pref_new_value = v;
- pref_type = box_type;
- pref_apply = (fun () -> ());
- pref_apply_default = (fun () -> ());
- }
-
-(*************************************************************************)
-(* *)
-(* Global functions *)
-(* *)
-(*************************************************************************)
-
-let safe_int s = float_of_int (Options.value_to_int (Options.StringValue s))
-
-let safe_int32 s =
- try
- Int32.to_float (Int32.of_string s)
- with _ -> failwith "Options: not an int32 option"
-
-let safe_int64 s = Int64.to_float (Options.value_to_int64 (Options.StringValue
s))
-
-let safe_float s = Options.value_to_float (Options.StringValue s)
-
-let safe_bool s = Options.value_to_bool (Options.StringValue s)
-
-(*************************************************************************)
-(* *)
-(* event_wrap_widget *)
-(* *)
-(*************************************************************************)
-
-let event_wrap_widget ~w ~p ?h_label () =
- match h_label with
- None -> w#coerce
- | Some label ->
- begin
- let evbox = GBin.event_box () in
- ignore (evbox#event#add [`ENTER_NOTIFY;`LEAVE_NOTIFY]);
- ignore (evbox#event#connect#enter_notify
- ~callback:
- (fun ev ->
- if GdkEvent.get_type ev = `ENTER_NOTIFY
- then (label#set_label p.pref_help; true)
- else false
- ));
- ignore (evbox#event#connect#leave_notify
- ~callback:
- (fun ev ->
- if GdkEvent.get_type ev = `LEAVE_NOTIFY
- then (label#set_label ""; true)
- else false
- ));
- evbox#add w#coerce;
- evbox#coerce
- end
-
-(*************************************************************************)
-(* *)
-(* add_string_param *)
-(* *)
-(*************************************************************************)
-
-let add_string_param ~p ~top ~(table : GPack.table) ?(h_label : GMisc.label
option) () =
- let label =
- GMisc.label ~xalign:0.
- ~markup:p.pref_label ()
- in
- let edit =
- GEdit.entry ~text:p.pref_new_value
- ~editable:true ~visibility:true ()
- in
- table#attach ~left:0 ~top
- ~xpadding:18 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:label ~p ?h_label ());
- table#attach ~left:1 ~top
- ~xpadding:0 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:edit ~p ?h_label ());
- p.pref_apply <- (fun _ -> p.pref_new_value <- edit#text);
- p.pref_apply_default <- (fun _ -> edit#set_text p.pref_default)
-
-(*************************************************************************)
-(* *)
-(* add_password_param *)
-(* *)
-(*************************************************************************)
-
-let add_password_param ~p ~top ~(table : GPack.table) ?(h_label : GMisc.label
option) () =
- let label = GMisc.label ~xalign:0. ~markup:p.pref_label () in
- let hbox = GPack.hbox ~homogeneous:false ~spacing:6 () in
- let pixbuf = A.get_icon ~icon:"icon_password" () in
- let image = GMisc.image ~pixbuf ~packing:(hbox#pack ~expand:false
~fill:true) () in
- let edit =
- GEdit.entry ~text:p.pref_new_value ~editable:true ~visibility:false
- ~packing:(hbox#pack ~expand:true ~fill:true) ()
- in
- table#attach ~left:0 ~top
- ~xpadding:18 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:label ~p ?h_label ());
- table#attach ~left:1 ~top
- ~xpadding:0 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:hbox ~p ?h_label ());
- p.pref_apply <- (fun _ -> p.pref_new_value <- edit#text);
- p.pref_apply_default <- (fun _ -> edit#set_text p.pref_default)
-
-(*************************************************************************)
-(* *)
-(* add_int_param *)
-(* *)
-(*************************************************************************)
-
-let add_int_param ~p ~f ~top ~(table : GPack.table) ?(h_label : GMisc.label
option) () =
- let value = f p.pref_new_value in
- let label = GMisc.label ~xalign:0. ~markup:p.pref_label () in
- let hbox = GPack.hbox ~homogeneous:false ~spacing:3 () in
- let range = GData.adjustment ~lower:0. ~upper:(float_of_int max_int)
~step_incr:1. () in
- let spin =
- GEdit.spin_button ~adjustment:range ~rate:1. ~digits:0 ~numeric:true
- ~snap_to_ticks:true ~update_policy:`IF_VALID ~value ~wrap:true
- ~packing:(hbox#pack ~expand:false ~fill:true) ()
- in
- let a_box =
- GPack.hbox ~homogeneous:false
- ~packing:(hbox#pack ~expand:true ~fill:true) ()
- in
- table#attach ~left:0 ~top
- ~xpadding:18 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:label ~p ?h_label ());
- table#attach ~left:1 ~top
- ~xpadding:0 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:hbox ~p ?h_label ());
- p.pref_apply <- (fun _ -> p.pref_new_value <- string_of_int
spin#value_as_int);
- p.pref_apply_default <- (fun _ -> spin#set_value (f p.pref_default))
-
-(*************************************************************************)
-(* *)
-(* add_float_param *)
-(* *)
-(*************************************************************************)
-
-let add_float_param ~p ~top ~(table : GPack.table) ?(h_label : GMisc.label
option) () =
- let value = safe_float p.pref_new_value in
- let label = GMisc.label ~xalign:0. ~markup:p.pref_label () in
- let hbox = GPack.hbox ~homogeneous:false ~spacing:3 () in
- let range = GData.adjustment ~lower:0. ~upper:((float_of_int max_int) *.
1000.) ~step_incr:0.1 () in
- let spin =
- GEdit.spin_button ~adjustment:range ~rate:1. ~digits:1 ~numeric:true
- ~snap_to_ticks:true ~update_policy:`IF_VALID ~value ~wrap:true
- ~packing:(hbox#pack ~expand:false ~fill:true) ()
- in
- let a_box =
- GPack.hbox ~homogeneous:false
- ~packing:(hbox#pack ~expand:true ~fill:true) ()
- in
- table#attach ~left:0 ~top
- ~xpadding:18 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:label ~p ?h_label ());
- table#attach ~left:1 ~top
- ~xpadding:0 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:hbox ~p ?h_label ());
- p.pref_apply <- (fun _ -> p.pref_new_value <- string_of_float spin#value);
- p.pref_apply_default <- (fun _ -> spin#set_value (float_of_string
p.pref_default))
-
-(*************************************************************************)
-(* *)
-(* add_filename_param *)
-(* *)
-(*************************************************************************)
-
-let last_dir = ref ""
-
-let add_filename_param ~p ~top ~(table : GPack.table) ~path ?(h_label :
GMisc.label option) () =
- let label = GMisc.label ~xalign:0. ~markup:p.pref_label () in
- let hbox = GPack.hbox ~homogeneous:false ~spacing:6 () in
- let edit =
- GEdit.entry ~text:p.pref_new_value ~editable:true ~visibility:true
- ~packing:(hbox#pack ~expand:true ~fill:true) ()
- in
- let button = GButton.button ~packing:(hbox#pack ~expand:false ~fill:true) ()
in
- let bbox = GPack.hbox ~packing:button#add () in
- let bimage =
- GMisc.image ~pixbuf:(A.get_icon ~icon:"icon_directory" ())
- ~packing:(bbox#pack ~expand:false ~fill:true) ()
- in
- let blabel =
- GMisc.label ~markup:" _Browse ..." ~use_underline:true
- ~packing:(bbox#pack ~expand:false ~fill:true) ()
- in
- table#attach ~left:0 ~top
- ~xpadding:18 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:label ~p ?h_label ());
- table#attach ~left:1 ~top
- ~xpadding:0 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:hbox ~p ?h_label ());
- let files = ref ([] : string list) in
- let f_sel () =
- let dialog = GWindow.file_selection
- ~title:p.pref_label
- ~modal:false
- ~show:true ()
- in
- let wb_ok = dialog#ok_button in
- let wb_cancel = dialog#cancel_button in
- let _ =
- match p.pref_new_value with
- "" ->
- if !last_dir <> ""
- then dialog#set_filename !last_dir
- | dir -> dialog#set_filename dir
- in
- ignore (wb_ok#connect#clicked ~callback:
- (fun () ->
- files := [dialog#filename];
- let _ =
- match !files with
- []
- | [""] -> ()
- | l ->
- last_dir := Filename.dirname (List.hd l);
- if not path
- then edit#set_text (List.hd l)
- else edit#set_text !last_dir
- in
- dialog#destroy ()
- ));
- ignore (wb_cancel#connect#clicked dialog#destroy)
- in
- ignore (button#connect#clicked f_sel);
- p.pref_apply <- (fun _ -> p.pref_new_value <- edit#text);
- p.pref_apply_default <- (fun _ -> edit#set_text p.pref_default)
-
-(*************************************************************************)
-(* *)
-(* add_color_param *)
-(* *)
-(*************************************************************************)
-
-let add_color_param ~p ~top ~(table : GPack.table) ?(h_label : GMisc.label
option) () =
- let label = GMisc.label ~xalign:0. ~markup:p.pref_label () in
- let hbox = GPack.hbox ~homogeneous:false () in
- let button = GButton.button ~packing:(hbox#pack ~expand:false ~fill:true) ()
in
- let box = GPack.hbox ~homogeneous:false ~spacing:6 ~packing:button#add () in
- let bimage =
- GMisc.image ~pixbuf:(A.get_icon ~icon:"icon_color" ())
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let separator =
- GMisc.separator `VERTICAL
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let pixbuf = GdkPixbuf.create ~width:100 ~height:16 () in
- let colv = ref "" in
- let set_color col =
- try
- GdkPixbuf.fill pixbuf (Int32.of_string col)
- with _ -> ()
- in
- let string_of_int_of_col color =
- let r = (Gdk.Color.red color) / 256 in
- let g = (Gdk.Color.green color) / 256 in
- let b = (Gdk.Color.blue color) / 256 in
- let s = Printf.sprintf "%02X%02X%02X" r g b in
- let _ =
- for i = 1 to (String.length s) - 1 do
- if s.[i] = ' ' then s.[i] <- '0'
- done
- in
- colv := "#" ^ s;
- ("0x" ^ s ^ "FF")
- in
- let col = GDraw.color (`NAME p.pref_new_value) in
- set_color (string_of_int_of_col col);
- let sample = GMisc.image ~pixbuf ~packing:box#add () in
- let separator =
- GMisc.separator `VERTICAL
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let a_box =
- GPack.hbox ~homogeneous:false
- ~packing:(hbox#pack ~expand:true ~fill:true) ()
- in
- table#attach ~left:0 ~top
- ~xpadding:18 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:label ~p ?h_label ());
- table#attach ~left:1 ~top
- ~xpadding:0 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:hbox ~p ?h_label ());
- let f_sel () =
- let dialog = GWindow.color_selection_dialog
- ~title:p.pref_label
- ~modal:false
- ~show:true ()
- in
- let color = GDraw.color (`NAME !colv) in
- dialog#colorsel#set_color color;
- let wb_ok = dialog#ok_button in
- let wb_cancel = dialog#cancel_button in
- let _ = wb_ok#connect#clicked
- (fun () ->
- let color = dialog#colorsel#color in
- set_color (string_of_int_of_col color);
- dialog#destroy ()
- )
- in
- ignore (wb_cancel#connect#clicked dialog#destroy)
- in
- ignore (button#connect#clicked f_sel);
- p.pref_apply <- (fun _ -> p.pref_new_value <- !colv);
- p.pref_apply_default <-
- (fun _ ->
- let color = GDraw.color (`NAME p.pref_default) in
- set_color (string_of_int_of_col color))
-
-(*************************************************************************)
-(* *)
-(* add_font_param *)
-(* *)
-(*************************************************************************)
-
-let add_font_param ~p ~top ~(table : GPack.table) ?(h_label : GMisc.label
option) () =
- let label = GMisc.label ~xalign:0. ~markup:p.pref_label () in
- let hbox = GPack.hbox ~homogeneous:false () in
- let button = GButton.button ~packing:(hbox#pack ~expand:false ~fill:true) ()
in
- let box = GPack.hbox ~homogeneous:false ~spacing:6 ~packing:button#add () in
- let bimage =
- GMisc.image ~pixbuf:(A.get_icon ~icon:"icon_font" ())
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let separator =
- GMisc.separator `VERTICAL
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let sample =
- GMisc.label ~width:100 ~xalign:0.
- ~markup:"Font sample"
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let fontv = ref "" in
- let set_font font =
- sample#misc#modify_font_by_name font;
- fontv := font
- in
- set_font p.pref_new_value;
- let separator =
- GMisc.separator `VERTICAL
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let a_box =
- GPack.hbox ~homogeneous:false
- ~packing:(hbox#pack ~expand:true ~fill:true) ()
- in
- table#attach ~left:0 ~top
- ~xpadding:18 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:label ~p ?h_label ());
- table#attach ~left:1 ~top
- ~xpadding:0 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:hbox ~p ?h_label ());
- let f_sel () =
- let dialog = GWindow.font_selection_dialog
- ~title:p.pref_label
- ~modal:false
- ~show:true ()
- in
- dialog#selection#set_font_name !fontv;
- let wb_ok = dialog#ok_button in
- let wb_cancel = dialog#cancel_button in
- let _ = wb_ok#connect#clicked
- (fun () ->
- let font = dialog#selection#font_name in
- set_font font;
- dialog#destroy ()
- )
- in
- ignore (wb_cancel#connect#clicked dialog#destroy)
- in
- ignore (button#connect#clicked f_sel);
- p.pref_apply <- (fun _ -> p.pref_new_value <- !fontv);
- p.pref_apply_default <- (fun _ -> set_font p.pref_default)
-
-(*************************************************************************)
-(* *)
-(* add_bool *)
-(* *)
-(*************************************************************************)
-
-let add_bool ~p ~top ~(table : GPack.table) ?(h_label : GMisc.label option) ()
=
- let active = safe_bool p.pref_new_value in
- let check = GButton.check_button ~active ~label:p.pref_label () in
- table#attach ~left:0 ~top
- ~xpadding:18 ~ypadding:0
- ~right:2 ~bottom:(top + 1)
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:check ~p ?h_label ());
- check
-
-(*************************************************************************)
-(* *)
-(* add_bool_param *)
-(* *)
-(*************************************************************************)
-
-let add_bool_param ~p ~top ~(table : GPack.table) ?(h_label : GMisc.label
option) () =
- let check = add_bool ~p ~top ~table ?h_label () in
- p.pref_apply <- (fun _ -> p.pref_new_value <- string_of_bool check#active);
- p.pref_apply_default <- (fun _ -> check#set_active (bool_of_string
p.pref_default))
-
-(*************************************************************************)
-(* *)
-(* add_advanced_param *)
-(* *)
-(*************************************************************************)
-
-let add_advanced_param ~p ~top ~(table : GPack.table) ?(h_label : GMisc.label
option) ~advanced_mode () =
- let check = add_bool ~p ~top ~table ?h_label () in
- p.pref_apply <-
- (fun _ ->
- begin
- advanced_mode := check#active;
- p.pref_new_value <- string_of_bool check#active
- end
- );
- p.pref_apply_default <-
- (fun _ ->
- begin
- advanced_mode := check#active;
- check#set_active (bool_of_string p.pref_default)
- end
- )
-
-(*************************************************************************)
-(* *)
-(* add_combo_param *)
-(* *)
-(*************************************************************************)
-
-let set_combobox_value (combobox : GEdit.combo_box) (column : string
GTree.column) v =
- combobox#model#foreach
- (fun _ row ->
- let s = combobox#model#get ~row ~column in
- if s = v
- then begin
- combobox#set_active_iter (Some row);
- true
- end else false)
-
-let get_combobox_value (combobox : GEdit.combo_box) (column : string
GTree.column) default_value =
- match combobox#active_iter with
- None -> default_value
- | Some row -> combobox#model#get ~row ~column
-
-let add_combo_param ~p ~top ~(table : GPack.table) ?(h_label : GMisc.label
option) () =
- let label = GMisc.label ~xalign:0. ~markup:p.pref_label () in
- let (combobox, (_, column)) =
- GEdit.combo_box_text ~strings:p.pref_option_list ()
- in
- set_combobox_value combobox column p.pref_new_value;
- table#attach ~left:0 ~top
- ~xpadding:18 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:label ~p ?h_label ());
- table#attach ~left:1 ~top
- ~xpadding:0 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:combobox ~p ?h_label ());
- p.pref_apply <- (fun _ -> p.pref_new_value <- get_combobox_value combobox
column p.pref_default);
- p.pref_apply_default <- (fun _ -> set_combobox_value combobox column
p.pref_default)
-
-(*************************************************************************)
-(* *)
-(* add_time_param *)
-(* *)
-(*************************************************************************)
-
-let add_time_param ~p ~top ~(table : GPack.table) ?(h_label : GMisc.label
option) () =
- let label = GMisc.label ~xalign:0. ~markup:p.pref_label () in
- let hbox = GPack.hbox ~homogeneous:false ~spacing:3 () in
- let range_day = GData.adjustment ~lower:0. ~upper:365. ~step_incr:1. () in
- let spin_day =
- GEdit.spin_button ~adjustment:range_day ~rate:1. ~digits:0 ~numeric:true
- ~snap_to_ticks:true ~update_policy:`IF_VALID ~wrap:true
- ~packing:(hbox#pack ~expand:false ~fill:true) ()
- in
- let label_day =
- GMisc.label ~xalign:0. ~markup:"d"
- ~packing:(hbox#pack ~expand:false ~fill:true) ()
- in
- let range_hour = GData.adjustment ~lower:0. ~upper:23. ~step_incr:1. () in
- let spin_hour =
- GEdit.spin_button ~adjustment:range_hour ~rate:1. ~digits:0 ~numeric:true
- ~snap_to_ticks:true ~update_policy:`IF_VALID ~wrap:true
- ~packing:(hbox#pack ~expand:false ~fill:true) ()
- in
- let label_hour =
- GMisc.label ~xalign:0. ~markup:"h"
- ~packing:(hbox#pack ~expand:false ~fill:true) ()
- in
- let range_minute = GData.adjustment ~lower:0. ~upper:59. ~step_incr:1. () in
- let spin_minute =
- GEdit.spin_button ~adjustment:range_minute ~rate:1. ~digits:0 ~numeric:true
- ~snap_to_ticks:true ~update_policy:`IF_VALID ~wrap:true
- ~packing:(hbox#pack ~expand:false ~fill:true) ()
- in
- let label_minute =
- GMisc.label ~xalign:0. ~markup:"min"
- ~packing:(hbox#pack ~expand:false ~fill:true) ()
- in
- let range_second = GData.adjustment ~lower:0. ~upper:59. ~step_incr:1. () in
- let spin_second =
- GEdit.spin_button ~adjustment:range_second ~rate:1. ~digits:0 ~numeric:true
- ~snap_to_ticks:true ~update_policy:`IF_VALID ~wrap:true
- ~packing:(hbox#pack ~expand:false ~fill:true) ()
- in
- let label_second =
- GMisc.label ~xalign:0. ~markup:"s"
- ~packing:(hbox#pack ~expand:false ~fill:true) ()
- in
- let a_box =
- GPack.hbox ~homogeneous:false
- ~packing:(hbox#pack ~expand:true ~fill:true) ()
- in
- let set_time v =
- let time = int_of_float (safe_int v) in
- let days = time / 60 / 60 / 24 in
- let rest = time - days * 60 * 60 * 24 in
- let hours = rest / 60 / 60 in
- let rest = rest - hours * 60 * 60 in
- let minutes = rest / 60 in
- let seconds = rest - minutes * 60 in
- spin_day#set_value (float_of_int days);
- spin_hour#set_value (float_of_int hours);
- spin_minute#set_value (float_of_int minutes);
- spin_second#set_value (float_of_int seconds)
- in
- let get_time _ =
- let days = spin_day#value_as_int * 60 * 60 * 24 in
- let hours = spin_hour#value_as_int * 60 * 60 in
- let minutes = spin_minute#value_as_int * 60 in
- let seconds = spin_second#value_as_int in
- let time = seconds + minutes + hours + days in
- string_of_int time
- in
- set_time p.pref_new_value;
- table#attach ~left:0 ~top
- ~xpadding:18 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:label ~p ?h_label ());
- table#attach ~left:1 ~top
- ~xpadding:0 ~ypadding:0
- ~expand:`X ~fill:`X
- (event_wrap_widget ~w:hbox ~p ?h_label ());
- p.pref_apply <- (fun _ -> p.pref_new_value <- get_time () );
- p.pref_apply_default <- (fun _ -> set_time p.pref_default)
-
-(*************************************************************************)
-(* *)
-(* add_pref *)
-(* *)
-(*************************************************************************)
-
-let add_pref ?h_label ~table ~p ~top ~advanced_mode () =
- match p.pref_type with
- BBool -> add_bool_param ~p ~top ~table ?h_label ()
- | BAdvanced -> add_advanced_param ~p ~top ~table ?h_label ~advanced_mode
()
- | BFilename -> add_filename_param ~p ~top ~table ~path:false ?h_label ()
- | BPath -> add_filename_param ~p ~top ~table ~path:true ?h_label ()
- | BPassword -> add_password_param ~p ~top ~table ?h_label ()
- | BCombo -> add_combo_param ~p ~top ~table ?h_label ()
- | BTime -> add_time_param ~p ~top ~table ?h_label ()
- | BColor -> add_color_param ~p ~top ~table ?h_label ()
- | BFont -> add_font_param ~p ~top ~table ?h_label ()
- | BInt -> add_int_param ~p ~f:safe_int ~top ~table ?h_label ()
- | BInt32 -> add_int_param ~p ~f:safe_int32 ~top ~table ?h_label ()
- | BInt64 -> add_int_param ~p ~f:safe_int64 ~top ~table ?h_label ()
- | BFloat -> add_float_param ~p ~top ~table ?h_label ()
- | _ -> add_string_param ~p ~top ~table ?h_label ()
-
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(* *)
-(* PANEL *)
-(* *)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-
-let panel ~(structure: (string * preference list) list)
- ?(title=Chat_messages.software)
- ?(width=Gdk.Screen.width () * 2 / 5)
- ?(height=Gdk.Screen.height () * 2 / 5)
- ?(icon=(A.get_icon ~icon:"icon_settings" ()))
- ?(advanced_mode=ref false)
- ?(on_ok = fun () -> ()) () =
- let window =
- GWindow.window ~width ~height
- ~title
- ~icon
- ~position:`CENTER_ALWAYS
- ~kind:`TOPLEVEL
- ~resizable:true ~modal:false ()
- in
- window#set_skip_taskbar_hint false;
- window#set_skip_pager_hint false;
- let vbox =
- GPack.vbox ~homogeneous:false
- ~packing:window#add ()
- in
- let notebook =
- GPack.notebook ~homogeneous_tabs:true ~scrollable:true
- ~packing:(vbox#pack ~expand:true ~fill:true) ()
- in
- let separator =
- GMisc.separator `HORIZONTAL
- ~packing:(vbox#pack ~expand:false ~fill:true) ()
- in
- let hbox_button =
- GPack.hbox ~homogeneous:false ~border_width:6
- ~packing:(vbox#pack ~expand:false ~fill:true) ()
- in
- let bbox =
- GPack.button_box `HORIZONTAL ~border_width:6 ~spacing:6
- ~layout:`END ~packing:hbox_button#add ()
- in
- let b_close = GButton.button ~packing:bbox#add () in
- let box = GPack.hbox ~spacing:6 ~border_width:3 ~packing:b_close#add () in
- let bimage =
- GMisc.image ~pixbuf:(A.get_icon ~icon:"icon_close" ())
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let blabel =
- GMisc.label ~markup:"_Close" ~use_underline:true
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- ignore (b_close#connect#clicked ~callback:
- (fun _ -> window#destroy ()
- ));
- let callback () =
- List.iter (fun (_, prefs) ->
- List.iter (fun p ->
- p.pref_apply_default ()
- ) prefs;
- ) structure
- in
- let b_default =
- GButton.button ~label:"_Default"
- ~use_mnemonic:true ~packing:bbox#add ()
- in
- ignore (b_close#connect#clicked ~callback);
- let callback () =
- List.iter (fun (_, prefs) ->
- List.iter (fun p ->
- p.pref_apply ();
- ) prefs;
- ) structure;
- on_ok ();
- window#destroy ()
- in
- let b_ok = GButton.button ~packing:bbox#add () in
- let box = GPack.hbox ~spacing:6 ~border_width:3 ~packing:b_ok#add () in
- let bimage =
- GMisc.image ~pixbuf:(A.get_icon ~icon:"icon_ok" ())
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let blabel =
- GMisc.label ~markup:"_Ok" ~use_underline:true
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- ignore (b_ok#connect#clicked ~callback);
- List.iter (fun (s, prefs) ->
- let top = ref 0 in
- let scrolled_box =
- GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC
- ~placement:`TOP_LEFT ()
- in
- let table =
- GPack.table ~columns:2 ~homogeneous:false
- ~row_spacings:6 ~col_spacings:6 ~border_width:6
- ~packing:scrolled_box#add_with_viewport ()
- in
- notebook#append_page
- ~tab_label:((GMisc.label ~use_underline:true ~markup:s ())#coerce)
- scrolled_box#coerce;
- List.iter (fun p->
- add_pref ~table ~p ~top:!top ~advanced_mode ();
- incr top
- ) prefs;
- ) structure;
- window#show ()
-
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(* *)
-(* SIMPLE_PANEL *)
-(* *)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-
-let simple_panel ~(prefs: preference list)
- ?(title=Chat_messages.software)
- ?(icon=(A.get_icon ~icon:"icon_mlchat" ()))
- ?(advanced_mode=ref false)
- ?(on_ok = fun () -> ()) () =
- let window =
- GWindow.window
- ~title
- ~icon
- ~position:`CENTER_ALWAYS
- ~kind:`TOPLEVEL
- ~resizable:true ~modal:false ()
- in
- window#set_skip_taskbar_hint false;
- window#set_skip_pager_hint false;
- let vbox =
- GPack.vbox ~homogeneous:false
- ~packing:window#add ()
- in
- let table =
- GPack.table ~columns:2 ~homogeneous:false
- ~row_spacings:6 ~col_spacings:6 ~border_width:6
- ~packing:vbox#add ()
- in
- let separator =
- GMisc.separator `HORIZONTAL
- ~packing:(vbox#pack ~expand:false ~fill:true) ()
- in
- let hbox_button =
- GPack.hbox ~homogeneous:false ~border_width:6
- ~packing:(vbox#pack ~expand:false ~fill:true) ()
- in
- let bbox =
- GPack.button_box `HORIZONTAL ~border_width:6 ~spacing:6
- ~layout:`END ~packing:hbox_button#add ()
- in
- let b_close = GButton.button ~packing:bbox#add () in
- let box = GPack.hbox ~spacing:6 ~border_width:2 ~packing:b_close#add () in
- let bimage =
- GMisc.image ~pixbuf:(A.get_icon ~icon:"icon_close" ())
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let blabel =
- GMisc.label ~markup:"_Close" ~use_underline:true
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- ignore (b_close#connect#clicked ~callback:
- (fun _ -> window#destroy ()
- ));
- let callback () =
- List.iter (fun p ->
- p.pref_apply ();
- ) prefs;
- on_ok ();
- window#destroy ()
- in
- let b_ok = GButton.button ~packing:bbox#add () in
- let box = GPack.hbox ~spacing:6 ~border_width:3 ~packing:b_ok#add () in
- let bimage =
- GMisc.image ~pixbuf:(A.get_icon ~icon:"icon_ok" ())
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let blabel =
- GMisc.label ~markup:"_Ok" ~use_underline:true
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- ignore (b_ok#connect#clicked ~callback);
- let top = ref 0 in
- List.iter (fun p ->
- add_pref ~table ~p ~top:!top ~advanced_mode ();
- incr top
- ) prefs;
- window#show ()
Index: src/gtk2/chat/chat_gui.ml
===================================================================
RCS file: src/gtk2/chat/chat_gui.ml
diff -N src/gtk2/chat/chat_gui.ml
--- src/gtk2/chat/chat_gui.ml 2 Mar 2005 19:28:14 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,304 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** Graphical interface. *)
-
-open Chat_types
-open Chat_proto
-
-type dialog_type =
- Single of id * host * port
- | Room of id * (id * host * port) list
-
-let remove_key ~target ~sign =
- ignore (target#misc#disconnect sign)
-
-let add_key ~key ~target ~f ?(mods = [`MOD1]) ?source () =
- let sign =
- target#event#connect#key_press
- ~callback:(fun ev ->
- if GdkEvent.Key.keyval ev = key && GdkEvent.Key.state ev = mods
- then begin
- f ();
- true
- end else false
- )
- in
- Gaux.may ~f:(fun w ->
- ignore (w#misc#connect#destroy
- ~callback:(fun _ -> remove_key ~target ~sign)
- )) source
-
-
-class dialog (data : Chat_data.data) typ_dial =
- let id, host, port =
- match typ_dial with
- Single (i,h,p) -> (i,h,p)
- | Room (n,_) -> n,"",0
- in
- object (self)
- inherit Chat_gui_base.dialog ()
-
- val mutable name =
- match typ_dial with
- Single (id, h, p) -> Printf.sprintf "%s @ %s:%d" id h p
- | Room (name, _) -> name
-
- method name = name
- method id = id
- method host = host
- method port = port
-
- method send s =
- match typ_dial with
- Single (i,h,p) ->
- (
- try data#com#send i (h, p) (Message s)
- with Failure s -> Chat_messages.verbose s
- )
- | Room (name, people) ->
- List.iter
- (fun (i,h,p) ->
- try data#com#send i (h, p) (RoomMessage (self#name, people, s))
- with Failure s -> Chat_messages.verbose s
- )
- people
-
- method handle_message source_id mes =
- let col = data#conf#color_connected in
- ignore (wt_dialog#buffer#create_tag ~name:"foreground" [`FOREGROUND
col]);
- wt_dialog#buffer#insert ~iter:(wt_dialog#buffer#get_iter `END)
~tag_names:["foreground"] source_id;
- wt_dialog#buffer#insert ~iter:(wt_dialog#buffer#get_iter `END) (" :
"^mes^"\n")
-
- initializer
- let return () =
- let start = wt_input#buffer#get_iter `START in
- let stop = wt_input#buffer#get_iter `END in
- let s = wt_input#buffer#get_text ~start ~stop () in
- let len = String.length s in
- let s2 =
- if len <= 0 then s
- else
- match s.[0] with
- '\n' -> String.sub s 1 (len - 1)
- | _ -> s
- in
- self#send s2;
- let col = data#conf#color_myself in
- ignore (wt_dialog#buffer#create_tag ~name:"myself_foreground"
[`FOREGROUND col]);
- wt_dialog#buffer#insert ~iter:(wt_dialog#buffer#get_iter `END)
~tag_names:["myself_foreground"] data#conf#id;
- wt_dialog#buffer#insert ~iter:(wt_dialog#buffer#get_iter `END) (" :
"^s2^"\n");
- wt_input#buffer#delete ~start ~stop
-
- in
- add_key ~key:GdkKeysyms._Return ~target:wt_input ~f:return ~mods:[] ();
- add_key ~key:GdkKeysyms._w ~target:wt_input ~f:box#destroy
~mods:[`CONTROL] ();
- add_key ~key:GdkKeysyms._w ~target:wt_dialog ~f:box#destroy
~mods:[`CONTROL] ();
- add_key ~key:GdkKeysyms._l ~target:wt_input ~f:wb_show_hide#clicked
~mods:[`CONTROL] ();
- add_key ~key:GdkKeysyms._l ~target:wt_dialog ~f:wb_show_hide#clicked
~mods:[`CONTROL] ();
-
- match typ_dial with
- Single _ ->
- wb_show_hide#misc#hide ();
- wscroll_people#misc#hide ()
- | Room (name, people) ->
- wscroll_people#misc#hide ();
- let show = ref false in
- ignore (wb_show_hide#connect#clicked
- (fun () ->
- show := not !show;
- if !show then
- wscroll_people#misc#show ()
- else
- wscroll_people#misc#hide ()));
- List.iter
- (fun (i,h,p) ->
- ignore (wlist_people#append
- [i ; h ; string_of_int p]))
- people;
- GToolbox.autosize_clist wlist_people
- end
-
-(** Liste des dialogs ouverts *)
-let dialogs = ref ([] : (GWindow.window * dialog) list)
-
-(** Liste des rooms ouvertes *)
-let room_dialogs = ref ([] : (GWindow.window * dialog) list)
-
-(** Remove the dialog with the given id from the list of dialogs. *)
-let remove_dialog data typ_dial =
- match typ_dial with
- Single (id,host,port) ->
- dialogs := List.filter
- (fun (_,d) -> not (data#pred (id,host,port) (d#id, d#host, d#port)))
- !dialogs
- | Room (name, people) ->
- room_dialogs := List.filter
- (fun (_,d) -> d#name <> name)
- !room_dialogs
-
-
-(** Find the window and dialog with the given id. It
- it was not found, create it and add it to the list of dialogs.*)
-let get_dialog ?(show=true) data typ_dial =
- try
- match typ_dial with
- Single (id,host,port) ->
- let (w,d) = List.find
- (fun (w,d) -> data#pred (id,host,port) (d#id, d#host, d#port))
- !dialogs
- in
- d#wt_input#misc#grab_focus ();
- if show then w#show () ;
- d
- | Room (name, people) ->
- let (w,d) = List.find (fun (_,d) -> d#name = name) !room_dialogs in
- d#wt_input#misc#grab_focus ();
- if show then w#show () ;
- d
- with
- Not_found ->
- let window = GWindow.window ~kind:`TOPLEVEL ~width: 300 ~height: 200
~title: "" () in
- ignore (window#connect#destroy (fun () -> remove_dialog data typ_dial));
- let dialog = new dialog data typ_dial in
- window#set_title dialog#name;
- ignore (dialog#box#connect#destroy window#destroy);
- window#add dialog#box#coerce;
- if show then window#show ();
- (
- match typ_dial with
- Single _ -> dialogs := (window, dialog) :: ! dialogs
- | Room _ -> room_dialogs := (window, dialog) :: ! room_dialogs
- );
- dialog#wt_input#misc#grab_focus ();
- dialog
-
-class gui no_quit (data : Chat_data.data) =
- object (self)
- inherit Chat_gui_base.gui ()
-
- val mutable people = data#people
-
- val mutable selected_people = []
-
- method update =
- wlist#clear ();
- people <- data#people ;
- List.iter
- (fun (id,host,port,state,temp) ->
- ignore (wlist#append ["" ; id ; host ; (string_of_int port) ;
- Chat_messages.yes_or_no temp]
- );
- let color,pix =
- match state, temp with
- Connected, true ->
- (data#conf#color_connected_temp,
- Chat_icons.create_gdk_pixmap Chat_icons.connected)
- | Connected, false ->
- (data#conf#color_connected,
- Chat_icons.create_gdk_pixmap Chat_icons.connected)
- | Not_connected, _ ->
- (data#conf#color_not_connected,
- Chat_icons.create_gdk_pixmap Chat_icons.not_connected)
- in
- wlist#set_cell ~pixmap: pix (wlist#rows - 1) 0 ;
- wlist#set_row ~foreground: (`NAME color) (wlist#rows - 1)
- )
- data#people;
- GToolbox.autosize_clist wlist;
- selected_people <- []
-
- method open_dialog (id, host, port, _, _) =
- ignore (get_dialog data (Single (id, host, port)))
-
- method open_room room_name people =
- let l = List.map (fun (i,h,p,_,_) -> (i,h,p)) people in
- ignore (get_dialog data (Room (room_name, l)))
-
- method open_dialog_for_selected_people =
- match selected_people with
- [] -> ()
- | [p] -> self#open_dialog p
- | l ->
- match GToolbox.input_string
- ~title: Chat_messages.m_open_dialog_for_selected_people
- (Chat_messages.room_name^": ")
- with
- None -> ()
- | Some name ->
- let c = data#conf in
- self#open_room name ((c#id, c#hostname, c#port, Connected, false)
:: l)
-
- initializer
- if no_quit then
- itemQuit#misc#hide ()
- else
- ignore (itemQuit#connect#activate box#destroy);
- ignore (itemOpenDialog#connect#activate
- (fun () -> self#open_dialog_for_selected_people));
- ignore (itemAbout#connect#activate
- (fun () ->
- GToolbox.message_box
- Chat_messages.m_about
- Chat_messages.software_about)
- );
-
-
- let maybe_double_click (ev : GdkEvent.Button.t) =
- let t = GdkEvent.get_type ev in
- match t with
- `TWO_BUTTON_PRESS -> itemOpenDialog#activate ()
- | _ -> ()
- in
-
- let f_select ~row ~column ~event =
- try
- let (id,host,port,_,_) as p = List.nth people row in
- if List.exists
- (fun (i,h,p,_,_) -> data#pred (id,host,port) (i,h,p))
- selected_people
- then
- ()
- else
- selected_people <- p :: selected_people ;
- match event with
- None -> ()
- | Some ev -> maybe_double_click ev
- with _ -> ()
- in
- let f_unselect ~row ~column ~event =
- try
- let (id, host, port, _, _) = List.nth people row in
- selected_people <- List.filter
- (fun (i,h,p,_,_) -> not (data#pred (id,host,port) (i,h,p)))
- selected_people;
- match event with
- None -> ()
- | Some ev -> maybe_double_click ev
- with _ -> ()
- in
- (* connect the select and deselect events *)
- ignore (wlist#connect#select_row f_select) ;
- ignore (wlist#connect#unselect_row f_unselect) ;
-
-
- end
Index: src/gtk2/chat/chat_gui_base.ml
===================================================================
RCS file: src/gtk2/chat/chat_gui_base.ml
diff -N src/gtk2/chat/chat_gui_base.ml
--- src/gtk2/chat/chat_gui_base.ml 2 Mar 2005 19:28:14 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,186 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-class gui () =
- let box = GPack.vbox ~homogeneous:false () in
- let menubar =
- GMenu.menu_bar ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let itemfile = GMenu.menu_item ~label:"File" ~packing:(menubar#add) () in
- let menuFile = GMenu.menu ~packing:(itemfile#set_submenu) () in
- let itemOptions =
- GMenu.menu_item ~label:(Chat_messages.m_options) ~packing:(menuFile#add)
- ()
- in
- let itemAddPeople =
- GMenu.menu_item ~label:(Chat_messages.m_add_people)
- ~packing:(menuFile#add) ()
- in
- let itemToggleTemp =
- GMenu.menu_item ~label:(Chat_messages.m_toggle_temp)
- ~packing:(menuFile#add) ()
- in
- let itemOpenDialog =
- GMenu.menu_item ~label:(Chat_messages.m_open_dialog_for_selected_people)
- ~packing:(menuFile#add) ()
- in
- let _ = GMenu.menu_item ~packing:(menuFile#add) () in
- let itemRemovePeople =
- GMenu.menu_item ~label:(Chat_messages.m_remove_people)
- ~packing:(menuFile#add) ()
- in
- let _ = GMenu.menu_item ~packing:(menuFile#add) () in
- let itemQuit =
- GMenu.menu_item ~label:(Chat_messages.m_quit) ~packing:(menuFile#add) ()
- in
- let itemHelp = GMenu.menu_item ~label:"?" ~packing:(menubar#add) () in
- let menuHelp = GMenu.menu ~packing:(itemHelp#set_submenu) () in
- let itemAbout =
- GMenu.menu_item ~label:(Chat_messages.m_about) ~packing:(menuHelp#add) ()
- in
- let accelgroup = GtkData.AccelGroup.create () in
- let _ = menuFile#set_accel_group accelgroup in
- let _ =
- itemOptions#add_accelerator ~group:accelgroup ~modi:([`CONTROL])
- ~flags:([`VISIBLE; `LOCKED]) GdkKeysyms._O
- in
- let _ =
- itemAddPeople#add_accelerator ~group:accelgroup ~modi:([`CONTROL])
- ~flags:([`VISIBLE; `LOCKED]) GdkKeysyms._A
- in
- let _ =
- itemToggleTemp#add_accelerator ~group:accelgroup ~modi:([`CONTROL])
- ~flags:([`VISIBLE; `LOCKED]) GdkKeysyms._T
- in
- let _ =
- itemOpenDialog#add_accelerator ~group:accelgroup ~modi:([`CONTROL])
- ~flags:([`VISIBLE; `LOCKED]) GdkKeysyms._D
- in
- let _ =
- itemRemovePeople#add_accelerator ~group:accelgroup ~modi:([`CONTROL])
- ~flags:([`VISIBLE; `LOCKED]) GdkKeysyms._K
- in
- let _ =
- itemQuit#add_accelerator ~group:accelgroup ~modi:([`CONTROL])
- ~flags:([`VISIBLE; `LOCKED]) GdkKeysyms._Q
- in
- let _ = menuHelp#set_accel_group accelgroup in
- let _anonymous_container_1 =
- GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC
- ~placement:`TOP_LEFT ~packing:(box#pack ~expand:true ~fill:true) ()
- in
- let wlist =
- GList.clist
- ~titles:(
- [""; Chat_messages.id; Chat_messages.host; Chat_messages.port;
- Chat_messages.temporary])
- ~shadow_type:`NONE ~selection_mode:`MULTIPLE ~titles_show:true
- ~packing:(_anonymous_container_1#add) ()
- in
- object
- val box = box
- val menubar = menubar
- val accelgroup = accelgroup
- val itemfile = itemfile
- val menuFile = menuFile
- val itemOptions = itemOptions
- val itemAddPeople = itemAddPeople
- val itemToggleTemp = itemToggleTemp
- val itemOpenDialog = itemOpenDialog
- val itemRemovePeople = itemRemovePeople
- val itemQuit = itemQuit
- val itemHelp = itemHelp
- val menuHelp = menuHelp
- val itemAbout = itemAbout
- val wlist = wlist
- method box = box
- method menubar = menubar
- method accelgroup = accelgroup
- method itemfile = itemfile
- method menuFile = menuFile
- method itemOptions = itemOptions
- method itemAddPeople = itemAddPeople
- method itemToggleTemp = itemToggleTemp
- method itemOpenDialog = itemOpenDialog
- method itemRemovePeople = itemRemovePeople
- method itemQuit = itemQuit
- method itemHelp = itemHelp
- method menuHelp = menuHelp
- method itemAbout = itemAbout
- method wlist = wlist
- method coerce = box#coerce
- end
-class dialog () =
- let box = GPack.vbox ~homogeneous:false () in
- let wscroll =
- GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC
- ~placement:`TOP_LEFT ~packing:(box#pack ~expand:true ~fill:true) ()
- in
- let wt_dialog =
- GText.view ~editable:false ~wrap_mode:`WORD
- ~packing:(wscroll#add) ()
- in
- let wtool =
- GButton.toolbar ~orientation:`HORIZONTAL ~style:`ICONS
- ~tooltips:true
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let wt_input =
- GText.view ~height:50 ~editable:true ~wrap_mode:`WORD
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let wb_show_hide =
- GButton.button ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let _65 =
- GMisc.label ~text:(Chat_messages.show_hide_people) ~justify:`LEFT
- ~line_wrap:true ~packing:(wb_show_hide#add) ()
- in
- let wscroll_people =
- GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC
- ~placement:`TOP_LEFT ~packing:(box#pack ~expand:true ~fill:true) ()
- in
- let wlist_people =
- GList.clist
- ~titles:([Chat_messages.id; Chat_messages.host; Chat_messages.port])
- ~shadow_type:`NONE ~selection_mode:`SINGLE ~titles_show:true
- ~packing:(wscroll_people#add) ()
- in
- object
- val box = box
- val wscroll = wscroll
- val wt_dialog = wt_dialog
- val wtool = wtool
- val wt_input = wt_input
- val wb_show_hide = wb_show_hide
- val wscroll_people = wscroll_people
- val wlist_people = wlist_people
- method box = box
- method wscroll = wscroll
- method wt_dialog = wt_dialog
- method wtool = wtool
- method wt_input = wt_input
- method wb_show_hide = wb_show_hide
- method wscroll_people = wscroll_people
- method wlist_people = wlist_people
- method coerce = box#coerce
- end
Index: src/gtk2/chat/chat_main.ml
===================================================================
RCS file: src/gtk2/chat/chat_main.ml
diff -N src/gtk2/chat/chat_main.ml
--- src/gtk2/chat/chat_main.ml 2 Mar 2005 20:01:07 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,50 +0,0 @@
-(**************************************************************************)
-(* Copyright 2003, 2002 b8_bavard, b8_zoggy, , b52_simon INRIA *)
-(* *)
-(* This file is part of mldonkey. *)
-(* *)
-(* mldonkey 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 of the License, *)
-(* or (at your option) any later version. *)
-(* *)
-(* mldonkey 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 mldonkey; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, *)
-(* MA 02111-1307 USA *)
-(* *)
-(**************************************************************************)
-
-(** Main module of the standalone tool. *)
-
-ignore (GMain.Main.init ());;
-
-let pred (i1,h1,p1) (i2,h2,p2) =
- i1 = i2 && h1 = h2 && p1 = p2
-
-let main () =
- let _ = GMain.Main.init () in
- let config = Chat_args.parse () in
- let com = new Mlchat.tcp config in
- let app = new Mlchat.app ~pred: pred config com in
- let window = GWindow.window
- ~allow_shrink: true
- ~allow_grow: true
- ~icon:(Chat_art.get_icon ~icon:"icon_mlchat" ())
- ~width:(Gdk.Screen.height () * 2 / 5)
- ~height:(Gdk.Screen.width () * 1 / 3)
- ~title:Chat_messages.software ()
- in
- window#add app#coerce ;
- ignore (app#box#connect#destroy window#destroy);
- ignore (window#connect#destroy GMain.Main.quit);
- app#init_window window ;
- window#show () ;
- GMain.Main.main ()
-
-let _ = main ()
Index: src/gtk2/im/.cvsignore
===================================================================
RCS file: src/gtk2/im/.cvsignore
diff -N src/gtk2/im/.cvsignore
--- src/gtk2/im/.cvsignore 30 May 2006 11:23:48 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,2 +0,0 @@
-*.cm?
-*.annot
Index: src/gtk2/im/guiIm.ml
===================================================================
RCS file: src/gtk2/im/guiIm.ml
diff -N src/gtk2/im/guiIm.ml
--- src/gtk2/im/guiIm.ml 2 Mar 2005 20:16:53 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,169 +0,0 @@
-(* Copyright 2004 b8_bavard *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open Options
-open ImOptions
-open ImAccount
-open ImProtocol
-open ImEvent
-open ImTypes
-open ImIdentity
-open ImChat
-open ImRoom
-
-module O = GuiOptions
-module A = GuiArt
-module U = GuiUtf8
-module M = GuiMessages
-
-let verbose = !!O.gtk_verbose_im
-
-let lprintf' fmt =
- Printf2.lprintf ("GuiIm: " ^^ fmt)
-
-(*************************************************************************)
-(* *)
-(* Global variables *)
-(* *)
-(*************************************************************************)
-
-let quit_on_close = ref false
-
-(*************************************************************************)
-(* *)
-(* main_window *)
-(* *)
-(*************************************************************************)
-
-let main_window () =
- let width = (Gdk.Screen.width ()) * 1 / 2 in
- let height = (Gdk.Screen.height ()) * 1 / 2 in
- let window =
- GWindow.window ~width ~height
- ~title:(!M.iM_wt_software)
- ~icon:(A.get_icon ~icon:M.icon_menu_im ~size:A.SMALL ())
- ~modal:false ()
- in
- ignore (window#event#connect#delete ~callback:
- (fun _ ->
- if !quit_on_close
- then CommonGlobals.exit_properly 0
- else window#coerce#misc#hide ();
- true
- ));
- let box =
- GPack.vbox ~homogeneous:false
- ~packing:window#add ()
- in
- let menubar =
- GMenu.menu_bar ~packing:(box#pack ~expand:false ~fill:false) ()
- in
- let menu =
- GMenu.menu_item ~label:!M.iM_me_menu ~use_mnemonic:true
- ~packing:menubar#add ()
- in
- let main_menu = GMenu.menu ~packing:menu#set_submenu () in
- let itemAccounts =
- GMenu.image_menu_item ~label:!M.iM_me_new_accounts ~use_mnemonic:true
- ~image:(GMisc.image ~pixbuf:(A.get_icon ~icon:M.icon_menu_mlchat
~size:A.SMALL ()) ())
- ~packing:main_menu#add ()
- in
- let itemQuit =
- GMenu.image_menu_item ~label:!M.iM_me_quit ~use_mnemonic:true
- ~image:(GMisc.image ~pixbuf:(A.get_icon ~icon:M.icon_menu_quit
~size:A.SMALL ()) ())
- ~packing:main_menu#add ()
- in
- let new_accounts = GMenu.menu ~packing:itemAccounts#set_submenu () in
- ignore (itemQuit#connect#activate
- (fun _ ->
- if !quit_on_close
- then CommonGlobals.exit_properly 0
- else window#coerce#misc#hide ()
- ));
- let accel_menubar = GtkData.AccelGroup.create () in
- let _ = window#add_accel_group accel_menubar in
- let _ = main_menu#set_accel_group accel_menubar in
- itemAccounts#add_accelerator ~group:accel_menubar ~modi:[`CONTROL]
- ~flags:[`VISIBLE] GdkKeysyms._n;
- itemQuit#add_accelerator ~group:accel_menubar ~modi:[`CONTROL]
- ~flags:[`VISIBLE] GdkKeysyms._w;
- let main_notebook =
- GPack.notebook ~tab_pos:`TOP ~show_tabs:true ~homogeneous_tabs:true
- ~show_border:true ~scrollable:true ~enable_popup:true
- ~packing:(box#pack ~expand:true ~fill:true) ()
- in
- main_notebook#append_page
- ~tab_label:((GMisc.label ~text:!M.iM_lb_accounts ())#coerce)
- (GuiImAccounts.accounts_window ());
- ImProtocol.iter (fun p ->
- let menu_item =
- GMenu.menu_item ~label:(Printf.sprintf !M.iM_me_x_account (protocol_name
p))
- ~packing:new_accounts#add ()
- in
- ignore (menu_item#connect#activate ~callback:
- (fun _ ->
- let account = protocol_new_account p in
- GuiImAccounts.input_account account;
- ImEvent.add_event (Account_event account);
- if verbose then lprintf' "NEW ACCOUNT\n"
- ))
- );
- ImEvent.set_event_handler (fun event ->
- match event with
- | Account_event account ->
- GuiImAccounts.h_update_account account
-
- | Account_friend_event id -> ()
-(*
- (if verbose then lprintf' "Account_friend_event\n");
- let account = identity_account id in
- begin try
- let w = find_account_window account in
- (if verbose then lprintf' "Window available\n");
- w#update_contact id
- with _ -> () end
-*)
- | Chat_open_event chat ->
- GuiImChat.h_open_chat chat
-
- | Chat_close_event chat ->
- GuiImChat.h_close_chat chat
-
- | Chat_my_message (chat, msg) -> ()
-
- | Chat_message_event (chat, id, msg) ->
- GuiImChat.h_chat_message (chat, id, msg)
-
- | Room_join room ->
- GuiImRooms.h_join_room room main_notebook
-
- | Room_leave room ->
- GuiImRooms.h_leave_room room
-
- | Room_public_message (room, _)
- | Room_message (room, _, _)
- | Room_user_join (room, _)
- | Room_user_leave (room, _) ->
- GuiImRooms.h_room_event room event
- );
- window#show ()
-
-
-
-
Index: src/gtk2/im/guiImAccounts.ml
===================================================================
RCS file: src/gtk2/im/guiImAccounts.ml
diff -N src/gtk2/im/guiImAccounts.ml
--- src/gtk2/im/guiImAccounts.ml 12 Nov 2005 11:16:36 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,412 +0,0 @@
-(* Copyright 2004 b8_bavard *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open Options
-open ImOptions
-open ImAccount
-open ImProtocol
-open ImEvent
-open ImTypes
-open ImIdentity
-open ImChat
-open ImRoom
-open GuiColumns
-
-module U = GuiUtf8
-module O = GuiOptions
-module A = GuiArt
-module M = GuiMessages
-
-let verbose = !!O.gtk_verbose_im
-
-let lprintf' fmt =
- Printf2.lprintf ("GuiImAccounts: " ^^ fmt)
-
-(*************************************************************************)
-(* *)
-(* Global tables *)
-(* *)
-(*************************************************************************)
-
-let (act_by_num : (int, account) Hashtbl.t) = Hashtbl.create 13
-
-(*************************************************************************)
-(* *)
-(* account_pixb *)
-(* *)
-(*************************************************************************)
-
-let account_pixb ac =
- if !!O.gtk_look_use_icons
- then begin
- let size = A.SMALL in
- let pixb =
- match (account_status ac) with
- Status_offline -> A.get_icon ~icon:M.icon_menu_mlchat ~size
~desat:true ()
- | _ -> A.get_icon ~icon:M.icon_menu_mlchat ~size ()
- in
- Some pixb
- end else None
-
-(*************************************************************************)
-(* *)
-(* string_of_status *)
-(* *)
-(*************************************************************************)
-
-let string_of_status status =
- match status with
- | Status_online Online_available -> !M.iM_tx_online
- | Status_online Online_away -> !M.iM_tx_online_away
- | Status_connecting -> !M.iM_tx_connecting
- | Status_offline -> !M.iM_tx_offline
-
-(*************************************************************************)
-(* *)
-(* act_num *)
-(* *)
-(*************************************************************************)
-
-let act_num key =
- try int_of_string key with _ -> raise Not_found
-
-(*************************************************************************)
-(* *)
-(* act_of_key *)
-(* *)
-(*************************************************************************)
-
-let act_of_key key =
- try
- let num = act_num key in
- Hashtbl.find act_by_num num
- with _ -> raise Not_found
-
-(*************************************************************************)
-(* *)
-(* keys_to_acts *)
-(* *)
-(*************************************************************************)
-
-let keys_to_acts keys =
- let l = ref [] in
- List.iter (fun k ->
- try
- let s = act_of_key k in
- l := s :: !l
- with _ -> ()) keys;
- !l
-
-(*************************************************************************)
-(* *)
-(* act_key *)
-(* *)
-(*************************************************************************)
-
-let act_key act_num =
- Printf.sprintf "%d" act_num
-
-(*************************************************************************)
-(* *)
-(* Templates *)
-(* *)
-(*************************************************************************)
-
-module Accounts = GuiTemplates.Gview(struct
-
- module Column = GuiColumns.IMAccount
-
- type item = account
-
- let columns = O.account_columns
- let get_key = (fun ac -> act_key (account_num ac))
- let module_name = "IM Accounts"
-
-end)
-
-
-class g_account () =
- let ac_cols = new GTree.column_list in
- let ac_name = ac_cols#add Gobject.Data.string in
- let ac_status = ac_cols#add Gobject.Data.string in
- let ac_protocol = ac_cols#add Gobject.Data.string in
- let ac_name_pixb = ac_cols#add Gobject.Data.gobject_option in
- object
- inherit Accounts.g_list ac_cols
-
-(*************************************************************************)
-(* *)
-(* from_item *)
-(* *)
-(*************************************************************************)
-
- method from_item (row : Gtk.tree_iter) (ac : account) =
- store#set ~row ~column:ac_name (U.utf8_of (account_name ac));
- store#set ~row ~column:ac_status (U.simple_utf8_of (string_of_status
(account_status ac)));
- store#set ~row ~column:ac_protocol (U.simple_utf8_of (protocol_name
(account_protocol ac)));
- store#set ~row ~column:ac_name_pixb (account_pixb ac)
-
-(*************************************************************************)
-(* *)
-(* from_new_item *)
-(* *)
-(*************************************************************************)
-
- method from_new_item (row : Gtk.tree_iter) (ac : account) (ac_new : account)
=
- Printf2.lprintf " ** Account name: %s | %s\n ** Account status %s |
%s\n ** Account protocol %s | %s\n"
- (account_name ac) (account_name ac_new)
- (string_of_status (account_status ac)) (string_of_status (account_status
ac_new))
- (protocol_name (account_protocol ac)) (protocol_name (account_protocol
ac_new));
- store#set ~row ~column:ac_name (U.utf8_of (account_name ac_new));
- store#set ~row ~column:ac_status (U.simple_utf8_of (string_of_status
(account_status ac_new)));
- store#set ~row ~column:ac_name_pixb (account_pixb ac_new);
- store#set ~row ~column:ac_protocol (U.simple_utf8_of (protocol_name
(account_protocol ac_new)))
-
-(*************************************************************************)
-(* *)
-(* content *)
-(* *)
-(*************************************************************************)
-
- method content col c =
- match c with
- Col_account_name ->
- begin
- if !!O.gtk_look_use_icons
- then begin
- let renderer = GTree.cell_renderer_pixbuf [`XALIGN 0.;`XPAD 4]
in
- col#pack ~expand:false renderer;
- col#add_attribute renderer "pixbuf" ac_name_pixb
- end;
- let renderer = GTree.cell_renderer_text [`XALIGN 0.] in
- col#pack ~expand:false renderer;
- col#add_attribute renderer "text" ac_name
- end
-
- | Col_account_status ->
- begin
- let renderer = GTree.cell_renderer_text [`XALIGN 0.] in
- col#pack renderer;
- col#add_attribute renderer "text" ac_status
- end
-
- | Col_account_protocol ->
- begin
- let renderer = GTree.cell_renderer_text [`XALIGN 0.] in
- col#pack renderer;
- col#add_attribute renderer "text" ac_protocol
- end
-
-(*************************************************************************)
-(* *)
-(* sort_items *)
-(* *)
-(*************************************************************************)
-
- method sort_items c k1 k2 =
- try
- let ac1 = act_of_key k1 in
- let ac2 = act_of_key k2 in
- match c with
- Col_account_name -> compare (account_name ac1) (account_name ac2)
- | Col_account_status -> compare (account_status ac1) (account_status ac2)
- | Col_account_protocol -> compare (account_protocol ac1)
(account_protocol ac2)
- with _ -> 0
-
- end
-
-let accountstore = new g_account ()
-
-
-(*************************************************************************)
-(* *)
-(* input_record *)
-(* *)
-(*************************************************************************)
-
-module C = ConfigWindow
-
-let preference ?(help="") label v box_type () =
- {
- C.pref_section = None;
- C.opt_section = "";
- C.pref_subsection = None;
- C.pref_help = help;
- C.pref_advanced = false;
- C.pref_default = v;
- C.pref_name = label;
- C.pref_label = label;
- C.pref_group = None;
- C.pref_option_list = [];
- C.pref_value = v;
- C.pref_new_value = v;
- C.pref_type = box_type;
- C.pref_apply = (fun () -> ());
- C.pref_apply_default = (fun () -> ());
- }
-
-let input_record record account =
- let rec iter list params refs =
- match list with
- (_, name, _, from_record, to_record) :: tail ->
- let param, f =
- match from_record, to_record with
- FromString fs, ToString ts ->
- let pref = preference name (ts ()) C.BString () in
- pref, (fun _ -> fs pref.C.pref_new_value)
-
- | FromBool fb, ToBool tb ->
- let pref = preference name (string_of_bool (tb ())) C.BBool () in
- pref, (fun _ -> fb (C.safe_bool pref.C.pref_new_value))
-
- | FromInt fi, ToInt ti ->
- let pref = preference name (string_of_int (ti ())) C.BInt () in
- pref, (fun _ -> fi (int_of_float (C.safe_int
pref.C.pref_new_value)))
-
- | _ -> assert false
- in
- iter tail (param :: params) (f :: refs)
- | [] ->
- begin
- let prefs = (List.rev params) in
- let on_ok () =
- List.iter (fun f -> f ()) refs;
- add_event (Account_event account);
- Options.save_with_help accounts_ini
- in
- C.simple_panel ~prefs
- ~title:!M.iM_lb_new_account
- ~icon:(A.get_icon ~icon:M.icon_menu_mlchat ~size:A.SMALL ())
- ~on_ok ()
- end
- in
- iter record [] []
-
-
-(*************************************************************************)
-(* *)
-(* input_account *)
-(* *)
-(*************************************************************************)
-
-let input_account account =
- try
- input_record (account_config_record account) account
- with e ->
- if verbose then lprintf' "Execption %s in input_account\n"
- (Printexc2.to_string e)
-
-(*************************************************************************)
-(* *)
-(* message to the core *)
-(* *)
-(*************************************************************************)
-
-let settings sel () =
- let l = keys_to_acts sel in
- List.iter (fun account ->
- input_account account
- ) l
-
-let connect sel () =
- let l = keys_to_acts sel in
- List.iter (fun account ->
- match account_status account with
- Status_offline -> account_login account
- | _ -> account_logout account
- ) l
-
-let remove sel () = ()
-
-let ask_for_room account =
- let pref = preference !M.im_lb_room_name "" C.BString () in
- let on_ok () =
- account_join_room account pref.C.pref_new_value
- in
- C.input_window ~pref
- ~title:!M.iM_lb_join_room
- ~icon:(A.get_icon ~icon:M.icon_menu_mlchat ~size:A.SMALL ())
- ~on_ok ()
-
-(*************************************************************************)
-(* *)
-(* account_menu *)
-(* *)
-(*************************************************************************)
-
-let account_menu sel =
- match sel with
- [] -> []
- | k :: tail ->
- begin
- let basic_menu =
- [
- `I (!M.iM_me_connect_disconnect, connect sel) ;
- `I (!M.iM_me_settings, settings sel) ;
- `I (!M.iM_me_remove, remove sel) ;
- ]
- in
- try
- let account = act_of_key k in
- if tail = [] && account_has_rooms account then
- (`I (!M.iM_me_join_room, (fun _ -> ask_for_room account)))::
- (let prefered_rooms = account_prefered_rooms account in
- if prefered_rooms = []
- then []
- else
- [ `M (!M.iM_me_prefered_rooms,
- List.map (fun name ->
- `I ((U.utf8_of name), (fun _ ->
- account_join_room account name))
- ) prefered_rooms)]
- ) @basic_menu
- else basic_menu
- with _ -> basic_menu
- end
-
-(*************************************************************************)
-(* *)
-(* message from the core *)
-(* *)
-(*************************************************************************)
-
-let h_update_account account =
- lprintf' "h_update_account %d\n" (account_num account);
- try
- let ac = act_of_key (act_key (account_num account)) in
- let row = accountstore#find_row (act_key (account_num account)) in
- lprintf' "Updating Account %d\n" (account_num account);
- Gaux.may ~f:(fun r -> accountstore#update_item r ac account) row;
- lprintf' "Updated Account %d\n" (account_num account)
- with _ ->
- lprintf' "Adding Account %d\n" (account_num account);
- accountstore#add_item account ();
- lprintf' "Added Account %d\n" (account_num account)
-
-(*************************************************************************)
-(* *)
-(* accounts_window *)
-(* *)
-(*************************************************************************)
-
-let accounts_window () =
- let accountview = Accounts.treeview ~mode:`MULTIPLE () in
- accountview#set_model accountstore#gmodel;
- accountview#set_menu account_menu;
- accountview#coerce
Index: src/gtk2/im/guiImChat.ml
===================================================================
RCS file: src/gtk2/im/guiImChat.ml
diff -N src/gtk2/im/guiImChat.ml
--- src/gtk2/im/guiImChat.ml 2 Mar 2005 20:16:53 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,157 +0,0 @@
-(* Copyright 2004 b8_bavard *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open Options
-open ImOptions
-open ImAccount
-open ImProtocol
-open ImEvent
-open ImTypes
-open ImIdentity
-open ImChat
-open ImRoom
-
-module U = GuiUtf8
-module O = GuiOptions
-module A = GuiArt
-module M = GuiMessages
-
-let verbose = !!O.gtk_verbose_im
-
-let lprintf' fmt =
- Printf2.lprintf ("GuiImChat: " ^^ fmt)
-
-(*************************************************************************)
-(* *)
-(* Types *)
-(* *)
-(*************************************************************************)
-
-type im_chat =
- {
- buffer : GuiTemplates.chat_buffer;
- view : GuiTemplates.chat_view;
- }
-
-(*************************************************************************)
-(* *)
-(* Global tables *)
-(* *)
-(*************************************************************************)
-
-let chats = Hashtbl.create 13
-
-(*************************************************************************)
-(* *)
-(* messages to the core *)
-(* *)
-(*************************************************************************)
-
-let on_entry_return chat s =
- (if verbose then lprintf' "SEND MESSAGE %s\n" s);
- let len = String.length s in
- let s =
- if len <= 0 then ""
- else
- match s.[0] with
- '\n' -> String.sub s 1 (len - 1)
- | _ -> s
- in
- chat_send chat s
-
-(*************************************************************************)
-(* *)
-(* dialog *)
-(* *)
-(*************************************************************************)
-
-let dialog chat =
- let chat_buf = GuiTemplates.chat_buffer ~on_entry:(on_entry_return chat) ()
in
- let chatview =
- GuiTemplates.chat_view ~extended:true ~buffer:chat_buf
- ~my_name:(account_name (chat_account chat)) ()
- in
- {buffer = chat_buf; view = chatview}
-
-(*************************************************************************)
-(* *)
-(* new_dialog *)
-(* *)
-(*************************************************************************)
-
-let new_dialog chat =
- let width = (Gdk.Screen.width ()) * 3 / 10 in
- let height = (Gdk.Screen.height ()) * 3 / 10 in
- let window =
- GWindow.window ~width ~height
- ~icon:(A.get_icon ~icon:M.icon_menu_mlchat ~size:A.SMALL ())
- ~allow_grow:false ~allow_shrink:false
- ~resizable:false ~modal:false ~border_width:6
- ~title:(U.utf8_of (chat_name chat)) ()
- in
- let dialog = dialog chat in
- ignore (window#connect#destroy ~callback:
- (fun _ ->
- chat_close chat
- ));
- window#add dialog.view#coerce;
- window, dialog
-
-(*************************************************************************)
-(* *)
-(* find_chat_window *)
-(* *)
-(*************************************************************************)
-
-let find_chat_window chat =
- try
- let (w, d) = Hashtbl.find chats (chat_num chat) in
- w#present ();
- (w, d)
- with _ ->
- begin
- let w = new_dialog chat in
- Hashtbl.add chats (chat_num chat) w;
- w
- end
-
-(*************************************************************************)
-(* *)
-(* messages from the core *)
-(* *)
-(*************************************************************************)
-
-let h_open_chat chat =
- let (w, _) = find_chat_window chat in
- w#show ()
-
-let h_close_chat chat =
- try
- let num = chat_num chat in
- let (w, d) = Hashtbl.find chats num in
- Hashtbl.remove chats num;
- d.view#clear ();
- d.view#destroy ();
- w#destroy ();
- d.buffer#clear ()
- with _ -> ()
-
-let h_chat_message (chat, id, msg) =
- let (_, d) = find_chat_window chat in
- d.buffer#insert_text msg (identity_name id) ~priv:true ()
Index: src/gtk2/im/guiImMain.ml
===================================================================
RCS file: src/gtk2/im/guiImMain.ml
diff -N src/gtk2/im/guiImMain.ml
--- src/gtk2/im/guiImMain.ml 2 Mar 2005 20:16:53 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,23 +0,0 @@
-(* Copyright 2002 b8_fange *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open GuiIm
-
-let _ =
- quit_on_close := true
Index: src/gtk2/im/guiImRooms.ml
===================================================================
RCS file: src/gtk2/im/guiImRooms.ml
diff -N src/gtk2/im/guiImRooms.ml
--- src/gtk2/im/guiImRooms.ml 12 Nov 2005 11:16:36 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,315 +0,0 @@
-(* Copyright 2004 b8_bavard *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open Options
-open ImOptions
-open ImAccount
-open ImProtocol
-open ImEvent
-open ImTypes
-open ImIdentity
-open ImChat
-open ImRoom
-
-module O = GuiOptions
-module A = GuiArt
-module U = GuiUtf8
-module M = GuiMessages
-
-let verbose = !!O.gtk_verbose_im
-
-let lprintf' fmt =
- Printf2.lprintf ("GuiIm: " ^^ fmt)
-
-(*************************************************************************)
-(* *)
-(* Global tables *)
-(* *)
-(*************************************************************************)
-
-let (id_by_num : (int, identity) Hashtbl.t) = Hashtbl.create 13
-
-(*************************************************************************)
-(* *)
-(* id_num *)
-(* *)
-(*************************************************************************)
-
-let id_num key =
- try int_of_string key with _ -> raise Not_found
-
-(*************************************************************************)
-(* *)
-(* id_of_key *)
-(* *)
-(*************************************************************************)
-
-let id_of_key key =
- try
- let num = id_num key in
- Hashtbl.find id_by_num num
- with _ -> raise Not_found
-
-(*************************************************************************)
-(* *)
-(* keys_to_ids *)
-(* *)
-(*************************************************************************)
-
-let keys_to_ids keys =
- let l = ref [] in
- List.iter (fun k ->
- try
- let s = id_of_key k in
- l := s :: !l
- with _ -> ()) keys;
- !l
-
-(*************************************************************************)
-(* *)
-(* id_key *)
-(* *)
-(*************************************************************************)
-
-let id_key id_num =
- Printf.sprintf "%d" id_num
-
-(*************************************************************************)
-(* *)
-(* Templates *)
-(* *)
-(*************************************************************************)
-
-module Identities = GuiTemplates.Gview(struct
-
- module Column = GuiColumns.IMIdentities
-
- type item = identity
-
- let columns = O.identities_columns
- let get_key = (fun c -> id_key (identity_num c))
- let module_name = "IM Identities"
-
-end)
-
-class g_identity () =
- let id_cols = new GTree.column_list in
- let id_name = id_cols#add Gobject.Data.string in
- object (self)
-
- inherit Identities.g_list id_cols
-
-(*************************************************************************)
-(* *)
-(* from_item *)
-(* *)
-(*************************************************************************)
-
- method from_item (row : Gtk.tree_iter) (id : identity) =
- store#set ~row ~column:id_name (U.utf8_of (identity_name id))
-
-(*************************************************************************)
-(* *)
-(* from_new_item *)
-(* *)
-(*************************************************************************)
-
- method from_new_item (row : Gtk.tree_iter) (id : identity) (id_new :
identity) =
- self#from_item row id_new
-
-(*************************************************************************)
-(* *)
-(* content *)
-(* *)
-(*************************************************************************)
-
- method content col c =
- let renderer = GTree.cell_renderer_text [`XALIGN 0.] in
- col#pack renderer;
- col#add_attribute renderer "text" id_name
-
-(*************************************************************************)
-(* *)
-(* sort_items *)
-(* *)
-(*************************************************************************)
-
- method sort_items c k1 k2 =
- try
- let id1 = id_of_key k1 in
- let id2 = id_of_key k2 in
- compare (String.lowercase (identity_name id1)) (String.lowercase
(identity_name id2))
- with _ -> 0
-
- end
-
-(*************************************************************************)
-(* *)
-(* Types *)
-(* *)
-(*************************************************************************)
-
-type im_room =
- {
- buffer : GuiTemplates.chat_buffer;
- store : g_identity;
- box : GObj.widget;
- }
-
-(*************************************************************************)
-(* *)
-(* Global tables *)
-(* *)
-(*************************************************************************)
-
-let rooms = Hashtbl.create 13
-
-(*************************************************************************)
-(* *)
-(* messages to the core *)
-(* *)
-(*************************************************************************)
-
-let on_entry_return room s =
- (if verbose then lprintf' "SEND MESSAGE %s\n" s);
- room_send room s
-
-(*************************************************************************)
-(* *)
-(* on_double_click_identity *)
-(* *)
-(*************************************************************************)
-
-let on_double_click_identity k =
- try
- let id = id_of_key k in
- identity_open_chat id
- with _ -> ()
-
-(*************************************************************************)
-(* *)
-(* room_window *)
-(* *)
-(*************************************************************************)
-
-let room_window room =
- let hbox = GPack.hbox ~homogeneous:false ~border_width:6 () in
- let hpaned_room = GPack.paned `HORIZONTAL ~packing:hbox#add () in
- let my_name = account_name (room_account room) in
- let idstore = new g_identity () in
- let room_buf =
- GuiTemplates.chat_buffer ~smileys:true
- ~on_entry:(on_entry_return room) ()
- in
- let room_chat =
- GuiTemplates.chat_view ~extended:true ~buffer:room_buf
- ~my_name ~packing:hpaned_room#add1 ()
- in
- let vbox_id =
- GPack.vbox ~homogeneous:false ~spacing:6
- ~packing:hpaned_room#add2 ()
- in
- let idview =
- Identities.treeview ~mode:`MULTIPLE
- ~packing:(vbox_id#pack ~fill:true ~expand:true) ()
- in
- idview#set_model idstore#gmodel;
- idview#set_on_double_click on_double_click_identity;
- let wtool = GuiTools.tool_bar `HORIZONTAL ~layout:`END
~packing:(vbox_id#pack ~fill:true ~expand:false) () in
- let markup = GuiTools.create_markup !M.iM_lb_close in
- let bClose = wtool#add_button
- ~style:`BOTH_HORIZ
- ~icon:(A.get_icon ~icon:M.icon_stock_close ~size:A.SMALL ())
- ~markup
- ~f:(fun _ -> room_quit room) ()
- in
- GuiTools.set_hpaned hpaned_room O.im_room_hpane;
- GuiTools.get_hpaned hpaned_room O.im_room_hpane;
- {buffer = room_buf; store = idstore; box = hbox#coerce}
-
-(*************************************************************************)
-(* *)
-(* messages from the core *)
-(* *)
-(*************************************************************************)
-
-let update_identity id_new (idstore : g_identity) =
- try
- let id = Hashtbl.find id_by_num (identity_num id_new) in
- let row = idstore#find_row (id_key (identity_num id_new)) in
- Gaux.may ~f:(fun r -> idstore#update_item r id id_new) row;
- Hashtbl.replace id_by_num (identity_num id_new) id_new
- with _ ->
- begin
- idstore#add_item id_new ();
- Hashtbl.add id_by_num (identity_num id_new) id_new
- end
-
-let remove_identity id idstore =
- idstore#remove_item (id_key (identity_num id));
- Hashtbl.remove id_by_num (identity_num id)
-
-let h_join_room room (note : GPack.notebook) =
- try
- let ro = Hashtbl.find rooms (room_num room) in
- ()
- with _ ->
- begin
- let ro = room_window room in
- let text =
- U.utf8_of (Printf.sprintf "%s: Room %s"
- (protocol_name (room_protocol room)) (room_name room))
- in
- let label = GMisc.label ~text () in
- note#append_page ~tab_label:label#coerce ro.box;
- Hashtbl.add rooms (room_num room) ro
- end
-
-let h_leave_room room =
- try
- let ro = Hashtbl.find rooms (room_num room) in
- ro.buffer#clear ();
- ro.store#clear ();
- ro.box#destroy ();
- Hashtbl.remove rooms (room_num room);
- Hashtbl.clear id_by_num
- with _ -> ()
-
-let h_room_event room event =
- try
- let ro = Hashtbl.find rooms (room_num room) in
- match event with
- Room_message (_, id, msg) ->
- begin
- let nick = identity_name id in
- ro.buffer#insert_text (Printf.sprintf "%s\n" msg) nick ();
- end
-
- | Room_user_join (_, identity) ->
- update_identity identity ro.store
-
- | Room_user_leave (_, identity) ->
- remove_identity identity ro.store
-
- | Room_public_message (_, msg) ->
- ro.buffer#insert_text (Printf.sprintf "%s\n\n" msg) (room_name
room) ()
-
- | _ ->
- (if verbose then lprintf' "unused room event\n")
- with _ -> ()
Index: src/im/.cvsignore
===================================================================
RCS file: src/im/.cvsignore
diff -N src/im/.cvsignore
--- src/im/.cvsignore 30 May 2006 11:23:48 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,2 +0,0 @@
-*.cm?
-*.annot
Index: src/im/gui_im.ml
===================================================================
RCS file: src/im/gui_im.ml
diff -N src/im/gui_im.ml
--- src/im/gui_im.ml 20 Mar 2005 01:52:14 -0000 1.5
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,812 +0,0 @@
-(* Copyright 2002 b8_fange *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open Printf2
-open Options
-open ImOptions
-open ImAccount
-open ImProtocol
-open ImEvent
-open ImTypes
-open ImIdentity
-open ImChat
-open ImRoom
-open Gpattern
-
-
-
-
-
-
-
-
-
-
-
-
-
-let quit_on_close = ref false
-
-class dialog_box () =
- let box = GPack.vbox ~homogeneous:false () in
- let wscroll =
- GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC
- ~placement:`TOP_LEFT ~packing:(box#pack ~expand:true ~fill:true) ()
- in
- let wt_dialog =
- GEdit.text ~editable:false ~word_wrap:true ~line_wrap:true
- ~packing:(wscroll#add) ()
- in
- let wtool =
- GButton.toolbar ~orientation:`HORIZONTAL ~style:`ICONS
- (* ~space_style:`EMPTY *)
- ~tooltips:true
- ~button_relief:`NORMAL
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let wt_input =
- GEdit.text ~height:50 ~editable:true
- ~word_wrap:true ~line_wrap:true
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let wb_show_hide =
- GButton.button ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let _65 =
- GMisc.label ~text:(Chat_messages.show_hide_people) ~justify:`LEFT
- ~line_wrap:true ~packing:(wb_show_hide#add) ()
- in
- let wscroll_people =
- GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC
- ~placement:`TOP_LEFT ~packing:(box#pack ~expand:true ~fill:true) ()
- in
- let wlist_people =
- GList.clist
- ~titles:([Chat_messages.id; Chat_messages.host; Chat_messages.port])
- ~shadow_type:`NONE ~selection_mode:`SINGLE ~titles_show:true
- ~packing:(wscroll_people#add) ()
- in
- object
- val box = box
- val wscroll = wscroll
- val wt_dialog = wt_dialog
- val wtool = wtool
- val wt_input = wt_input
- val wb_show_hide = wb_show_hide
- val wscroll_people = wscroll_people
- val wlist_people = wlist_people
- method box = box
- method wscroll = wscroll
- method wt_dialog = wt_dialog
- method wtool = wtool
- method wt_input = wt_input
- method wb_show_hide = wb_show_hide
- method wscroll_people = wscroll_people
- method wlist_people = wlist_people
- method coerce = box#coerce
- end
-
-
-class dialog (chat : chat) =
- object (self)
- inherit dialog_box ()
-
- val mutable name = chat_name chat
-
- method name = name
-
- method send s =
- lprintf "SEND MESSAGE %s" s; lprint_newline ();
- chat_send chat s
-
- method handle_message source_id mes =
- wt_dialog#insert ~foreground: (`NAME "red") source_id;
- wt_dialog#insert (" : "^mes^"\n");
- wt_dialog#set_position (wt_dialog#length - 1);
- ()
-
- method handle_my_message mes =
- wt_dialog#insert ~foreground: (`NAME "green")
- (account_name (chat_account chat));
- wt_dialog#insert (" : "^mes^"\n");
- wt_dialog#set_position (wt_dialog#length - 1);
- ()
-
- initializer
- let return () =
- let s = wt_input#get_chars 0 wt_input#length in
- let len = String.length s in
- let s2 =
- if len <= 0 then s
- else
- match s.[0] with
- '\n' -> String.sub s 1 (len - 1)
- | _ -> s
- in
- self#send s2;
- wt_input#delete_text ~start: 0 ~stop: wt_input#length
-
- in
- Okey.add wt_input ~mods: [] GdkKeysyms._Return return;
- Okey.add_list wt_input ~mods: [`CONTROL]
- [GdkKeysyms._c; GdkKeysyms._C]
- box#destroy;
- Okey.add_list wt_dialog ~mods: [`CONTROL]
- [GdkKeysyms._c; GdkKeysyms._C]
- box#destroy;
- Okey.add_list wt_input ~mods: [`CONTROL]
- [GdkKeysyms._l; GdkKeysyms._L]
- wb_show_hide#clicked;
- Okey.add_list wt_dialog ~mods: [`CONTROL]
- [GdkKeysyms._l; GdkKeysyms._L]
- wb_show_hide#clicked;
-
- wscroll_people#misc#hide ();
- let show = ref false in
- ignore (wb_show_hide#connect#clicked
- (fun () ->
- show := not !show;
- if !show then
- wscroll_people#misc#show ()
- else
- wscroll_people#misc#hide ()));
- (*
- List.iter
- (fun (i,h,p) ->
- ignore (wlist_people#append
- [i ; h ; string_of_int p]))
- people; *)
- GToolbox.autosize_clist wlist_people
- end
-
-
-let input_record record =
- let module C = Configwin in
- let rec iter list params refs =
- match list with
- (_, name, _, from_record, to_record) :: tail ->
- let param, f =
- match from_record, to_record with
- FromString fs, ToString ts ->
- let x = ref (ts ()) in
- C.string ~f: (fun s -> x := s) name !x,
- (fun _ -> fs !x)
- | FromBool fb, ToBool tb ->
- let x = ref (tb ()) in
- C.bool ~f: (fun s -> x := s) name !x,
- (fun _ -> fb !x)
- | FromInt fi, ToInt ti ->
- let x = ref (ti ()) in
- C.string ~f: (fun s -> x := int_of_string s) name
- (string_of_int !x),
- (fun _ -> fi !x)
- | _ -> assert false
- in
- iter tail (param :: params) (f :: refs)
- | [] ->
- match C.simple_get "" (List.rev params) with
- C.Return_cancel -> ()
- | C.Return_apply | C.Return_ok ->
- List.iter (fun f -> f ()) refs
- in
- iter record [] []
-
-
-let ask_for_room account =
- let module C = Configwin in
- let room_name = ref "" in
- let params = [
- C.string ~f: (fun s -> room_name := s) "Room Name:" !room_name;
- ] in
- match C.simple_get "" (List.rev params) with
- C.Return_cancel -> ()
- | C.Return_apply | C.Return_ok ->
- account_join_room account !room_name
-
-let input_record record =
- input_record record;
- Options.save_with_help accounts_ini
-
-let input_account account =
- try
- input_record (account_config_record account);
- add_event (Account_event account);
- Options.save_with_help accounts_ini
- with e ->
- lprintf "Execption %s in input_account"
- (Printexc2.to_string e); lprint_newline ()
-
-let string_of_status status =
- match status with
- | Status_online Online_available -> "Online"
- | Status_online Online_away -> "Away"
- | Status_connecting -> "Connecting"
- | Status_offline -> "Offline"
-
-let new_dialog chat =
- let window = GWindow.window ~kind: `POPUP ~width: 300 ~height: 200
- ~title: "" () in
- ignore (window#connect#destroy (fun () ->
- ()
- ));
- let dialog = new dialog chat in
- window#set_title dialog#name;
- ignore (dialog#box#connect#destroy
- (fun _ -> chat_close chat));
- window#add dialog#box#coerce;
- window#show ();
- dialog#wt_input#misc#grab_focus ();
- window, dialog
-
-class simple_box () =
- let vbox = GPack.vbox ~homogeneous:false () in
- let wtool =
- GButton.toolbar ~orientation:`HORIZONTAL ~style:`BOTH
-(* ~space_size:2 ~space_style:`LINE *)
- ~tooltips:true
-(* ~button_relief:`NONE *)
- ~width: 200
- ~packing:(vbox#pack ~expand:false ~fill:true ~padding:2) ()
- in
- object
- val vbox = vbox
- val wtool = wtool
- method vbox = vbox
- method wtool = wtool
- method coerce = vbox#coerce
-end
-
-class contacts_window_list () =
- object(self)
- inherit [identity] Gpattern.plist `MULTIPLE ["Name"; "Status"; "Temporary"]
- true (fun f -> identity_num f) as pl
-
- method compare id1 id2 = identity_num id1 - identity_num id2
- method content id =
- lprintf "content"; lprint_newline ();
- ([ String (identity_name id); String "offline"; String "yes"]
- , None)
-
-
- method update_contact id =
- try
- let (row, _ ) = self#find (identity_num id) in
- self#update_row id row
- with _ ->
- lprintf "add_item"; lprint_newline ();
- self#add_item id;
- lprintf "add_item done"; lprint_newline ();
-
- method on_double_click id =
- identity_open_chat id
- (*
- let dialog = new_dialog id in
-()
- *)
-
-end
-
-
-class identity_list () =
- object(self)
- inherit [identity] Gpattern.plist `MULTIPLE ["Name"]
- true (fun f -> identity_num f) as pl
- inherit simple_box () as box
-
-
- method compare id1 id2 = identity_num id1 - identity_num id2
- method content id =
- lprintf "content"; lprint_newline ();
- ([ String (identity_name id) ], None)
-
- method update_contact id =
- try
- let (row, _ ) = self#find (identity_num id) in
- self#update_row id row
- with _ ->
- self#add_item id;
-
- method on_double_click id =
- identity_open_chat id
- (*
- let dialog = new_dialog id in
-()
- *)
-
- method remove_identity id =
- try
- let (row, _ ) = self#find (identity_num id) in
- self#remove_item row id
- with _ -> ()
-
-
- initializer
- box#vbox#pack ~expand: true pl#box;
-
-
-end
-
-
-let chat_windows = Hashtbl.create 13
-
-let find_chat_window chat =
- Hashtbl.find chat_windows (chat_num chat)
-
-let chat_window chat =
- try
- find_chat_window chat
- with _ ->
- let w = new_dialog chat in
- Hashtbl.add chat_windows (chat_num chat) w;
- w
-
-class contacts_window account =
- let contacts = new contacts_window_list () in
- object (self)
- val mutable hidden = true
-
- inherit Gui_im_base.window () as super
-
- method coerce = window#coerce
-
- method update_contact = contacts#update_contact
-
- method show =
- hidden <- false;
- super#window#show
-
- method hide =
- hidden <- true;
- super#window#coerce#misc#hide
-
- method hidden = hidden
-
- initializer
- friends#add contacts#box
-end
-
-let account_windows = Hashtbl.create 13
-
-let find_account_window account =
- Hashtbl.find account_windows (account_num account)
-
-let account_window account =
- let window =
- try find_account_window account
- with _ ->
- let window = new contacts_window account in
- window#window#set_title (Printf.sprintf "%s: account %s"
- (protocol_name (account_protocol account)) (account_name account));
- ignore (window#window#connect#destroy (fun _ ->
- window#hide ()
- ));
- ignore (window#itemQuit#connect#activate
- (fun _ ->
- window#hide ();));
- ignore (window#itemAddFriend#connect#activate
- (fun _ ->
- let id = account_new_identity account in
- input_record (identity_config_record id)));
- ignore (window#itemOptions#connect#activate
- (fun _ ->
- input_account account));
-
- ignore (window#itemSetStatusOffline#connect#activate (fun _ ->
- account_set_status account Status_offline));
- List.iter (fun online ->
- let item =
- GMenu.menu_item
- ~label:(string_of_status (Status_online online))
- ~packing:(window#menuSetStatus#add) ()
- in
- ignore (item#connect#activate (fun _ ->
- account_set_status account (Status_online online)));
-
-
- ) (protocol_available_status (account_protocol account));
-
-
- Hashtbl.add account_windows (account_num account) window;
- window
- in
- window
-
-
-class accounts_window () =
- object(self)
- inherit [account] Gpattern.plist `MULTIPLE ["Name"; "Status"; "Protocol"]
- true (fun f -> account_num f) as pl
-
- method compare id1 id2 = account_num id1 - account_num id2
- method content ac =
- ([ String (account_name ac);
- String (string_of_status (account_status ac));
- String (protocol_name (account_protocol ac))]
- , None)
-
- method update_account account =
- try
- let (row, _ ) = self#find (account_num account) in
- self#update_row account row
- with _ ->
- self#add_item account
-
-
- method menu =
- (match self#selection with
- [] -> []
- | account :: tail ->
- let basic_menu =
- [
- `I ("Connect/Disconnect", self#connect) ;
- `I ("Settings", self#settings) ;
- `I ("Remove", self#remove) ;
- ] in
- if tail = [] && account_has_rooms account then
- (`I ("Join Room", (fun _ -> ask_for_room account)))::
- (let prefered_rooms = account_prefered_rooms account in
- if prefered_rooms = [] then [] else
- [ `M ("Prefered Rooms",
- List.map (fun name ->
- `I (name, (fun _ ->
- account_join_room account name))
- ) prefered_rooms)]
-
- ) @basic_menu
- else basic_menu
- )
-
- method settings () =
- List.iter (fun account ->
- input_account account
- ) self#selection
-
- method connect () =
- List.iter (fun account ->
- match account_status account with
- Status_offline -> account_login account
- | _ -> account_logout account
- ) self#selection
-
- method remove () = ()
-
-
- method on_double_click account =
- (account_window account)#show ()
-
-end
-
-class im_window account =
- let accounts = new accounts_window () in
- object (self)
- inherit Gui_im_base.accounts ()
-
- method coerce = window#coerce
-
- method update_account account = accounts#update_account account
-
- initializer
- friends#add accounts#box
-end
-
-(*
-let accounts_window =
-
- let window = new im_window () in
- window#window#set_title "Accounts Window";
- ignore (window#window#connect#destroy (fun _ ->
- window#coerce#misc#hide ()
- ));
- ignore (window#itemQuit#connect#activate
- (fun _ -> window#coerce#misc#hide ()));
-
-(*
- ignore (window#itemAddFriend#connect#activate
- (fun _ ->
- let id = protocol_new_account in
- input_record (identity_config_record id)));
- ignore (window#itemOptions#connect#activate
-(fun _ ->
-input_record (account_config_record account)));
-
-*)
-
-
- let _new_accounts =
- GMenu.menu_item ~label:"New accounts" ~packing:(window#menubar#add) ()
- in
- let new_accounts =
- GMenu.menu ~packing:(_new_accounts#set_submenu) () in
-
-
- ImProtocol.iter (fun p ->
- let menu_item =
- GMenu.menu_item ~label:
- (Printf.sprintf "New %s account" (protocol_name p))
-(* ~active:n.network_enabled *)
- ~packing:new_accounts#add ()
- in
- ignore (menu_item#connect#activate ~callback:(fun _ ->
- let account = protocol_new_account p in
- input_account account;
- ImEvent.add_event (Account_event account);
- lprintf "NEW ACCOUNT"; lprint_newline ();
- ))
-
- );
- window
-*)
-
-(** Return a color for a given name. *)
-let color_of_name name =
- let accs = [| ref 0 ; ref 0 ; ref 0 |] in
- for i = 0 to (String.length name) - 1 do
- let m = i mod 3 in
- accs.(m) := !(accs.(m)) + Char.code name.[i]
- done;
- let r = !(accs.(0)) mod 210 in
- let g = !(accs.(1)) mod 210 in
- let b = !(accs.(2)) mod 210 in
- let s = Printf.sprintf "#%02X%02X%02X" r g b in
- `NAME s
-
-class room_window (room: room) =
- let room_users = new identity_list () in
- object (self)
-
- inherit Gui_im_base.room_tab ()
-
-
-
- method update_room = ()
-
- (*
- method init_window =
- let (w,_) = Gdk.Window.get_size wpane#misc#window in
- wpane#set_position (w - 200)
-*)
-
- method room_event (label: GMisc.label) event =
- lprintf "room event"; lprint_newline ();
- match event with
- | Room_message (_, id, msg) ->
- let nick = identity_name id in
- let c = color_of_name nick in
- text#insert ~foreground: c (Printf.sprintf "%s: " nick);
- text#insert (Printf.sprintf "%s\n" msg)
-
- | Room_user_join (_, identity) ->
- room_users#add_item identity
-
- | Room_user_leave (_, identity) ->
- room_users#remove_identity identity
-
- | _ ->
- lprintf "unused room event"; lprint_newline ()
-
- method quit_this_room () =
- room_quit room
-
- initializer
- ignore
- (room_users#wtool#insert_button
- ~text: "Leave"
- ~tooltip: "Leave this room"
- ~icon: (Gui_options.pixmap Gui_messages.o_xpm_close_room)#coerce
- ~callback: self#quit_this_room
- ()
- );
- let account = room_account room in
- nick_label#set_text (Printf.sprintf "%s:" (account_name account));
- wpane#add2 room_users#coerce;
- room_users#coerce#misc#show ();
- let on_entry_return () =
- match entry#text with
- "" -> ()
- | s ->
- room_send room s;
- entry#set_text "";
-(*self#insert_text (Printf.sprintf "> %s\n" s) *)
- in
- Okey.add entry ~mods: [] GdkKeysyms._Return
- on_entry_return;
-
-
-end
-
-let room_tabs = Hashtbl.create 13
-
-let find_room_tab room =
- Hashtbl.find room_tabs (room_num room)
-
-class main_window account =
- let accounts = new accounts_window () in
- let contacts = new contacts_window_list () in
- object (self)
- inherit Gui_im_base.window2 ()
-
- method coerce = window#coerce
-
- method update_contact = contacts#update_contact
- method update_account account = accounts#update_account account
-
- method find_room_or_create room =
- try
- Hashtbl.find room_tabs (room_num room)
- with _ ->
- lprintf "New room %d" (room_num room); lprint_newline ();
- let room_window = new room_window room in
- let label_text = Printf.sprintf "%s: Room %s"
- (protocol_name (room_protocol room))
- (room_name room) in
- let label = GMisc.label ~text: label_text () in
- main_notebook#append_page ~tab_label:label#coerce
- room_window#coerce;
- Hashtbl.add room_tabs (room_num room) (room_window, label);
- room_window, label
-
- method update_room room =
- let room_window, label = self#find_room_or_create room in
- room_window#update_room
-
- method remove_room room =
- let room_window, label = self#find_room_or_create room in
- let page_num = main_notebook#page_num room_window#coerce in
- main_notebook#goto_page 1;
- main_notebook#remove_page page_num;
- Hashtbl.remove room_tabs (room_num room)
-
- method room_event room event =
- let (room_window, label) = self#find_room_or_create room in
- room_window#room_event label event
-
- initializer
- contacts_hbox#add contacts#box;
- accounts_hbox#add accounts#box;
-end
-
-let main_window =
- let window = new main_window () in
- window#window#set_title "IM Window";
- (* Here there is an error if you close directly the window. You cannot call
it back !
- #connect#destroy is too late : the window is already destroyed.
- Call #event#connect#delete instead to make operations before destroying
the window *)
- (* ignore (window#window#connect#destroy (fun _ ->
- if !quit_on_close then CommonGlobals.exit_properly 0 else
- window#coerce#misc#hide ()
- )); *)
- ignore (window#window#event#connect#delete (fun _ ->
- if !quit_on_close then CommonGlobals.exit_properly 0 else
- window#coerce#misc#hide ();
- true
- ));
- ignore (window#itemQuit#connect#activate
- (fun _ ->
- if !quit_on_close then CommonGlobals.exit_properly 0 else
- window#coerce#misc#hide ()));
- let _new_accounts =
- GMenu.menu_item ~label:"New accounts" ~packing:(window#menubar#add) ()
- in
- let new_accounts =
- GMenu.menu ~packing:(_new_accounts#set_submenu) () in
-
-
- ImProtocol.iter (fun p ->
- let menu_item =
- GMenu.menu_item ~label:
- (Printf.sprintf "New %s account" (protocol_name p))
-(* ~active:n.network_enabled *)
- ~packing:new_accounts#add ()
- in
- ignore (menu_item#connect#activate ~callback:(fun _ ->
- let account = protocol_new_account p in
- input_account account;
- ImEvent.add_event (Account_event account);
- lprintf "NEW ACCOUNT"; lprint_newline ();
- ))
-
- );
- window
-
-
-
-
-let _ =
- ImEvent.set_event_handler (fun event ->
- match event with
- | Account_event account ->
- lprintf "Account event"; lprint_newline ();
- main_window#update_account account;
-
- (*
- let w = account_window account in
- if w#hidden && account_status account <> Status_offline then
- w#show ();
- w#label_connect_status#set_text (match account_status account with
- Status_offline -> "Offline"
- | Status_connecting -> "Connecting ... "
- | _ -> "Connected"); *)
- | Account_friend_event id ->
- lprintf "Account_friend_event"; lprint_newline ();
- let account = identity_account id in
- begin try
- let w = find_account_window account in
- lprintf "Window available"; lprint_newline ();
- w#update_contact id
- with _ -> () end
- | Chat_open_event chat ->
- begin
- let w,_ = chat_window chat in
- w#show ()
- end
- | Chat_close_event chat ->
- begin
- try
- let w,_ = find_chat_window chat in
- Hashtbl.remove chat_windows (chat_num chat);
- w#destroy ();
- with _ -> ()
- end
- | Chat_my_message (chat, msg) ->
- begin
- let _,d = chat_window chat in
- d#handle_my_message msg
- end
-
- | Chat_message_event (chat, id, msg) ->
- begin
- let _,d = chat_window chat in
- d#handle_message (identity_name id) msg
- end
-
- | Room_join room ->
- main_window#update_room room
-
- | Room_leave room ->
- main_window#remove_room room
-
- | Room_public_message (room, _)
- | Room_message (room, _, _)
- | Room_user_join (room, _)
- | Room_user_leave (room, _) ->
- main_window#room_event room event
-
-(* | _ ->
- lprintf "Discarding event"; lprint_newline (); *)
- )
-
-(*
- Gui_global.top_menus := ("IM", (fun menu ->
-
- let menu_item =
- GMenu.menu_item ~label: "IM Window"
- ~packing:menu#add ()
- in
- ignore (menu_item#connect#activate ~callback:(fun _ ->
- main_window#window#show ()));
-
- )) :: !Gui_global.top_menus
-*)
-
- (*
-
-let _ =
- accounts_window#window#show ();
- BasicSocket.loop ()
- *)
Index: src/im/gui_im_base.ml
===================================================================
RCS file: src/im/gui_im_base.ml
diff -N src/im/gui_im_base.ml
--- src/im/gui_im_base.ml 20 Mar 2005 01:52:14 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,275 +0,0 @@
-
-
-class window () =
- let window =
- GWindow.window ~width:400 ~height:200 ~title:(Gui_messages.iM_wt_software)
- ~allow_shrink:true ~allow_grow:true
-(* ~auto_shrink:true *)
- ~modal:false ()
- in
- let box =
- GPack.vbox ~width:600 ~height:440 ~homogeneous:false ~packing:(window#add)
- ()
- in
- let menubar =
- GMenu.menu_bar ~packing:(box#pack ~expand:false ~fill:false) ()
- in
- let _Menu =
- GMenu.menu_item ~label:(Gui_messages.iM_me_file)
- ~packing:(menubar#add) ()
- in
- let _FileMenu = GMenu.menu ~packing:(_Menu#set_submenu) () in
- let itemOptions =
- GMenu.menu_item ~label:(Gui_messages.iM_me_settings)
- ~packing:(_FileMenu#add) ()
- in
- let _ = GMenu.menu_item ~packing:(_FileMenu#add) () in
- let itemSetStatus =
- GMenu.menu_item ~label:"Change Status" ~packing:(_FileMenu#add) ()
- in
- let menuSetStatus = GMenu.menu ~packing:(itemSetStatus#set_submenu) () in
- let itemSetStatusOffline =
- GMenu.menu_item ~label:"Offline" ~packing:(menuSetStatus#add) ()
- in
- let itemAddFriend =
- GMenu.menu_item ~label:"Add Friend" ~packing:(_FileMenu#add) ()
- in
- let _ = GMenu.menu_item ~packing:(_FileMenu#add) () in
- let itemQuit =
- GMenu.menu_item ~label:(Gui_messages.iM_me_quit)
- ~packing:(_FileMenu#add) ()
- in
- let accel_menubar = GtkData.AccelGroup.create () in
- let _ = window#add_accel_group accel_menubar in
- let _ = _FileMenu#set_accel_group accel_menubar in
- let _ = menuSetStatus#set_accel_group accel_menubar in
- let friends =
- GPack.hbox ~homogeneous:false ~packing:(box#pack ~expand:true ~fill:true)
- ()
- in
- let hbox_status =
- GPack.hbox ~homogeneous:false ~spacing:10
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let label_connect_status =
- GMisc.label ~text:"" ~justify:`LEFT ~line_wrap:true ~xalign:(-1.0)
- ~yalign:(-1.0) ~packing:(hbox_status#pack ~expand:true ~fill:true) ()
- in
- object
- val window = window
- val box = box
- val menubar = menubar
- val accel_menubar = accel_menubar
- val itemOptions = itemOptions
- val itemSetStatus = itemSetStatus
- val menuSetStatus = menuSetStatus
- val itemSetStatusOffline = itemSetStatusOffline
- val itemAddFriend = itemAddFriend
- val itemQuit = itemQuit
- val friends = friends
- val hbox_status = hbox_status
- val label_connect_status = label_connect_status
- method window = window
- method box = box
- method menubar = menubar
- method accel_menubar = accel_menubar
- method itemOptions = itemOptions
- method itemSetStatus = itemSetStatus
- method menuSetStatus = menuSetStatus
- method itemSetStatusOffline = itemSetStatusOffline
- method itemAddFriend = itemAddFriend
- method itemQuit = itemQuit
- method friends = friends
- method hbox_status = hbox_status
- method label_connect_status = label_connect_status
-end
-class accounts () =
- let window =
- GWindow.window ~width:400 ~height:200 ~title:(Gui_messages.iM_wt_software)
- ~allow_shrink:true ~allow_grow:true
-(* ~auto_shrink:true *)
- ~modal:false ()
- in
- let box =
- GPack.vbox ~width:600 ~height:440 ~homogeneous:false ~packing:(window#add)
- ()
- in
- let menubar =
- GMenu.menu_bar ~packing:(box#pack ~expand:false ~fill:false) ()
- in
- let _Menu =
- GMenu.menu_item ~label:(Gui_messages.iM_me_file)
- ~packing:(menubar#add) ()
- in
- let _FileMenu = GMenu.menu ~packing:(_Menu#set_submenu) () in
- let itemOptions =
- GMenu.menu_item ~label:(Gui_messages.iM_me_settings)
- ~packing:(_FileMenu#add) ()
- in
- let _ = GMenu.menu_item ~packing:(_FileMenu#add) () in
- let itemQuit =
- GMenu.menu_item ~label:(Gui_messages.iM_me_quit)
- ~packing:(_FileMenu#add) ()
- in
- let accel_menubar = GtkData.AccelGroup.create () in
- let _ = window#add_accel_group accel_menubar in
- let _ = _FileMenu#set_accel_group accel_menubar in
- let friends =
- GPack.hbox ~homogeneous:false ~packing:(box#pack ~expand:true ~fill:true)
- ()
- in
- let hbox_status =
- GPack.hbox ~homogeneous:false ~spacing:10
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let label_connect_status =
- GMisc.label ~text:"" ~justify:`LEFT ~line_wrap:true ~xalign:(-1.0)
- ~yalign:(-1.0) ~packing:(hbox_status#pack ~expand:true ~fill:true) ()
- in
- object
- val window = window
- val box = box
- val menubar = menubar
- val accel_menubar = accel_menubar
- val itemOptions = itemOptions
- val itemQuit = itemQuit
- val friends = friends
- val hbox_status = hbox_status
- val label_connect_status = label_connect_status
- method window = window
- method box = box
- method menubar = menubar
- method accel_menubar = accel_menubar
- method itemOptions = itemOptions
- method itemQuit = itemQuit
- method friends = friends
- method hbox_status = hbox_status
- method label_connect_status = label_connect_status
-end
-class window2 () =
- let window =
- GWindow.window ~width:640 ~height:400 ~title:(Gui_messages.iM_wt_software)
- ~allow_shrink:true ~allow_grow:true
- (* ~auto_shrink:true *) ~modal:false ()
- in
- let box =
- GPack.vbox ~width:600 ~height:440 ~homogeneous:false ~packing:(window#add)
- ()
- in
- let menubar =
- GMenu.menu_bar ~packing:(box#pack ~expand:false ~fill:false) ()
- in
- let _Menu =
- GMenu.menu_item ~label:(Gui_messages.iM_me_file)
- ~packing:(menubar#add) ()
- in
- let _FileMenu = GMenu.menu ~packing:(_Menu#set_submenu) () in
- let itemOptions =
- GMenu.menu_item ~label:(Gui_messages.iM_me_settings)
- ~packing:(_FileMenu#add) ()
- in
- let _ = GMenu.menu_item ~packing:(_FileMenu#add) () in
- let itemQuit =
- GMenu.menu_item ~label:(Gui_messages.iM_me_quit)
- ~packing:(_FileMenu#add) ()
- in
- let accel_menubar = GtkData.AccelGroup.create () in
- let _ = window#add_accel_group accel_menubar in
- let _ = _FileMenu#set_accel_group accel_menubar in
- let main_notebook =
- GPack.notebook ~tab_pos:`LEFT ~show_tabs:true ~homogeneous_tabs:true
- ~show_border:true ~scrollable:true
- (* ~popup:true *)
- ~packing:(box#pack ~expand:true ~fill:true) ()
- in
- let accounts_hbox =
- GPack.hbox ~homogeneous:false
- ~packing:(
- fun w ->
- main_notebook#append_page
- ~tab_label:((GMisc.label ~text:"Accounts" ())#coerce) w)
- ()
- in
- let contacts_hbox =
- GPack.hbox ~homogeneous:false
- ~packing:(
- fun w ->
- main_notebook#append_page
- ~tab_label:((GMisc.label ~text:"Friends" ())#coerce) w)
- ()
- in
- let hbox_status =
- GPack.hbox ~homogeneous:false ~spacing:10
- ~packing:(box#pack ~expand:false ~fill:true) ()
- in
- let label_connect_status =
- GMisc.label ~text:"" ~justify:`LEFT ~line_wrap:true ~xalign:(-1.0)
- ~yalign:(-1.0) ~packing:(hbox_status#pack ~expand:true ~fill:true) ()
- in
- object
- val window = window
- val box = box
- val menubar = menubar
- val accel_menubar = accel_menubar
- val itemOptions = itemOptions
- val itemQuit = itemQuit
- val main_notebook = main_notebook
- val accounts_hbox = accounts_hbox
- val contacts_hbox = contacts_hbox
- val hbox_status = hbox_status
- val label_connect_status = label_connect_status
- method window = window
- method box = box
- method menubar = menubar
- method accel_menubar = accel_menubar
- method itemOptions = itemOptions
- method itemQuit = itemQuit
- method main_notebook = main_notebook
- method accounts_hbox = accounts_hbox
- method contacts_hbox = contacts_hbox
- method hbox_status = hbox_status
- method label_connect_status = label_connect_status
-end
-class room_tab () =
- let room_vbox = GPack.vbox ~homogeneous:false () in
- let wpane =
- GPack.paned `HORIZONTAL ~width:600
- ~packing:(room_vbox#pack ~expand:true ~fill:true) ()
- in
- let wscroll =
- GBin.scrolled_window ~width:450 ~height:0 ~hpolicy:`AUTOMATIC
- ~vpolicy:`AUTOMATIC ~placement:`TOP_LEFT ~packing:(wpane#add1) ()
- in
- let text =
- GEdit.text ~editable:false (* ~word_wrap:true ~line_wrap:true *)
- ~packing:(wscroll#add) ()
- in
- let hbox_91 =
- GPack.hbox ~homogeneous:false
- ~packing:(room_vbox#pack ~expand:false ~fill:true) ()
- in
- let nick_label =
- GMisc.label ~text:"My nick:" ~justify:`LEFT ~line_wrap:true ~xalign:(-1.0)
- ~yalign:(-1.0) ~packing:(hbox_91#pack ~expand:false ~fill:true) ()
- in
- let entry =
- GEdit.entry ~visibility:true ~editable:true
- ~packing:(hbox_91#pack ~expand:true ~fill:true) ()
- in
- object
- val room_vbox = room_vbox
- val wpane = wpane
- val wscroll = wscroll
- val text = text
- val hbox_91 = hbox_91
- val nick_label = nick_label
- val entry = entry
- method room_vbox = room_vbox
- method wpane = wpane
- method wscroll = wscroll
- method text = text
- method hbox_91 = hbox_91
- method nick_label = nick_label
- method entry = entry
- method coerce = room_vbox#coerce
-end
Index: src/im/gui_im_main.ml
===================================================================
RCS file: src/im/gui_im_main.ml
diff -N src/im/gui_im_main.ml
--- src/im/gui_im_main.ml 20 Mar 2005 01:52:14 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,27 +0,0 @@
-(* Copyright 2002 b8_fange *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open Gui_im
-
-let _ =
- quit_on_close := true;
- main_window#window#show ();
- BasicSocket.loop ()
-;;
-
Index: src/im/gui_im_rooms.ml
===================================================================
RCS file: src/im/gui_im_rooms.ml
diff -N src/im/gui_im_rooms.ml
--- src/im/gui_im_rooms.ml 20 Mar 2005 01:52:14 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,442 +0,0 @@
-open ImTypes
-open Gui_columns
-open ImIdentity
-
-class box () =
- let vbox = GPack.vbox ~homogeneous:false () in
- let wtool =
- GButton.toolbar ~orientation:`HORIZONTAL ~style:`BOTH ~space_size:2
- ~space_style:`LINE ~tooltips:true ~button_relief:`NONE
- ~packing:(vbox#pack ~expand:false ~fill:true ~padding:2) ()
- in
- object
- val vbox = vbox
- val wtool = wtool
- method vbox = vbox
- method wtool = wtool
- method coerce = vbox#coerce
- end
-
-
-(** The different columns which can be displayed for a
identity/location/friend. *)
-type identity_column =
-| Col_identity_name
-
-let identity_column_strings = [
- Col_identity_name, "Name" ;
-]
-
-module IdentityCols = Make(struct
- type column = identity_column
- let kind = "Identity"
- let column_strings = identity_column_strings
- end)
-
-
-let identity_columns = [ Col_identity_name ]
-
-class identity_box () =
- let titles = List.map IdentityCols.string_of_column identity_columns in
- object (self)
- inherit [ImTypes.identity] Gpattern.plist `EXTENDED titles true
- (fun id -> identity_num id) as pl
- inherit box () as box
-
- val mutable columns = identity_columns
- method set_columns l =
- columns <- l;
- self#set_titles (List.map IdentityCols.string_of_column columns);
- self#update
-
-
- method compare_by_col col f1 f2 =
- match col with
- Col_identity_name -> compare (identity_name f1) (identity_name f2)
-
- method compare f1 f2 =
- let abs = if current_sort >= 0 then current_sort else - current_sort in
- let col =
- try List.nth columns (abs - 1)
- with _ -> Col_identity_name
- in
- let res = self#compare_by_col col f1 f2 in
- res * current_sort
-
- method content_by_col f col =
- match col with
- Col_identity_name -> identity_name f
-
- method content f =
- let strings = List.map
- (fun col -> Gpattern.String (self#content_by_col f col))
- columns
- in
- let col_opt = Some `BLACK in
- (strings, col_opt)
-
- method menu = []
- (*
- match self#selection with
- [] -> []
- | _ -> [
- `I (gettext M.add_to_friends, self#add_to_friends);
- `I (gettext M.browse_files, self#browse_files)
- ]
-*)
-
- method set_tb_style = wtool#set_style
-
- method find_identity num = self#find num
-
-
- initializer
- box#vbox#pack ~expand: true pl#box ;
-
- (*
- ignore
- (wtool#insert_button
- ~text: (gettext M.add_to_friends)
- ~tooltip: (gettext M.add_to_friends)
- ~icon: (Gui_icons.pixmap M.o_xpm_add_to_friends)#coerce
- ~callback: self#add_to_friends
- ()
-);
- *)
- end
-
-(*
-class box tb_style () =
- object(self)
- inherit Gui_rooms_base.box tb_style ()
-
- method set_tb_style (tb_style : Gtk.Tags.toolbar_style) = ()
-end
-
-class rooms_box columns () =
-
- let titles = List.map Gui_columns.Room.string_of_column columns in
- object (self)
- inherit [GuiTypes.room_info] Gpattern.plist `SINGLE titles true (fun r ->
r.room_num) as pl
- inherit Gui_users_base.box () as box
-
- val mutable columns = columns
- method set_columns l =
- columns <- l;
- self#set_titles (List.map Gui_columns.Room.string_of_column columns);
- self#update
-
- method compare_by_col col f1 f2 =
- match col with
- Col_room_name -> compare f1.room_name f2.room_name
- | Col_room_network -> compare f1.room_network f2.room_network
- | Col_room_nusers -> compare f1.room_nusers f2.room_nusers
-
-
- method compare f1 f2 =
- let abs = if current_sort >= 0 then current_sort else - current_sort in
- let col =
- try List.nth columns (abs - 1)
- with _ -> Col_room_name
- in
- let res = self#compare_by_col col f1 f2 in
- res * current_sort
-
- method content_by_col f col =
- match col with
- Col_room_name -> f.room_name
- | Col_room_network -> G.network_name f.room_network
- | Col_room_nusers -> string_of_int f.room_nusers
-
- method content f =
- let strings = List.map
- (fun col -> P.String (self#content_by_col f col))
- columns
- in
- let col_opt = Some `BLACK in
- (strings, col_opt)
-
- method find_room num = self#find num
-
- method add_room room = self#add_item room
-
- method remove_room row room = self#remove_item row room
-
- method set_tb_style = wtool#set_style
-
- initializer
- box#vbox#pack ~expand: true pl#box ;
-
-end
-
-class box_users room =
-
- object (self)
-
- inherit Gui_users.box_users ()
-
- initializer
-
- ignore
- (wtool#insert_button
- ~text: (gettext M.close_room)
- ~tooltip: (gettext M.close_room)
- ~icon: (Gui_options.pixmap M.o_xpm_close_room)#coerce
- ~callback: (fun _ ->
- Gui_com.send (GuiProto.SetRoomState (
- room.room_num, RoomClosed)))
- ()
- );
-
-end
-
-class opened_rooms_box on_select =
- object (self)
-
- inherit rooms_box !!O.rooms_columns () as box_rooms
-
- method add_room room =
- box_rooms#add_room room;
- let w = box_rooms#wlist in
- w#select (w#rows - 1) 0
-
-(* method rooms = data *)
- method on_select room = on_select room
-end
-
-class paused_rooms_box () =
- object (self)
-
- inherit rooms_box !!O.rooms_columns () as box_rooms
-
-
- method on_double_click room =
- Gui_com.send (GuiProto.SetRoomState (room.room_num, RoomOpened))
-
-end
-
-let add_room_user room user_num =
- lprintf "ADD ROOM USER"; lprint_newline ();
- if not (List.memq user_num room.room_users) then begin
- room.room_users <- user_num :: room.room_users;
- lprintf "Should have added user"; lprint_newline ();
- end
-
-let insert_text (messages: box) ?user ?(priv=false) s =
- let user_info =
- match user with
- None -> None
- | Some u ->
- let col = Gui_misc.color_of_name u in
- Some (col,
- Printf.sprintf "%s%s :" u
- (if priv then " (private)" else ""))
- in
- (
- match user_info with
- None -> ()
- | Some (c,s) ->
- messages#wt_10#insert ~foreground: c s
- );
- messages#wt_10#insert s
-
-let update_users r (users : box_users) =
- let list = ref [] in
- List.iter (fun u ->
- try
- let user_info = Hashtbl.find G.users u in
- list := user_info :: !list
- with _ ->
- Gui_com.send (GuiProto.GetUser_info u);
- ) r.room_users;
- users#reset_data !list
-
-let append_message r (messages:box) msg =
- match msg with
- | ServerMessage s ->
-(* try to get the user name to put some color: ????
-Username of what ? ServerMessage is a message sent from the server, not from
- a user !!! *)
- let len = String.length s in
- if len > 0 then
- (
- let (user, mes) =
- match s.[0] with
- '<' ->
- (
- try
- let pos = String.index s '>' in
- let u = String.sub s 1 (pos - 1) in
- let mes = String.sub s (pos + 1) (len - pos - 1) in
- (Some u, mes)
- with
- _ ->
- (None, s)
- )
- | _ ->
- (None, s)
- in
- insert_text messages ?user (mes^"\n")
- )
- else
- ()
- | PublicMessage (user_num, s) ->
- add_room_user r user_num;
- let user = Hashtbl.find G.users user_num in
- insert_text messages ~user: user.user_name (s^"\n")
- | PrivateMessage (user_num, s) ->
- add_room_user r user_num;
- let user = Hashtbl.find G.users user_num in
- insert_text messages ~user: user.user_name ~priv: true (s^"\n")
-*)
-
-(*
-class pane_rooms () =
-
- let select = ref (fun room -> ()) in
- let (widgets: (int, box_users * box) Hashtbl.t) = Hashtbl.create 13 in
- let opened_rooms = new opened_rooms_box (fun room -> !select room) in
- let paused_rooms = new paused_rooms_box () in
-
- object(self)
- inherit Gui_rooms_base.box2 ()
-
- method clear_widgets room =
- try
- let (users, messages) = Hashtbl.find widgets room.room_num in
- users#coerce#misc#unmap ();
- messages#coerce#misc#unmap ();
- users#coerce#misc#unparent ();
- messages#coerce#misc#unparent ();
- Hashtbl.remove widgets room.room_num
- with _ -> ()
-
- method room_info room =
- begin
- try
- let (num, old_room) = try
- opened_rooms#find_room room.room_num
- with _ -> paused_rooms#find_room room.room_num in
- if old_room.room_state <> room.room_state then begin
- (match old_room.room_state with
- RoomPaused -> paused_rooms#remove_room num old_room
- | RoomOpened ->
- opened_rooms#remove_room num old_room;
- self#clear_widgets room;
- | _ -> assert false);
- match room.room_state with
- | RoomPaused -> paused_rooms#add_room room
- | RoomOpened -> opened_rooms#add_room room
- | RoomClosed -> ()
- end
- with Not_found ->
- match room.room_state with
- | RoomPaused -> paused_rooms#add_room room
- | RoomOpened -> opened_rooms#add_room room
- | RoomClosed -> ()
- end
-(* Maybe automatic selection is not that good ?:
- ;
- match opened_rooms#rooms with
- [room] -> opened_rooms#on_select room
- | _ -> () *)
-
-
- method add_room_message room_num msg =
- try
- let (num, room) = try
- opened_rooms#find_room room_num
- with _ -> paused_rooms#find_room room_num in
- room.room_messages <- msg :: room.room_messages;
- try
- let (users, messages) = Hashtbl.find widgets room_num in
- append_message room messages msg
- with _ -> ()
- with e ->
- lprintf "ROOM %d Exception %s" room_num (Printexc2.to_string e);
- lprint_newline ();
- ()
-
-
-
- method hpaned = hpaned
-
- method clear =
- opened_rooms#clear;
- paused_rooms#clear;
- opened_rooms#iter self#clear_widgets
-
- method remove_room_user room_num user_num =
- try
- let (num, room) = try
- opened_rooms#find_room room_num
- with _ -> paused_rooms#find_room room_num in
- if List.memq user_num room.room_users then begin
- room.room_users <- List2.removeq user_num room.room_users;
- try
- let (users, messages) = Hashtbl.find widgets room_num in
- update_users room users
- with _ -> ()
- end
- with _ -> ()
-
-
- method add_room_user room_num user_num =
- lprintf "add romm user"; lprint_newline ();
- try
- let (num, room) = try
- opened_rooms#find_room room_num
- with _ -> paused_rooms#find_room room_num in
- if not (List.memq user_num room.room_users) then begin
- room.room_users <- user_num :: room.room_users;
- try
- let (users, messages) = Hashtbl.find widgets room_num in
- lprintf "update_users"; lprint_newline ();
- update_users room users
- with _ -> ()
- end
- with _ -> ()
-
- initializer
- rooms_pane#add1 opened_rooms#coerce;
- rooms_pane#add2 paused_rooms#coerce;
- select := (fun room ->
- let (users, messages) = try Hashtbl.find widgets room.room_num
- with _ ->
- let users = new box_users room in
- let messages = new box () () in
- let on_entry_return () =
- match messages#we_11#text with
- "" -> ()
- | s ->
- Gui_com.send
- (GuiProto.SendMessage (room.room_num,
- PublicMessage (0,s)));
- messages#we_11#set_text "";
-(*self#insert_text (Printf.sprintf "> %s\n" s) *)
- in
- Okey.add messages#we_11 ~mods: [] GdkKeysyms._Return
- on_entry_return;
- Hashtbl.add widgets room.room_num (users, messages);
- users, messages
- in
- room_pane#add1 users#coerce;
- room_pane#add2 messages#coerce;
- update_users room users
- )
-end
-
-(* for now, no way to update users ? *)
-let user_info user = ()
-
- *)
-
-let room_num room = 1
-
-class room_window (room: room) =
-
- object (self)
-
- inherit Gui_im_base.room_tab ()
-
- method update_room = ()
-end
Index: src/im/imAccount.ml
===================================================================
RCS file: src/im/imAccount.ml
diff -N src/im/imAccount.ml
--- src/im/imAccount.ml 10 Oct 2005 16:22:25 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,200 +0,0 @@
-(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open Printf2
-open ImTypes
-open ImProtocol
-open ImEvent
-
-type 'a account_impl = {
- mutable impl_account_num : int;
- mutable impl_account_val : 'a;
- mutable impl_account_ops : 'a account_ops;
- mutable impl_account_status : status;
- }
-
-and 'a account_ops = {
- mutable op_account_protocol : protocol;
-
-(* Send a message to this account *)
- mutable op_account_send : ('a -> string -> unit);
-
-(* Remove this account from my contacts *)
- mutable op_account_logout : ('a -> unit);
-
- mutable op_account_contacts : ('a -> identity list);
-
-(* Remove this account from my contacts *)
- mutable op_account_login : ('a -> unit);
-
-(* Get the name of this account *)
- mutable op_account_name : ('a -> string);
-
- mutable op_account_set_status : ('a -> status -> unit);
-
-(* How to save infos on this account ? *)
- mutable op_account_to_option : ('a -> (string * Options.option_value)
list);
-
-(* This function is called every minute *)
- mutable op_account_keepalive : ('a -> unit);
-
- mutable op_account_config_record : ('a -> config_record);
-
- mutable op_account_new_identity : ('a -> identity);
-
- mutable op_account_open_chat : ('a -> identity list -> unit);
-
- mutable op_account_join_room : ('a -> string -> unit);
-
- mutable op_account_has_rooms : ('a -> bool);
-
- mutable op_account_prefered_rooms : ('a -> string list);
- }
-
-
-let as_account (account : 'a account_impl) =
- let (account : account) = Obj.magic account in
- account
-
-let as_account_impl (account : account) =
- let (account : 'a account_impl) = Obj.magic account in
- account
-
-let account_num account =
- let impl = as_account_impl account in
- impl.impl_account_num
-
-let dummy_account_impl = {
- impl_account_num = 0;
- impl_account_val = 0;
- impl_account_ops = Obj.magic 0;
- impl_account_status = Status_offline;
- }
-
-let dummy_account = as_account dummy_account_impl
-
-module H = Weak.Make(struct
- type t = account
- let hash account = Hashtbl.hash (account_num account)
-
- let equal x y = (account_num x) = (account_num y)
- end)
-
-let account_counter = ref 0
-let accounts_by_num = H.create 1027
-
-let update_account_num impl =
- if impl.impl_account_num = 0 then begin
- incr account_counter;
- impl.impl_account_num <- !account_counter;
- H.add accounts_by_num (as_account impl);
- add_event (Account_event (as_account impl));
- end
-
-let account_send account msg =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_send account.impl_account_val msg
-
-let account_login account =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_login account.impl_account_val
-
-let account_logout account =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_logout account.impl_account_val
-
-let account_keepalive account =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_keepalive account.impl_account_val
-
-let account_has_rooms account =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_has_rooms account.impl_account_val
-
-let account_join_room account room_name =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_join_room account.impl_account_val
room_name
-
-let account_status account =
- let account = as_account_impl account in
- account.impl_account_status
-
-let set_account_status account status =
- lprintf "set_account_status"; lprint_newline ();
- let impl = as_account_impl account in
- if impl.impl_account_status <> status then begin
- impl.impl_account_status <- status;
- lprintf "Add event account"; lprint_newline ();
- add_event (Account_event account);
- end
-
-let account_name account =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_name account.impl_account_val
-
-let account_status account =
- let account = as_account_impl account in
- account.impl_account_status
-
-let account_config_record account =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_config_record account.impl_account_val
-
-let account_to_option account =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_to_option account.impl_account_val
-
-let account_new_identity account =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_new_identity account.impl_account_val
-
-let account_set_status account status =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_set_status account.impl_account_val
status
-
-let account_protocol account =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_protocol
-
-let account_open_chat account =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_open_chat account.impl_account_val
-
-let account_prefered_rooms account =
- let account = as_account_impl account in
- account.impl_account_ops.op_account_prefered_rooms account.impl_account_val
-
-
-let new_account_ops protocol = {
- op_account_protocol = protocol;
- op_account_send = fni2 protocol "op_account_send";
- op_account_login = fni protocol "op_account_login";
- op_account_logout = fni protocol "op_account_logout";
- op_account_name = fni protocol "op_account_name";
- op_account_to_option = fni protocol "op_account_to_option";
- op_account_keepalive = fni protocol "op_account_keepalive";
- op_account_config_record = fni protocol "op_account_config_record";
- op_account_new_identity = fni protocol "op_account_new_identity";
- op_account_set_status = fni protocol "op_account_set_status";
- op_account_contacts = fni protocol "op_account_contacts";
- op_account_open_chat = fni protocol "op_account_open_chat";
- op_account_has_rooms = (fun x -> ni protocol "op_account_has_rooms" x;
false);
- op_account_prefered_rooms = (fun x -> ni protocol
"op_account_prefered_rooms" x; []);
- op_account_join_room = fni protocol "op_account_open_chat";
- }
Index: src/im/imChat.ml
===================================================================
RCS file: src/im/imChat.ml
diff -N src/im/imChat.ml
--- src/im/imChat.ml 10 Oct 2005 16:22:25 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,102 +0,0 @@
-(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open ImTypes
-open ImProtocol
-
-type 'a chat_impl = {
- mutable impl_chat_num : int;
- mutable impl_chat_val : 'a;
- mutable impl_chat_ops : 'a chat_ops;
- mutable impl_chat_account : account;
- }
-
-and 'a chat_ops = {
- op_chat_protocol : protocol;
-
-(* Send a message to this chat *)
- mutable op_chat_send : ('a -> string -> unit);
-
- mutable op_chat_close : ('a -> unit);
-
-(* Get the name of this chat *)
- mutable op_chat_name : ('a -> string);
- }
-
-
-let as_chat (chat : 'a chat_impl) =
- let (chat : chat) = Obj.magic chat in
- chat
-
-let as_chat_impl (chat : chat) =
- let (chat : 'a chat_impl) = Obj.magic chat in
- chat
-
-let chat_num chat =
- let impl = as_chat_impl chat in
- impl.impl_chat_num
-
-let dummy_chat_impl = {
- impl_chat_num = 0;
- impl_chat_val = 0;
- impl_chat_ops = Obj.magic 0;
- impl_chat_account = Obj.magic 0;
- }
-
-let dummy_chat = as_chat dummy_chat_impl
-
-module H = Weak.Make(struct
- type t = chat
- let hash chat = Hashtbl.hash (chat_num chat)
-
- let equal x y = (chat_num x) = (chat_num y)
- end)
-
-let chat_counter = ref 0
-let chats_by_num = H.create 1027
-
-let update_chat_num impl =
- if impl.impl_chat_num = 0 then begin
- incr chat_counter;
- impl.impl_chat_num <- !chat_counter;
- H.add chats_by_num (as_chat impl);
- end
-
-let chat_send chat msg =
- let chat = as_chat_impl chat in
- chat.impl_chat_ops.op_chat_send chat.impl_chat_val msg
-
-let chat_close chat =
- let chat = as_chat_impl chat in
- chat.impl_chat_ops.op_chat_close chat.impl_chat_val
-
-let chat_name chat =
- let chat = as_chat_impl chat in
- chat.impl_chat_ops.op_chat_name chat.impl_chat_val
-
-let chat_account chat =
- let chat = as_chat_impl chat in
- chat.impl_chat_account
-
-let new_chat_ops protocol = {
- op_chat_protocol = protocol;
- op_chat_send = fni2 protocol "op_chat_send";
- op_chat_close = fni protocol "op_chat_close";
- op_chat_name = fni protocol "op_chat_name";
- }
Index: src/im/imEvent.ml
===================================================================
RCS file: src/im/imEvent.ml
diff -N src/im/imEvent.ml
--- src/im/imEvent.ml 2 Mar 2005 20:37:09 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,60 +0,0 @@
-(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open ImTypes
-
-type event =
-| Account_event of account
-| Account_friend_event of identity
-
-| Chat_open_event of chat
-| Chat_my_message of chat * string
-| Chat_message_event of chat * identity * string
-| Chat_close_event of chat
-
-| Room_join of room
-| Room_leave of room
-| Room_message of room * identity * string
-| Room_user_join of room * identity
-| Room_user_leave of room * identity
-| Room_public_message of room * string
-
- (*
-
-| Chat_open_event of chat
-| Chat_close_event of chat
-| Chat_login_event of chat * identity
-| Chat_logout_event of chat * identity
-*)
-
-let event_handler = ref None
-let pending_events = ref []
-
-let set_event_handler f =
- event_handler := Some f;
- let old_events = List.rev !pending_events in
- pending_events := [];
- List2.safe_iter f old_events
-
-let add_event (e : event) =
- match !event_handler with
- None -> pending_events := e :: !pending_events
- | Some f -> try f e with _ -> ()
-
-
\ No newline at end of file
Index: src/im/imIdentity.ml
===================================================================
RCS file: src/im/imIdentity.ml
diff -N src/im/imIdentity.ml
--- src/im/imIdentity.ml 10 Oct 2005 16:22:25 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,128 +0,0 @@
-(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open ImTypes
-open ImProtocol
-
-type 'a identity_impl = {
- mutable impl_identity_num : int;
- mutable impl_identity_val : 'a;
- mutable impl_identity_ops : 'a identity_ops;
- }
-
-and 'a identity_ops = {
- mutable op_identity_protocol : protocol;
-
-(* Send a message to this identity *)
- mutable op_identity_send : ('a -> string -> unit);
-
-(* Remove this identity from my contacts *)
- mutable op_identity_remove : ('a -> unit);
-
-(* Get the name of this identity *)
- mutable op_identity_name : ('a -> string);
-
-(* Is this identity online ? *)
- mutable op_identity_status : ('a -> bool);
-
- mutable op_identity_account : ('a -> account);
-
- mutable op_identity_config_record : ('a -> config_record);
-
- mutable op_identity_open_chat : ('a -> unit);
- }
-
-
-let as_identity (identity : 'a identity_impl) =
- let (identity : identity) = Obj.magic identity in
- identity
-
-let as_identity_impl (identity : identity) =
- let (identity : 'a identity_impl) = Obj.magic identity in
- identity
-
-let identity_num identity =
- let impl = as_identity_impl identity in
- impl.impl_identity_num
-
-let dummy_identity_impl = {
- impl_identity_num = 0;
- impl_identity_val = 0;
- impl_identity_ops = Obj.magic 0;
- }
-
-let dummy_identity = as_identity dummy_identity_impl
-
-module H = Weak.Make(struct
- type t = identity
- let hash identity = Hashtbl.hash (identity_num identity)
-
- let equal x y = (identity_num x) = (identity_num y)
- end)
-
-let identity_counter = ref 0
-let identitys_by_num = H.create 1027
-
-let update_identity_num impl =
- if impl.impl_identity_num = 0 then begin
- incr identity_counter;
- impl.impl_identity_num <- !identity_counter;
- H.add identitys_by_num (as_identity impl);
- end
-
-let identity_send identity msg =
- let identity = as_identity_impl identity in
- identity.impl_identity_ops.op_identity_send identity.impl_identity_val msg
-
-let identity_remove identity =
- let identity = as_identity_impl identity in
- identity.impl_identity_ops.op_identity_remove identity.impl_identity_val
-
-let identity_name identity =
- let identity = as_identity_impl identity in
- identity.impl_identity_ops.op_identity_name identity.impl_identity_val
-
-let identity_status identity =
- let identity = as_identity_impl identity in
- identity.impl_identity_ops.op_identity_status identity.impl_identity_val
-
-let identity_account identity =
- let impl = as_identity_impl identity in
- impl.impl_identity_ops.op_identity_account identity
-
-let identity_config_record identity =
- let identity = as_identity_impl identity in
- identity.impl_identity_ops.op_identity_config_record
identity.impl_identity_val
-
-
-let identity_open_chat identity =
- let identity = as_identity_impl identity in
- identity.impl_identity_ops.op_identity_open_chat identity.impl_identity_val
-
-let new_identity_ops protocol = {
- op_identity_protocol = protocol;
- op_identity_send = fni2 protocol "op_identity_send";
- op_identity_remove = fni protocol "op_identity_remove";
- op_identity_name = fni protocol "op_identity_name";
- op_identity_status = fni protocol "op_identity_status";
- op_identity_config_record = fni protocol "op_identity_config_record";
- op_identity_open_chat = fni protocol "op_identity_open_chat";
- op_identity_account = fni protocol "op_identity_account";
- }
-
\ No newline at end of file
Index: src/im/imMain.ml
===================================================================
RCS file: src/im/imMain.ml
diff -N src/im/imMain.ml
--- src/im/imMain.ml 2 Mar 2005 20:37:09 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,62 +0,0 @@
-(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open Printf2
-open Options
-open BasicSocket
-open ImTypes
-open ImOptions
-open ImAccount
-open ImOptions
-
-(*********************************************************************
-
- FOR TESTING PURPOSE
-
-*********************************************************************)
-
-
-let _ =
- (*
-
- Msn.msn_login ();
-
- add_infinite_timer 10. (fun _ ->
- lprintf "******** SENDING **********"; lprint_newline ();
- Msn.msn_send "address@hidden" "Hello");
-
- BasicSocket.loop ()
-
- *)
-
- (try Options.load accounts_ini with e ->
- lprintf "Exception during options load accounts";
- lprint_newline ());
- Options.save_with_help accounts_ini;
- add_infinite_timer 60. (fun _ ->
- List2.safe_iter account_keepalive !!accounts
- )
-
-(********************************************************************
-
- THE INTERFACE
-
-******************************************************************)
-
-
Index: src/im/imOptions.ml
===================================================================
RCS file: src/im/imOptions.ml
diff -N src/im/imOptions.ml
--- src/im/imOptions.ml 5 Aug 2005 00:56:13 -0000 1.7
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,67 +0,0 @@
-(* Copyright 2002 b8_fange *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open Options
-open ImProtocol
-open ImAccount
-
-module AccountOption = struct
-
- let value_to_account v =
- match v with
- Options.Module assocs ->
- let get_value name conv = conv (List.assoc name assocs) in
- let network = try
- get_value "account_network" value_to_string
- with _ -> "Donkey"
- in
- let network = protocol_find_by_name network in
- let account = protocol_account_from_option network assocs in
- account
- | _ -> assert false
-
- let account_to_value account =
- let netname = string_to_value (protocol_name (
- account_protocol account)) in
- Options.Module (
- ("account_network", netname)
- ::
- (account_to_option account)
- )
-
- let t =
- define_option_class "Account" value_to_account account_to_value
- ;;
- end
-
-let accounts_ini = create_options_file
- (Filename.concat CommonOptions.home_dir "mldonkey_im.ini")
-let accounts_section = file_section accounts_ini [] ""
-
-let accounts =
- define_option accounts_section ["accounts"]
- "The different accounts" (listiter_option AccountOption.t) []
-
-
-open Gettext
-
-let browse_url_command = define_option accounts_section
- ["browse_url_command"] "The command to be called for browsing an url"
- (T.option (T.string T.format)) "opera -newwindow '%s'"
-
\ No newline at end of file
Index: src/im/imProtocol.ml
===================================================================
RCS file: src/im/imProtocol.ml
diff -N src/im/imProtocol.ml
--- src/im/imProtocol.ml 14 Dec 2005 21:17:46 -0000 1.5
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,137 +0,0 @@
-(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open Printf2
-open ImTypes
-
-type 'a protocol_impl = {
- mutable impl_protocol_num : int;
- mutable impl_protocol_val : 'a;
- mutable impl_protocol_name : string;
- mutable op_protocol_account_from_option : 'a ->
- (string * Options.option_value) list -> account;
- mutable op_protocol_new_account : 'a -> account;
- mutable op_protocol_available_status : 'a -> online_status list;
- }
-
-
-let as_protocol (protocol : 'a protocol_impl) =
- let (protocol : protocol) = Obj.magic protocol in
- protocol
-
-let as_protocol_impl (protocol : protocol) =
- let (protocol : 'a protocol_impl) = Obj.magic protocol in
- protocol
-
-let protocol_num protocol =
- let impl = as_protocol_impl protocol in
- impl.impl_protocol_num
-
-let protocol_name protocol =
- let protocol = as_protocol_impl protocol in
- protocol.impl_protocol_name
-
-let dummy_protocol_impl = {
- impl_protocol_num = 0;
- impl_protocol_val = 0;
- impl_protocol_name = "";
- op_protocol_new_account = (fun _ -> raise Exit);
- op_protocol_account_from_option = (fun _ -> raise Exit);
- op_protocol_available_status = (fun _ -> [Online_available]);
- }
-
-let dummy_protocol = as_protocol dummy_protocol_impl
-
-module Hnum = Weak.Make(struct
- type t = protocol
- let hash protocol = Hashtbl.hash (protocol_num protocol)
-
- let equal x y = (protocol_num x) = (protocol_num y)
- end)
-
-module Hname = Weak.Make(struct
- type t = protocol
- let hash protocol = Hashtbl.hash (protocol_name protocol)
-
- let equal x y = (protocol_name x) = (protocol_name y)
- end)
-
-let protocols_by_name = Hname.create 1027
-let protocols_by_num = Hnum.create 1027
-let counter = ref 0
-
-let protocol_account_from_option protocol info =
- let protocol = as_protocol_impl protocol in
- protocol.op_protocol_account_from_option protocol.impl_protocol_val info
-
-let protocol_new_account protocol =
- let protocol = as_protocol_impl protocol in
- protocol.op_protocol_new_account protocol.impl_protocol_val
-
-let protocol_available_status protocol =
- let protocol = as_protocol_impl protocol in
- protocol.op_protocol_available_status protocol.impl_protocol_val
-
-let new_protocol name v =
- incr counter;
- let p = {
- dummy_protocol with
- impl_protocol_name = name;
- impl_protocol_val = v;
- impl_protocol_num = !counter;
- op_protocol_account_from_option = (fun s ->
- failwith (Printf.sprintf "op_protocol_account_from_option not
implemented for %s" name));
- op_protocol_new_account = (fun s ->
- failwith (Printf.sprintf "op_protocol_new_account not implemented for
%s" name));
- op_protocol_available_status = (fun s ->
- [Online_available])
- } in
- let p = as_protocol p in
- Hname.add protocols_by_name p;
- lprintf "Registered protocol %s" name; lprint_newline ();
- Hnum.add protocols_by_num p;
- p
-
-let ni protocol name _ =
- lprintf "Method %s not implemented in %s" name
- (protocol_name protocol);
- lprint_newline ()
-
-let fni protocol name x =
- ni protocol name x;
- raise Not_found
-
-let ni2 protocol name _ _ =
- lprintf "Method %s not implemented in %s" name
- (protocol_name protocol); lprint_newline ()
-
-
-let fni2 protocol name x y =
- ni2 protocol name x y;
- raise Not_found
-
-
-let protocol_find_by_name name =
- Hname.find protocols_by_name
- (as_protocol { dummy_protocol_impl with impl_protocol_name = name })
-
-
-let iter f =
- Hname.iter (fun p -> try f p with _ -> ()) protocols_by_name
-
\ No newline at end of file
Index: src/im/imRoom.ml
===================================================================
RCS file: src/im/imRoom.ml
diff -N src/im/imRoom.ml
--- src/im/imRoom.ml 10 Oct 2005 16:22:25 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,118 +0,0 @@
-(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open ImTypes
-open ImProtocol
-
-type 'a room_impl = {
- mutable impl_room_num : int;
- mutable impl_room_val : 'a;
- mutable impl_room_ops : 'a room_ops;
- }
-
-and 'a room_ops = {
- mutable op_room_protocol : protocol;
-
-(* Send a message to this roomentity *)
- mutable op_room_send : ('a -> string -> unit);
-
-(* Remove this room from my contacts *)
- mutable op_room_quit : ('a -> unit);
-
-(* Get the name of this room *)
- mutable op_room_name : ('a -> string);
-
-(* Is this room online ? *)
- mutable op_room_status : ('a -> bool);
-
- mutable op_room_account : ('a -> account);
- }
-
-
-let as_room (room : 'a room_impl) =
- let (room : room) = Obj.magic room in
- room
-
-let as_room_impl (room : room) =
- let (room : 'a room_impl) = Obj.magic room in
- room
-
-let room_num room =
- let impl = as_room_impl room in
- impl.impl_room_num
-
-let dummy_room_impl = {
- impl_room_num = 0;
- impl_room_val = 0;
- impl_room_ops = Obj.magic 0;
- }
-
-let dummy_room = as_room dummy_room_impl
-
-module H = Weak.Make(struct
- type t = room
- let hash room = Hashtbl.hash (room_num room)
-
- let equal x y = (room_num x) = (room_num y)
- end)
-
-let room_counter = ref 0
-let rooms_by_num = H.create 1027
-
-let update_room_num impl =
- if impl.impl_room_num = 0 then begin
- incr room_counter;
- impl.impl_room_num <- !room_counter;
- H.add rooms_by_num (as_room impl);
- end
-
-let room_send room msg =
- let room = as_room_impl room in
- room.impl_room_ops.op_room_send room.impl_room_val msg
-
-let room_quit room =
- let room = as_room_impl room in
- room.impl_room_ops.op_room_quit room.impl_room_val
-
-let room_name room =
- let room = as_room_impl room in
- room.impl_room_ops.op_room_name room.impl_room_val
-
-let room_status room =
- let room = as_room_impl room in
- room.impl_room_ops.op_room_status room.impl_room_val
-
-
-let room_account room =
- let room = as_room_impl room in
- room.impl_room_ops.op_room_account room.impl_room_val
-
-
-let room_protocol room =
- let room = as_room_impl room in
- room.impl_room_ops.op_room_protocol
-
-let new_room_ops protocol = {
- op_room_protocol = protocol;
- op_room_send = fni2 protocol "op_room_send";
- op_room_quit = fni protocol "op_room_quit";
- op_room_name = fni protocol "op_room_name";
- op_room_status = fni protocol "op_room_status";
- op_room_account = fni protocol "op_room_account";
- }
Index: src/im/imTypes.ml
===================================================================
RCS file: src/im/imTypes.ml
diff -N src/im/imTypes.ml
--- src/im/imTypes.ml 2 Mar 2005 20:37:09 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,182 +0,0 @@
-(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-type identity
-type protocol
-type chat
-type room
-type account
-
-type online_status =
-| Online_available
-| Online_away
-
-type status =
- Status_offline
-| Status_connecting
-| Status_online of online_status
-
-type from_record =
-| FromString of (string -> unit)
-| FromBool of (bool -> unit)
-| FromInt of (int -> unit)
-
-type to_record =
-| ToString of (unit -> string)
-| ToBool of (unit -> bool)
-| ToInt of (unit -> int)
-
-type config_record =
- (string * string * bool * from_record * to_record) list
-
-open Options
-
-exception Optional
-
-let from_record record assocs =
- List.iter (fun (option, name, optional, from_record, to_record) ->
- try
- let value =
- try
- List.assoc option assocs
- with _ ->
- if not optional then
- failwith (Printf.sprintf "Required field %s missing" option)
- else
- raise Optional
- in
- match from_record with
- FromString f -> f (value_to_string value)
- | FromBool f -> f (value_to_bool value)
- | FromInt f -> f (value_to_int value)
- with Optional -> ()
- ) record
-
-let to_record record =
- List.map (fun (option, name, optional, from_record, to_record) ->
- match to_record with
- ToString f -> option,string_to_value (f ())
- | ToBool f -> option, bool_to_value (f ())
- | ToInt f -> option, int_to_value (f ())
- ) record
-
-(*
-(* The abstract type we manipulate for contacts *)
-type contact = {
- contact_name : string; (* his name *)
- contact_identities : identity list; (* all his identities *)
- contact_online : identity list; (* online identities *)
- }
-
-type protocol = {
- im_name : string;
- im_login : (unit -> unit);
- im_send : (string -> string -> unit);
- im_add_buddy : (string -> string -> unit);
- im_remove_buddy : (string -> string -> unit);
- im_keepalive : (unit -> unit);
- im_set_idle : (bool -> unit);
- }
-*)
-
-(*********
-
- A very simple interface for the Instant Messaging facility:
-
-*********)
-
-(*
-module type Main_Interface = sig
-
-(* An Instant-Messaging Network. *)
- type protocol
-
-(* A chat session: a chat may be:
-- a simple discussion with one guy
-- a conference between several guys
-- a room with discussion with multiple guys
- *)
- type chat
-
-(* An identity: some of them may be one of my accounts *)
- type identity
-
-(* A room *)
- type room
-
-(* [protocols ()] returns the list of available protocols *)
-(* [protocol_name p] returns the name of the protocol *)
-(* [protocol_login p] connect the given network *)
-(* [protocol_logout p] disconnect from the given network *)
- val protocols : unit -> protocol list
- val protocol_name : protocol -> string
- val account_login : identity -> unit
- val account_logout : identity -> unit
-
-(* The list of opened chats for a given protocol. *)
- val protocol_chats : protocol -> chat list
- val protocol_rooms : protocol -> room list
- val protocol_accounts : protocol -> identity list
-
-(* [new_contact name] returns a new contact of name [name] *)
-(* [contact_name contact] returns the name of the contact [contact] *)
-(* [contact_protocols contact] returns the list of networks on which [contact]
- has a known identity. *)
-(* [contact_available contact] returns if the contact [contact] is online *)
-(* [contacts_merge contact list] adds the list of identities [list] as other
- identities for the contact [contact], that can be used to contact it. *)
- val contact_name : identity -> string
- val contact_online : identity -> bool
-
- val room_name : room -> string
- val room_protocol : room -> protocol
- val room_open : room -> chat
-
- val identity_is_me : identity -> bool
-
-(* [protocol_contacts p] returns the list of known contacts on the given
- network. *)
-(* [protocol_add_contact contact p url] add a new identity on network [p] for
- contact [contact] using info from [url]. *)
-(* [protocol_remove_contact p contact] removes [contact] from the list of
- contacts on the given network [p] *)
- val new_account : protocol -> string -> identity
- val account_contacts : identity -> identity list
- val account_enter_contact : identity -> string -> identity
- val account_add_contact : identity -> identity -> unit
- val account_remove_contact : identity -> identity -> unit
-
- val chat_open : identity list -> chat
- val chat_close : chat -> unit
- val chat_identities : chat -> identity list
- val chat_send : chat -> string -> unit
-
- val identity_protocol : identity -> protocol
-
-(* [set_available p online] change my online status to [online] on
- network [p] *)
- val set_available : identity -> bool -> unit
-(* [send_message contact msg] sends a simple message [msg] to contact [contact]
- using one of the network he is online on. *)
-
- val add_event_handler : (event -> unit) -> unit
-
-end
- *)
-
Index: src/im/icq/icq.ml
===================================================================
RCS file: src/im/icq/icq.ml
diff -N src/im/icq/icq.ml
--- src/im/icq/icq.ml 2 Mar 2005 20:37:09 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,18 +0,0 @@
-(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
Index: src/im/irc/.cvsignore
===================================================================
RCS file: src/im/irc/.cvsignore
diff -N src/im/irc/.cvsignore
--- src/im/irc/.cvsignore 30 May 2006 11:23:48 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,2 +0,0 @@
-*.cm?
-*.annot
Index: src/im/irc/irc.ml
===================================================================
RCS file: src/im/irc/irc.ml
diff -N src/im/irc/irc.ml
--- src/im/irc/irc.ml 2 Mar 2005 20:37:09 -0000 1.7
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,678 +0,0 @@
-(* Copyright 2001, 2002 sy23, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-(* Translated from sources of Gaim *)
-
-open Printf2
-open Options
-open Md4
-open BigEndian
-open BasicSocket
-open TcpBufferedSocket
-
-open ImChat
-open ImTypes
-open ImProtocol
-open ImAccount
-open ImOptions
-open ImEvent
-open ImIdentity
-open ImRoom
-
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-
-type account = {
- mutable account_account : account account_impl;
-
- mutable account_sock : TcpBufferedSocket.t option;
- mutable account_server : string;
- mutable account_port : int;
- account_identity : identity;
- mutable account_identities : (string, identity) Hashtbl.t;
- mutable account_friends : identity list;
- mutable account_autologin : bool;
- mutable account_channels : string list;
-
- mutable account_rooms : (string, room) Hashtbl.t;
- }
-
-and identity = {
- mutable identity_identity : identity identity_impl;
-
- mutable identity_login : string;
- identity_account : account;
- mutable identity_chat : chat option;
- }
-
-and chat = {
- mutable chat_chat : chat chat_impl;
-
- mutable chat_friends : identity list;
- mutable chat_account : account;
- }
-
-and room = {
- mutable room_room : room room_impl;
-
- mutable room_name : string;
- mutable room_account : account;
- }
-
-let protocol = ImProtocol.new_protocol "IRC" ()
-let (protocol_ops : unit protocol_impl) = as_protocol_impl protocol
-
-let (account_ops : account ImAccount.account_ops) =
- ImAccount.new_account_ops protocol
-
-let (chat_ops : chat ImChat.chat_ops) =
- ImChat.new_chat_ops protocol
-
-let (room_ops : room ImRoom.room_ops) =
- ImRoom.new_room_ops protocol
-
-let (identity_ops : identity ImIdentity.identity_ops) =
- ImIdentity.new_identity_ops protocol
-
-
-let as_account a = as_account a.account_account
-let as_identity a = as_identity a.identity_identity
-let as_chat a = as_chat a.chat_chat
-
-
-
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-
-
-
-
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-
-let new_account_val () =
- let rec impl = {
- impl_account_ops = account_ops;
- impl_account_val = account;
- impl_account_num = 0;
- impl_account_status = Status_offline;
- } and
- account = {
- account_sock = None;
- account_account = impl;
- account_server = "irc.freenode.net";
- account_port = 6667;
- account_autologin = false;
- account_friends = [];
- account_identities = Hashtbl.create 13;
- account_rooms = Hashtbl.create 13;
- account_identity = identity;
- account_channels = ["#mldonkey"];
- }
- and id_impl = {
- impl_identity_ops = identity_ops;
- impl_identity_val = identity;
- impl_identity_num = 0;
- } and
- identity = {
- identity_login = "NEW LOGIN";
- identity_identity = id_impl;
- identity_account = account;
- identity_chat = None;
- } in
- account
-
-let register_account account =
- let impl = account.account_account in
- update_account_num impl;
- update_identity_num account.account_identity.identity_identity;
- accounts =:= (ImAccount.as_account impl) :: !!accounts
-
-let new_chat_val account =
- let rec impl = {
- impl_chat_ops = chat_ops;
- impl_chat_val = chat;
- impl_chat_num = 0;
- impl_chat_account = as_account account;
- } and
- chat = {
- chat_account = account;
- chat_friends = [];
- chat_chat = impl;
- } in
- chat
-
-let register_chat chat =
- let impl = chat.chat_chat in
- update_chat_num impl
-
-let new_room_val account name =
- let rec impl = {
- impl_room_ops = room_ops;
- impl_room_val = room;
- impl_room_num = 0;
- } and
- room = {
- room_name = name;
- room_account = account;
- room_room = impl;
- } in
- room
-
-let register_room room =
- let impl = room.room_room in
- update_room_num impl
-
-let new_identity_val account =
- let rec impl = {
- impl_identity_ops = identity_ops;
- impl_identity_val = identity;
- impl_identity_num = 0;
- } and
- identity = {
- identity_login = "NEW FRIEND";
- identity_identity = impl;
- identity_account = account;
- identity_chat = None;
- } in
- identity
-
-let register_identity identity =
- let impl = identity.identity_identity in
- Hashtbl.add identity.identity_account.account_identities
- identity.identity_login identity;
- update_identity_num impl
-
-let account_record a =
- [
- "account_login", "Nick", false,
- FromString (fun s -> a.account_identity.identity_login <- s),
- ToString (fun _ -> a.account_identity.identity_login);
-
- "account_server", "Server", false,
- FromString (fun s -> a.account_server <- s),
- ToString (fun _ -> a.account_server);
-
- "account_port", "Server Port", false,
- FromInt (fun s -> a.account_port <- s),
- ToInt (fun _ -> a.account_port);
-
- "auto_login", "Auto Login", true,
- FromBool (fun b -> a.account_autologin <- b),
- ToBool (fun _ -> a.account_autologin);
-
- "account_channels", "Preferred channels", true,
- FromString (fun s -> a.account_channels <- String2.split_simplify s ' '),
- ToString(fun s -> String2.unsplit a.account_channels ' ')
- ]
-
-let identity_record a =
- [
- "identity_login", "Nick", false,
- FromString (fun s -> a.identity_login <- s),
- ToString (fun _ -> a.identity_login);
- ]
-
-let id_open_chat id =
- let chat =
- match id.identity_chat with
- None ->
- let chat = new_chat_val id.identity_account in
- chat.chat_friends <- [id];
- id.identity_chat <- Some chat;
- register_chat chat;
- chat
- | Some chat -> chat
- in
- add_event (Chat_open_event (as_chat chat));
- chat
-
-(*********************************************************************
-
- More interesting functions
-
-*********************************************************************)
-
-let get_sock account =
- match account.account_sock with
- None -> failwith "NOT CONNECTED"
- | Some sock -> sock
-
-let irc_handler account s event =
- match event with
- BASIC_EVENT (CLOSED s) ->
- lprintf "disconnected from irc"; lprint_newline ();
- account.account_sock <- None;
- set_account_status (as_account account) Status_offline;
- | _ -> ()
-
-let new_identity account name =
- let id =
- try
- Hashtbl.find account.account_identities name
- with _ ->
- let id = new_identity_val account in
- id.identity_login <- name;
- register_identity id;
- id
- in
- id
-
-let verbose = ref true
-
-let rec get_arg s pos len =
- if pos >= len then raise Not_found;
- if s.[pos] = ':' then String.sub s (pos+1) (len-pos-1), len else
- if s.[pos] = ' ' then get_arg s (pos+1) len else
- try
- let new_pos = String.index_from s pos ' ' in
- String.sub s pos (new_pos - pos), new_pos
- with _ -> String.sub s (pos+1) (len-pos-1), len
-
-
-
-let rec get_args s pos len =
- try
- let (arg, pos) = get_arg s pos len in
- arg :: (get_args s pos len)
- with _ -> []
-
-let irc_parser s =
- let len = String.length s in
-
- let prefix, pos =
- if len>0 && s.[0] = ':' then
- let pos = String.index_from s 1 ' ' in
- String.sub s 1 (pos-1), pos
- else "", 0
- in
- let cmd, pos = get_arg s pos len in
- let args = get_args s pos len in
-
- prefix, cmd, args
-
-let parse_prefix prefix =
- try
- let nick, _ = String2.cut_at prefix '!' in
- nick
- with _ ->
- try
- let nick, _ = String2.cut_at prefix '@' in
- nick
- with _ -> prefix
-
-let find_room account room_name =
- try
- lprintf "FIND ROOM [%s]" room_name ; lprint_newline ();
- Hashtbl.find account.account_rooms room_name
- with _ ->
- let room = new_room_val account room_name in
- register_room room;
- Hashtbl.add account.account_rooms room_name room;
- add_event (Room_join (as_room room.room_room));
- room
-
-
-let irc_reader account (prefix, command, args) sock =
- begin
- match account_status (as_account account) with
- Status_offline | Status_connecting ->
- set_account_status (as_account account)
- (Status_online Online_available);
- add_event (Account_event (as_account account));
- | _ -> ()
- end;
- match command, args with
- "PING", arg :: _ -> write_string sock (Printf.sprintf "PONG %s" arg)
-
- | "JOIN", room_name :: _ ->
- begin
- let nick = parse_prefix prefix in
- let room = find_room account room_name in
- (*
- if nick = account.account_login then
-add_event (Room_join (as_room room.room_room))
- else *)
- let id = new_identity account nick in
- add_event (Room_user_join (as_room room.room_room,
- as_identity id))
- end
-
- | "PART", room_name :: _ ->
- begin
- let nick = parse_prefix prefix in
- if nick <> account.account_identity.identity_login then
- let room = find_room account room_name in
- let id = new_identity account nick in
- add_event (Room_user_leave (as_room room.room_room,
- as_identity id))
- end
-
- | "353", my_nick :: _ :: room_name :: names :: [] ->
- let room = find_room account room_name in
-
- let names = String2.split_simplify names ' ' in
-
- List.iter (fun nick ->
- if nick <> account.account_identity.identity_login then
- let id = new_identity account nick in
- add_event (Room_user_join (as_room room.room_room,
- as_identity id))
- ) names
-
- | "332", my_nick :: room_name :: motd :: _ ->
- let room = find_room account room_name in
- add_event (Room_public_message (as_room room.room_room,
- motd))
-
- | "PRIVMSG", room_name :: msg :: [] ->
-
- begin
- let len = String.length room_name in
- if len > 0 then
- if room_name.[0] = '#' then
-(* a chat room *)
- begin
- let room = find_room account room_name in
- let nick = parse_prefix prefix in
- let id = new_identity account nick in
- add_event (Room_message (as_room room.room_room,
- as_identity id, msg))
- end else
- if room_name = account.account_identity.identity_login then
- (* a private message *)
- begin
- let nick = parse_prefix prefix in
- let id = new_identity account nick in
- let chat = id_open_chat id in
- add_event (Chat_message_event (as_chat chat, as_identity id,
msg))
- end
- else begin
- lprintf "UNUSED MESSAGE (bad room ?)"; lprint_newline ();
- end
- end
-
-
- (* Some code from Gaim
- case 4:
- if (!strncmp(word[5], "u2.10", 5))
- id->six_modes = TRUE;
- else
- id->six_modes = FALSE;
- break;
- case 5:
- handle_005(gc, word, word_eol);
- break;
- case 301:
- if (id->in_whois) {
- id->liststr = g_string_append(id->liststr,
"<BR><b>Away: </b>");
-
- if (word_eol[5][0] == ':')
- id->liststr = g_string_append(id->liststr,
word_eol[5] + 1);
- else
- id->liststr = g_string_append(id->liststr,
word_eol[5]);
- } else
- irc_got_im(gc, word[4], word_eol[5], IM_FLAG_AWAY,
time(NULL));
- break;
- case 303:
- handle_list(gc, &word_eol[4][1]);
- break;
- case 311:
- case 312:
- case 313:
- case 317:
- case 319:
- handle_whois(gc, word, word_eol, n);
- break;
- case 322:
- handle_roomlist(gc, word, word_eol);
- break;
- case 323:
- case 318:
- if ((id->in_whois || id->in_list) && id->liststr) {
- GString *str = decode_html(id->liststr->str);
- g_show_info_text(gc, NULL, 2, str->str, NULL);
- g_string_free(str, TRUE);
- g_string_free(id->liststr, TRUE);
- id->liststr = NULL;
- id->in_whois = FALSE;
- id->in_list = FALSE;
- }
- break;
- case 324:
- handle_mode(gc, word, word_eol, TRUE);
- break;
- case 332:
- handle_topic(gc, text);
- break;
- case 353:
- handle_names(gc, word[5], word_eol[6]);
- break;
- case 376:
- irc_request_buddy_update(gc);
- break;
- case 401:
- do_error_dialog(_("No such nick/channel"), _("IRC Error"));
- break;
- case 402:
- do_error_dialog(_("No such server"), _("IRC Error"));
- case 431:
- do_error_dialog(_("No nickname given"), _("IRC Error"));
- break;
- }
-*)
-
-
- | _ ->
- lprintf "UNUSED MESSAGE"; lprint_newline ()
-
-let cut_messages parse_fun reader sock nread =
- if !verbose then begin
- lprintf "server to client: read %d" nread;
- lprint_newline ();
- end;
-
- let b = TcpBufferedSocket.buf sock in
- let offset = if nread < b.len then 1 else 0 in
- let nread = nread + offset in
- let pos = b.pos + b.len - nread in
- let rec iter pos nread =
- if nread > 1 then
- if b.buf.[pos] = '\r' && b.buf.[pos+1] = '\n' then begin
-
- if !verbose then begin
- lprintf "server_to_client: complete message";
- lprint_newline ();
- end;
-
- let s = String.sub b.buf b.pos (pos-b.pos) in
- let used = pos - b.pos + 2 in
- buf_used b used;
-
- if !verbose then begin
- lprintf "Message: %s" s;
- lprint_newline ();
- end;
-
- (try reader (parse_fun s) sock with e ->
- lprintf "Exception %s in Irc.cut_messages"
- (Printexc2.to_string e); lprint_newline ();
- );
-
- if not (closed sock) then
- iter b.pos b.len
-
- end else
- iter (pos+1) (nread-1)
- in
- iter pos nread
-
-
-let irc_login account =
- match account.account_sock with
- Some sock -> () (* already connected *)
- | None ->
- lprintf "connecting to irc %s" account.account_identity.identity_login;
- lprint_newline ();
- set_account_status (as_account account) Status_connecting;
-
- try
- let token = create_token unlimited_connection_manager in
- let sock = TcpBufferedSocket.connect token "im to irc"
- (Ip.to_inet_addr (Ip.from_name account.account_server))
- account.account_port
- (irc_handler account) in
- account.account_sock <- Some sock;
- set_account_status (as_account account) Status_connecting;
- set_reader sock (cut_messages irc_parser (irc_reader account));
- write_string sock (Printf.sprintf "NICK %s\r\n"
- account.account_identity.identity_login);
- write_string sock (Printf.sprintf "USER %s %s %s :mlim(%s)\r\n"
- account.account_identity.identity_login (Unix.gethostname())
- account.account_server account.account_identity.identity_login);
-
- lprintf "connecting to irc %s" account.account_identity.identity_login;
lprint_newline ()
-
- with e ->
- lprintf "Exception %s in irc_login\n" (Printexc2.to_string e);
- (match account.account_sock with
- None -> ()
- | Some sock ->
- account.account_sock <- None;
- close sock (Closed_for_exception e));
- set_account_status (as_account account) Status_offline
-
-let irc_keepalive account = ()
-let irc_send account id msg =
- match account.account_sock with
- | None ->
- lprintf "We are not connected anymore !!!"; lprint_newline ();
- | Some sock ->
- lprintf "sending private message"; lprint_newline ();
- write_string sock (Printf.sprintf "PRIVMSG %s :%s\r\n"
- id msg)
-
-let _ =
- protocol_ops.op_protocol_account_from_option <- (fun p assocs ->
- let account = new_account_val () in
- from_record (account_record account) assocs;
- register_account account;
- if account.account_autologin then (try irc_login account with _ -> ());
- as_account account
- );
- account_ops.op_account_login <- (fun account ->
- (try irc_login account with _ -> ());
- );
- account_ops.op_account_logout <- (fun account ->
- match account.account_sock with
- None -> ()
- | Some sock ->
- close sock Closed_by_user;
- set_account_status (as_account account) Status_offline
- );
- account_ops.op_account_has_rooms <- (fun account ->
- account.account_sock <> None);
- room_ops.op_room_name <- (fun room -> room.room_name);
- account_ops.op_account_to_option <- (fun account ->
- to_record (account_record account)
- );
- protocol_ops.op_protocol_new_account <- (fun p ->
- let account = new_account_val () in
- register_account account;
- as_account account);
- account_ops.op_account_keepalive <- irc_keepalive;
- account_ops.op_account_name <- (fun account ->
account.account_identity.identity_login);
- account_ops.op_account_config_record <- (fun a -> account_record a);
- account_ops.op_account_new_identity <- (fun account ->
- let identity = new_identity_val account in
- register_identity identity;
- as_identity identity);
- identity_ops.op_identity_config_record <- (fun id -> identity_record id);
- account_ops.op_account_contacts <- (fun account ->
- List.map as_identity account.account_friends);
- identity_ops.op_identity_name <- (fun id -> id.identity_login);
- chat_ops.op_chat_send <- (fun chat msg ->
- List.iter (fun id ->
- irc_send chat.chat_account id.identity_login msg
- ) chat.chat_friends;
- add_event (Chat_my_message (as_chat chat, msg))
- );
- chat_ops.op_chat_name <- (fun chat ->
- let s = ref "" in
- List.iter (fun f ->
- s := f.identity_login ^ " " ^ !s
- ) chat.chat_friends;
- !s
- );
- identity_ops.op_identity_open_chat <- (fun id ->
- ignore (id_open_chat id));
- chat_ops.op_chat_close <- (fun chat ->
- add_event (Chat_close_event (as_chat chat));
- List.iter (fun id ->
- id.identity_chat <- None
- ) chat.chat_friends
- );
- room_ops.op_room_send <- (fun room msg ->
- let account = room.room_account in
- match account.account_sock with
- None ->
-(* One day, all these messages will be displayed in the interface !! *)
- lprintf "Cannot send message because not connected :)";
- lprint_newline ();
- | Some sock ->
- write_string sock (Printf.sprintf "PRIVMSG %s :%s\r\n"
- room.room_name msg);
- add_event (Room_message (as_room room.room_room, as_identity
account.account_identity, msg))
- );
- room_ops.op_room_quit <- (fun room ->
- let account = room.room_account in
- match account.account_sock with
- None ->
- lprintf "Cannot quit this room since not connected :)";
- lprint_newline ();
- | Some sock ->
- write_string sock (Printf.sprintf "PART %s\r\n"
- room.room_name);
- add_event (Room_leave (as_room room.room_room))
-
- );
- account_ops.op_account_join_room <- (fun account room_name ->
- match account.account_sock with
- None -> ()
- | Some sock ->
- write_string sock (Printf.sprintf "JOIN %s\r\n" room_name)
- );
- account_ops.op_account_prefered_rooms <- (fun account ->
account.account_channels);
- room_ops.op_room_account <- (fun room -> as_account room.room_account)
-
Index: src/im/msn/msn.ml
===================================================================
RCS file: src/im/msn/msn.ml
diff -N src/im/msn/msn.ml
--- src/im/msn/msn.ml 2 Mar 2005 20:37:09 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,643 +0,0 @@
-(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open AnyEndian
-
-open Printf2
-open Md4
-open ImTypes
-open BasicSocket
-open TcpBufferedSocket
-open Options
-
-open ImProtocol
-open ImAccount
-open ImTypes
-open ImOptions
-
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-
-type switchboard_server = {
- mutable ss_sock : TcpBufferedSocket.t option;
- mutable ss_users : string list;
- mutable ss_messages : (string * string) list;
- }
-
-type account = {
- mutable account_sock : TcpBufferedSocket.t option;
- mutable account_password : string;
- mutable account_login : string;
- mutable account_account : account account_impl;
- mutable account_autologin : bool;
- mutable tryId : int;
- mutable msn_sock : TcpBufferedSocket.t option;
- mutable msn_switches : ((Ip.t * int) * switchboard_server) list;
- mutable msn_xfr_requests : (int * switchboard_server) list;
- mutable ns_sock : TcpBufferedSocket.t option;
- mutable ns_ip : Ip.t;
- mutable ns_port : int;
- }
-
-let protocol = ImProtocol.new_protocol "MSN" ()
-let (protocol_ops : unit protocol_impl) = as_protocol_impl protocol
-
-let (account_ops : account ImAccount.account_ops) =
- ImAccount.new_account_ops protocol
-
-let (chat_ops : chat ImChat.chat_ops) =
- ImChat.new_chat_ops protocol
-
-let (room_ops : room ImRoom.room_ops) =
- ImRoom.new_room_ops protocol
-
-let (identity_ops : identity ImIdentity.identity_ops) =
- ImIdentity.new_identity_ops protocol
-
-
-let as_account a = as_account a.account_account
-
-
-
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-
-
-
-let msn_server = "messenger.hotmail.com"
-let msn_port = 1863
-
-let mime_header =
- Printf.sprintf "MIME-Version: 1.0\r\nContent-Type: text/plain;
charset=UTF-8\r\nUser-Agent: mldonkey/%s\r\nX-MMS-IM-Format: FN=Arial; EF=;
CO=0; PF=0\r\n\r\n"
- Autoconf.current_version
-
-let mime_header_len = String.length mime_header
-
-let write_string sock s =
- lprintf "SEND [%s]" (String.escaped s); lprint_newline ();
- write_string sock s
-
-
-
-let get_ms_sock account =
- match account.msn_sock with
- None -> failwith "NOT CONNECTED"
- | Some sock -> sock
-
-let get_ns_sock account =
- match account.ns_sock with
- None -> failwith "NOT CONNECTED"
- | Some sock -> sock
-
-let msn_ms_handler account s event =
- match event with
- BASIC_EVENT (CLOSED s) ->
- lprintf "disconnected from Master Server"; lprint_newline ();
- account.msn_sock <- None
- | _ -> ()
-
-let msn_ns_handler account s event =
- match event with
- BASIC_EVENT (CLOSED s) ->
- lprintf "disconnected from Notification Server"; lprint_newline ();
- account.ns_sock <- None
- | _ -> ()
-
-let msn_ss_handler account ss s event =
- match event with
- BASIC_EVENT (CLOSED s) ->
- lprintf "disconnected from Switchboard Server"; lprint_newline ();
- ss.ss_sock <- None;
- account.msn_switches <- List.filter (fun (_,s) -> s != ss)
- account.msn_switches
- | _ -> ()
-
-let msn_error errcode =
- match errcode with
-
- | 200 ->
- "Syntax Error (probably a Gaim bug)"
-
- | 201 ->
- "Invalid Parameter (probably a Gaim bug)"
-
- | 205 ->
- "Invalid User"
-
- | 206 ->
- "Fully Qualified Domain Name missing"
-
- | 207 ->
- "Already Login"
-
- | 208 ->
- "Invalid Username"
-
- | 209 ->
- "Invalid Friendly Name"
-
- | 210 ->
- "List Full"
-
- | 215 ->
- "Already there"
-
- | 216 ->
- "Not on list"
-
- | 217 ->
- "User is offline"
-
- | 218 ->
- "Already in the mode"
-
- | 219 ->
- "Already in opposite list"
-
- | 280 ->
- "Switchboard failed"
-
- | 281 ->
- "Notify Transfer failed"
-
-
- | 300 ->
- "Required fields missing"
-
- | 302 ->
- "Not logged in"
-
-
- | 500 ->
- "Internal server error"
-
- | 501 ->
- "Database server error"
-
- | 510 ->
- "File operation error"
-
- | 520 ->
- "Memory allocation error"
-
-
- | 600 ->
- "Server busy"
-
- | 601 ->
- "Server unavailable"
-
- | 602 ->
- "Peer Notification server down"
-
- | 603 ->
- "Database connect error"
-
- | 604 ->
- "Server is going down (abandon ship)"
-
-
- | 707 ->
- "Error creating connection"
-
- | 711 ->
- "Unable to write"
-
- | 712 ->
- "Session overload"
-
- | 713 ->
- "User is too active"
-
- | 714 ->
- "Too many sessions"
-
- | 715 ->
- "Not expected"
-
- | 717 ->
- "Bad friend file"
-
-
- | 911 ->
- "Authentication failed"
-
- | 913 ->
- "Not allowed when offline"
-
- | 920 ->
- "Not accepting new users"
-
- | 924 ->
- "User unverified"
-
- | _ ->
- "Unknown Error Code"
-
-let incr_tryId account =
- account.tryId <- account.tryId + 1
-
-let msn_really_send account sock msg =
- let msg = msg in (* translate to utf8 *)
- write_string sock
- (Printf.sprintf "MSG %d N %d\r\n%s%s" account.tryId
- (mime_header_len + String.length msg)
- mime_header msg);
- incr_tryId account
-
-let rec msn_ss_parser account ss sock tokens msg =
- match tokens with
- [] -> assert false
-
- | "USR" :: _ ->
- begin
- match ss.ss_users with
- [] -> lprintf "NO USER!!!"; lprint_newline ();
- | who :: _ ->
- write_string sock (Printf.sprintf "CAL %d %s\r\n" account.tryId
who);
- incr_tryId account
- end
-
- | "CAL" :: _ -> ()
-
- | "JOI" :: _ :: user :: _ ->
- let rec iter list left =
- match list with
- (who, msg) :: tail ->
- if who = user then (msn_really_send account sock msg; iter tail
left)
- else iter tail ((who,msg) :: left)
- | [] -> left
- in
- ss.ss_messages <- List.rev (iter ss.ss_messages [])
-
- | "MSG" :: _ :: user :: _ ->
- let len = String.length msg in
- let rec iter pos =
- if pos + 3 >= len then len else
- if msg.[pos] = '\r' && msg.[pos+1] = '\n' &&
- msg.[pos+2] = '\r' && msg.[pos+3] = '\n' then
- pos+4 else iter (pos+1)
- in
- let pos = iter 0 in
- let msg = String.sub msg pos (len-pos) in
- lprintf "MSG RECEIVED FROM %s : [%s]" user
- (String.escaped msg); lprint_newline ();
-
- | "NAK" :: _ ->
- lprintf "The session is probably closed, and the message was
- not received"; lprint_newline ();
- close sock "closed session"
-
- | "BYE" :: user :: _ ->
- lprintf "User %s is now unavailable" user; lprint_newline ();
-
- | opcode :: _ ->
- lprintf "UNKNOWN OPCODE (SS) [%s]" opcode;
- lprint_newline ();
- match opcode.[0] with
- '0' .. '9' ->
- lprintf "ERROR %s" (msn_error (int_of_string opcode));
- lprint_newline ();
- | _ ->
- lprintf "UNKNOWN MESSAGE"; lprint_newline ();
- ()
-
-
-let rec msn_parser account sock tokens msg =
- match tokens with
- [] -> assert false
- | "VER" :: _ :: "MSNP5" :: _ ->
- write_string sock (Printf.sprintf "INF %d\r\n" account.tryId);
- incr_tryId account
-
- | "INF" :: _ :: "MD5" :: _ ->
- write_string sock (Printf.sprintf "USR %d MD5 I %s\r\n" account.tryId
- account.account_login
- );
- incr_tryId account
-
- | "ADD" :: _ (* num *) :: "RL" :: _ (* 2 *) :: user :: friend :: _ ->
- write_string sock (Printf.sprintf "ADD %d AL %s %s\r\n" account.tryId
- user friend
- );
- incr_tryId account
-
- | "XFR" :: _ :: "NS" :: ns :: _ ->
- let name, port = try
- String2.cut_at ns ':' with _ -> ns, "1863"
- in
- let port = int_of_string port in
- let ip = Ip.from_name name in
- lprintf "XFR connect to [%s] %d" (Ip.to_string ip) port;
- lprint_newline ();
- close sock "ok";
- account.ns_ip <- ip;
- account.ns_port <- port;
- msn_ns_connect account
-
- | "XFR" :: num :: "SB" :: ns :: _ :: auth :: _ ->
- let name, port = try
- String2.cut_at ns ':' with _ -> ns, "1863"
- in
- let num = int_of_string num in
- let ss = List.assoc num account.msn_xfr_requests in
- account.msn_xfr_requests <- List.remove_assoc num
account.msn_xfr_requests;
-
- lprintf "SB request found"; lprint_newline ();
-
- let port = int_of_string port in
- let ip = Ip.from_name name in
- lprintf "XFR connect to [%s] %d" (Ip.to_string ip) port;
- lprint_newline ();
-
- begin
- try
-
- let ss_old = List.assoc (ip, port) account.msn_switches in
- lprintf "ALREADY CONNECTED TO THE SWITCHBOARD";
- raise Not_found (* For now, connect several times *)
- with _ ->
- msn_ss_connect account ss ip port auth
- end
-
- | "USR" :: _ :: "MD5" :: _ :: friend :: _ ->
- let s = friend ^ account.account_password in
- lprintf "pass: [%s]" s; lprint_newline ();
- let md5 = String.lowercase (Md5.to_string (Md5.string s)) in
- write_string sock (
- Printf.sprintf "USR %d MD5 S %s\r\n" account.tryId md5);
- incr_tryId account
-
- | "USR" :: _ :: "OK" :: _ ->
- write_string sock (
- Printf.sprintf "SYN %d 0\r\n" account.tryId);
- incr_tryId account
-
- | "LST" :: _ :: "RL" :: _ ->
- write_string sock (
- Printf.sprintf "CHG %d NLN\r\n" account.tryId);
- incr_tryId account
-
- | "BLP" :: _ ->
- ()
-
- | ("PRP" | "GTC" | "QNG" | "QRY" | "REM") :: _ -> (* UNUSED MESSAGES *)
- ()
-
- | opcode :: _ ->
- lprintf "UNKNOWN OPCODE [%s]" opcode;
- lprint_newline ();
- match opcode.[0] with
- '0' .. '9' ->
- lprintf "ERROR %s" (msn_error (int_of_string opcode));
- lprint_newline ();
- | _ ->
- lprintf "UNKNOWN MESSAGE"; lprint_newline ();
- ()
-
-and msn_reader msn_parser sock nread =
- try
- lprintf "server to client %d" nread;
- lprint_newline ();
- let b = TcpBufferedSocket.buf sock in
- dump (String.sub b.buf b.pos b.len);
- lprint_newline ();
-
- let rec iter pos max_pos =
- if pos < max_pos - 1 then
- if b.buf.[pos] = '\r' && b.buf.[pos+1] = '\n' then
-
- let tokens = String2.split_simplify (
- String.sub b.buf b.pos (pos - b.pos)) ' ' in
-
- match tokens with
- [] ->
- TcpBufferedSocket.buf_used sock (pos-b.pos+2);
- (if b.len > 0 then iter b.pos (b.pos + b.len))
-
- | "MSG" :: _ ->
- begin
- match List.rev tokens with
- len :: _ ->
- let len = int_of_string len in
- lprintf "MUST WAIT: %d" len; lprint_newline ();
- if b.len - pos - 2 >= len then begin
- lprintf "OK !!!!!!"; lprint_newline ();
- TcpBufferedSocket.buf_used sock (pos-b.pos+2);
- let msg = String.sub b.buf b.pos len in
- TcpBufferedSocket.buf_used sock len;
- lprintf "MSG:"; lprint_newline ();
- AnyEndian.dump msg;
- lprint_newline ();
- msn_parser sock tokens msg;
-
- (if not (closed sock) &&
- b.len > 0 then iter b.pos (b.pos + b.len))
-
- end
- | _ -> failwith "BAD MSG"
- end
- | opcode :: args ->
- TcpBufferedSocket.buf_used sock (pos-b.pos+2);
-
- msn_parser sock tokens "";
- (if not (closed sock) && b.len > 0 then
- iter b.pos (b.pos + b.len))
-
- else
- iter (pos+1) max_pos
- in
- iter (maxi (b.pos + b.len - nread - 1) b.pos) (b.pos + b.len)
- with e ->
- close sock "Exception"
-
-and msn_ns_connect account =
- match account.ns_sock with
- Some sock -> () (* already connected *)
- | None ->
- lprintf "connecting to Notification Server"; lprint_newline ();
- let sock = TcpBufferedSocket.connect "im to ns"
- (Ip.to_inet_addr account.ns_ip)
- account.ns_port
- (msn_ns_handler account) in
- account.ns_sock <- Some sock;
- set_reader sock (msn_reader (msn_parser account));
- write_string sock (Printf.sprintf "VER %d MSNP5\r\n" account.tryId);
- incr_tryId account
-
-and msn_ss_connect account ss ip port auth =
- lprintf "connecting to SwitchBoard Server"; lprint_newline ();
- let sock = TcpBufferedSocket.connect "im to ns"
- (Ip.to_inet_addr ip)
- port
- (msn_ss_handler account ss) in
- account.msn_switches <- ((ip,port) , ss) :: account.msn_switches;
- set_reader sock (msn_reader (msn_ss_parser account ss));
- ss.ss_sock <- Some sock;
- write_string sock (Printf.sprintf "USR %d %s %s\r\n" account.tryId
- account.account_login auth);
- incr_tryId account
-
-(*
- ascii: [ V E R 0 M S N P 5(13)(10)]
-*)
-
-let msn_login account =
- match account.msn_sock with
- Some sock -> () (* already connected *)
- | None ->
- lprintf "connecting to msn"; lprint_newline ();
- let ip = Ip.from_name msn_server in
- let sock = TcpBufferedSocket.connect "im to msn"
- (Ip.to_inet_addr ip)
- msn_port
- (msn_ms_handler account) in
- account.msn_sock <- Some sock;
- set_reader sock (msn_reader (msn_parser account));
- write_string sock (Printf.sprintf "VER %d MSNP5\r\n" account.tryId);
- incr_tryId account
-
-let msn_remove_buddy who group = ()
-let msn_add_buddy who group = ()
-
-let msn_keepalive account =
- write_string (get_ns_sock account) "PNG\r\n"
-
-let msn_set_idle idle = ()
-
-let msn_send account who msg =
-(* This is done in two steps *)
-
- try
- List.iter (fun (_, ss) ->
- if List.mem who ss.ss_users then
- match ss.ss_sock with
- Some sock when ss.ss_messages = [] ->
- msn_really_send account sock msg;
- raise Exit
- | _ ->
- lprintf "ADDING MESSAGE"; lprint_newline ();
- ss.ss_messages <- ss.ss_messages @ [who, msg];
- raise Exit
- ) account.msn_switches;
- let ss = {
- ss_sock = None;
- ss_users = [who];
- ss_messages = [];
- } in
- account.msn_xfr_requests <- (account.tryId, ss) ::
account.msn_xfr_requests;
- ss.ss_messages <- ss.ss_messages @ [who, msg];
- write_string (get_ns_sock account)
- (Printf.sprintf "XFR %d SB\r\n" account.tryId);
- incr_tryId account;
- with Exit -> ()
-
-(*
-let protocol = {
- im_name = "MSN";
- im_login = msn_login;
- im_remove_buddy = msn_remove_buddy;
- im_add_buddy = msn_add_buddy;
- im_keepalive = msn_keepalive;
- im_set_idle = msn_set_idle;
- im_send = msn_send;
- }
- *)
-
-
-
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-
-let new_account_val () =
- let rec impl = {
- impl_account_ops = account_ops;
- impl_account_val = account;
- impl_account_num = 0;
- impl_account_status = Status_offline;
- } and
- account = {
- account_login = "";
- account_password = "";
- account_sock = None;
- account_account = impl;
- account_autologin = false;
- tryId = 0;
- msn_sock = None;
- msn_switches = [];
- msn_xfr_requests = [];
- ns_sock = None;
- ns_ip = Ip.null;
- ns_port = 1863;
- } in
- account
-
-let register_account account =
- let impl = account.account_account in
- update_account_num impl;
- accounts =:= (ImAccount.as_account impl) :: !!accounts
-
-let account_record a =
- [
- "account_login", "Nick", false,
- FromString (fun s -> a.account_login <- s),
- ToString (fun _ -> a.account_login);
-
- "account_password", "Password", false,
- FromString (fun s -> a.account_password <- s),
- ToString (fun _ -> a.account_password);
-
- "auto_login", "Auto Login", true,
- FromBool (fun b -> a.account_autologin <- b),
- ToBool (fun _ -> a.account_autologin);
- ]
-
-let _ =
- protocol_ops.op_protocol_account_from_option <- (fun p assocs ->
- let account = new_account_val () in
- from_record (account_record account) assocs;
- register_account account;
- if account.account_autologin then (try msn_login account with _ -> ());
- as_account account
- );
- account_ops.op_account_to_option <- (fun account ->
- to_record (account_record account)
- );
- protocol_ops.op_protocol_new_account <- (fun p ->
- let account = new_account_val () in
- register_account account;
- as_account account);
- account_ops.op_account_keepalive <- msn_keepalive;
- account_ops.op_account_name <- (fun account -> account.account_login);
- account_ops.op_account_config_record <- (fun a -> account_record a)
Index: src/im/toc/toc.ml
===================================================================
RCS file: src/im/toc/toc.ml
diff -N src/im/toc/toc.ml
--- src/im/toc/toc.ml 2 Mar 2005 20:37:09 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,18 +0,0 @@
-(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
Index: src/im/yahoo/yahoo.ml
===================================================================
RCS file: src/im/yahoo/yahoo.ml
diff -N src/im/yahoo/yahoo.ml
--- src/im/yahoo/yahoo.ml 6 Sep 2005 11:24:59 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,1193 +0,0 @@
-(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
-(*
- This file is part of mldonkey.
-
- mldonkey 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 of the License, or
- (at your option) any later version.
-
- mldonkey 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 mldonkey; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-(* Translated from sources of Gaim *)
-
-open AnyEndian
-
-open Printf2
-open Options
-open Md4
-open BigEndian
-open BasicSocket
-open TcpBufferedSocket
-
-open ImChat
-open ImTypes
-open ImProtocol
-open ImAccount
-open ImOptions
-open ImEvent
-open ImIdentity
-
-let yahoo_servers = [ "cs.yahoo.com"; "scs.yahoo.com" ]
-let yahoo_server = "scs.yahoo.com"
-(* let yahoo_server = "127.0.0.1" for testing purposes *)
-let yahoo_port = 5050
-
-
-
-type yahoo_service =
-| YAHOO_SERVICE_LOGON
-| YAHOO_SERVICE_LOGOFF
-| YAHOO_SERVICE_ISAWAY
-| YAHOO_SERVICE_ISBACK
-| YAHOO_SERVICE_IDLE
-| YAHOO_SERVICE_MESSAGE
-| YAHOO_SERVICE_IDACT
-| YAHOO_SERVICE_IDDEACT
-| YAHOO_SERVICE_MAILSTAT
-| YAHOO_SERVICE_USERSTAT
-| YAHOO_SERVICE_NEWMAIL
-| YAHOO_SERVICE_CHATINVITE
-| YAHOO_SERVICE_CALENDAR
-| YAHOO_SERVICE_NEWPERSONALMAIL
-| YAHOO_SERVICE_NEWCONTACT
-| YAHOO_SERVICE_ADDIDENT
-| YAHOO_SERVICE_ADDIGNORE
-| YAHOO_SERVICE_PING
-| YAHOO_SERVICE_GROUPRENAME
-| YAHOO_SERVICE_SYSMESSAGE
-| YAHOO_SERVICE_PASSTHROUGH2
-| YAHOO_SERVICE_CONFINVITE
-| YAHOO_SERVICE_CONFLOGON
-| YAHOO_SERVICE_CONFDECLINE
-| YAHOO_SERVICE_CONFLOGOFF
-| YAHOO_SERVICE_CONFADDINVITE
-| YAHOO_SERVICE_CONFMSG
-| YAHOO_SERVICE_CHATLOGON
-| YAHOO_SERVICE_CHATLOGOFF
-| YAHOO_SERVICE_CHATMSG
-| YAHOO_SERVICE_GAMELOGON
-| YAHOO_SERVICE_GAMELOGOFF
-| YAHOO_SERVICE_GAMEMSG
-| YAHOO_SERVICE_FILETRANSFER
-| YAHOO_SERVICE_NOTIFY
-| YAHOO_SERVICE_AUTHRESP
-| YAHOO_SERVICE_LIST
-| YAHOO_SERVICE_AUTH
-| YAHOO_SERVICE_ADDBUDDY
-| YAHOO_SERVICE_REMBUDDY
-| YAHOO_SERVICE_UNKNOWN of int
-
-
-type yahoo_status =
-| YAHOO_STATUS_AVAILABLE
-| YAHOO_STATUS_BRB
-| YAHOO_STATUS_BUSY
-| YAHOO_STATUS_NOTATHOME
-| YAHOO_STATUS_NOTATDESK
-| YAHOO_STATUS_NOTINOFFICE
-| YAHOO_STATUS_ONPHONE
-| YAHOO_STATUS_ONVACATION
-| YAHOO_STATUS_OUTTOLUNCH
-| YAHOO_STATUS_STEPPEDOUT
-| YAHOO_STATUS_INVISIBLE
-| YAHOO_STATUS_CUSTOM
-| YAHOO_STATUS_IDLE
-| YAHOO_STATUS_OFFLINE
-| YAHOO_STATUS_TYPING
-| YAHOO_STATUS_UNKNOWN of int
-
-
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-
-type account = {
- mutable account_account : account account_impl;
-
- mutable account_sock : TcpBufferedSocket.t option;
- mutable account_password : string;
- mutable account_login : string;
- mutable account_friends : (string, identity) Hashtbl.t;
- mutable account_autologin : bool;
- }
-
-and identity = {
- mutable identity_identity : identity identity_impl;
-
- mutable identity_login : string;
- mutable identity_account : account;
- mutable identity_chat : chat option;
- }
-
-and chat = {
- mutable chat_chat : chat chat_impl;
-
- mutable chat_friends : identity list;
- mutable chat_account : account;
- }
-
-let protocol = ImProtocol.new_protocol "Yahoo" ()
-let (protocol_ops : unit protocol_impl) = as_protocol_impl protocol
-
-let (account_ops : account ImAccount.account_ops) =
- ImAccount.new_account_ops protocol
-
-let (chat_ops : chat ImChat.chat_ops) =
- ImChat.new_chat_ops protocol
-
-let (room_ops : room ImRoom.room_ops) =
- ImRoom.new_room_ops protocol
-
-let (identity_ops : identity ImIdentity.identity_ops) =
- ImIdentity.new_identity_ops protocol
-
-
-let as_account a = as_account a.account_account
-let as_identity a = as_identity a.identity_identity
-let as_chat a = as_chat a.chat_chat
-
-
-
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-
-
-
-
-let string_of_service s =
- match s with
-| YAHOO_SERVICE_LOGON -> "YAHOO_SERVICE_LOGON"
-| YAHOO_SERVICE_LOGOFF -> "YAHOO_SERVICE_LOGOFF"
-| YAHOO_SERVICE_ISAWAY -> "YAHOO_SERVICE_ISAWAY"
-| YAHOO_SERVICE_ISBACK -> "YAHOO_SERVICE_ISBACK"
-| YAHOO_SERVICE_IDLE -> "YAHOO_SERVICE_IDLE"
-| YAHOO_SERVICE_MESSAGE -> "YAHOO_SERVICE_MESSAGE"
-| YAHOO_SERVICE_IDACT -> "YAHOO_SERVICE_IDACT"
-| YAHOO_SERVICE_IDDEACT -> "YAHOO_SERVICE_IDDEACT"
-| YAHOO_SERVICE_MAILSTAT -> "YAHOO_SERVICE_MAILSTAT"
-| YAHOO_SERVICE_USERSTAT -> "YAHOO_SERVICE_USERSTAT"
-| YAHOO_SERVICE_NEWMAIL -> "YAHOO_SERVICE_NEWMAIL"
-| YAHOO_SERVICE_CHATINVITE -> "YAHOO_SERVICE_CHATINVITE"
-| YAHOO_SERVICE_CALENDAR -> "YAHOO_SERVICE_CALENDAR"
-| YAHOO_SERVICE_NEWPERSONALMAIL -> "YAHOO_SERVICE_NEWPERSONALMAIL"
-| YAHOO_SERVICE_NEWCONTACT -> "YAHOO_SERVICE_NEWCONTACT"
-| YAHOO_SERVICE_ADDIDENT -> "YAHOO_SERVICE_ADDIDENT"
-| YAHOO_SERVICE_ADDIGNORE -> "YAHOO_SERVICE_ADDIGNORE"
-| YAHOO_SERVICE_PING -> "YAHOO_SERVICE_PING"
-| YAHOO_SERVICE_GROUPRENAME -> "YAHOO_SERVICE_GROUPRENAME"
-| YAHOO_SERVICE_SYSMESSAGE -> "YAHOO_SERVICE_SYSMESSAGE"
-| YAHOO_SERVICE_PASSTHROUGH2 -> "YAHOO_SERVICE_PASSTHROUGH2"
-| YAHOO_SERVICE_CONFINVITE -> "YAHOO_SERVICE_CONFINVITE"
-| YAHOO_SERVICE_CONFLOGON -> "YAHOO_SERVICE_CONFLOGON"
-| YAHOO_SERVICE_CONFDECLINE -> "YAHOO_SERVICE_CONFDECLINE"
-| YAHOO_SERVICE_CONFLOGOFF -> "YAHOO_SERVICE_CONFLOGOFF"
-| YAHOO_SERVICE_CONFADDINVITE -> "YAHOO_SERVICE_CONFADDINVITE"
-| YAHOO_SERVICE_CONFMSG -> "YAHOO_SERVICE_CONFMSG"
-| YAHOO_SERVICE_CHATLOGON -> "YAHOO_SERVICE_CHATLOGON"
-| YAHOO_SERVICE_CHATLOGOFF -> "YAHOO_SERVICE_CHATLOGOFF"
-| YAHOO_SERVICE_CHATMSG -> "YAHOO_SERVICE_CHATMSG"
-| YAHOO_SERVICE_GAMELOGON -> "YAHOO_SERVICE_GAMELOGON"
-| YAHOO_SERVICE_GAMELOGOFF -> "YAHOO_SERVICE_GAMELOGOFF"
-| YAHOO_SERVICE_GAMEMSG -> "YAHOO_SERVICE_GAMEMSG"
-| YAHOO_SERVICE_FILETRANSFER -> "YAHOO_SERVICE_FILETRANSFER"
-| YAHOO_SERVICE_NOTIFY -> "YAHOO_SERVICE_NOTIFY"
-| YAHOO_SERVICE_AUTHRESP -> "YAHOO_SERVICE_AUTHRESP"
-| YAHOO_SERVICE_LIST -> "YAHOO_SERVICE_LIST"
-| YAHOO_SERVICE_AUTH -> "YAHOO_SERVICE_AUTH"
-| YAHOO_SERVICE_ADDBUDDY -> "YAHOO_SERVICE_ADDBUDDY"
-| YAHOO_SERVICE_REMBUDDY -> "YAHOO_SERVICE_REMBUDDY"
-| YAHOO_SERVICE_UNKNOWN i -> Printf.sprintf "YAHOO_SERVICE_UNKNOWN %d" i
-
-let int_of_service s =
- match s with
- | YAHOO_SERVICE_LOGON -> 1
- | YAHOO_SERVICE_LOGOFF -> 2
- | YAHOO_SERVICE_ISAWAY -> 3
- | YAHOO_SERVICE_ISBACK -> 4
- | YAHOO_SERVICE_IDLE -> 5 (* place holder *)
- | YAHOO_SERVICE_MESSAGE -> 6
- | YAHOO_SERVICE_IDACT -> 7
- | YAHOO_SERVICE_IDDEACT -> 8
- | YAHOO_SERVICE_MAILSTAT -> 9
- | YAHOO_SERVICE_USERSTAT -> 10
- | YAHOO_SERVICE_NEWMAIL -> 11
- | YAHOO_SERVICE_CHATINVITE -> 12
- | YAHOO_SERVICE_CALENDAR -> 13
- | YAHOO_SERVICE_NEWPERSONALMAIL -> 14
- | YAHOO_SERVICE_NEWCONTACT -> 15
- | YAHOO_SERVICE_ADDIDENT -> 16
- | YAHOO_SERVICE_ADDIGNORE -> 17
- | YAHOO_SERVICE_PING -> 18
- | YAHOO_SERVICE_GROUPRENAME -> 19
- | YAHOO_SERVICE_SYSMESSAGE -> 0x14
- | YAHOO_SERVICE_PASSTHROUGH2 -> 0x16
- | YAHOO_SERVICE_CONFINVITE -> 0x18
- | YAHOO_SERVICE_CONFLOGON -> 25
- | YAHOO_SERVICE_CONFDECLINE -> 26
- | YAHOO_SERVICE_CONFLOGOFF -> 27
- | YAHOO_SERVICE_CONFADDINVITE -> 28
- | YAHOO_SERVICE_CONFMSG -> 29
- | YAHOO_SERVICE_CHATLOGON -> 30
- | YAHOO_SERVICE_CHATLOGOFF -> 31
- | YAHOO_SERVICE_CHATMSG -> 0x20
- | YAHOO_SERVICE_GAMELOGON -> 0x28
- | YAHOO_SERVICE_GAMELOGOFF -> 0x29
- | YAHOO_SERVICE_GAMEMSG -> 0x2a
- | YAHOO_SERVICE_FILETRANSFER -> 0x46
- | YAHOO_SERVICE_NOTIFY -> 0x4B
- | YAHOO_SERVICE_AUTHRESP -> 0x54
- | YAHOO_SERVICE_LIST -> 0x55
- | YAHOO_SERVICE_AUTH -> 0x57
- | YAHOO_SERVICE_ADDBUDDY -> 0x83
- | YAHOO_SERVICE_REMBUDDY -> 0x84
- | YAHOO_SERVICE_UNKNOWN s -> s
-
-let service_of_int s =
- match s with
- | 1 -> YAHOO_SERVICE_LOGON
- | 2 -> YAHOO_SERVICE_LOGOFF
- | 3 -> YAHOO_SERVICE_ISAWAY
- | 4 -> YAHOO_SERVICE_ISBACK
- | 5 (* place holder *) -> YAHOO_SERVICE_IDLE
- | 6 -> YAHOO_SERVICE_MESSAGE
- | 7 -> YAHOO_SERVICE_IDACT
- | 8 -> YAHOO_SERVICE_IDDEACT
- | 9 -> YAHOO_SERVICE_MAILSTAT
- | 10 -> YAHOO_SERVICE_USERSTAT
- | 11 -> YAHOO_SERVICE_NEWMAIL
- | 12 -> YAHOO_SERVICE_CHATINVITE
- | 13 -> YAHOO_SERVICE_CALENDAR
- | 14 -> YAHOO_SERVICE_NEWPERSONALMAIL
- | 15 -> YAHOO_SERVICE_NEWCONTACT
- | 16 -> YAHOO_SERVICE_ADDIDENT
- | 17 -> YAHOO_SERVICE_ADDIGNORE
- | 18 -> YAHOO_SERVICE_PING
- | 19 -> YAHOO_SERVICE_GROUPRENAME
- | 0x14 -> YAHOO_SERVICE_SYSMESSAGE
- | 0x16 -> YAHOO_SERVICE_PASSTHROUGH2
- | 0x18 -> YAHOO_SERVICE_CONFINVITE
- | 25 -> YAHOO_SERVICE_CONFLOGON
- | 26 -> YAHOO_SERVICE_CONFDECLINE
- | 27 -> YAHOO_SERVICE_CONFLOGOFF
- | 28 -> YAHOO_SERVICE_CONFADDINVITE
- | 29 -> YAHOO_SERVICE_CONFMSG
- | 30 -> YAHOO_SERVICE_CHATLOGON
- | 31 -> YAHOO_SERVICE_CHATLOGOFF
- | 0x20 -> YAHOO_SERVICE_CHATMSG
- | 0x28 -> YAHOO_SERVICE_GAMELOGON
- | 0x29 -> YAHOO_SERVICE_GAMELOGOFF
- | 0x2a -> YAHOO_SERVICE_GAMEMSG
- | 0x46 -> YAHOO_SERVICE_FILETRANSFER
- | 0x4B -> YAHOO_SERVICE_NOTIFY
- | 0x54 -> YAHOO_SERVICE_AUTHRESP
- | 0x55 -> YAHOO_SERVICE_LIST
- | 0x57 -> YAHOO_SERVICE_AUTH
- | 0x83 -> YAHOO_SERVICE_ADDBUDDY
- | 0x84 -> YAHOO_SERVICE_REMBUDDY
- | s -> YAHOO_SERVICE_UNKNOWN s
-
-let int_of_status s =
- match s with
- | YAHOO_STATUS_AVAILABLE -> 0
- | YAHOO_STATUS_BRB -> 1
- | YAHOO_STATUS_BUSY -> 2
- | YAHOO_STATUS_NOTATHOME -> 3
- | YAHOO_STATUS_NOTATDESK -> 4
- | YAHOO_STATUS_NOTINOFFICE -> 5
- | YAHOO_STATUS_ONPHONE -> 6
- | YAHOO_STATUS_ONVACATION -> 7
- | YAHOO_STATUS_OUTTOLUNCH -> 8
- | YAHOO_STATUS_STEPPEDOUT -> 9
- | YAHOO_STATUS_INVISIBLE -> 12
- | YAHOO_STATUS_CUSTOM -> 99
- | YAHOO_STATUS_IDLE -> 999
- | YAHOO_STATUS_OFFLINE -> 0x5a55aa56
- | YAHOO_STATUS_TYPING -> 0x16
- | YAHOO_STATUS_UNKNOWN s -> s
-
-let status_of_int s =
- match s with
- | 0 -> YAHOO_STATUS_AVAILABLE
- | 1 -> YAHOO_STATUS_BRB
- | 2 -> YAHOO_STATUS_BUSY
- | 3 -> YAHOO_STATUS_NOTATHOME
- | 4 -> YAHOO_STATUS_NOTATDESK
- | 5 -> YAHOO_STATUS_NOTINOFFICE
- | 6 -> YAHOO_STATUS_ONPHONE
- | 7 -> YAHOO_STATUS_ONVACATION
- | 8 -> YAHOO_STATUS_OUTTOLUNCH
- | 9 -> YAHOO_STATUS_STEPPEDOUT
- | 12 -> YAHOO_STATUS_INVISIBLE
- | 99 -> YAHOO_STATUS_CUSTOM
- | 999 -> YAHOO_STATUS_IDLE
- | 0x5a55aa56 -> YAHOO_STATUS_OFFLINE
- | 0x16 -> YAHOO_STATUS_TYPING
- | s -> YAHOO_STATUS_UNKNOWN s
-
-let string_of_status s =
- match s with
- | YAHOO_STATUS_BRB -> "Be Right Back";
- | YAHOO_STATUS_BUSY -> "Busy";
- | YAHOO_STATUS_NOTATHOME -> "Not At Home";
- | YAHOO_STATUS_NOTATDESK -> "Not At Desk";
- | YAHOO_STATUS_NOTINOFFICE -> "Not In Office";
- | YAHOO_STATUS_ONPHONE -> "On Phone";
- | YAHOO_STATUS_ONVACATION -> "On Vacation";
- | YAHOO_STATUS_OUTTOLUNCH -> "Out To Lunch";
- | YAHOO_STATUS_STEPPEDOUT -> "Stepped Out";
- | YAHOO_STATUS_INVISIBLE -> "Invisible";
- | _ -> "Online"
-
-
-
-(********************************************************************
-
- Authentification stuff
-
-*********************************************************************)
-
-
-
-let base64digits =
- "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789._"
-
-
-(* This is taken from Sylpheed by Hiroyuki Yamamoto. *)
-
-let to_y64 s =
- let buf = Buffer.create 30 in
- let inlen = String.length s in
- let rec iter pos inlen =
- match inlen with
- 0 -> Buffer.contents buf
- | 1 ->
- let in0 = get_int8 s pos in
- Buffer.add_char buf base64digits.[in0 lsr 2];
- let fragment = (in0 lsl 4) land 0x30 in
- Buffer.add_char buf base64digits.[fragment];
- Buffer.add_char buf '-';
- Buffer.add_char buf '-';
- Buffer.contents buf
- | 2 ->
- let in0 = get_int8 s pos in
- let in1 = get_int8 s (pos+1) in
-
- Buffer.add_char buf base64digits.[in0 lsr 2];
- let fragment = ((in0 lsl 4) land 0x30) lor (in1 lsr 4) in
- Buffer.add_char buf base64digits.[fragment];
- Buffer.add_char buf base64digits.[(in1 lsl 2) land 0x3c];
- Buffer.add_char buf '-';
- Buffer.contents buf
- | _ ->
- let in0 = get_int8 s pos in
- let in1 = get_int8 s (pos+1) in
- let in2 = get_int8 s (pos+2) in
- Buffer.add_char buf (base64digits.[in0 lsr 2]);
- Buffer.add_char buf (base64digits.[
- ((in0 lsl 4) land 0x30) lor (in1 lsr 4)]);
- Buffer.add_char buf (base64digits.[
- ((in1 lsl 2) land 0x3c) lor (in2 lsr 6)]);
- Buffer.add_char buf base64digits.[in2 land 0x3f];
- iter (pos+3) (inlen-3)
- in
- iter 0 inlen
-
-external yahoo_crypt : string -> string -> string -> unit = "ml_yahoo_crypt"
-
-
-let yahoo_process_auth account seed =
- let client_nick = account.account_login in
-
- let sv = get_int8 seed 15 in
- let sv = sv mod 8 in
-
- let password_hash = to_y64 (Md5.direct_to_string
- (Md5.string account.account_password)) in
-
- let crypt_hash = String.create 100 in
- yahoo_crypt account.account_password "$1$_2S43d5f$" crypt_hash;
- let pos = String.index crypt_hash '\000' in
- let crypt_hash = String.sub crypt_hash 0 pos in
- let crypt_hash = to_y64 (Md5.direct_to_string (Md5.string crypt_hash)) in
-
- let get_seed pos = (get_int8 seed pos) mod 16 in
-
- let (hash_string_p, hash_string_c) =
- match sv with
- | 1 | 6 ->
- let checksum = seed.[get_seed 9] in
- Printf.sprintf "%c%s%s%s" checksum client_nick seed password_hash,
- Printf.sprintf "%c%s%s%s" checksum client_nick seed crypt_hash
- | 2 | 7 ->
- let checksum = seed.[get_seed 15] in
- Printf.sprintf "%c%s%s%s" checksum seed password_hash client_nick,
- Printf.sprintf "%c%s%s%s" checksum seed crypt_hash client_nick
- | 3 ->
- let checksum = seed.[get_seed 1] in
- Printf.sprintf "%c%s%s%s" checksum client_nick password_hash seed,
- Printf.sprintf "%c%s%s%s" checksum client_nick crypt_hash seed
- | 4 ->
- let checksum = seed.[get_seed 3] in
- Printf.sprintf "%c%s%s%s" checksum password_hash seed client_nick,
- Printf.sprintf "%c%s%s%s" checksum crypt_hash seed client_nick
- | 0 | 5 ->
- let checksum = seed.[get_seed 7] in
- Printf.sprintf "%c%s%s%s" checksum password_hash client_nick seed,
- Printf.sprintf "%c%s%s%s" checksum crypt_hash client_nick seed
- | _ -> assert false
- in
-
- let result6 = to_y64 (Md5.direct_to_string (Md5.string hash_string_p)) in
- let result96 = to_y64 (Md5.direct_to_string (Md5.string hash_string_c)) in
-
- result6, result96
-
-
-
-
-
-(* format of a Yahoo message:
-
-int32: "YMSG"
-int16: 0x0600
-int16: 0x00
-int16: pktlen (* payload *)
-int16: service
-int32: status
-int32: id
-char[pktlen]: payload
-
-*)
-
-type 'a packet = {
- service : yahoo_service;
- status : yahoo_status;
- id : int32;
- payload : 'a;
- }
-
-let yahoo_header_len = 4 + 2 + 2 + 2 + 2 + 4 + 4
-
-let cut_messages parse f sock nread =
- lprintf "server to client %d" nread;
- lprint_newline ();
- let b = TcpBufferedSocket.buf sock in
- try
- while b.len >= yahoo_header_len do
- let msg_len = get_int16 b.buf (b.pos+8) in
-
- if b.len >= yahoo_header_len + msg_len then
- let header = String.sub b.buf b.pos yahoo_header_len in
-(*
- lprintf "NEW MESSAGE: header:"; lprint_newline ();
- LittleEndian.dump header;
- lprint_newline (); *)
- let service = get_int16 b.buf (b.pos+10) in
- let status = get_int b.buf (b.pos+12) in
- let id = get_int32 b.buf (b.pos+16) in
- lprintf "server_to_client: one message";
- lprint_newline ();
- let s = String.sub b.buf (b.pos + yahoo_header_len) msg_len in
- let service = service_of_int service in
- lprintf "NEW MESSAGE: service %s status %x payload:"
- (string_of_service service) status;
- lprint_newline ();
- (*
- LittleEndian.dump s;
- lprint_newline ();
-*)
-
- let pkt = {
- service = service;
- status = status_of_int status;
- id = id;
- payload = s;
- } in
- TcpBufferedSocket.buf_used sock (msg_len + yahoo_header_len);
- let t = parse pkt in
- f t sock
- else raise Not_found
- done
- with Not_found -> ()
- | e ->
- lprintf "EXCEPTION: %s" (Printexc2.to_string e); lprint_newline ();
- raise e
-
-let buf = Buffer.create 30000
-
-let send_message sock pkt =
- Buffer.reset buf;
- Buffer.add_char buf 'Y';
- Buffer.add_char buf 'M';
- Buffer.add_char buf 'S';
- Buffer.add_char buf 'G';
- buf_int16 buf 0x0600;
- buf_int16 buf 0;
- buf_int16 buf (String.length pkt.payload);
- buf_int16 buf (int_of_service pkt.service);
- buf_int buf (int_of_status pkt.status);
- buf_int32 buf pkt.id;
- Buffer.add_string buf pkt.payload;
- let s = Buffer.contents buf in
- Buffer.reset buf;
- lprintf "SENDING MESSAGE:"; lprint_newline ();
- dump s; lprint_newline ();
- write_string sock s;
- ()
-
-let yahoo_send_message sock pkt =
- Buffer.reset buf;
- List.iter (fun (key, data) ->
- Printf.bprintf buf "%d" key;
- buf_int8 buf 0xc0;
- buf_int8 buf 0x80;
- Buffer.add_string buf data;
- buf_int8 buf 0xc0;
- buf_int8 buf 0x80;
- ) pkt.payload;
- send_message sock { pkt with payload = Buffer.contents buf }
-
-
-let new_packet0 service status payload =
- {
- service = service;
- status = status;
- id = Int32.zero;
- payload = payload;
- }
-
-let rec cut_in_pairs list =
- match list with
- [] -> []
- | key :: _ :: value :: _ :: tail ->
- lprintf "[%s=%s]" key value; lprint_newline ();
- (int_of_string key, value) :: (cut_in_pairs tail)
- | _ -> []
-
-
-let c128 = char_of_int 128
-let c192 = char_of_int 192
-
-let cut_pairs s =
- String2.replace_char s c128 c192;
- let list = String2.split s c192 in
- (*
- List.iter (fun s ->
- lprintf "item [%s]" s; lprint_newline ();
-) list;
- *)
- cut_in_pairs list
-
-let yahoo_parser pkt = { pkt with
- payload = cut_pairs pkt.payload }
-
-
-
-
-
-
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-(*************************************************************************)
-
-let new_account_val () =
- let rec impl = {
- impl_account_ops = account_ops;
- impl_account_val = account;
- impl_account_num = 0;
- impl_account_status = Status_offline;
- } and
- account = {
- account_login = "NEW LOGIN";
- account_password = "NEW PASSWORD";
- account_sock = None;
- account_account = impl;
- account_autologin = false;
- account_friends = Hashtbl.create 13;
- } in
- account
-
-let register_account account =
- let impl = account.account_account in
- update_account_num impl;
- accounts =:= (ImAccount.as_account impl) :: !!accounts
-
-let new_chat_val account =
- let rec impl = {
- impl_chat_ops = chat_ops;
- impl_chat_val = chat;
- impl_chat_num = 0;
- impl_chat_account = as_account account;
- } and
- chat = {
- chat_account = account;
- chat_friends = [];
- chat_chat = impl;
- } in
- chat
-
-let register_chat chat =
- let impl = chat.chat_chat in
- update_chat_num impl
-
-let new_identity_val account =
- let rec impl = {
- impl_identity_ops = identity_ops;
- impl_identity_val = identity;
- impl_identity_num = 0;
-(* impl_identity_status = Status_offline; *)
- } and
- identity = {
- identity_login = "NEW FRIEND";
- identity_identity = impl;
- identity_account = account;
- identity_chat = None;
- } in
- identity
-
-let register_identity identity =
- let impl = identity.identity_identity in
- Hashtbl.add identity.identity_account.account_friends
- identity.identity_login identity;
- update_identity_num impl
-
-let account_record a =
- [
- "account_login", "Nick", false,
- FromString (fun s -> a.account_login <- s),
- ToString (fun _ -> a.account_login);
-
- "account_password", "Password", false,
- FromString (fun s -> a.account_password <- s),
- ToString (fun _ -> a.account_password);
-
- "auto_login", "Auto Login", true,
- FromBool (fun b -> a.account_autologin <- b),
- ToBool (fun _ -> a.account_autologin);
- ]
-
-let identity_record a =
- [
- "identity_login", "Nick", false,
- FromString (fun s -> a.identity_login <- s),
- ToString (fun _ -> a.identity_login);
- ]
-
-(*********************************************************************
-
- More interesting functions
-
-*********************************************************************)
-
-let get_sock account =
- match account.account_sock with
- None -> failwith "NOT CONNECTED"
- | Some sock -> sock
-
-let yahoo_handler account s event =
- match event with
- BASIC_EVENT (CLOSED s) ->
- lprintf "disconnected from yahoo"; lprint_newline ();
- account.account_sock <- None;
- set_account_status (as_account account) Status_offline;
- | _ -> ()
-
-(* NEW MESSAGE: service 2 status ffffffff payload: *)
-
-let yahoo_process_status account pkt =
- lprintf "NOT IMPLEMENTED: yahoo_process_status"; lprint_newline ();
- List.iter (fun (key, value) ->
- match key with
- | 1 ->
- set_account_status (as_account account)
- (Status_online Online_available);
- add_event (Account_event (as_account account));
- | _ -> ()
- ) pkt.payload
-
-let yahoo_process_notify pkt =
- lprintf "NOT IMPLEMENTED: yahoo_process_notify"; lprint_newline ();
- ()
-
-let id_open_chat id =
- let chat =
- match id.identity_chat with
- None ->
- let chat = new_chat_val id.identity_account in
- chat.chat_friends <- [id];
- id.identity_chat <- Some chat;
- register_chat chat;
- chat
- | Some chat -> chat
- in
- add_event (Chat_open_event (as_chat chat));
- chat
-
-let yahoo_process_message account pkt =
- let from = List.assoc 4 pkt.payload in
- let msg = List.assoc 14 pkt.payload in
-(* let tm = List.assoc 15 pkt.payload in *)
-
-(*
- if (pkt->status <= 1 || pkt->status == 5) {
- char *m;
- int i, j;
- strip_linefeed(msg);
- m = msg;
- for (i = 0, j = 0; m[i]; i++) {
- if (m[i] == 033) {
- while (m[i] && (m[i] != 'm'))
- i++;
- if (!m[i])
- i--;
- continue;
- }
- msg[j++] = m[i];
- }
- msg[j] = 0;
- serv_got_im(gc, from, msg, 0, tm, -1);
- } else if (pkt->status == 2) {
- do_error_dialog(_("Your message did not get sent."), _("Gaim -
Error"));
- }
-
- *)
-
- lprintf "MESSAGE FROM %s: %s" from msg; lprint_newline ();
- begin
-(* Who sent the message *)
- let id = try
- Hashtbl.find account.account_friends from
- with _ ->
- let id = new_identity_val account in
- id.identity_login <- from;
- register_identity id;
- id
- in
-(* On which chat ? *)
- let chat = id_open_chat id in
- add_event (Chat_message_event (as_chat chat, as_identity id, msg))
- end
-
-let yahoo_process_mail pkt =
- lprintf "NOT IMPLEMENTED: yahoo_process_mail"; lprint_newline ();
- ()
-
-let yahoo_process_contact pkt =
- lprintf "NOT IMPLEMENTED: yahoo_process_contact"; lprint_newline ();
- ()
-
-let yahoo_add_friend_in_group account group name =
- lprintf "group: [%s] [%s]" group name; lprint_newline ();
- let id =
- try
- Hashtbl.find account.account_friends name
- with _ ->
- let id = new_identity_val account in
- id.identity_login <- name;
- register_identity id;
- add_event (Account_friend_event (as_identity id));
- id
- in
- ()
-
-let yahoo_process_list account pkt =
- List.iter (fun (key, value) ->
- if key = 87 then
- List.iter (fun line ->
- let (group, names) = String2.cut_at line ':' in
- let names = String2.split_simplify names ',' in
- List.iter (fun name ->
- yahoo_add_friend_in_group account group name;
- ) names
- ) (String2.split_simplify value '\n')
- ) pkt.payload;
- ()
-
-let yahoo_reader account pkt sock =
- lprintf "Message from Yahoo"; lprint_newline ();
- match pkt.service with
- | YAHOO_SERVICE_AUTH ->
- let result6, result96 = yahoo_process_auth account
- (List.assoc 94 pkt.payload) in
- yahoo_send_message (get_sock account) (new_packet0
- YAHOO_SERVICE_AUTHRESP YAHOO_STATUS_AVAILABLE
- [
- 0, account.account_login;
- 6, result6;
- 96, result96;
- 1, account.account_login
- ])
- | YAHOO_SERVICE_LOGON
- | YAHOO_SERVICE_LOGOFF
- | YAHOO_SERVICE_ISAWAY
- | YAHOO_SERVICE_ISBACK
- | YAHOO_SERVICE_GAMELOGON
- | YAHOO_SERVICE_GAMELOGOFF ->
- yahoo_process_status account pkt
-
- | YAHOO_SERVICE_NOTIFY ->
- yahoo_process_notify pkt
-
- | YAHOO_SERVICE_MESSAGE
- | YAHOO_SERVICE_GAMEMSG ->
- yahoo_process_message account pkt
-
- | YAHOO_SERVICE_NEWMAIL ->
- yahoo_process_mail pkt
-
- | YAHOO_SERVICE_NEWCONTACT ->
- yahoo_process_contact pkt
-
- | YAHOO_SERVICE_LIST ->
- yahoo_process_list account pkt
-
- | _ ->
- lprintf "UNUSED MESSAGE"; lprint_newline ()
-
-let yahoo_login account =
- match account.account_sock with
- Some sock -> () (* already connected *)
- | None ->
- lprintf "connecting to yahoo %s" account.account_login; lprint_newline
();
- set_account_status (as_account account) Status_connecting;
- let ip = Ip.from_name yahoo_server in
-
- let sock = TcpBufferedSocket.connect "im to yahoo"
- (Ip.to_inet_addr ip)
- yahoo_port
- (yahoo_handler account) in
- account.account_sock <- Some sock;
- set_account_status (as_account account) Status_connecting;
- set_reader sock (cut_messages yahoo_parser (yahoo_reader account));
- yahoo_send_message sock (
- new_packet0 YAHOO_SERVICE_AUTH YAHOO_STATUS_AVAILABLE
- [
- 1, account.account_login
- ]);
- lprintf "connecting to yahoo %s" account.account_login; lprint_newline ()
-
-let yahoo_remove_buddy account who group =
- let pkt = {
- service = YAHOO_SERVICE_REMBUDDY;
- status = YAHOO_STATUS_AVAILABLE;
- id = Int32.zero;
- payload = [
- 1, account.account_login;
- 7, who;
- 65, group;
- ];
- } in
- yahoo_send_message (get_sock account) pkt
-
-(* We should try to find the group from "who" (gaim uses "Buddies"
-for default) *)
-let yahoo_add_buddy account who group =
- let pkt = {
- service = YAHOO_SERVICE_ADDBUDDY;
- status = YAHOO_STATUS_AVAILABLE;
- id = Int32.zero;
- payload = [
- 1, account.account_login;
- 7, who;
- 65, group;
- ];
- } in
- yahoo_send_message (get_sock account) pkt
-
-let yahoo_keepalive account =
- yahoo_send_message (get_sock account) (
- new_packet0 YAHOO_SERVICE_PING YAHOO_STATUS_AVAILABLE [])
-
-(* We should probably check our current status *)
-let yahoo_set_idle account idle =
- yahoo_send_message (get_sock account) (if idle then
- new_packet0 YAHOO_SERVICE_ISAWAY YAHOO_STATUS_IDLE []
- else
- new_packet0 YAHOO_SERVICE_ISAWAY YAHOO_STATUS_AVAILABLE []
- )
-
-let yahoo_send account who what =
- yahoo_send_message (get_sock account) (
- new_packet0 YAHOO_SERVICE_MESSAGE YAHOO_STATUS_OFFLINE
- [
- 1, account.account_login;
- 5, who;
- 14, what;
- ])
-
-
-(* Used to activate a given identifier ?? *)
-let yahoo_act_id account entry =
- yahoo_send_message (get_sock account) (
- new_packet0 YAHOO_SERVICE_IDACT YAHOO_STATUS_AVAILABLE
- [ 3, entry ])
-
-let yahoo_send_typing account who typ =
- yahoo_send_message (get_sock account) (
- new_packet0 YAHOO_SERVICE_NOTIFY YAHOO_STATUS_TYPING
- [
- 49, "TYPING";
- 1, account.account_login;
- 14, " ";
- 13, (if typ then "1" else "0");
- 5, who;
- 1002, "1"
- ])
-
-(*
-let protocol = {
- im_name = "Yahoo";
- im_login = yahoo_login;
- im_remove_buddy = yahoo_remove_buddy;
- im_add_buddy = yahoo_add_buddy;
- im_keepalive = yahoo_keepalive;
- im_set_idle = yahoo_set_idle;
- im_send = yahoo_send;
- }
-
- *)
-
-let _ =
- protocol_ops.op_protocol_account_from_option <- (fun p assocs ->
- let account = new_account_val () in
- from_record (account_record account) assocs;
- register_account account;
- if account.account_autologin then (try yahoo_login account with _ -> ());
- as_account account
- );
- account_ops.op_account_login <- (fun account ->
- (try yahoo_login account with _ -> ());
- );
- account_ops.op_account_to_option <- (fun account ->
- to_record (account_record account)
- );
- protocol_ops.op_protocol_new_account <- (fun p ->
- let account = new_account_val () in
- register_account account;
- as_account account);
- account_ops.op_account_keepalive <- yahoo_keepalive;
- account_ops.op_account_name <- (fun account -> account.account_login);
- account_ops.op_account_config_record <- (fun a -> account_record a);
- account_ops.op_account_new_identity <- (fun account ->
- let identity = new_identity_val account in
- register_identity identity;
- as_identity identity);
- identity_ops.op_identity_config_record <- (fun id -> identity_record id);
- account_ops.op_account_contacts <- (fun account ->
- List.map as_identity (Hashtbl2.to_list account.account_friends));
- identity_ops.op_identity_name <- (fun id -> id.identity_login);
- chat_ops.op_chat_send <- (fun chat msg ->
- List.iter (fun id ->
- yahoo_send chat.chat_account id.identity_login msg
- ) chat.chat_friends;
- add_event (Chat_my_message (as_chat chat, msg))
- );
- chat_ops.op_chat_name <- (fun chat ->
- let s = ref "" in
- List.iter (fun f ->
- s := f.identity_login ^ " " ^ !s
- ) chat.chat_friends;
- !s
- );
- identity_ops.op_identity_open_chat <- (fun id ->
- ignore (id_open_chat id));
- chat_ops.op_chat_close <- (fun chat ->
- add_event (Chat_close_event (as_chat chat));
- List.iter (fun id ->
- id.identity_chat <- None
- ) chat.chat_friends
- )
-
-
- (*
-(************************************************************************)
-
-(* Fake a server (useful when you have no network ;) ) *)
-
-(************************************************************************)
-
-type client = {
- nick : string;
- mutable friends : client list;
- mutable status : status;
- mutable sock : TcpBufferedSocket.t option;
- mutable friend_of : client list;
- }
-
-let clients = Hashtbl.create 13
-
-let new_client name =
- try
- Hashtbl.find clients name
- with _ ->
- let client = {
- nick = name;
- friends = [];
- status = Status_offline;
- sock = None;
- friend_of = [];
- } in
- Hashtbl.add clients name client;
- client
-
-let yahoo_client_reader c pkt sock =
- match pkt.service with
- | YAHOO_SERVICE_AUTH ->
- List.iter (fun (key, value) ->
- match key with
- | 1 ->
- let client = new_client value in
- client.sock <- Some sock;
- client.status <- Status_online Online_available;
- c := Some client;
-
- yahoo_send_message sock (
- new_packet0 YAHOO_SERVICE_LOGON YAHOO_STATUS_AVAILABLE
- [
- 1, value;
- ]);
-
- yahoo_send_message sock (
- new_packet0 YAHOO_SERVICE_LIST YAHOO_STATUS_AVAILABLE
- [
- 1, value;
- 87, (let s = ref "Buddies:" in
- List.iter (fun f ->
- s := !s ^ f.nick ^ ","
- ) client.friends;
- !s^"\n")
- ]);
-
- | _ -> ()
- ) pkt.payload
-
- | YAHOO_SERVICE_LOGON
- | YAHOO_SERVICE_LOGOFF
- | YAHOO_SERVICE_ISAWAY
- | YAHOO_SERVICE_ISBACK
- | YAHOO_SERVICE_GAMELOGON
- | YAHOO_SERVICE_GAMELOGOFF ->
- ()
-
- | YAHOO_SERVICE_NOTIFY ->
- yahoo_process_notify pkt
-
- | YAHOO_SERVICE_MESSAGE
- | YAHOO_SERVICE_GAMEMSG ->
- begin
- let sender = ref "" in
- let receiver = ref "" in
- let message = ref "" in
-
- List.iter (fun (key, value) ->
- match key with
- | 1 -> sender := value
- | 5 -> receiver := value
- | 14 -> message := value
- | _ -> ()
- ) pkt.payload;
-
- let client = new_client !receiver in
- match client.sock with
- None ->
-(* Should send a warning *) ()
- | Some sock ->
-
- yahoo_send_message sock (
- new_packet0 YAHOO_SERVICE_MESSAGE YAHOO_STATUS_OFFLINE
- [
- 4, !sender;
- 14, !message;
- ])
-
-
- end
-
- | YAHOO_SERVICE_NEWMAIL ->
- yahoo_process_mail pkt
-
- | YAHOO_SERVICE_NEWCONTACT ->
- yahoo_process_contact pkt
-
- | YAHOO_SERVICE_LIST ->
- ()
-
- | _ ->
- lprintf "UNUSED MESSAGE"; lprint_newline ()
-
-
-let notify_status client friend =
- ()
-
-let client_connection_handler t event =
- match event with
- TcpServerSocket.CONNECTION (s, Unix.ADDR_INET (from_ip, from_port)) ->
- lprintf "CONNECTION From Yahoo CLient !!!"; lprint_newline ();
- let c = ref None in
- let sock =
- TcpBufferedSocket.create "yahoo client connection" s
- (fun _ _ -> ())
- (*client_msg_to_string*)
- in
- set_reader sock (cut_messages yahoo_parser (yahoo_client_reader c));
- set_closer sock (fun _ _ ->
- match !c with
- None ->
- c := None;
- | Some client ->
- c := None;
- client.status <- Status_offline;
- client.sock <- None;
- List.iter (fun c ->
-(* Notify new state *)
- notify_status c client
- ) client.friend_of
- )
- | _ -> ()
-
-let add_friend c1 c2 =
- c1.friends <- c2 :: c1.friends;
- c2.friend_of <- c1 :: c2.friend_of;
- notify_status c1 c2
-
-let _ =
- try
- let _ = Sys.getenv "YAHOO_SERVER" in
- lprintf "STARTING YAHOO SERVER"; lprint_newline ();
- let sock = TcpServerSocket.create
- "yahoo client server" Unix.inet_addr_any
- 5050 client_connection_handler in
- lprintf "Server binded on port 5050"; lprint_newline ();
- ()
- with _ -> ()
-
-let _ =
-(* Initial state of server *)
- let b8_cro = new_client "b8_cro" in
- let b8_bavard = new_client "b8_bavard" in
- add_friend b8_cro b8_bavard;
- add_friend b8_bavard b8_cro;
- ()
- *)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Mldonkey-commits] mldonkey .cvsignore config/Makefile.in config/c...,
mldonkey-commits <=