1 ;; jabber-chatbuffer.el - functions common to all chat buffers
3 ;; Copyright (C) 2005, 2007, 2008 - Magnus Henoch - mange@freemail.hu
5 ;; This file is a part of jabber.el.
7 ;; This program is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2 of the License, or
10 ;; (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program; if not, write to the Free Software
19 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 (require 'jabber-keymap
)
23 (defvar jabber-point-insert nil
24 "Position where the message being composed starts")
26 (defvar jabber-send-function nil
27 "Function for sending a message from a chat buffer.")
29 (defvar jabber-chat-mode-hook nil
30 "Hook called at the end of `jabber-chat-mode'.
31 Note that functions in this hook have no way of knowing
32 what kind of chat buffer is being created.")
34 (defcustom jabber-chat-fill-long-lines t
35 "If non-nil, fill long lines in chat buffers.
36 Lines are broken at word boundaries at the width of the
37 window or at `fill-column', whichever is shorter."
41 (defvar jabber-chat-ewoc nil
42 "The ewoc showing the messages of this chat buffer.")
45 (defvar jabber-buffer-connection nil
46 "The connection used by this buffer.")
48 (make-variable-buffer-local 'jabber-buffer-connection
)
50 (defun jabber-chat-mode (jc ewoc-pp
)
51 "\\{jabber-chat-mode-map}"
52 (kill-all-local-variables)
53 ;; Make sure to set this variable somewhere
54 (make-local-variable 'jabber-send-function
)
56 (setq jabber-buffer-connection jc
)
58 (make-local-variable 'scroll-conservatively
)
59 (setq scroll-conservatively
5)
61 (make-local-variable 'jabber-point-insert
)
62 (make-local-variable 'jabber-chat-ewoc
)
63 (unless jabber-chat-ewoc
64 (setq jabber-chat-ewoc
65 (ewoc-create ewoc-pp nil
"---"))
66 (goto-char (point-max))
67 (put-text-property (point-min) (point) 'read-only t
)
68 (let ((inhibit-read-only t
))
69 (put-text-property (point-min) (point) 'front-sticky t
)
70 (put-text-property (point-min) (point) 'rear-nonsticky t
))
71 (setq jabber-point-insert
(point-marker)))
73 ;;(setq header-line-format jabber-chat-header-line-format)
75 (setq major-mode
'jabber-chat-mode
76 mode-name
"jabber-chat")
77 (use-local-map jabber-chat-mode-map
)
79 (if (fboundp 'run-mode-hooks
)
80 (run-mode-hooks 'jabber-chat-mode-hook
)
81 (run-hooks 'jabber-chat-mode-hook
)))
83 (put 'jabber-chat-mode
'mode-class
'special
)
85 ;; Spell check only what you're currently writing
86 (defun jabber-chat-mode-flyspell-verify ()
87 (>= (point) jabber-point-insert
))
88 (put 'jabber-chat-mode
'flyspell-mode-predicate
89 'jabber-chat-mode-flyspell-verify
)
91 (defvar jabber-chat-mode-map
92 (let ((map (make-sparse-keymap)))
93 (set-keymap-parent map jabber-common-keymap
)
94 (define-key map
"\r" 'jabber-chat-buffer-send
)
97 (defun jabber-chat-buffer-send ()
99 ;; If user accidentally hits RET without writing anything, just
101 (when (plusp (- (point-max) jabber-point-insert
))
102 ;; If connection was lost...
103 (unless (memq jabber-buffer-connection jabber-connections
)
104 ;; ...maybe there is a new connection to the same account.
105 (let ((new-jc (jabber-find-active-connection jabber-buffer-connection
)))
107 ;; If so, just use it.
108 (setq jabber-buffer-connection new-jc
)
109 ;; Otherwise, ask for a new account.
110 (setq jabber-buffer-connection
(jabber-read-account t
)))))
112 (let ((body (delete-and-extract-region jabber-point-insert
(point-max))))
113 (funcall jabber-send-function jabber-buffer-connection body
))))
115 (defun jabber-chat-buffer-fill-long-lines ()
116 "Fill lines that are wider than the window width."
117 ;; This was mostly stolen from article-fill-long-lines
120 (let ((inhibit-read-only t
)
121 (width (window-width (get-buffer-window (current-buffer)))))
123 (goto-char (point-min))
124 (let ((adaptive-fill-mode nil
)) ;Why? -sm
127 (when (>= (current-column) (min fill-column width
))
128 (narrow-to-region (min (1+ (point)) (point-max))
130 (let ((goback (point-marker)))
132 (goto-char (marker-position goback
)))
134 (forward-line 1)))))))
136 (provide 'jabber-chatbuffer
)
137 ;; arch-tag: 917e5b60-5894-4c49-b3bc-12e1f97ffdc6