1 ;;; liece-misc.el --- Miscellaneous routines.
2 ;; Copyright (C) 1998-2000 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;; Keywords: IRC, liece
9 ;; This file is part of Liece.
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
36 (require 'liece-inlines)
37 (require 'liece-coding))
40 (autoload '_ "liece-intl" nil nil 'macro))
42 (defun liece-toggle-command-buffer-mode (&optional mode)
43 "Toggle command buffer MODE."
46 (if (eq liece-command-buffer-mode 'chat)
49 (hide (get 'liece-nick-buffer-mode 'hide)))
52 (put 'liece-nick-buffer-mode 'hide t)
53 (setq liece-private-indicator "P"))
55 (put 'liece-nick-buffer-mode 'hide nil)
56 (setq liece-private-indicator "-")))
57 (and (not (eq liece-command-buffer-mode mode))
58 (not (eq hide (get 'liece-nick-buffer-mode 'hide)))
59 liece-nick-window-auto-hide
60 (liece-configure-windows))
61 (setq liece-command-buffer-mode mode)
62 liece-command-buffer-mode))
64 (defsubst liece-set-frame-title-format ()
65 "Inline function for modifying `frame-title-format'."
66 (let ((frame-indicator liece-channel-indicator))
67 (when (eq liece-command-buffer-mode 'channel)
68 (if liece-display-status-on-channel-indicator
69 (setq frame-indicator liece-channel-indicator)
72 liece-channel-indicator
73 (or (and liece-current-channel
74 (liece-channel-get-topic))
76 (or (and liece-current-channel
77 (liece-channel-get-modes))
79 (setq liece-channel-status-indicator frame-indicator)))
81 (defsubst liece-set-channel-indicator ()
82 "Inline-function for modifying `liece-channel-indicator'."
83 (if (eq liece-command-buffer-mode 'chat)
84 (setq liece-channel-indicator
85 (if liece-current-chat-partner
86 (format (_ "Chatting with %s")
87 liece-current-chat-partner)
89 (setq liece-channel-indicator
90 (if liece-current-channel
91 (concat liece-current-channel
92 (if liece-display-status-on-channel-indicator
94 (or (and liece-current-channel
95 (liece-channel-get-topic))
97 (or (and liece-current-channel
98 (liece-channel-get-modes))
102 (with-current-buffer liece-command-buffer
103 (force-mode-line-update))
104 (if liece-display-frame-title
105 (liece-set-frame-title-format)))
107 (defun liece-set-beep (buffer &optional arg)
108 (with-current-buffer buffer
109 (setq liece-beep (if arg (plusp arg) (not liece-beep))
110 liece-beep-indicator (if liece-beep "B" "-"))
111 (force-mode-line-update)))
113 (defmacro liece-beep (&optional arg)
114 (list 'funcall 'liece-beep-function arg))
116 (defun liece-freeze (buffer &optional arg)
117 (with-current-buffer buffer
118 (setq liece-freeze (if arg (plusp arg) (not liece-freeze))
119 liece-freeze-indicator (if liece-freeze "F" "-"))
120 (force-mode-line-update)))
122 (defmacro liece-frozen (buffer)
123 (list 'with-current-buffer buffer 'liece-freeze))
125 (defun liece-own-freeze (buffer &optional arg)
126 (with-current-buffer buffer
127 (setq liece-own-freeze (if arg (plusp arg) (not liece-own-freeze))
128 liece-own-freeze-indicator (if liece-own-freeze "M" "-"))
129 (force-mode-line-update)))
131 (defmacro liece-own-frozen (buffer)
132 (list 'with-current-buffer buffer 'liece-own-freeze))
134 (defun liece-ignore-this-p (nick user-at-host)
135 ;; Remove entries which are expired.
136 (let ((time (current-time)) expire-time)
137 (dolist (kill liece-kill-nickname)
138 (setq expire-time (if (cdr kill)
139 (liece-time-difference time (cdr kill))
141 (when (< expire-time 0)
142 (if (zerop (cadddr kill))
143 (liece-insert-info liece-D-buffer
144 (format (_ "Ignore timeout for %s expired.\n")
146 (when (setq kill (string-assoc-ignore-case
147 (car kill) liece-kill-nickname))
148 (setq liece-kill-nickname (delq kill liece-kill-nickname)
149 liece-save-variables-are-dirty t)))))
150 ;; Search on `liece-kill-nickname' and return non-nil if matches.
151 (unless (run-hook-with-args-until-success
152 'liece-custom-ignore-this-p nick user-at-host)
153 (let ((case-fold-search t))
156 (or (liece-nick-equal (car kill) nick)
157 (string-match (concat "\\<" (car kill) "\\>") nick)
158 (and (string-match "@" (car kill))
159 (or (string-equal-ignore-case
160 (car kill) user-at-host)
161 (string-match (concat "^" (car kill) "$")
163 liece-kill-nickname))))
165 (defun liece-split-line (line)
167 ((eq ?: (aref line 0))
168 (list (substring line 1)))
172 (while (string-match "^\\([^ ]+\\) +" line)
173 (setq args (nconc args (list (match-string 1 line)))
174 line (substring line (match-end 0)))
175 (and (not (string= "" line)) (eq ?: (aref line 0))
176 (setq line (substring line 1))
178 (or (string= "" line)
179 (setq args (nconc args (list line))))
182 (defmacro liece-message (&rest message)
184 (product-name (product-find 'liece-version))
187 (defmacro liece-insert-change (buffer msg)
188 `(liece-insert ,buffer (concat liece-change-prefix ,msg)))
190 (defmacro liece-insert-notice (buffer msg)
191 `(liece-insert ,buffer (concat liece-notice-prefix ,msg)))
193 (defmacro liece-insert-broadcast (buffer msg)
194 `(liece-insert ,buffer (concat liece-broadcast-prefix ,msg)))
196 (defmacro liece-insert-wallops (buffer msg)
197 `(liece-insert ,buffer (concat liece-wallops-prefix ,msg)))
199 (defmacro liece-insert-error (buffer msg)
200 `(liece-insert ,buffer (concat liece-error-prefix ,msg)))
202 (defmacro liece-insert-info (buffer msg)
203 `(liece-insert ,buffer (concat liece-info-prefix ,msg)))
205 (defmacro liece-insert-timestamp (buffer msg)
206 `(liece-insert ,buffer (concat liece-timestamp-prefix ,msg)))
208 (defmacro liece-insert-dcc (buffer msg)
209 `(liece-insert ,buffer (concat liece-dcc-prefix ,msg)))
211 (defmacro liece-insert-client (buffer msg)
212 `(liece-insert ,buffer (concat liece-client-prefix ,msg)))
214 (defmacro liece-own-message (message)
215 `(if (eq liece-command-buffer-mode 'channel)
216 (liece-own-channel-message ,message)
217 (liece-own-channel-message ,message)))
219 (defmacro liece-own-channel-message (message &optional chnl)
220 `(let* ((chnl (or ,chnl (liece-current-channel)))
221 (liece-message-target chnl)
222 (liece-message-speaker (liece-current-nickname))
223 (liece-message-direction 'outgoing))
224 (liece-display-message ,message)))
226 (defmacro liece-own-private-message (message &optional partner)
227 `(let* ((partner (or ,partner liece-current-chat-partner))
228 (liece-message-target partner)
229 (liece-message-speaker (liece-current-nickname))
230 (liece-message-direction 'outgoing))
231 (liece-display-message ,message)))
233 (defmacro liece-convert-received-input (input)
234 "Convert input before it is processed"
235 `(let ((conv-list liece-receive-convert-list)
238 (while (and conv-list (not liece-polling))
239 (setq i (car conv-list)
242 s1 (if (stringp f) f (funcall f input))
243 s2 (if (stringp s) s (funcall s s1))
244 input (replace-in-string input s1 s2)
245 conv-list (cdr conv-list)))
248 (defun liece-send (&rest args)
249 "Send message to IRC server."
251 (let ((string (apply #'format args)) send-string len)
252 (dolist (convert liece-send-convert-list)
253 (setq string (apply #'replace-in-string string convert)))
254 (with-current-buffer liece-command-buffer
255 (setq send-string (liece-coding-encode-charset-string string)
256 send-string (if (string-match "\r$" send-string) send-string
257 (concat send-string "\r\n"))
258 len (length send-string)))
260 (process-send-string liece-server-process send-string)
261 (message "Protocol message too long (%d). Truncated." len)
262 (if liece-beep-on-bells (beep)))
263 (if (string-match "^list\\s-*" (setq string (downcase string)))
264 (setq liece-channel-filter (substring string (match-end 0))))))
266 (defmacro liece-send-pong ()
267 '(liece-send "PONG :%s" liece-tmp-server-name))
269 (defmacro liece-increment-long-reply-count ()
270 '(incf liece-long-reply-count))
272 (defmacro liece-reset-long-reply-count ()
273 '(setq liece-long-reply-count 0))
275 (defmacro liece-check-long-reply-count ()
276 '(when (> liece-long-reply-count liece-long-reply-max)
277 (liece-reset-long-reply-count)
280 (defmacro liece-server-host ()
281 '(if (listp liece-server)
282 (plist-get liece-server ':host)
283 (if (or (string-match "^\\[\\([^]]+\\)\\]:?[0-9]*" liece-server)
284 (string-match "^\\([^:]+\\):?[0-9]*" liece-server))
285 (match-string 1 liece-server)
288 (defmacro liece-clean-hostname (hostname)
289 "Return the arg HOSTNAME, but if is a dotted-quad, put brackets around it."
291 (if (string-match "[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+" ,hostname)
292 (concat "[" ,hostname "]")
295 (defun liece-current-nickname ()
296 "Return the current nickname."
299 (defun liece-current-channel ()
300 "Return the current channel."
301 liece-current-channel)
303 (defun liece-current-channels ()
304 "Return the current channels."
305 liece-current-channels)
307 (defun liece-current-chat-partner ()
308 "Return the current chat partner."
309 liece-current-chat-partner)
311 (defun liece-current-chat-partners ()
312 "Return the current chat partners."
313 liece-current-chat-partners)
315 (defmacro liece-scroll-if-visible (window)
316 `(if ,window (set-window-point ,window (point-max))))
318 (defmacro liece-pick-buffer-1 (chnl)
319 `(cdr (string-assoc-ignore-case ,chnl liece-channel-buffer-alist)))
321 (defun liece-pick-buffer (chnl)
324 (let ((buf (liece-pick-buffer-1 chnl)))
325 (if buf (list buf))))
326 ((and chnl (listp chnl))
327 (let ((buf (liece-pick-buffer-1 (car chnl))))
328 (if buf (cons buf (liece-pick-buffer (cdr chnl))))))
332 ;;; Date and time handling functions
333 (defun liece-compose-time-string (time)
334 (format-time-string "%A %B %e %Y %R" time))
336 (defun liece-convert-seconds (time)
337 "Convert seconds to printable string."
338 (let* ((seconds (string-to-int time))
339 (minutes (/ seconds 60))
340 (seconds (if minutes (% seconds 60) seconds))
341 (hours (/ minutes 60))
342 (minutes (if hours (% minutes 60) minutes))
344 (hours (if days (% hours 24) hours))
346 (format "%d day%s, " days
347 (if (> days 1) "s" ""))))
348 (hs (and (/= 0 hours)
349 (format "%d hour%s, " hours
350 (if (> hours 1) "s" ""))))
351 (ms (and (/= 0 minutes)
352 (format "%d minute%s " minutes
353 (if (> minutes 1) "s" ""))))
354 (ss (format "%d seconds" seconds)))
355 (concat ds hs ms (if seconds ss ""))))
357 (defmacro liece-insert-time-string ()
358 '(insert (substring (current-time-string) 11 16) " "))
360 (defvar liece-idle-point nil "Timestamp of last idle reset.")
362 (defmacro liece-reset-idle ()
363 "Reset idle counter and return last idle."
364 '(prog1 (liece-idle) (setq liece-idle-point (current-time))))
366 (defmacro liece-idle ()
367 "How long has liece been idle."
368 '(if liece-idle-point
369 (liece-time-difference liece-idle-point (current-time))
372 (defmacro liece-ping-if-idle (&optional limit)
373 `(if (<= (liece-idle) (or ,limit 120))
378 (defmacro liece-maybe-poll ()
379 '(liece-send "PING %s" (system-name)))
381 (defun liece-get-buffer-create (name)
382 "Get or create buffer, keep track on its NAME so we can kill it."
383 (let ((buffer (get-buffer-create name)))
384 (or (memq buffer liece-buffer-list)
385 (push buffer liece-buffer-list))
388 (defmacro liece-message-from-ignored (prefix rest)
390 (liece-insert liece-I-buffer (concat ,prefix "::" ,rest "\n"))
393 (defmacro liece-is-message-ignored (string buffer)
394 `(let (found (case-fold-search t) msg str msgstr who)
396 (when (member ,buffer liece-no-ignore-buffers)
398 (dolist (ignore-entry liece-ignore-list)
399 ;; Check message type
401 ((consp (car ignore-entry))
402 (setq msg (caar ignore-entry)
403 str (cdar ignore-entry)))
404 ((fboundp (car ignore-entry))
405 (setq msgstr (apply (car ignore-entry) (list ,string))
410 (_ "Malformed ignore-list, no msg+str function."))))
411 ;; Check message from whom
413 ((listp (cadr ignore-entry))
414 (setq who (cadr ignore-entry)))
415 ((fboundp (cadr ignore-entry))
416 (setq who (apply (cadr ignore-entry) (list ,string))))
417 ((not (cadr ignore-entry))
419 (_ "Malformed ignore-list, no user function."))))
422 (when (and (or msg str)
425 msg (cadr liece-current-function)))
426 (and str (string-match str ,string)))
428 (when (string-match (car who) (car liece-current-function))
431 (setq who (cdr who)))))))
434 ;;; stolen (and renamed) from time-date.el.
435 (defun liece-subtract-time (t1 t2)
436 "Subtract two internal times."
437 (let ((borrow (< (cadr t1) (cadr t2))))
438 (list (- (car t1) (car t2) (if borrow 1 0))
439 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
441 (defun liece-time-difference (t1 t2)
442 "Return the differnce between two internal times in seconds."
443 (let ((sub (liece-subtract-time t1 t2)))
444 (+ (* (car sub) 65536) (cadr sub))))
446 (defun liece-time-elapsed (time seconds)
447 "Add SECONDS to TIME."
448 (list (+ (car time) (/ (+ (cadr time) seconds) 65536))
449 (% (+ (cadr time) seconds) 65536)
452 ;;; stolen (and renamed) from time-date.el.
453 (defun liece-seconds-to-time (seconds)
454 "Convert SECONDS (a floating point number) to an Emacs time structure."
455 (list (floor seconds 65536)
456 (floor (mod seconds 65536))
457 (floor (* (- seconds (ffloor seconds)) 1000000))))
459 (defun liece-generate-hex-timestamp (&optional time)
460 "Generate timestamp string as hexadecimal.
461 If optional argument TIME is nil, calculate timestamp using current time."
463 (setq time (current-time)))
464 (format "%04x%04x" (car time) (cadr time)))
466 (defmacro liece-hex-timestamp-valid (timestamp limit)
467 "Is TIMESTAMP valid within LIMIT?"
468 `(let (t1 t2 diff (timestamp ,timestamp))
469 (if (not (and (stringp timestamp)
471 "^[0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f]$" timestamp)))
473 (setq t1 (liece-hex-string-to-integer (substring timestamp 0 4))
474 t2 (liece-hex-string-to-integer (substring timestamp 4 8))
475 diff (liece-time-difference
476 (list t1 t2 0) (current-time)))
478 (and (< diff ,limit) (> diff (- 0 ,limit)))))))
480 (defmacro liece-hex-char-to-integer (character)
481 "Convert single hex digit CHARACTER to integer."
482 `(if (and (>= ,character ?0) (<= ,character ?9))
484 (let ((ch (logior ,character 32)))
485 (if (and (>= ch ?a) (<= ch ?f))
487 (error "Invalid hex digit `%c'" ch)))))
489 (defmacro liece-hex-string-to-integer (hex-string)
490 "Convert a HEX-STRING like ffff to the decimal integer."
491 `(let ((hex-string ,hex-string) (hex-num 0))
492 (while (not (equal hex-string ""))
493 (setq hex-num (+ (* hex-num 16)
494 (liece-hex-char-to-integer
495 (string-to-char hex-string))))
496 (setq hex-string (substring hex-string 1)))
499 (defmacro liece-remove-properties-region (start end)
500 (unless (fboundp 'make-extent)
503 (narrow-to-region ,start ,end)
504 (goto-char (point-min))
506 (while (setq start (next-single-property-change
508 (when (invisible-p start)
509 (delete-region start (next-visible-point start))
511 (remove-text-properties (point-min)(point-max) '(face))))))))
513 (provide 'liece-misc)
515 ;;; liece-misc.el ends here