;;; emchat-log.el --- Logging code for EMchat.
-;; Copyright (C) 2002 - 2010 Steve Youngs
+;; Copyright (C) 2002 - 2011 Steve Youngs
;; Author: Steve Youngs <steve@emchat.org>
;; Maintainer: Steve Youngs <steve@emchat.org>
"Fill column for `emchat-log-buffer'.
If this is set to 0 \(zero\), the default, the fill-column in the log
-buffer is left alone. In other words, default value for fill-column."
+buffer is left alone. In other words, default value for fill-column."
:type 'integer
:group 'emchat-log)
(defcustom emchat-log-buffer-position-flag 'tail
"*Non-nil means automatically updating buffer position.
-Nil means no automatic update, 'tail means keeping the bottom of the buffer
+Nil means no automatic update, 'tail means keeping the bottom of the buffer
visible, other non-nil means keeping the top of the buffer visible."
:group 'emchat-log
- :type '(choice (item t) (item tail) (item nil)))
+ :type '(choice (item t) (item tail) (item nil)))
(defcustom emchat-log-info-flag 'tail
"*Non-nil means log misc info.
(defcustom emchat-log-info-mark nil
"*Non-nil means mark unread.
-These include any info from ICQ server other than buddy messages,
+These include any info from ICQ server other than buddy messages,
status change notice, and query results.
Nil means mark read."
:group 'emchat-log
(defvar emchat-log-buffer nil
"Buffer for log.")
-(defvar emchat-log-outline-regexp "^...:.. "
- "Regexp for log header.
-See `outline-regexp'.")
+(defconst emchat-log-entry-re "[SMTWRFA][0-9][0-9]:[0-9][0-9]"
+ "Regular expression matching the beginning of a log entry.")
(defvar emchat-log-mode-syntax-table
(let ((table (copy-syntax-table text-mode-syntax-table)))
(setq modeline-buffer-identification
(list (cons modeline-buffer-id-left-extent
(cons 10 (list "[" 'emchat-user-alias "]: ")))
- (cons modeline-buffer-id-right-extent
- (cons 1 (list "<"
+ (cons modeline-buffer-id-right-extent
+ (cons 1 (list "<"
'emchat-user-status
'emchat-user-meta-invisibility-indicator
">")))))
(setq modeline-buffer-identification
(list (cons modeline-buffer-id-left-extent
(cons 10 (list "[" 'emchat-user-alias "]: ")))
- (cons modeline-buffer-id-right-extent
- (cons 1 (list "<"
+ (cons modeline-buffer-id-right-extent
+ (cons 1 (list "<"
'emchat-user-status
">"))))))))
(let ((features (remove 'menubar features)))
(outline-minor-mode))
(set (make-local-variable 'outline-regexp)
- emchat-log-outline-regexp)
+ (concat emchat-log-entry-re " "))
(emchat-log-update-modeline)
;; Use our syntax-table
(set-syntax-table emchat-log-mode-syntax-table)
(when new
;; save and close current log first if any
(setq emchat-log-buffer
- (find-buffer-visiting emchat-log-filename))
+ (find-buffer-visiting emchat-log-filename))
(if emchat-log-buffer
- (with-current-buffer emchat-log-buffer
- (save-buffer)
- (kill-buffer nil)))
+ (with-current-buffer emchat-log-buffer
+ (save-buffer)
+ (kill-buffer nil)))
;; rename old log in disk
(if (file-exists-p emchat-log-filename)
- (rename-file
- emchat-log-filename
- (concat emchat-log-filename
- ;; in case you do something stupid with it
- (format-time-string "-%Y-%b%d-%H%M-%S")))))
+ (rename-file
+ emchat-log-filename
+ (concat emchat-log-filename
+ ;; in case you do something stupid with it
+ (format-time-string "-%Y-%b%d-%H%M-%S")))))
(unless (buffer-live-p emchat-log-buffer)
(setq emchat-log-buffer (find-file-noselect emchat-log-filename))
ext
(make-glyph (list (vector 'xbm ':file emchat-log-header))))
(insert "\n\n")))
- (insert "===========================================\n"
+ (insert "===========================================\n"
"Welcome to EMchat - The (S)XEmacs IM Client\n\n"
"If you like this software, please consider\n"
" \'M-x emchat-donation RET\'\n"
(interactive)
(emchat-log-show-buffer 'new))
-(defconst emchat-log-entry-re "^[SMTWRFA][0-9][0-9]:[0-9][0-9]"
- "Regular expression matching the beginning of a log entry.")
-
(defun emchat-log-update-history (id message weekday)
"Updates the history for ID, with MESSAGE.
(unless (get 'emchat-track 'initialized)
(emchat-track-init))
(and (not (get-buffer-window emchat-log-buffer))
- (ecase emchat-track-events-type
+ (ecase emchat-track-events-type
(all (emchat-track-add-nick id))
(incoming
(and (not (search ">>>" message)) ; XXX
(save-excursion
(search-backward id)
(let* ((exp (extent-at (point)))
- (bhelp
- (format
+ (bhelp
+ (format
"%s (%s)\n Status: %s\n Groups: %s\nHistory: %s\n\n\n"
id
(emchat-alias-uin id)
Mark MESSAGE unread if MARK-UNREAD is non-nil"
(if (and option (buffer-live-p emchat-log-buffer))
(with-current-buffer emchat-log-buffer
- (save-excursion
- (let ((start-point (if (eq option 'tail)
- (point-max) (point-min)))
- (weekday ["S" "M" "T" "W" "R" "F" "A"])
- ;; to fill messages correctly
- (paragraph-start ""))
- (goto-char start-point)
- (insert
- (aref weekday (string-to-number (format-time-string "%w")))
- (format-time-string "%R ")
- ;; use concat instead of format for extent
- (concat "[" id "] " message "\n"))
- (fill-region start-point (point))
- (when emchat-history-enabled-flag
+ (save-excursion
+ (let ((start-point (if (eq option 'tail)
+ (point-max) (point-min)))
+ (weekday ["S" "M" "T" "W" "R" "F" "A"])
+ ;; to fill messages correctly
+ (paragraph-start ""))
+ (goto-char start-point)
+ (insert
+ (aref weekday (string-to-number (format-time-string "%w")))
+ (format-time-string "%R ")
+ ;; use concat instead of format for extent
+ (concat "[" id "] " message "\n"))
+ (fill-region start-point (point))
+ (when emchat-history-enabled-flag
(emchat-log-update-history id message weekday))
- (when emchat-track-enable
+ (when emchat-track-enable
(emchat-log-update-tracker id message))
- (when (member id emchat-all-aliases)
+ (when (member id emchat-all-aliases)
(emchat-log-update-balloon id))
(when emchat-smiley
(smiley-region start-point (point)))
(when emchat-emphasis-enabled-flag
(emchat-emphasis-treat-message start-point (point)))
(emchat-emphasis-hyperlink-message start-point (point))
- (goto-char start-point)
+ (goto-char start-point)
(if mark-unread
(emchat-log-mark-unread)
(emchat-log-mark-read))))
(if (eq emchat-log-buffer-position-flag 'tail)
(progn
(goto-char (point-max))
- (re-search-backward emchat-log-entry-re))
- (progn
+ (re-search-backward
+ (concat "^" emchat-log-entry-re " ")))
+ (progn
(goto-char (point-min))
- (re-search-forward emchat-log-entry-re)))))))
+ (re-search-forward
+ (concat "^" emchat-log-entry-re " "))))))))
(defun emchat-log-info (&rest messages)
"See `emchat-log-info-flag'.
"See `emchat-log-buddy-status-flag'.
ALIAS is an id to be logged under.
MESSAGES is an argument list for `format' to be inserted."
- (emchat-log alias
- (apply 'format messages)
+ (emchat-log alias
+ (apply 'format messages)
emchat-log-buddy-status-flag emchat-log-buddy-status-mark))
(defun emchat-log-buddy-message (alias fmt &rest fmt-messages)
ALIAS is an id to be logged under.
FMT is message format, passed directly to `format'.
FMT-MESSAGES are arguments for `format'."
- (emchat-log alias
- (apply 'format fmt fmt-messages)
+ (emchat-log alias
+ (apply 'format fmt fmt-messages)
emchat-log-buddy-message-flag emchat-log-buddy-message-mark))
(defun emchat-log-buddy-url (alias message url)
balloon-help "Mouse button2 -- Follow this link."
face ,widget-button-face))
(emchat-log alias (concat message "\nURL: " url)
- emchat-log-buddy-message-flag emchat-log-buddy-message-mark))
+ emchat-log-buddy-message-flag emchat-log-buddy-message-mark))
(defun emchat-log-outgoing (alias &rest messages)
"See `emchat-log-outgoing-flag'.
ALIAS is an id to be logged under.
MESSAGES is an argument list for `format' to be inserted."
- (emchat-log alias
+ (emchat-log alias
(apply 'format messages) emchat-log-outgoing-flag emchat-log-outgoing-mark))
(defun emchat-log-error (&rest messages)
"See `emchat-log-error-flag'.
MESSAGES is an argument list for `format' to be inserted."
- (emchat-log "!error"
+ (emchat-log "!error"
(apply 'format messages) emchat-log-error-flag emchat-log-error-mark))
(defun emchat-log-debug (&rest messages)
"See `emchat-log-debug-flag'.
MESSAGES is an argument list for `format' to be inserted."
- (emchat-log "!debug"
+ (emchat-log "!debug"
(apply 'format messages) emchat-log-debug-flag emchat-log-debug-mark))
(defun emchat-log-system (&rest messages)
"See `emchat-log-system-flag'.
MESSAGES is an argument list for `format' to be inserted."
- (emchat-log "!system"
+ (emchat-log "!system"
(apply 'format messages) emchat-log-system-flag emchat-log-system-mark)
(run-hooks 'emchat-system-message-hook))
(save-excursion
;; so that we can mark current line even at bol
(end-of-line)
- (let ((len (length emchat-log-outline-regexp))
- (p (search-backward-regexp emchat-log-outline-regexp nil t))
- (face (cdr (assoc mark emchat-log-mark-alist))))
+ (let ((len 8)
+ (p (search-backward-regexp
+ (concat "^" emchat-log-entry-re " ") nil t))
+ (face (cdr (assoc mark emchat-log-mark-alist))))
(if p (add-text-properties
- p (+ len p -2)
- (list 'face face 'start-open t))))))
+ p (+ len p -2)
+ (list 'face face 'start-open t))))))
(defun emchat-log-mark-region (start end &optional mark)
"Mark all log messages in the region.
;; Due to bad design of outline.el, we use condition-case to guard
;; against error when advancing at the end of buffer.
(condition-case nil
- (while (<= (point) end)
- (emchat-log-mark mark)
- (emchat-log-next 1))
+ (while (<= (point) end)
+ (emchat-log-mark mark)
+ (emchat-log-next 1))
(error nil))))
(defun emchat-log-mark-unread (&optional mark-region)
(defalias 'emchat-log-next 'outline-forward-same-level)
(defun emchat-log-next-unread ()
- "Moves point to the next unread message.
+ "Moves point to the next unread message.
Does nothing if there are no unread messages after point."
(interactive)
(let ((here (point)))
- (goto-char
+ (goto-char
(catch 'where
- (progn
+ (progn
(while (not (eq here (point-max))) ; mildly bogus target
(let ((next (next-single-property-change here 'face)))
(unless next
(setq here next)))))))))
(defun emchat-log-previous-unread ()
- "Moves point to the previous unread message.
+ "Moves point to the previous unread message.
Does nothing if there are no unread messages after point."
(interactive)
(let ((here (point)))
- (goto-char
+ (goto-char
(catch 'where
- (progn
+ (progn
(while (not (eq here (point-max))) ; mildly bogus target
(let ((prev (previous-single-property-change here 'face)))
(unless prev
(provide 'emchat-log)
;;; emchat-log.el ends here
-
projects / emchat / blobdiff