File: riece-mini.el

package info (click to toggle)
xemacs21-packages 2009.02.17.dfsg.1-1
  • links: PTS
  • area: main
  • in suites: squeeze
  • size: 116,928 kB
  • ctags: 88,975
  • sloc: lisp: 1,232,060; ansic: 16,570; java: 13,514; xml: 6,477; sh: 4,611; makefile: 4,036; asm: 3,007; perl: 839; cpp: 500; ruby: 257; csh: 96; haskell: 93; awk: 49; python: 47
file content (158 lines) | stat: -rw-r--r-- 5,360 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
;;; riece-mini.el --- use Riece only on the minibuffer
;; Copyright (C) 2003 OHASHI Akira

;; Author: OHASHI Akira <bg66@koka-in.org>
;; Keywords: IRC, riece

;; This file is part of Riece.

;; 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; NOTE: This is an add-on module for Riece.

;; This add-on shows arrival messages to minibuffer. And you can send
;; message using minibuffer.
;;
;; By using this add-on, you can use always "mini riece", even if you
;; are visiting other buffers.

;; To use, add the following line to your ~/.riece/init.el:
;; (add-to-list 'riece-addons 'riece-mini)
;;
;; For using conveniently, bind any global key to
;; `riece-mini-send-message' and `riece-mini-show-backlog'.
;; For example:
;; (global-set-key "\C-cm" 'riece-mini-send-message)
;; (global-set-key "\C-cb" 'riece-mini-show-backlog)

;;; Code:

(require 'riece-message)
(require 'riece-biff)

(defgroup riece-mini nil
  "Use Riece only on the minibuffer."
  :group 'riece)

(defcustom riece-mini-backlog-size 5
  "*Line numbers for logging back log."
  :type 'integer
  :group 'riece-mini)

(defvar riece-mini-last-channel nil)
(defvar riece-mini-backlog-history nil)
(defvar riece-mini-backlog-shown nil)

(defconst riece-mini-description
  "Use Riece only on the minibuffer.")

(defun riece-mini-message-no-log (string &rest args)
  "Like `message', except that message logging is disabled."
  (if (featurep 'xemacs)
      (if args
	  (display-message 'no-log (apply #'format string args))
	(display-message 'no-log string))
    (let (message-log-max)
      (apply #'message string args))))

(defun riece-mini-display-message-function (message)
  "Show arrival messages to minibuffer."
  (let ((string (concat (format-time-string "%H:%M") " "
			(riece-format-message message t))))
    (when (string-match "\\(.*\\)$" string)
      (setq string (riece-match-string-no-properties 1 string)))
    (while (>= (length riece-mini-backlog-history)
	       riece-mini-backlog-size)
      (setq riece-mini-backlog-history
	    (cdr riece-mini-backlog-history)))
    (setq riece-mini-backlog-history
	  (reverse (cons string (reverse riece-mini-backlog-history))))
    (when (and (get 'riece-mini 'riece-addon-enabled)
	       (not (or (eq (window-buffer (selected-window))
			    (get-buffer riece-command-buffer))
			(riece-message-own-p message)
			(active-minibuffer-window))))
      (unless (riece-message-type message)
	(setq riece-mini-last-channel (riece-message-target message)))
      (riece-mini-message-no-log "%s" string))))

(defun riece-mini-send-message (arg)
  "Send message using minibuffer.
Prefix argument onece (C-u), send message to last received channel.
If twice (C-u C-u), then ask the channel."
  (interactive "P")
  (let* ((completion-ignore-case t)
	 (target
	  (cond
	   ((equal arg '(16))
	    (riece-completing-read-identity
	     "Channel/User: " riece-current-channels nil t))
	   (arg (or riece-mini-last-channel riece-current-channel))
	   (t riece-current-channel)))
	 (message (read-string (format "Message to %s: " target))))
    (unless (equal message "")
      (riece-switch-to-channel target)
      (riece-send-string
       (format "PRIVMSG %s :%s\r\n"
	       (riece-identity-prefix target)
	       message))
      (riece-display-message
       (riece-make-message (riece-current-nickname) target
			   message nil t)))))

(defun riece-mini-show-backlog ()
  "Send back logs to minibuffer."
  (interactive)
  (when riece-mini-backlog-history
    (let ((height (1+ riece-mini-backlog-size)))
      (mapc #'(lambda (string)
		(setq height (+ height
				(/ (length string) (window-width)))))
	    riece-mini-backlog-history)
      (let ((max-mini-window-height height)
	    (resize-mini-windows t))
	(setq riece-mini-backlog-shown t)
	(when (and (memq 'riece-biff riece-addons)
		   (get 'riece-biff 'riece-addon-enabled))
	  (riece-biff-clear))
	(riece-mini-message-no-log
	 "%s" (mapconcat #'identity riece-mini-backlog-history "\n"))))))

(defun riece-mini-pre-command ()
  (when riece-mini-backlog-shown
    (let ((resize-mini-windows t))
      (setq riece-mini-backlog-shown nil)
      (riece-mini-message-no-log ""))))

(defun riece-mini-requires ()
  (if (memq 'riece-biff riece-addons)
      '(riece-biff)))

(defun riece-mini-insinuate ()
  (add-hook 'riece-after-display-message-functions
	    'riece-mini-display-message-function)
  (add-hook 'pre-command-hook 'riece-mini-pre-command))

(defun riece-mini-uninstall ()
  (remove-hook 'riece-after-display-message-functions
	       'riece-mini-display-message-function)
  (remove-hook 'pre-command-hook 'riece-mini-pre-command))

(provide 'riece-mini)

;;; riece-mini.el ends here