1 ;; jabber-history.el - recording message history
3 ;; Copyright (C) 2004, 2007, 2008 - Magnus Henoch - mange@freemail.hu
4 ;; Copyright (C) 2004 - Mathias Dahl
6 ;; This file is a part of jabber.el.
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2 of the License, or
11 ;; (at your option) any later version.
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this program; if not, write to the Free Software
20 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23 ;; Each message is on one separate line, represented as a vector with
24 ;; five elements. The first element is time encoded according to
25 ;; JEP-0082. The second element is direction, "in" or "out".
26 ;; The third element is the sender, "me" or a JID. The fourth
27 ;; element is the recipient. The fifth element is the text
30 ;; FIXME: when rotation is enabled, jabber-history-query won't look
31 ;; for older history files if the current history file doesn't contain
32 ;; enough backlog entries.
34 (require 'jabber-core
)
35 (require 'jabber-util
)
36 (require 'jabber-autoloads
)
38 (defgroup jabber-history nil
"Customization options for Emacs
39 Jabber history files."
42 (defcustom jabber-history-enabled nil
43 "Non-nil means message logging is enabled."
45 :group
'jabber-history
)
47 (defcustom jabber-use-global-history t
48 "Indicate whether Emacs Jabber should use a global file for
49 store messages. If non-nil, jabber-global-history-filename is
50 used, otherwise, messages are stored in per-user files under
51 the jabber-history-dir directory."
53 :group
'jabber-history
)
55 (defcustom jabber-history-dir
"~/.emacs-jabber"
56 "Base directory where per-contact history files are stored.
57 Used only when jabber-use-global-history is not true."
59 :group
'jabber-history
)
61 (defcustom jabber-global-history-filename
"~/.jabber_global_message_log"
62 "Global file where all messages are logged. Used when
63 jabber-use-global-history is non-nil."
65 :group
'jabber-history
)
67 (defcustom jabber-history-enable-rotation nil
68 "Whether history files should be renamed when reach
69 jabber-history-size-limit kilobytes. If nil, history files
70 will grow indefinitely, otherwise they'll be renamed to
71 <history-file>-<number>, where <number> is 1 or the smallest
72 number after the last rotation."
74 :group
'jabber-history
)
76 (defcustom jabber-history-size-limit
1024
77 "Maximum history file size in kilobytes. When history file
78 reaches this limit, it is renamed to <history-file>-<number>,
79 where <number> is 1 or the smallest number after the last
82 :group
'jabber-history
)
85 (defun jabber-rotate-history-p (history-file)
86 "Return true if HISTORY-FILE should be rotated."
87 (when (and jabber-history-enable-rotation
88 (file-exists-p history-file
))
89 (> (/ (nth 7 (file-attributes history-file
)) 1024)
90 jabber-history-size-limit
)))
92 (defun jabber-history-rotate (history-file &optional try
)
93 "Rename HISTORY-FILE to HISTORY-FILE-TRY."
94 (let ((suffix (number-to-string (or try
1))))
95 (if (file-exists-p (concat history-file
"-" suffix
))
96 (jabber-history-rotate history-file
(if try
(1+ try
) 1))
97 (rename-file history-file
(concat history-file
"-" suffix
)))))
99 (add-to-list 'jabber-message-chain
'jabber-message-history
)
100 (defun jabber-message-history (jc xml-data
)
101 "Log message to log file."
102 (when (and (not jabber-use-global-history
)
103 (not (file-directory-p jabber-history-dir
)))
104 (make-directory jabber-history-dir
))
105 (if (and jabber-history-enabled
(not (jabber-muc-message-p xml-data
)))
106 (let ((from (jabber-xml-get-attribute xml-data
'from
))
107 (text (car (jabber-xml-node-children
108 (car (jabber-xml-get-children xml-data
'body
)))))
109 (timestamp (car (delq nil
(mapcar 'jabber-x-delay
(jabber-xml-get-children xml-data
'x
))))))
110 (when (and from text
)
111 (jabber-history-log-message "in" from nil text timestamp
)))))
113 (add-hook 'jabber-chat-send-hooks
'jabber-history-send-hook
)
115 (defun jabber-history-send-hook (body id
)
116 "Log outgoing message to log file."
117 (when (and (not jabber-use-global-history
)
118 (not (file-directory-p jabber-history-dir
)))
119 (make-directory jabber-history-dir
))
120 ;; This function is called from a chat buffer, so jabber-chatting-with
121 ;; contains the desired value.
122 (if jabber-history-enabled
123 (jabber-history-log-message "out" nil jabber-chatting-with body
(current-time))))
125 (defun jabber-history-filename (contact)
126 "Return a history filename for CONTACT if the per-user file
127 loggin strategy is used or the global history filename."
128 (if jabber-use-global-history
129 jabber-global-history-filename
130 ;; jabber-jid-symbol is the best canonicalization we have.
131 (concat jabber-history-dir
132 "/" (symbol-name (jabber-jid-symbol contact
)))))
134 (defun jabber-history-log-message (direction from to body timestamp
)
138 (set-text-properties 0 (length body
) nil body
)
139 ;; Encode text as Lisp string - get decoding for free
140 (setq body
(prin1-to-string body
))
142 (while (string-match "\n" body
)
143 (setq body
(replace-match "\\n" nil t body nil
)))
144 (while (string-match "\r" body
)
145 (setq body
(replace-match "\\r" nil t body nil
)))
146 (insert (format "[\"%s\" \"%s\" %s %s %s]\n"
147 (jabber-encode-time (or timestamp
(current-time)))
151 (prin1-to-string from
))
154 (prin1-to-string to
))
157 (let ((coding-system-for-write 'utf-8
)
158 (history-file (jabber-history-filename (or from to
))))
159 (when (and (not jabber-use-global-history
)
160 (not (file-directory-p jabber-history-dir
)))
161 (make-directory jabber-history-dir
))
162 (when (jabber-rotate-history-p history-file
)
163 (jabber-history-rotate history-file
))
165 (write-region (point-min) (point-max) history-file t
'quiet
)
167 (message "Unable to write history: %s" (error-message-string e
)))))))
169 (defun jabber-history-query (start-time
175 "Return a list of vectors, one for each message matching the criteria.
176 START-TIME and END-TIME are floats as obtained from `float-time'.
177 Either or both may be nil, meaning no restriction.
178 NUMBER is the maximum number of messages to return, or t for
180 DIRECTION is either \"in\" or \"out\", or t for no limit on direction.
181 JID-REGEXP is a regexp which must match the JID.
182 HISTORY-FILE is the file in which to search.
184 Currently jabber-history-query performs a linear search from the end
186 (when (file-readable-p history-file
)
188 (let ((coding-system-for-read 'utf-8
))
189 (if jabber-use-global-history
190 (insert-file-contents history-file
)
191 (let* ((lines-collected nil
)
192 (matched-files (directory-files jabber-history-dir t
(file-name-nondirectory history-file
)))
193 (matched-files (cons (car matched-files
) (sort (cdr matched-files
) 'string
>-numerical
))))
194 (while (not lines-collected
)
195 (if (null matched-files
)
196 (setq lines-collected t
)
197 (let ((file (pop matched-files
)))
199 (insert-file-contents file
)
200 (if (>= (count-lines (point-min) (point-max)) number
)
201 (setq lines-collected t
)))))))))
202 (let (collected current-line
)
203 (goto-char (point-max))
204 (catch 'beginning-of-file
207 (setq current-line
(car (read-from-string
213 (and (or (null start-time
)
214 (> (jabber-float-time (jabber-parse-time
215 (aref current-line
0)))
218 (< (length collected
) number
))))
219 (if (and (or (eq direction t
)
220 (string= direction
(aref current-line
1)))
222 (> end-time
(jabber-float-time (jabber-parse-time
223 (aref current-line
0)))))
228 (list (aref current-line
2)
229 (aref current-line
3))))))
230 (push current-line collected
))
232 (throw 'beginning-of-file nil
))))
235 (defcustom jabber-backlog-days
3.0
236 "Age limit on messages in chat buffer backlog, in days"
238 :type
'(choice (number :tag
"Number of days")
239 (const :tag
"No limit" nil
)))
241 (defcustom jabber-backlog-number
10
242 "Maximum number of messages in chat buffer backlog"
246 (defun jabber-history-backlog (jid &optional before
)
247 "Fetch context from previous chats with JID.
248 Return a list of history entries (vectors), limited by
249 `jabber-backlog-days' and `jabber-backlog-number'.
250 If BEFORE is non-nil, it should be a float-time after which
251 no entries will be fetched. `jabber-backlog-days' still
253 (jabber-history-query
254 (and jabber-backlog-days
255 (- (jabber-float-time) (* jabber-backlog-days
86400.0)))
257 jabber-backlog-number
258 t
; both incoming and outgoing
259 (concat "^" (regexp-quote (jabber-jid-user jid
)) "\\(/.*\\)?$")
260 (jabber-history-filename jid
)))
262 (defun jabber-history-move-to-per-user ()
263 "Migrate global history to per-user files."
265 (when (file-directory-p jabber-history-dir
)
266 (error "Per-user history directory already exists"))
267 (make-directory jabber-history-dir
)
268 (let ((jabber-use-global-history nil
))
270 (let ((coding-system-for-read 'utf-8
))
271 (insert-file-contents jabber-global-history-filename
))
272 (let ((progress-reporter
273 (when (fboundp 'make-progress-reporter
)
274 (make-progress-reporter "Migrating history..."
275 (point-min) (point-max))))
276 ;;(file-table (make-hash-table :test 'equal))
277 ;; Keep track of blocks of entries pertaining to the same JID.
278 current-jid jid-start
)
280 (let* ((start (point))
281 (end (progn (forward-line) (point)))
282 (line (buffer-substring start end
))
283 (parsed (car (read-from-string line
)))
284 (jid (if (string= (aref parsed
2) "me")
287 ;; Whenever there is a change in JID...
288 (when (not (equal jid current-jid
))
290 ;; ...save data for previous JID...
291 (let ((history-file (jabber-history-filename current-jid
)))
292 (write-region jid-start start history-file t
'quiet
)))
293 ;; ...and switch to new JID.
294 (setq current-jid jid
)
295 (setq jid-start start
))
296 (when (fboundp 'progress-reporter-update
)
297 (progress-reporter-update progress-reporter
(point)))))
298 ;; Finally, save the last block, if any.
300 (let ((history-file (jabber-history-filename current-jid
)))
301 (write-region jid-start
(point-max) history-file t
'quiet
))))))
302 (message "Done. Please change `jabber-use-global-history' now."))
304 (provide 'jabber-history
)
306 ;; arch-tag: 0AA0C235-3FC0-11D9-9FE7-000A95C2FCD0