djavu-asus/emacs/elpa/jabber-20230715.456/jabber-chatbuffer.el

   1 ;; jabber-chatbuffer.el - functions common to all chat buffers  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2005, 2007, 2008 - Magnus Henoch - mange@freemail.hu
   4
   5 ;; This file is a part of jabber.el.
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program; if not, write to the Free Software
  19 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  20
  21 (require 'jabber-keymap)
  22
  23 (defvar jabber-point-insert nil
  24   "Position where the message being composed starts.")
  25
  26 (defvar jabber-send-function nil
  27   "Function for sending a message from a chat buffer.")
  28
  29 (defvar jabber-chat-mode-hook nil
  30   "Hook called at the end of `jabber-chat-mode'.
  31 Note that functions in this hook have no way of knowing
  32 what kind of chat buffer is being created.")
  33
  34 (defcustom jabber-chat-fill-long-lines t
  35   "If non-nil, fill long lines in chat buffers.
  36 Lines are broken at word boundaries at the width of the
  37 window or at `fill-column', whichever is shorter."
  38   :group 'jabber-chat
  39   :type 'boolean)
  40
  41 (defvar jabber-chat-ewoc nil
  42   "The ewoc showing the messages of this chat buffer.")
  43
  44 ;;;###autoload
  45 (defvar jabber-buffer-connection nil
  46   "The connection used by this buffer.")
  47 ;;;###autoload
  48 (make-variable-buffer-local 'jabber-buffer-connection)
  49
  50 (defun jabber-chat-mode (jc ewoc-pp)
  51   "Jabber chat mode.
  52 \\{jabber-chat-mode-map}
  53
  54 JC is the Jabber connection."
  55   (kill-all-local-variables)
  56   ;; Make sure to set this variable somewhere
  57   (make-local-variable 'jabber-send-function)
  58   (make-local-variable 'scroll-conservatively)
  59   (make-local-variable 'jabber-point-insert)
  60   (make-local-variable 'jabber-chat-ewoc)
  61   (make-local-variable 'buffer-undo-list)
  62
  63   (setq jabber-buffer-connection jc
  64         scroll-conservatively 5
  65         buffer-undo-list t)             ;dont keep undo list for chatbuffer
  66
  67   (unless jabber-chat-ewoc
  68     (setq jabber-chat-ewoc
  69           (ewoc-create ewoc-pp nil "---"))
  70     (goto-char (point-max))
  71     (put-text-property (point-min) (point) 'read-only t)
  72     (let ((inhibit-read-only t))
  73       (put-text-property (point-min) (point) 'front-sticky t)
  74       (put-text-property (point-min) (point) 'rear-nonsticky t))
  75     (setq jabber-point-insert (point-marker)))
  76
  77   ;;(setq header-line-format jabber-chat-header-line-format)
  78
  79   (setq major-mode 'jabber-chat-mode
  80         mode-name "jabber-chat")
  81   (use-local-map jabber-chat-mode-map)
  82
  83   (if (fboundp 'run-mode-hooks)
  84       (run-mode-hooks 'jabber-chat-mode-hook)
  85     (run-hooks 'jabber-chat-mode-hook)))
  86
  87 (put 'jabber-chat-mode 'mode-class 'special)
  88
  89 ;; Spell check only what you're currently writing
  90 (defun jabber-chat-mode-flyspell-verify ()
  91   (>= (point) jabber-point-insert))
  92 (put 'jabber-chat-mode 'flyspell-mode-predicate
  93   'jabber-chat-mode-flyspell-verify)
  94
  95 (defvar jabber-chat-mode-map
  96   (let ((map (make-sparse-keymap)))
  97     (set-keymap-parent map jabber-common-keymap)
  98     (define-key map "\r" 'jabber-chat-buffer-send)
  99     map))
 100
 101 (defun jabber-chat-buffer-send ()
 102   (interactive)
 103   ;; If user accidentally hits RET without writing anything, just
 104   ;; ignore it.
 105   (when (cl-plusp (- (point-max) jabber-point-insert))
 106     ;; If connection was lost...
 107     (unless (memq jabber-buffer-connection jabber-connections)
 108       ;; ...maybe there is a new connection to the same account.
 109       (let ((new-jc (jabber-find-active-connection jabber-buffer-connection)))
 110         (if new-jc
 111             ;; If so, just use it.
 112             (setq jabber-buffer-connection new-jc)
 113           ;; Otherwise, ask for a new account.
 114           (setq jabber-buffer-connection (jabber-read-account t)))))
 115
 116     (let ((body (delete-and-extract-region jabber-point-insert (point-max))))
 117       (funcall jabber-send-function jabber-buffer-connection body))))
 118
 119 (defun jabber-chat-buffer-fill-long-lines ()
 120   "Fill lines that are wider than the window width."
 121   ;; This was mostly stolen from article-fill-long-lines
 122   (interactive)
 123   (save-excursion
 124     (let ((inhibit-read-only t)
 125           (width (window-width (get-buffer-window (current-buffer)))))
 126       (goto-char (point-min))
 127       (let ((adaptive-fill-mode nil))   ;Why?  -sm
 128         (while (not (eobp))
 129           (end-of-line)
 130           (when (>= (current-column) (min fill-column width))
 131             (save-restriction
 132               (narrow-to-region (min (1+ (point)) (point-max))
 133                                 (point-at-bol))
 134               (let ((goback (point-marker)))
 135                 (fill-paragraph nil)
 136                 (goto-char (marker-position goback)))))
 137           (forward-line 1))))))
 138
 139 (provide 'jabber-chatbuffer)
 140 ;; arch-tag: 917e5b60-5894-4c49-b3bc-12e1f97ffdc6