;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: pjb-erc.el
;;;;LANGUAGE: emacs lisp
;;;;SYSTEM: POSIX
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; ERC stuff.
;;;;
;;;; Don't worry anymore about flooding a channel!
;;;;
;;;; This yank function for erc uses lisppaste when the text to yank
;;;; is more than *erc-yank-flood-limit* lines long.
;;;;
;;;; If the text is below this limit, it's yanked using the function
;;;; set in *erc-yank-function* (eg. can be yank or delete-region-and-yank).
;;;;
;;;; Otherwise, if the current buffer is one of the buffer where lisppaste
;;;; works, then use lisppaste on this buffer (and let lisppaste send its
;;;; notification message; the Title is taken as the first non empty line
;;;; of the pasted text).
;;;;
;;;; Otherwise, the text is pasted to the "None" lisppaste channel, and the
;;;; url of the lisppaste is yanked into the current buffer.
;;;;
;;;; You can safely use:
;;;; (global-set-key (kbd "C-y") (function erc-yank))
;;;; or just add it to some erc buffer hook.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2006-11-15 <PJB> Extracted from ~/.emacs; Fusioned erc-yank.el
;;;; 2006-10-23 <PJB> Updated for the new anti-spam lisppaste feature.
;;;; 2006-05-15 <PJB> Created.
;;;;BUGS
;;;; We should check if there's a recent paste with same title, and
;;;; if there is, add: annotate=#pastenumber to get an annotation.
;;;;LEGAL
;;;; GPL
;;;;
;;;; Copyright Pascal Bourguignon 2006 - 2011
;;;;
;;;; 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 of the License, 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 this program; if not, write to the Free
;;;; Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
;;;;**************************************************************************
(require 'cl)
(require 'w3 nil t)
(require 'w3-forms nil t)
(require 'pjb-cl)
(require 'pjb-make-depends)
(eval-when (compile load exec)
(require 'erc-auto nil t)
;;(autoload 'erc-select "erc" "Connect to an IRC server." t)
;;(autoload 'irc "Kiwi.4.37" "Start an IRC sub-process." t)
;;(setf irc-nick "pjb__")
(require 'erc nil t)
(require 'erc-nets nil t)
(require 'erc-fill nil t)
(require 'erc-lang nil t)
(require 'erc-stamp nil t)
(require 'erc-match nil t)
(require 'erc-button nil t)
(require 'erc-truncate nil t)
(require 'erc-nickserv nil t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; erc-yank
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst +newline+ 10)
(defvar *erc-yank-flood-limit* 5
"Maximum number of lines allowed to yank to an erc buffer.")
(defvar *erc-yank-function* (function delete-region-and-yank)
"The function called by erc-yank to actually yank
(function delete-region-and-yank) or (function yank)")
(defun pjb-erc-buffer-p (buffer)
"Returns whether buffer is an erc buffer."
(member buffer (erc-buffer-list)))
(defun pjb-erc-buffer-channel (buffer)
"Returns the channel associated to an erc buffer, or nil if not an erc buffer"
;; (and (erc-buffer-p buffer) (buffer-name buffer))
(save-excursion
(set-buffer buffer)
(erc-default-target)))
(defun pjb-text-to-yank (arg)
"Returns the text to yank. This should be used by yank for consistency..."
(current-kill (cond ((listp arg) 0)
((eq arg '-) -2)
(t (1- arg)))))
(defun pjb-http-get (url)
"Fetches a resource at URL, and returns it."
(shell-command-to-string
(format "wget %s -O -" (shell-quote-argument url))))
(defun pjb-parse-html (html)
"Parse the HTML string."
(with-temp-buffer
(insert html)
(when (fboundp 'w3-parse-buffer)
(w3-parse-buffer (current-buffer)))))
(defun pjb-find-html-tag (tag html)
(cond
((atom html) nil)
((eq tag (car html)) html)
(t (or (find-html-tag tag (car html)) (find-html-tag tag (cdr html))))))
(defvar *lisp-paste-url* "http://paste.lisp.org/new")
(defvar *lisp-paste-action-url* "http://paste.lisp.org/submit")
(defvar *lisp-paste-channels* nil)
(defvar *lisp-paste-channel-list-url* "http://paste.lisp.org/channels")
;; (setf *lisp-paste-url* "http://paste.lisp.org/new"
;; *lisp-paste-action-url* "http://paste.lisp.org/submit"
;; *lisp-paste-channels* nil
;; *lisp-paste-channel-list-url* "http://paste.lisp.org/channels")
(defun pjb-collect-channels (tree)
(remove-if-not
(lambda (item)
(and (stringp item)
(string-match "^#\+[a-z0-9A-Z][-a-z0-9A-Z]*[a-z0-9A-Z]$" item)))
(flatten tree)))
(defun pjb-cache-lisp-paste ()
(let ((html (parse-html (http-get *lisp-paste-channel-list-url*))))
(setf *lisp-paste-channels* (collect-channels html))))
(defun pjb-lisp-paste-action-url ()
"Returns the action of paste.lisp.org."
*lisp-paste-action-url*)
(defun pjb-lisp-paste-channels ()
"Returns the list of channels paste.lisp.org can paste to."
(unless *lisp-paste-channels*
(cache-lisp-paste))
*lisp-paste-channels*)
(defun pjb-http-read (process)
(accept-process-output process 5 0)
(save-excursion
(set-buffer (process-buffer process))
(buffer-string)))
(defun pjb-http-send (process ctrl-string &rest args)
;; (message "http-send: %s" (apply (function format) ctrl-string args))
(process-send-string process (apply (function format) ctrl-string args)))
(defun pjb-split-header (http-output)
(let* ((header-end (or (search "\r\n\r\n" http-output)
(search "\n\n" http-output)))
(headers (mapcar
(lambda (line) (string-trim "\r" line))
(split-string (subseq http-output 0 header-end) "\n"))))
(values
(first headers)
(mapcar (lambda (header)
(let ((colon (position (character ":") header)))
(cons (string-trim " " (subseq header 0 colon))
(string-trim " " (subseq header (1+ colon))))))
(rest headers))
(string-trim "\r\n" (subseq http-output header-end)))))
(defun pjb-http-session (method url headers data)
(with-temp-buffer
(let* ((url (url-generic-parse-url url))
(process (open-network-stream
"http-post"
(current-buffer)
(url-host url)
(parse-integer (url-port url)))))
(unwind-protect
(progn
(http-send process "%s %s HTTP/1.0\r\n"
method (url-recreate-url url))
(dolist (item headers)
(http-send process "%s: %s\r\n" (car item) (cdr item)))
(http-send process "\r\n%s" data)
(process-send-eof process)
(split-header (http-read process)))
(delete-process process)))))
(defun pjb-lisp-paste (network channel nick text)
(if (fboundp 'w3-form-encode-xwfu)
(let* ((channel (if (and (eq 'freenode network)
(member* channel (lisp-paste-channels)
:test (function string=)))
channel "None"))
(data (subseq
(apply
(function concat)
(mapcar
(lambda (attribute)
(concat
"&"
(w3-form-encode-xwfu (car attribute))
"="
(w3-form-encode-xwfu (cdr attribute))))
(list
(cons "channel" channel)
(cons "username" nick)
(cons "title"
(replace-regexp-in-string
"\\`\n*\\([^\n]*\\)\n\\(.\\|\n\\)*\\'" "\\1" text))
(cons "colorize" "")
(cons "text"
(replace-regexp-in-string "\n" "\r\n" text))))) 1))
(session (http-session
"POST" (or (lisp-paste-action-url)
(error "Lisppaste is down!"))
(list '("Content-Encoding" .
"application/x-www-form-urlencoded")
(cons "Content-Length" (length data)))
data)))
;; (message "%s" (second (split-string (first session) " ")))
(when (string= "200" (second (split-string (first session) " ")))
(values (cdr (assoc 'href (second (find-html-tag
'a (parse-html (third session))))))
(not (string= "None" channel)))))
(error "No w3 to encode the attributes...")))
(defvar *paste-lisp-org-delay* (* 1 60 60)
"(seconds) delay between two ping checks")
(defvar *paste-lisp-org-cache* (cons 0 nil)
"(time-of-last-check . paste.lisp.org-available-p)")
(defun pjb-paste-lisp-org-available-p ()
(if (cl:< (GET-UNIVERSAL-TIME)
(cl:+ (car *paste-lisp-org-cache*) *paste-lisp-org-delay*))
(cdr *paste-lisp-org-cache*)
(progn
(message "pinging paste.lisp.org")
(let ((result (zerop (car (read-from-string
(shell-command-to-string
"ping -q -c 1 -w 2 paste.lisp.org>/dev/null 2>&1;echo $?"))))))
(message (format "pinging paste.lisp.org --> %s "
(if result 'success 'failed)))
(setf (car *paste-lisp-org-cache*) (GET-UNIVERSAL-TIME)
(cdr *paste-lisp-org-cache*) result)))))
(defun pjb-erc-yank (&optional arg)
"Yank or lisppaste depending on the size of the yanked text.
When inside a erc channel buffer, if the text to yank is more than 3 lines,
then use http://paste.lisp.org to lisppaste it instead of yanking it.
Otherwise, just yank it.
"
(interactive "*P")
(if (erc-buffer-p (current-buffer))
(if (paste-lisp-org-available-p)
(let* ((text (text-to-yank arg))
(lines (count +newline+ text)))
(if (<= lines *erc-yank-flood-limit*)
(funcall *erc-yank-function* arg)
(multiple-value-bind
(url sent-p)
(lisp-paste (funcall (if (fboundp 'erc-network)
'erc-network
'erc-current-network))
(erc-buffer-channel (current-buffer))
(erc-current-nick)
text)
(unless sent-p
(insert-for-yank url)))))
(funcall *erc-yank-function* arg))
(funcall *erc-yank-function* arg)))
;;----------------------------------------
(defun pjb-erc-join-meat ()
(unless (char= (character "#")
(aref (erc-buffer-channel (current-buffer)) 0))
(erc-log-mode 1)))
(defun pjb-server-available-p (server)
(let ((result (shell-command-to-string
(format "ping -c 10 -i 0.5 -q -w 5 %s"
(shell-quote-argument (string* server))))))
(when (string-match " \\([0-9]+\\)% packet loss" result)
(let ((loss (parse-integer (match-string 1 result))))
(if (< loss 80)
(progn
(message "pjb-erc: (server-available-p %S) -> %d (true)"
server loss)
loss)
(progn
(message "pjb-erc: (server-available-p %S) -> %d (nil)"
server loss)
nil))))))
(defun pjb-erc-add-fools (&rest fools)
(dolist (fool fools)
;; (pushnew fool erc-fools :test (function STRING-EQUAL))
(unless (member fool erc-ignore-list)
(erc-cmd-IGNORE fool))))
(defun pjb-erc-join-channels (&rest channels)
(dolist (chan channels)
(erc-join-channel chan)
(split-window-vertically)
;; we must balance to avoid 2^-n window size.
(balance-windows)))
(defun pjb-erc-adjust-width (&optional frame)
"Set the erc-fill-column to the minimum width of the windows
displaying erc buffers."
(interactive)
(setf erc-fill-column
(or (let ((frame (or frame (current-frame))))
(loop
with width = nil
with buffers = (erc-all-buffer-names)
for window in (window-list frame nil)
do (when (or (member (window-buffer window) buffers)
(null width)
(< (window-width window) width))
(setf width (window-width window)))
finally (return width))) 72)))
(defvar *erc-cancel-auto-adjust-width* nil)
(defun pjb-erc-auto-adjust-width ()
(interactive)
(if *erc-cancel-auto-adjust-width*
(setf *erc-cancel-auto-adjust-width* nil)
(progn (pjb-erc-adjust-width)
(run-with-idle-timer 10 10 (function erc-auto-adjust-width)))))
(defun pjb-erc-cancel-auto-adjust-width ()
(interactive)
(setf *erc-cancel-auto-adjust-width* t))
(defun pjb-erc-user-input ()
"Return the input of the user in the current buffer."
;; We use erc-bol to ignore the prompt.
(string-trim "\n" (buffer-substring
(progn
(goto-char (erc-beg-of-input-line))
(erc-bol))
(erc-end-of-input-line))))
(defun pjb-erc-send-bitlbee-password (password)
(erc-send-command (format "PRIVMSG &bitlbee :identify %s" password)))
(defun nsplit-list-on-indicator (list indicator)
"
RETURN: a list of sublists of list (the conses from list are reused),
the list is splited between items a and b for which (indicator a b).
"
(let* ((result nil)
(sublist list)
(current list)
(next (cdr current)))
(loop while next do
(if (funcall indicator (car current) (car next))
(progn ;; split
(setf (cdr current) nil)
(push sublist result)
(setq current next)
(setq next (cdr current))
(setq sublist current))
(progn ;; keep
(setq current next)
(setq next (cdr current)))))
(push sublist result)
(nreverse result)))
(unless (fboundp (quote netrc-parse))
(defalias 'netrc-point-at-eol
(if (fboundp 'point-at-eol)
'point-at-eol
'line-end-position))
(defun netrc-parse (file)
"Parse FILE and return a list of all entries in the file."
(when (file-exists-p file)
(with-temp-buffer
(let ((tokens '("machine" "default" "login"
"password" "account" "macdef" "force"
"port"))
alist elem result pair)
(insert-file-contents file)
(goto-char (point-min))
;; Go through the file, line by line.
(while (not (eobp))
(narrow-to-region (point) (netrc-point-at-eol))
;; For each line, get the tokens and values.
(while (not (eobp))
(skip-chars-forward "\t ")
;; Skip lines that begin with a "#".
(if (eq (char-after) ?#)
(goto-char (point-max))
(unless (eobp)
(setq elem
(if (= (following-char) ?\")
(read (current-buffer))
(buffer-substring
(point) (progn (skip-chars-forward "^\t ")
(point)))))
(cond
((equal elem "macdef")
;; We skip past the macro definition.
(widen)
(while (and (zerop (forward-line 1))
(looking-at "$")))
(narrow-to-region (point) (point)))
((member elem tokens)
;; Tokens that don't have a following value are ignored,
;; except "default".
(when (and pair (or (cdr pair)
(equal (car pair) "default")))
(push pair alist))
(setq pair (list elem)))
(t
;; Values that haven't got a preceding token are ignored.
(when pair
(setcdr pair elem)
(push pair alist)
(setq pair nil)))))))
(when alist
(push (nreverse alist) result))
(setq alist nil
pair nil)
(widen)
(forward-line 1))
(nreverse result))))))
(defvar server erc-server "For get-password")
(defvar nick (first erc-nick) "For get-password")
(defun get-password (server nick)
(cdr (assoc "password"
(car
(delete-if
(lambda (entry)
(or (string/=* (cdr (assoc "machine" entry)) server)
(string/=* (cdr (assoc "login" entry)) nick)))
(nsplit-list-on-indicator
(reduce 'nconc (netrc-parse "~/.netrc"))
(lambda (current next) (string= "machine" (car next)))))))))
(defun pjb-set-erc-nickserv-passwords ()
(setf erc-nickserv-passwords
(mapcar (lambda (nickserv)
(list (second nickserv)
(mapcar
(lambda (entry)
(cons (cdr (assoc "login" entry))
(cdr (assoc "password" entry))))
(delete-if
(lambda (entry)
(string/=* (cdr (assoc "machine" entry))
(second nickserv)))
(nsplit-list-on-indicator
(reduce 'nconc (netrc-parse "~/.netrc"))
(lambda (current next) (string= "machine" (car next))))))))
'((freenode "irc.freenode.org")))))
(defun pjb-pjb-erc-unhtmlize ()
(message ".EMACS: %S" (buffer-substring-no-properties (point-min) (point-max)))
(let ((s (make-marker)) (e (make-marker)) (c (make-marker)))
(set-marker c (point))
(set-marker s (point-min))
(set-marker e (point-max))
(unwind-protect
(progn
(goto-char (point-min))
(when (search-forward " ")
(goto-char (match-end 0))
(narrow-to-region (point) (point-max))
(when (and (< 6 (- (point-max) (point-min)))
(string-equal* "<HTML>" (buffer-substring-no-properties
(point-min) (+ 6 (point-min)))
:end2 6))
(shell-command-on-region
(point-min) (point-max) "lynx -stdin -dump" t t)
(goto-char (point-min))
(while (re-search-forward "[ \n]\+" (point-max) t)
(delete-region (match-beginning 0) (match-end 0))
(insert " "))
(insert "\n"))))
(widen)
(narrow-to-region s e)
(goto-char c)
(set-marker c nil)
(set-marker s nil)
(set-marker e nil))))
(defun pjb-erc-timestamp-offset ()
"Get length of timestamp if inserted left."
(if (and (boundp 'erc-timestamp-format)
erc-timestamp-format
(eq erc-insert-timestamp-function 'erc-insert-timestamp-left)
(not erc-hide-timestamps))
(length (car (last (split-string
(format-time-string erc-timestamp-format) "\n"))))
0))
(defun pjb-erc-fill-regarding-timestamp ()
"Do nothing"
(values))
(defun pjb-erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
(goto-char (point-min))
(let* ((ignore-p (and erc-timestamp-only-if-changed-flag
(string-equal string erc-timestamp-last-inserted)))
(len (length (car (last (split-string string "\n")))))
(s (if ignore-p (make-string len ? ) string)))
(unless ignore-p (setq erc-timestamp-last-inserted string))
(erc-put-text-property 0 len 'field 'erc-timestamp s)
(insert s)))
(defun pjb-erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. The function is a possible value
for `erc-insert-timestamp-function'.
If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is always
printed. If this variable is non-nil, a timestamp is only printed if
it is different from the last.
If `erc-timestamp-right-column' is set, its value will be used as the
column at which the timestamp is to be printed. If it is nil, and
`erc-fill-mode' is active, then the timestamp will be printed just
before `erc-fill-column'. Otherwise, if the current buffer is
shown in a window, that window's width is used. If the buffer is
not shown, and `fill-column' is set, then the timestamp will be
printed just `fill-column'. As a last resort, the timestamp will
be printed just before the window-width."
(unless (and erc-timestamp-only-if-changed-flag
(string-equal string erc-timestamp-last-inserted))
(setq erc-timestamp-last-inserted string)
(goto-char (point-max))
(forward-char -1) ;; before the last newline
(let ((current-window (get-buffer-window (current-buffer))))
(flet ((get-pos (string)
(cond
(erc-timestamp-right-column
(+ erc-timestamp-right-column (length string)))
((and (boundp 'erc-fill-mode)
erc-fill-mode
(boundp 'erc-fill-column))
(1+ erc-fill-column))
(current-window
(- (window-width current-window)
1))
(fill-column
(1+ fill-column))
(t
(- (window-width)
1)))))
(let* ((prefix-lines (butlast (split-string string "\n")))
(string (car (last (split-string string "\n"))))
(pos (get-pos string))
(from (point)))
(setq pos (- pos (length string)))
(if (= pos (indent-to pos))
(insert string)
(newline)
(indent-to pos)
(insert string))
(erc-put-text-property from (1+ (point)) 'field 'erc-timestamp)
(erc-put-text-property from (1+ (point)) 'rear-nonsticky t)
(when prefix-lines
(forward-line -1)
(setf from (point))
(dolist (line prefix-lines)
(if (string= "" line)
(insert "n")
(insert (format "%s%s\n"
(make-string (- (get-pos line) (length line)) 32)
line))))
(erc-put-text-property from (1+ (point)) 'field 'erc-timestamp)
(erc-put-text-property from (1+ (point)) 'rear-nonsticky t)
(setf from (point))))))))
(defun pjb-erc ()
(interactive)
;; --------------------
(erc-stamp-enable) ; == erc-timestamp-mode
(erc-show-timestamps)
(erc-match-mode 1)
;; (erc-add-scroll-to-bottom)
;; (setf erc-insert-modify-hook
;; (cons 'erc-add-timestamp ; must come before the rest.
;; (delete 'erc-add-timestamp erc-insert-modify-hook)))
;; --------------------
(when t ; (server-available-p "zelazny.freenode.org")
(erc :server "irc.freenode.org" :port 6667
:nick "pjb" :full-name "Pascal J. Bourguignon")
(pjb-erc-join-channels
;;"#cl-gardeners"
"#lisp" "#emacs"
;; "#ucw"
;;"#emacsfr"
;;"#sicp"
"#scheme")
;; (pjb-erc-add-fools "Xach")
(dolist (fool '("NP" "Xah" "xah" "xahlee" "xahlee_" "xahlee__"))
(pjb-erc-add-fools fool)))
;; --------------------
(when nil ; (server-available-p "irc.oftc.net")
(erc "irc.oftc.net" 6667 "pjb" "Pascal J. Bourguignon" t)
(pjb-erc-join-channels
"#ubuntu" "#uml"))
;; --------------------
(when t ; (server-available-p "im.bitlbee.org")
(let ((server "im.bitlbee.org")
(nick "matimago"))
(erc server 6667 nick "Pascal J. Bourguignon" t)
(pjb-erc-join-channels "&bitlbee")
(when (get-password server nick)
(pjb-erc-send-bitlbee-password (get-password server nick)))))
;; --------------------
(erc-auto-adjust-width)
(balance-windows))
(defun irc ()
(interactive)
(pjb-server-stop)
(set-frame-name "ERC")
(set-palette pal-irc)
(setf *frame-server-job-ticket* "~/frame-erc")
;; --------------------
(erc-stamp-enable) ; == erc-timestamp-mode
(erc-show-timestamps)
(erc-match-mode 1)
;; (erc-add-scroll-to-bottom)
;; (setf erc-insert-modify-hook
;; (cons 'erc-add-timestamp ; must come before the rest.
;; (delete 'erc-add-timestamp erc-insert-modify-hook)))
;; --------------------
(when t ; (server-available-p "zelazny.freenode.org")
(erc "irc.freenode.org" 6667 "pjb" "Pascal J. Bourguignon" t)
(pjb-erc-join-channels
;;"#cl-gardeners"
"#lisp" "#emacs"
;; "#ucw"
;;"#emacsfr"
;;"#sicp"
"#scheme")
;; (pjb-erc-add-fools "Xach")
(dolist (fool '("NP" "Xah" "xah" "xahlee" "xahlee_" "xahlee__"))
(pjb-erc-add-fools fool)))
;; --------------------
(when nil ; (server-available-p "irc.oftc.net")
(erc "irc.oftc.net" 6667 "pjb" "Pascal J. Bourguignon" t)
(pjb-erc-join-channels
"#ubuntu" "#uml"))
;; --------------------
(when nil ; (server-available-p "im.bitlbee.org")
(let ((server "im.bitlbee.org")
(nick "matimago"))
(erc server 6667 nick "Pascal J. Bourguignon" t)
(pjb-erc-join-channels "&bitlbee")
(when (get-password server nick)
(pjb-erc-send-bitlbee-password (get-password server nick)))))
;; --------------------
;; (erc-auto-adjust-width)
(balance-windows))
;; Not needed anymore: bitlbee can convert encoding all right.
;;
;; (defun erc-coding-system-for-target (target)
;; "Return the coding system or cons cell appropriate for TARGET.
;; This is determined via `erc-encoding-coding-alist' or
;; `erc-default-coding-system'."
;; ;;(print `(erc-coding-system-for-target ,target))
;; (block :result
;; (when target
;; (dolist (coding erc-encoding-coding-alist)
;; (if (string-match (car coding) target)
;; (return-from :result (cons (cdr coding) (cdr coding))))))
;; erc-default-coding-system))
(defun pjb-erc-match-directed-at-fool-p (msg)
"Check wether MSG is directed at a fool."
(with-syntax-table erc-button-syntax-table
(erc-list-match (mapcar (lambda (fool)
(concat "\\b" fool "\\b"))
erc-fools)
msg)))
(defun pjb-erc-cmd-ICQWHOIS (uin)
"Queries icq-user with UIN `uin', and returns the result."
(let* ((result (myerc-query-icq-user uin))
(fname (cdr (assoc 'fname result)))
(lname (cdr (assoc 'lname result)))
(nick (cdr (assoc 'nick result))))
(erc-display-message nil 'notice (current-buffer)
(format "%s (%s %s)" nick fname lname))))
(defun pjb-erc-cmd-CLEAR ()
(interactive)
;;(save-buffer)
(save-excursion
(let ((inhibit-read-only t))
(beginning-of-line)
(delete-region 1 (point))))) ;;erc-cmd-CLEAR
;; (fset 'ClearERC [?\C-p ?\C-e ?\C- ?\M-< ?\C-w ?\M->])
;; (global-set-key (kbd "C-c C-x C-c") 'ClearERC)
(defun pjb-erc-cmd-QUIT (reason)
"Disconnect from the current server.
If REASON is omitted, display a default quit message, otherwise display
the message given by REASON."
(unless reason
(setf reason (read-string "Reason: " "Awaking to the real world.")))
(cond
((string-match "^\\s-*\\(.*\\)$" reason)
(let* ((s (match-string 1 reason))
(ob (current-buffer))
(buffer (erc-server-buffer))
(reason (funcall erc-quit-reason (if (equal s "") nil s))))
(if (and buffer (bufferp buffer)) (set-buffer buffer))
(erc-log (format "cmd: QUIT: %s" reason))
(setq quitting t)
(erc-send-command (format "QUIT :%s" reason))
(set-buffer ob)
(run-hook-with-args 'erc-quit-hook erc-process)
(when erc-kill-queries-on-quit
(erc-kill-query-buffers erc-process)))
t)
(t nil))) ;;erc-cmd-QUIT
;; (add-hook 'erc-join-hook 'pjb-erc-join-meat)
;; (pjb-set-erc-nickserv-passwords)
;; (setf erc-timestamp-format "%Y-%m-%d %H:%M\n")
;; (erc-match-mode 1)
;; (global-set-key (kbd "C-y") (function erc-yank))
(provide 'pjb-erc)