From aab5bfd074e57d06a79e39d7c7c4760e1f385a06 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Mon, 17 Oct 2022 21:41:28 -0500 Subject: Bankruptcy 9 --- lisp/+jabber.el | 278 -------------------------------------------------------- 1 file changed, 278 deletions(-) delete mode 100644 lisp/+jabber.el (limited to 'lisp/+jabber.el') diff --git a/lisp/+jabber.el b/lisp/+jabber.el deleted file mode 100644 index e018b0c..0000000 --- a/lisp/+jabber.el +++ /dev/null @@ -1,278 +0,0 @@ -;;; +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) - -(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) - -(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))) - -;;; Hiding presence messages: -;; https://paste.sr.ht/~hdasch/f0ad09fbcd08e940a4fda71c2f40abc1c4efd45f - -;; 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)))))))))))) - -(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)))))) - -(provide '+jabber) -;;; +jabber.el ends here -- cgit 1.4.1-21-gabe81