]>
Commit | Line | Data |
---|---|---|
1 | ;; jabber-chatbuffer.el - functions common to all chat buffers -*- lexical-binding: t; -*- | |
2 | ||
3 | ;; Copyright (C) 2005, 2007, 2008 - Magnus Henoch - mange@freemail.hu | |
4 | ||
5 | ;; This file is a part of jabber.el. | |
6 | ||
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. | |
11 | ||
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. | |
16 | ||
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 | |
20 | ||
21 | (require 'jabber-keymap) | |
22 | ||
23 | (defvar jabber-point-insert nil | |
24 | "Position where the message being composed starts.") | |
25 | ||
26 | (defvar jabber-send-function nil | |
27 | "Function for sending a message from a chat buffer.") | |
28 | ||
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.") | |
33 | ||
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." | |
38 | :group 'jabber-chat | |
39 | :type 'boolean) | |
40 | ||
41 | (defvar jabber-chat-ewoc nil | |
42 | "The ewoc showing the messages of this chat buffer.") | |
43 | ||
44 | ;;;###autoload | |
45 | (defvar jabber-buffer-connection nil | |
46 | "The connection used by this buffer.") | |
47 | ;;;###autoload | |
48 | (make-variable-buffer-local 'jabber-buffer-connection) | |
49 | ||
50 | (defun jabber-chat-mode (jc ewoc-pp) | |
51 | "Jabber chat mode. | |
52 | \\{jabber-chat-mode-map} | |
53 | ||
54 | JC is the Jabber connection." | |
55 | (kill-all-local-variables) | |
56 | ;; Make sure to set this variable somewhere | |
57 | (make-local-variable 'jabber-send-function) | |
58 | (make-local-variable 'scroll-conservatively) | |
59 | (make-local-variable 'jabber-point-insert) | |
60 | (make-local-variable 'jabber-chat-ewoc) | |
61 | (make-local-variable 'buffer-undo-list) | |
62 | ||
63 | (setq jabber-buffer-connection jc | |
64 | scroll-conservatively 5 | |
65 | buffer-undo-list t) ;dont keep undo list for chatbuffer | |
66 | ||
67 | (unless jabber-chat-ewoc | |
68 | (setq jabber-chat-ewoc | |
69 | (ewoc-create ewoc-pp nil "---")) | |
70 | (goto-char (point-max)) | |
71 | (put-text-property (point-min) (point) 'read-only t) | |
72 | (let ((inhibit-read-only t)) | |
73 | (put-text-property (point-min) (point) 'front-sticky t) | |
74 | (put-text-property (point-min) (point) 'rear-nonsticky t)) | |
75 | (setq jabber-point-insert (point-marker))) | |
76 | ||
77 | ;;(setq header-line-format jabber-chat-header-line-format) | |
78 | ||
79 | (setq major-mode 'jabber-chat-mode | |
80 | mode-name "jabber-chat") | |
81 | (use-local-map jabber-chat-mode-map) | |
82 | ||
83 | (if (fboundp 'run-mode-hooks) | |
84 | (run-mode-hooks 'jabber-chat-mode-hook) | |
85 | (run-hooks 'jabber-chat-mode-hook))) | |
86 | ||
87 | (put 'jabber-chat-mode 'mode-class 'special) | |
88 | ||
89 | ;; Spell check only what you're currently writing | |
90 | (defun jabber-chat-mode-flyspell-verify () | |
91 | (>= (point) jabber-point-insert)) | |
92 | (put 'jabber-chat-mode 'flyspell-mode-predicate | |
93 | 'jabber-chat-mode-flyspell-verify) | |
94 | ||
95 | (defvar jabber-chat-mode-map | |
96 | (let ((map (make-sparse-keymap))) | |
97 | (set-keymap-parent map jabber-common-keymap) | |
98 | (define-key map "\r" 'jabber-chat-buffer-send) | |
99 | map)) | |
100 | ||
101 | (defun jabber-chat-buffer-send () | |
102 | (interactive) | |
103 | ;; If user accidentally hits RET without writing anything, just | |
104 | ;; ignore it. | |
105 | (when (cl-plusp (- (point-max) jabber-point-insert)) | |
106 | ;; If connection was lost... | |
107 | (unless (memq jabber-buffer-connection jabber-connections) | |
108 | ;; ...maybe there is a new connection to the same account. | |
109 | (let ((new-jc (jabber-find-active-connection jabber-buffer-connection))) | |
110 | (if new-jc | |
111 | ;; If so, just use it. | |
112 | (setq jabber-buffer-connection new-jc) | |
113 | ;; Otherwise, ask for a new account. | |
114 | (setq jabber-buffer-connection (jabber-read-account t))))) | |
115 | ||
116 | (let ((body (delete-and-extract-region jabber-point-insert (point-max)))) | |
117 | (funcall jabber-send-function jabber-buffer-connection body)))) | |
118 | ||
119 | (defun jabber-chat-buffer-fill-long-lines () | |
120 | "Fill lines that are wider than the window width." | |
121 | ;; This was mostly stolen from article-fill-long-lines | |
122 | (interactive) | |
123 | (save-excursion | |
124 | (let ((inhibit-read-only t) | |
125 | (width (window-width (get-buffer-window (current-buffer))))) | |
126 | (goto-char (point-min)) | |
127 | (let ((adaptive-fill-mode nil)) ;Why? -sm | |
128 | (while (not (eobp)) | |
129 | (end-of-line) | |
130 | (when (>= (current-column) (min fill-column width)) | |
131 | (save-restriction | |
132 | (narrow-to-region (min (1+ (point)) (point-max)) | |
133 | (point-at-bol)) | |
134 | (let ((goback (point-marker))) | |
135 | (fill-paragraph nil) | |
136 | (goto-char (marker-position goback))))) | |
137 | (forward-line 1)))))) | |
138 | ||
139 | (provide 'jabber-chatbuffer) | |
140 | ;; arch-tag: 917e5b60-5894-4c49-b3bc-12e1f97ffdc6 |