2022-01-25 22:57:38 +00:00
|
|
|
|
;;; +jabber.el --- Customizations for jabber.el -*- lexical-binding: t; -*-
|
|
|
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
|
|
;; Most changes I want to PR and contribute, but a few don't make sense to
|
|
|
|
|
|
;; contribute upstream, at least not now.
|
|
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
|
|
(require 'jabber)
|
|
|
|
|
|
(require 'tracking)
|
|
|
|
|
|
|
2022-05-06 15:23:02 +00:00
|
|
|
|
(defgroup +jabber nil
|
|
|
|
|
|
"Extra jabber.el customizations."
|
|
|
|
|
|
:group 'jabber)
|
|
|
|
|
|
|
|
|
|
|
|
(defcustom +jabber-ws-prefix 0
|
|
|
|
|
|
"Width to pad left side of chats."
|
|
|
|
|
|
:type 'string)
|
|
|
|
|
|
|
|
|
|
|
|
(defcustom +jabber-pre-prompt " \n"
|
|
|
|
|
|
"String to put before the prompt."
|
|
|
|
|
|
:type 'string)
|
|
|
|
|
|
|
2022-01-25 22:57:38 +00:00
|
|
|
|
(defvar +jabber-tracking-show-p #'jabber-activity-show-p-default
|
|
|
|
|
|
"Function that checks if the given JID should be shown in the mode line.
|
|
|
|
|
|
This does the same as `jabber-activity-show-p', but for the
|
|
|
|
|
|
`tracking-mode' mode-line.")
|
|
|
|
|
|
|
|
|
|
|
|
(defun +jabber-tracking-add (from buffer text proposed-alert)
|
|
|
|
|
|
"ADVICE to add jabber buffers to `tracking-buffers'."
|
|
|
|
|
|
(when (funcall +jabber-tracking-show-p from)
|
|
|
|
|
|
(tracking-add-buffer buffer 'jabber-activity-face)))
|
|
|
|
|
|
|
|
|
|
|
|
(defun +jabber-tracking-add-muc (nick group buffer text proposed-alert)
|
|
|
|
|
|
"ADVICE to add jabber MUC buffers to `tracking-buffers'."
|
|
|
|
|
|
(when (funcall +jabber-tracking-show-p group)
|
|
|
|
|
|
(tracking-add-buffer buffer 'jabber-activity-face)))
|
|
|
|
|
|
|
2022-02-01 21:05:25 +00:00
|
|
|
|
;;; Hiding presence messages:
|
2022-01-28 01:26:33 +00:00
|
|
|
|
;; https://paste.sr.ht/~hdasch/f0ad09fbcd08e940a4fda71c2f40abc1c4efd45f
|
|
|
|
|
|
|
2022-02-01 21:05:25 +00:00
|
|
|
|
;; Tame MUC presence notifications.
|
|
|
|
|
|
|
|
|
|
|
|
;; This patch hides or applies a face to MUC presence notifications in
|
|
|
|
|
|
;; the MUC chat buffer. To control its behavior, customize
|
|
|
|
|
|
;; ’jabber-muc-decorate-presence-patterns’. By default it does nothing.
|
|
|
|
|
|
|
|
|
|
|
|
;; ’jabber-muc-decorate-presence-patterns’ is a list of pairs consisting
|
|
|
|
|
|
;; of a regular expression and a either a face or ‘nil’. If a the
|
|
|
|
|
|
;; regular expression matches a presence notification, then either:
|
|
|
|
|
|
|
|
|
|
|
|
;; - the specified face is applied to the notification message
|
|
|
|
|
|
;; - or if the second value of the pair is nil, the notification is
|
|
|
|
|
|
;; discarded
|
|
|
|
|
|
|
|
|
|
|
|
;; If no regular expression in the list of pairs matches the notification
|
|
|
|
|
|
;; message, the message is displayed unchanged.
|
|
|
|
|
|
|
|
|
|
|
|
;; For example, the customization:
|
|
|
|
|
|
|
|
|
|
|
|
;; '(jabber-muc-decorate-presence-patterns
|
|
|
|
|
|
;; '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$")
|
|
|
|
|
|
;; ("." . jabber-muc-presence-dim)))
|
|
|
|
|
|
|
|
|
|
|
|
;; hides participant enter/leave notifications. It also diminishes other
|
|
|
|
|
|
;; presence notification messages to make it easier to distinguish
|
|
|
|
|
|
;; between conversation and notifications.
|
|
|
|
|
|
|
|
|
|
|
|
(defface jabber-muc-presence-dim
|
|
|
|
|
|
'((t (:foreground "dark grey" :weight light :slant italic)))
|
|
|
|
|
|
"face for diminished presence notifications.")
|
|
|
|
|
|
|
|
|
|
|
|
(defcustom jabber-muc-decorate-presence-patterns nil
|
|
|
|
|
|
"List of regular expressions and face pairs.
|
|
|
|
|
|
When a presence notification matches a pattern, display it with
|
|
|
|
|
|
associated face. Ignore notification if face is ‘nil’."
|
|
|
|
|
|
:type '(repeat
|
|
|
|
|
|
:tag "Patterns"
|
|
|
|
|
|
(cons :format "%v"
|
|
|
|
|
|
(regexp :tag "Regexp")
|
|
|
|
|
|
(choice
|
|
|
|
|
|
(const :tag "Ignore" nil)
|
|
|
|
|
|
(face :tag "Face" :value jabber-muc-presence-dim))))
|
|
|
|
|
|
:group 'jabber-alerts)
|
|
|
|
|
|
|
|
|
|
|
|
(defun jabber-muc-maybe-decorate-presence (node)
|
|
|
|
|
|
"Filter presence notifications."
|
|
|
|
|
|
(cl-destructuring-bind (key msg &key time) node
|
|
|
|
|
|
(let* ((match (cl-find-if
|
|
|
|
|
|
(lambda (pair)
|
|
|
|
|
|
(string-match (car pair) msg))
|
|
|
|
|
|
jabber-muc-decorate-presence-patterns))
|
|
|
|
|
|
(face (cdr-safe match)))
|
|
|
|
|
|
(if match
|
|
|
|
|
|
(when face
|
|
|
|
|
|
(jabber-maybe-print-rare-time
|
|
|
|
|
|
(ewoc-enter-last
|
|
|
|
|
|
jabber-chat-ewoc
|
|
|
|
|
|
(list key
|
|
|
|
|
|
(propertize msg 'face face)
|
|
|
|
|
|
:time time))))
|
|
|
|
|
|
(jabber-maybe-print-rare-time
|
|
|
|
|
|
(ewoc-enter-last jabber-chat-ewoc node))))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun jabber-muc-process-presence (jc presence)
|
|
|
|
|
|
(let* ((from (jabber-xml-get-attribute presence 'from))
|
|
|
|
|
|
(type (jabber-xml-get-attribute presence 'type))
|
|
|
|
|
|
(x-muc (cl-find-if
|
|
|
|
|
|
(lambda (x) (equal (jabber-xml-get-attribute x 'xmlns)
|
|
|
|
|
|
"http://jabber.org/protocol/muc#user"))
|
|
|
|
|
|
(jabber-xml-get-children presence 'x)))
|
|
|
|
|
|
(group (jabber-jid-user from))
|
|
|
|
|
|
(nickname (jabber-jid-resource from))
|
|
|
|
|
|
(symbol (jabber-jid-symbol from))
|
|
|
|
|
|
(our-nickname (gethash symbol jabber-pending-groupchats))
|
|
|
|
|
|
(item (car (jabber-xml-get-children x-muc 'item)))
|
|
|
|
|
|
(actor (jabber-xml-get-attribute (car (jabber-xml-get-children item 'actor)) 'jid))
|
|
|
|
|
|
(reason (car (jabber-xml-node-children (car (jabber-xml-get-children item 'reason)))))
|
|
|
|
|
|
(error-node (car (jabber-xml-get-children presence 'error)))
|
|
|
|
|
|
(status-codes (if error-node
|
|
|
|
|
|
(list (jabber-xml-get-attribute error-node 'code))
|
|
|
|
|
|
(mapcar
|
|
|
|
|
|
(lambda (status-element)
|
|
|
|
|
|
(jabber-xml-get-attribute status-element 'code))
|
|
|
|
|
|
(jabber-xml-get-children x-muc 'status)))))
|
|
|
|
|
|
;; handle leaving a room
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((or (string= type "unavailable") (string= type "error"))
|
|
|
|
|
|
;; error from room itself? or are we leaving?
|
|
|
|
|
|
(if (or (null nickname)
|
|
|
|
|
|
(member "110" status-codes)
|
|
|
|
|
|
(string= nickname our-nickname))
|
|
|
|
|
|
;; Assume that an error means that we were thrown out of the
|
|
|
|
|
|
;; room...
|
|
|
|
|
|
(let* ((leavingp t)
|
|
|
|
|
|
(message (cond
|
|
|
|
|
|
((string= type "error")
|
|
|
|
|
|
(cond
|
|
|
|
|
|
;; ...except for certain cases.
|
|
|
|
|
|
((or (member "406" status-codes)
|
|
|
|
|
|
(member "409" status-codes))
|
|
|
|
|
|
(setq leavingp nil)
|
|
|
|
|
|
(concat "Nickname change not allowed"
|
|
|
|
|
|
(when error-node
|
|
|
|
|
|
(concat ": " (jabber-parse-error error-node)))))
|
|
|
|
|
|
(t
|
|
|
|
|
|
(concat "Error entering room"
|
|
|
|
|
|
(when error-node
|
|
|
|
|
|
(concat ": " (jabber-parse-error error-node)))))))
|
|
|
|
|
|
((member "301" status-codes)
|
|
|
|
|
|
(concat "You have been banned"
|
|
|
|
|
|
(when actor (concat " by " actor))
|
|
|
|
|
|
(when reason (concat " - '" reason "'"))))
|
|
|
|
|
|
((member "307" status-codes)
|
|
|
|
|
|
(concat "You have been kicked"
|
|
|
|
|
|
(when actor (concat " by " actor))
|
|
|
|
|
|
(when reason (concat " - '" reason "'"))))
|
|
|
|
|
|
(t
|
|
|
|
|
|
"You have left the chatroom"))))
|
|
|
|
|
|
(when leavingp
|
|
|
|
|
|
(jabber-muc-remove-groupchat group))
|
|
|
|
|
|
;; If there is no buffer for this groupchat, don't bother
|
|
|
|
|
|
;; creating one just to tell that user left the room.
|
|
|
|
|
|
(let ((buffer (get-buffer (jabber-muc-get-buffer group))))
|
|
|
|
|
|
(if buffer
|
|
|
|
|
|
(with-current-buffer buffer
|
|
|
|
|
|
(jabber-muc-maybe-decorate-presence
|
|
|
|
|
|
(list (if (string= type "error")
|
|
|
|
|
|
:muc-error
|
|
|
|
|
|
:muc-notice)
|
|
|
|
|
|
message
|
|
|
|
|
|
:time (current-time)))))
|
|
|
|
|
|
(message "%s: %s" (jabber-jid-displayname group) message))))
|
|
|
|
|
|
;; or someone else?
|
|
|
|
|
|
(let* ((plist (jabber-muc-participant-plist group nickname))
|
|
|
|
|
|
(jid (plist-get plist 'jid))
|
|
|
|
|
|
(name (concat nickname
|
|
|
|
|
|
(when jid
|
|
|
|
|
|
(concat " <"
|
|
|
|
|
|
(jabber-jid-user jid)
|
|
|
|
|
|
">")))))
|
|
|
|
|
|
(jabber-muc-remove-participant group nickname)
|
|
|
|
|
|
(with-current-buffer (jabber-muc-create-buffer jc group)
|
|
|
|
|
|
(jabber-muc-maybe-decorate-presence
|
|
|
|
|
|
(list :muc-notice
|
|
|
|
|
|
(cond
|
|
|
|
|
|
((member "301" status-codes)
|
|
|
|
|
|
(concat name " has been banned"
|
|
|
|
|
|
(when actor (concat " by " actor))
|
|
|
|
|
|
(when reason (concat " - '" reason "'"))))
|
|
|
|
|
|
((member "307" status-codes)
|
|
|
|
|
|
(concat name " has been kicked"
|
|
|
|
|
|
(when actor (concat " by " actor))
|
|
|
|
|
|
(when reason (concat " - '" reason "'"))))
|
|
|
|
|
|
((member "303" status-codes)
|
|
|
|
|
|
(concat name " changes nickname to "
|
|
|
|
|
|
(jabber-xml-get-attribute item 'nick)))
|
|
|
|
|
|
(t
|
|
|
|
|
|
(concat name " has left the chatroom")))
|
|
|
|
|
|
:time (current-time))))))
|
|
|
|
|
|
(t
|
|
|
|
|
|
;; someone is entering
|
|
|
|
|
|
|
|
|
|
|
|
(when (or (member "110" status-codes) (string= nickname our-nickname))
|
|
|
|
|
|
;; This is us. We just succeeded in entering the room.
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; The MUC server is supposed to send a 110 code whenever this
|
|
|
|
|
|
;; is our presence ("self-presence"), but at least one
|
|
|
|
|
|
;; (ejabberd's mod_irc) doesn't, so check the nickname as well.
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; This check might give incorrect results if the server
|
|
|
|
|
|
;; changed our nickname to avoid collision with an existing
|
|
|
|
|
|
;; participant, but even in this case the window where we have
|
|
|
|
|
|
;; incorrect information should be very small, as we should be
|
|
|
|
|
|
;; getting our own 110+210 presence shortly.
|
|
|
|
|
|
(let ((whichgroup (assoc group *jabber-active-groupchats*)))
|
|
|
|
|
|
(if whichgroup
|
|
|
|
|
|
(setcdr whichgroup nickname)
|
|
|
|
|
|
(add-to-list '*jabber-active-groupchats* (cons group nickname))))
|
|
|
|
|
|
;; The server may have changed our nick. Record the new one.
|
|
|
|
|
|
(puthash symbol nickname jabber-pending-groupchats))
|
|
|
|
|
|
|
|
|
|
|
|
;; Whoever enters, we create a buffer (if it didn't already
|
|
|
|
|
|
;; exist), and print a notice. This is where autojoined MUC
|
|
|
|
|
|
;; rooms have buffers created for them. We also remember some
|
|
|
|
|
|
;; metadata.
|
|
|
|
|
|
(let ((old-plist (jabber-muc-participant-plist group nickname))
|
|
|
|
|
|
(new-plist (jabber-muc-parse-affiliation x-muc)))
|
|
|
|
|
|
(jabber-muc-modify-participant group nickname new-plist)
|
|
|
|
|
|
(let ((report (jabber-muc-report-delta nickname old-plist new-plist
|
|
|
|
|
|
reason actor)))
|
|
|
|
|
|
(when report
|
|
|
|
|
|
(with-current-buffer (jabber-muc-create-buffer jc group)
|
|
|
|
|
|
(jabber-muc-maybe-decorate-presence
|
|
|
|
|
|
(list :muc-notice report
|
|
|
|
|
|
:time (current-time)))
|
|
|
|
|
|
;; Did the server change our nick?
|
|
|
|
|
|
(when (member "210" status-codes)
|
|
|
|
|
|
(ewoc-enter-last
|
|
|
|
|
|
jabber-chat-ewoc
|
|
|
|
|
|
(list :muc-notice
|
|
|
|
|
|
(concat "Your nick was changed to " nickname " by the server")
|
|
|
|
|
|
:time (current-time))))
|
|
|
|
|
|
;; Was this room just created? If so, it's a locked
|
|
|
|
|
|
;; room. Notify the user.
|
|
|
|
|
|
(when (member "201" status-codes)
|
|
|
|
|
|
(ewoc-enter-last
|
|
|
|
|
|
jabber-chat-ewoc
|
|
|
|
|
|
(list :muc-notice
|
|
|
|
|
|
(with-temp-buffer
|
|
|
|
|
|
(insert "This room was just created, and is locked to other participants.\n"
|
|
|
|
|
|
"To unlock it, ")
|
|
|
|
|
|
(insert-text-button
|
|
|
|
|
|
"configure the room"
|
|
|
|
|
|
'action (apply-partially 'call-interactively 'jabber-muc-get-config))
|
|
|
|
|
|
(insert " or ")
|
|
|
|
|
|
(insert-text-button
|
|
|
|
|
|
"accept the default configuration"
|
|
|
|
|
|
'action (apply-partially 'call-interactively 'jabber-muc-instant-config))
|
|
|
|
|
|
(insert ".")
|
|
|
|
|
|
(buffer-string))
|
|
|
|
|
|
:time (current-time))))))))))))
|
|
|
|
|
|
|
2022-04-27 13:38:03 +00:00
|
|
|
|
(defun +jabber-colors-update (&optional buffer)
|
|
|
|
|
|
"Update jabber colors in BUFFER, defaulting to the current."
|
|
|
|
|
|
(with-current-buffer (or buffer (current-buffer))
|
|
|
|
|
|
(when jabber-buffer-connection
|
|
|
|
|
|
(setq jabber-muc-participant-colors nil)
|
|
|
|
|
|
(cond (jabber-chatting-with
|
|
|
|
|
|
(jabber-chat-create-buffer jabber-buffer-connection
|
|
|
|
|
|
jabber-chatting-with))
|
|
|
|
|
|
(jabber-group
|
|
|
|
|
|
(jabber-muc-create-buffer jabber-buffer-connection
|
|
|
|
|
|
jabber-group))))))
|
|
|
|
|
|
|
2022-01-25 22:57:38 +00:00
|
|
|
|
(provide '+jabber)
|
|
|
|
|
|
;;; +jabber.el ends here
|
