;;; liece-misc.el --- Miscellaneous routines.
;; Copyright (C) 1998-2000 Daiki Ueno

;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1998-09-28
;; Revised: 1998-11-25
;; Keywords: IRC, liece

;; This file is part of Liece.

;; This program 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, or (at your option)
;; any later version.

;; This program 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.


;;; Commentary:
;; 

;;; Code:

(eval-and-compile
  (require 'broken)
  (require 'pccl)
  (require 'invisible)
  (require 'liece-inlines)
  (require 'liece-coding))

(eval-when-compile
  (autoload '_ "liece-intl" nil nil 'macro))

(defun liece-toggle-command-buffer-mode (&optional mode)
  "Toggle command buffer MODE."
  (let ((mode
	 (or mode
	     (if (eq liece-command-buffer-mode 'chat)
		 'channel
	       'chat)))
	(hide (get 'liece-nick-buffer-mode 'hide)))
    (cond
     ((eq mode 'chat)
      (put 'liece-nick-buffer-mode 'hide t)
      (setq liece-private-indicator "P"))
     (t
      (put 'liece-nick-buffer-mode 'hide nil)
      (setq liece-private-indicator "-")))
    (and (not (eq liece-command-buffer-mode mode))
	 (not (eq hide (get 'liece-nick-buffer-mode 'hide)))
	 liece-nick-window-auto-hide
	 (liece-configure-windows))
    (setq liece-command-buffer-mode mode)
    liece-command-buffer-mode))

(defsubst liece-set-frame-title-format ()
  "Inline function for modifying `frame-title-format'."
  (let ((frame-indicator liece-channel-indicator))
    (when (eq liece-command-buffer-mode 'channel)
      (if liece-display-status-on-channel-indicator
	  (setq frame-indicator liece-channel-indicator)
	(setq frame-indicator
	      (format "%s: %s [%s]"
		      liece-channel-indicator
		      (or (and liece-current-channel
			       (liece-channel-get-topic))
			  "")
		      (or (and liece-current-channel
			       (liece-channel-get-modes))
			  "")))))
    (setq liece-channel-status-indicator frame-indicator)))

(defsubst liece-set-channel-indicator ()
  "Inline-function for modifying `liece-channel-indicator'."
  (if (eq liece-command-buffer-mode 'chat)
      (setq liece-channel-indicator
	    (if liece-current-chat-partner
		(format (_ "Chatting with %s")
			liece-current-chat-partner)
	      (_ "No partner")))
    (setq liece-channel-indicator
	  (if liece-current-channel
	      (concat liece-current-channel
		      (if liece-display-status-on-channel-indicator
			  (format ": %s [%s]"
				  (or (and liece-current-channel
					   (liece-channel-get-topic))
				      "")
				  (or (and liece-current-channel
					   (liece-channel-get-modes))
				      ""))
			""))
	    (_ "No channel"))))
  (with-current-buffer liece-command-buffer
    (force-mode-line-update))
  (if liece-display-frame-title
      (liece-set-frame-title-format)))

(defun liece-set-beep (buffer &optional arg)
  (with-current-buffer buffer
    (setq liece-beep (if arg (plusp arg) (not liece-beep))
          liece-beep-indicator (if liece-beep "B" "-"))
    (force-mode-line-update)))

(defmacro liece-beep (&optional arg)
  (list 'funcall 'liece-beep-function arg))

(defun liece-freeze (buffer &optional arg)
  (with-current-buffer buffer
    (setq liece-freeze (if arg (plusp arg) (not liece-freeze))
	  liece-freeze-indicator (if liece-freeze "F" "-"))
    (force-mode-line-update)))

(defmacro liece-frozen (buffer)
  (list 'with-current-buffer buffer 'liece-freeze))

(defun liece-own-freeze (buffer &optional arg)
  (with-current-buffer buffer
    (setq liece-own-freeze (if arg (plusp arg) (not liece-own-freeze))
	  liece-own-freeze-indicator (if liece-own-freeze "M" "-"))
    (force-mode-line-update)))

(defmacro liece-own-frozen (buffer)
  (list 'with-current-buffer buffer 'liece-own-freeze))

(defun liece-ignore-this-p (nick user-at-host)
  ;; Remove entries which are expired.
  (let ((time (current-time)) expire-time)
    (dolist (kill liece-kill-nickname)
      (setq expire-time (if (cdr kill)
			    (liece-time-difference time (cdr kill))
			  1))
      (when (< expire-time 0)
	(if (zerop (cadddr kill))
	    (liece-insert-info liece-D-buffer
			       (format (_ "Ignore timeout for %s expired.\n")
				       (car kill))))
	(when (setq kill (string-assoc-ignore-case
			  (car kill) liece-kill-nickname))
	  (setq liece-kill-nickname (delq kill liece-kill-nickname)
		liece-save-variables-are-dirty t)))))
  ;; Search on `liece-kill-nickname' and return non-nil if matches.
  (unless (run-hook-with-args-until-success
	   'liece-custom-ignore-this-p nick user-at-host)
    (let ((case-fold-search t))
      (member-if
       (lambda (kill)
	 (or (liece-nick-equal (car kill) nick)
	     (string-match (concat "\\<" (car kill) "\\>") nick)
	     (and (string-match "@" (car kill))
		  (or (string-equal-ignore-case
		       (car kill) user-at-host)
		      (string-match (concat "^" (car kill) "$")
				    user-at-host)))))
       liece-kill-nickname))))

(defun liece-split-line (line)
  (cond
   ((eq ?: (aref line 0))
    (list (substring line 1)))
   (t
    (let (args)
      (catch 'done
	(while (string-match "^\\([^ ]+\\) +" line)
	  (setq args (nconc args (list (match-string 1 line)))
		line (substring line (match-end 0)))
	  (and (not (string= "" line)) (eq ?: (aref line 0))
	       (setq line (substring line 1))
	       (throw 'done nil))))
      (or (string= "" line)
	  (setq args (nconc args (list line))))
      args))))

(defmacro liece-message (&rest message)
  `(message "%s: %s"
	    (product-name (product-find 'liece-version))
	    (format ,@message)))

(defmacro liece-insert-change (buffer msg)
  `(liece-insert ,buffer (concat liece-change-prefix ,msg)))

(defmacro liece-insert-notice (buffer msg)
  `(liece-insert ,buffer (concat liece-notice-prefix ,msg)))

(defmacro liece-insert-broadcast (buffer msg)
  `(liece-insert ,buffer (concat liece-broadcast-prefix ,msg)))

(defmacro liece-insert-wallops (buffer msg)
  `(liece-insert ,buffer (concat liece-wallops-prefix ,msg)))

(defmacro liece-insert-error (buffer msg)
  `(liece-insert ,buffer (concat liece-error-prefix ,msg)))

(defmacro liece-insert-info (buffer msg)
  `(liece-insert ,buffer (concat liece-info-prefix ,msg)))

(defmacro liece-insert-timestamp (buffer msg)
  `(liece-insert ,buffer (concat liece-timestamp-prefix ,msg)))

(defmacro liece-insert-dcc (buffer msg)
  `(liece-insert ,buffer (concat liece-dcc-prefix ,msg)))

(defmacro liece-insert-client (buffer msg)
  `(liece-insert ,buffer (concat liece-client-prefix ,msg)))

(defmacro liece-own-message (message)
  `(if (eq liece-command-buffer-mode 'channel)
       (liece-own-channel-message ,message)
     (liece-own-channel-message ,message)))

(defmacro liece-own-channel-message (message &optional chnl)
  `(let* ((chnl (or ,chnl (liece-current-channel)))
	  (liece-message-target chnl)
	  (liece-message-speaker (liece-current-nickname))
	  (liece-message-direction 'outgoing))
     (liece-display-message ,message)))

(defmacro liece-own-private-message (message &optional partner)
  `(let* ((partner (or ,partner liece-current-chat-partner))
	  (liece-message-target partner)
	  (liece-message-speaker (liece-current-nickname))
	  (liece-message-direction 'outgoing))
     (liece-display-message ,message)))

(defmacro liece-convert-received-input (input)
  "Convert input before it is processed"
  `(let ((conv-list liece-receive-convert-list)
	 (input ,input)
	 i f s s1 s2)
     (while (and conv-list (not liece-polling))
       (setq i (car conv-list)
	     f (car i)
	     s (cadr i)
	     s1 (if (stringp f) f (funcall f input))
	     s2 (if (stringp s) s (funcall s s1))
	     input (replace-in-string input s1 s2)
	     conv-list (cdr conv-list)))
     input))

(defun liece-send (&rest args)
  "Send message to IRC server."
  (liece-reset-idle)
  (let ((string (apply #'format args)) send-string len)
    (dolist (convert liece-send-convert-list)
      (setq string (apply #'replace-in-string string convert)))
    (with-current-buffer liece-command-buffer
      (setq send-string (liece-coding-encode-charset-string string)
	    send-string (if (string-match "\r$" send-string) send-string
			  (concat send-string "\r\n"))
	    len (length send-string)))
    (if (< len 512)
	(process-send-string liece-server-process send-string)
      (message "Protocol message too long (%d).  Truncated." len)
      (if liece-beep-on-bells (beep)))
    (if (string-match "^list\\s-*" (setq string (downcase string)))
	(setq liece-channel-filter (substring string (match-end 0))))))

(defmacro liece-send-pong ()
  '(liece-send "PONG :%s" liece-tmp-server-name))

(defmacro liece-increment-long-reply-count ()
  '(incf liece-long-reply-count))

(defmacro liece-reset-long-reply-count ()
  '(setq liece-long-reply-count 0))

(defmacro liece-check-long-reply-count ()
  '(when (> liece-long-reply-count liece-long-reply-max)
     (liece-reset-long-reply-count)
     (liece-send-pong)))

(defmacro liece-server-host ()
  '(if (listp liece-server)
       (plist-get liece-server ':host)
     (if (or (string-match "^\\[\\([^]]+\\)\\]:?[0-9]*" liece-server)
	     (string-match "^\\([^:]+\\):?[0-9]*" liece-server))
         (match-string 1 liece-server)
       liece-server)))

(defmacro liece-clean-hostname (hostname)
  "Return the arg HOSTNAME, but if is a dotted-quad, put brackets around it."
  `(save-match-data
     (if (string-match "[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+" ,hostname)
	 (concat "[" ,hostname "]")
       ,hostname)))

(defmacro liece-current-nickname ()
  "Our current nickname."
  'liece-real-nickname)

(defmacro liece-current-channel ()
  "Out current channel."
  'liece-current-channel)

(defmacro liece-current-channels ()
  "Out current channels."
  'liece-current-channels)

(defmacro liece-current-chat-partner ()
  "Out current chat partner."
  'liece-current-chat-partner)

(defmacro liece-current-chat-partners ()
  "Out current chat partners."
  'liece-current-chat-partners)

(defmacro liece-scroll-if-visible (window)
  `(if ,window (set-window-point ,window (point-max))))

(defmacro liece-pick-buffer-1 (chnl)
  `(cdr (string-assoc-ignore-case ,chnl liece-channel-buffer-alist)))

(defun liece-pick-buffer (chnl)
  (cond
   ((stringp chnl)
    (let ((buf (liece-pick-buffer-1 chnl)))
      (if buf (list buf))))
   ((and chnl (listp chnl))
    (let ((buf (liece-pick-buffer-1 (car chnl))))
      (if buf (cons buf (liece-pick-buffer (cdr chnl))))))
   (t nil)))


;;; Date and time handling functions
(defun liece-compose-time-string (time)
  (format-time-string "%A %B %e %Y %R" time))

(defun liece-convert-seconds (time)
  "Convert seconds to printable string."
  (let* ((seconds (string-to-int time))
	 (minutes (/ seconds 60))
	 (seconds (if minutes (% seconds 60) seconds))
	 (hours (/ minutes 60))
	 (minutes (if hours (% minutes 60) minutes))
	 (days (/ hours 24))
	 (hours (if days (% hours 24) hours))
	 (ds (and (/= 0 days)
		  (format "%d day%s, " days
			  (if (> days 1) "s" ""))))
	 (hs (and (/= 0 hours)
		  (format "%d hour%s, " hours
			  (if (> hours 1) "s" ""))))
	 (ms (and (/= 0 minutes)
		  (format "%d minute%s " minutes
			  (if (> minutes 1) "s" ""))))
	 (ss (format "%d seconds" seconds)))
    (concat ds hs ms (if seconds ss ""))))

(defmacro liece-insert-time-string ()
  '(insert (substring (current-time-string) 11 16) " "))

(defvar liece-idle-point nil "Timestamp of last idle reset.")

(defmacro liece-reset-idle ()
  "Reset idle counter and return last idle."
  '(prog1 (liece-idle) (setq liece-idle-point (current-time))))

(defmacro liece-idle ()
  "How long has liece been idle."
  '(if liece-idle-point
       (liece-time-difference liece-idle-point (current-time))
     9999999))

(defmacro liece-ping-if-idle (&optional limit)
  `(if (<= (liece-idle) (or ,limit 120))
       nil
     (liece-command-ping)
     t))

(defmacro liece-maybe-poll ()
  '(liece-send "PING %s" (system-name)))

(defun liece-get-buffer-create (name)
  "Get or create buffer, keep track on its NAME so we can kill it."
  (let ((buffer (get-buffer-create name)))
    (or (memq buffer liece-buffer-list)
	(push buffer liece-buffer-list))
    buffer))

(defmacro liece-message-from-ignored (prefix rest)
  `(save-excursion
     (liece-insert liece-I-buffer (concat ,prefix "::" ,rest "\n"))
     t))

(defmacro liece-is-message-ignored (string buffer)
  `(let (found (case-fold-search t) msg str msgstr who)
     (catch 'ignore
       (when (member ,buffer liece-no-ignore-buffers)
	 (throw 'ignore t))
       (dolist (ignore-entry liece-ignore-list)
	 ;; Check message type
	 (cond
	  ((consp (car ignore-entry))
	   (setq msg (caar ignore-entry)
		 str (cdar ignore-entry)))
	  ((fboundp (car ignore-entry))
	   (setq msgstr (apply (car ignore-entry) (list ,string))
		 msg (car msgstr)
		 str (cdr msgstr)))
	  (t
	   (liece-message
	    (_ "Malformed ignore-list, no msg+str function."))))
	 ;; Check message from whom
	 (cond
	  ((listp (cadr ignore-entry))
	   (setq who (cadr ignore-entry)))
	  ((fboundp (cadr ignore-entry))
	   (setq who (apply (cadr ignore-entry) (list ,string))))
	  ((not (cadr ignore-entry))
	   (liece-message
	    (_ "Malformed ignore-list, no user function."))))
	 ;; Handle regexp
	 (save-match-data
	   (when (and (or msg str)
		      (and msg
			   (string-match
			    msg (cadr liece-current-function)))
		      (and str (string-match str ,string)))
	     (while who
	       (when (string-match (car who) (car liece-current-function))
		 (setq found t)
		 (throw 'ignore t))
	       (setq who (cdr who)))))))
     found))

;;; stolen (and renamed) from time-date.el.
(defun liece-subtract-time (t1 t2)
  "Subtract two internal times."
  (let ((borrow (< (cadr t1) (cadr t2))))
    (list (- (car t1) (car t2) (if borrow 1 0))
	  (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))

(defun liece-time-difference (t1 t2)
  "Return the differnce between two internal times in seconds."
  (let ((sub (liece-subtract-time t1 t2)))
    (+ (* (car sub) 65536) (cadr sub))))

(defun liece-time-elapsed (time seconds)
  "Add SECONDS to TIME."
  (list (+ (car time) (/ (+ (cadr time) seconds) 65536))
	(% (+ (cadr time) seconds) 65536)
	(nth 2 time)))

;;; stolen (and renamed) from time-date.el.
(defun liece-seconds-to-time (seconds)
  "Convert SECONDS (a floating point number) to an Emacs time structure."
  (list (floor seconds 65536)
	(floor (mod seconds 65536))
	(floor (* (- seconds (ffloor seconds)) 1000000))))

(defun liece-generate-hex-timestamp (&optional time)
  "Generate timestamp string as hexadecimal.
If optional argument TIME is nil, calculate timestamp using current time."
  (or time
      (setq time (current-time)))
  (format "%04x%04x" (car time) (cadr time)))

(defmacro liece-hex-timestamp-valid (timestamp limit)
  "Is TIMESTAMP valid within LIMIT?"
  `(let (t1 t2 diff (timestamp ,timestamp))
     (if (not (and (stringp timestamp)
		   (string-match
		    "^[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)))
	 nil
       (setq t1 (liece-hex-string-to-integer (substring timestamp 0 4))
	     t2 (liece-hex-string-to-integer (substring timestamp 4 8))
	     diff (liece-time-difference
		   (list t1 t2 0) (current-time)))
       (or (>= ,limit 0)
	   (and (< diff ,limit) (> diff (- 0 ,limit)))))))

(defmacro liece-hex-char-to-integer (character)
  "Convert single hex digit CHARACTER to integer."
  `(if (and (>= ,character ?0) (<= ,character ?9))
       (- ,character ?0)
     (let ((ch (logior ,character 32)))
       (if (and (>= ch ?a) (<= ch ?f))
	   (- ch (- ?a 10))
	 (error "Invalid hex digit `%c'" ch)))))

(defmacro liece-hex-string-to-integer (hex-string)
  "Convert a HEX-STRING like ffff to the decimal integer."
  `(let ((hex-string ,hex-string) (hex-num 0))
     (while (not (equal hex-string ""))
       (setq hex-num (+ (* hex-num 16)
			(liece-hex-char-to-integer
			 (string-to-char hex-string))))
       (setq hex-string (substring hex-string 1)))
     hex-num))

(defmacro liece-remove-properties-region (start end)
  (unless (fboundp 'make-extent)
    `(save-excursion
       (save-restriction
	 (narrow-to-region ,start ,end)
	 (goto-char (point-min))
	 (let (start)
	   (while (setq start (next-single-property-change
			       (point) 'invisible))
	     (when (invisible-p start)
	       (delete-region start (next-visible-point start))
	       (goto-char start))
	     (remove-text-properties (point-min)(point-max) '(face))))))))

(provide 'liece-misc)

;;; liece-misc.el ends here