yowsup-el/yowsup.el

;;; yowsup-el --- Yowsup for Emacs -*- coding: utf-8; lexical-binding: t -*-
;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
;;;
;;; This file is part of yowsup-el.
;;;
;;; yowsup-el 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 3 of the License, or (at
;;; your option) any later version.
;;;
;;; yowsup-el 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 yowsup-el.  If not, see <http://www.gnu.org/licenses/>.


(require 'cl-lib)
(require 'comint)
(require 'r5rs)
(require 'srfi-1)


(cl-macrolet ((λ (formals form &rest forms)
                `(lambda ,formals
                   ,form
                   ,@forms))

              (add-hook! (hook proc)
                         `(add-hook ',hook ,proc))

              (buffer-exists? (buf-name)
                              `(get-buffer ,buf-name))

              (put! (sym prop val)
                    `(put ,sym ,prop ,val))

              (current-file-name ()
                                 (or byte-compile-current-file ; compile-time
                                     load-file-name ; load-time
                                     buffer-file-name)) ; eval-time

              (escape-string (str)
                             `(replace-regexp-in-string (rx (group (or "'"
                                                                       "`"
                                                                       "\\")))
                                                        "\\\\=\\1"
                                                        ,str))

              (escape (x)
                      (r5-let ((x* (cl-gensym)))
                        `(r5-let ((,x* ,x))
                           (if (r5-string? ,x*)
                               (escape-string ,x*)
                             ,x*))))

              (define-with-docs (var docs val)
                `(r5-begin (r5-define ,var ,val)
                           (put! ',var
                                 'variable-documentation
                                 (format "Global variable defined in url `%s'.
Default value is `%s'.

%s"
                                         (escape (current-file-name))
                                         (escape (with-output-to-string
                                                   (r5-write ,var)))
                                         ,docs)))))


  ;; variables intended to be modified by users

  (define-with-docs yowsup-process-name
    "Default name for Yowsup process."

    "Yowsup Cli client")

  (define-with-docs yowsup-buffer-name
    "Default name for Yowsup buffer."

    (r5-string-append "*" yowsup-process-name "*"))

  (define-with-docs yowsup-config
    "Default configuration file for Yowsup."

    "~/.yowsup/config")

  (define-with-docs yowsup-init
    "Default initialization file for Yowsup."

    "~/.yowsup/init")

  (define-with-docs yowsup-log
    "Default log file for Yowsup."

    "~/.yowsup/log")

  (define-with-docs yowsup-cli
    "Default location for Yowsup Cli."

    "~/.local/bin/yowsup-cli")

  (define-with-docs yowsup-cli-command
    "Default command for Yowsup Cli."

    "demos")

  (define-with-docs yowsup-cli-args
    "Default arguments for Yowsup Cli."

    `("--config" ,(expand-file-name yowsup-config)
      "--yowsup"))


  (define-minor-mode yowsup-logging-mode
    "Minor mode for logging Yowsup session."
    :lighter " Logging")

  (define-derived-mode yowsup-mode comint-mode "Yowsup"
    "Major mode for `run-yowsup'."
    (yowsup-logging-mode 1))

  (define-key yowsup-mode-map (kbd "<tab>") #'completion-at-point)


  ;; make current file name referenced in doc string clickable
  (let* ((current-file-name-regex (regexp-quote (current-file-name)))
         (any-str-regex (rx (* anything)))
         (regex-proc-pair? (λ (x)
                             (pcase-exhaustive x
                               (`(,(pred r5-string?) . ,_)
                                t)
                               (_
                                '()))))
         (regex-proc-alist? (λ (x)
                              (and (r5-list? x)
                                   (s1-every regex-proc-pair? x)))))

    (r5-set! browse-url-browser-function
             (cons (cons current-file-name-regex #'browse-url-emacs)
                   (if (funcall regex-proc-alist? browse-url-browser-function)
                       browse-url-browser-function
                     `((,any-str-regex . ,browse-url-browser-function))))))


  ;; save to log file when Yowsup buffer is killed if `yowsup-logging-mode' is
  ;; enabled
  (let* ((end-with-newline? (λ (str)
                              (string-match-p (rx "\n" eos) str)))
         (ensure-final-newline (λ (str)
                                 (if (funcall end-with-newline? str)
                                     str
                                   (r5-string-append str "\n")))))

    (add-hook! kill-buffer-hook
               (λ ()
                 (if (and (r5-eq? major-mode 'yowsup-mode)
                          yowsup-logging-mode)
                     (r5-let ((content (funcall ensure-final-newline
                                                (buffer-string))))
                       (append-to-file content '() yowsup-log))
                   '()))))


  ;; completion for Yowsup
  (add-hook! comint-dynamic-complete-functions
             (λ ()
               (if (r5-eq? major-mode 'yowsup-mode)
                   (r5-let ((match (string-match-p (rx "]:" (* nonl) eos)
                                                   (buffer-string))))
                     (if match
                         (r5-let ((start (r5+ match (r5-string-length "]:") 1))
                                  (end (point))
                                  (commands '("/L"
                                              "/account"
                                              "/audio"
                                              "/contact"
                                              "/contacts"
                                              "/disconnect"
                                              "/group"
                                              "/groups"
                                              "/help"
                                              "/ib"
                                              "/image"
                                              "/keys"
                                              "/login"
                                              "/message"
                                              "/ping"
                                              "/presence"
                                              "/profile"
                                              "/seq"
                                              "/state"
                                              "/statuses"
                                              "/video")))
                           (list start end commands))
                       '()))
                 '())))


  (r5-define (run-yowsup)
    "Start Yowsup.

Logging is enabled by default.
To disable it temporarily, toggle `yowsup-logging-mode'.
To disable it permanietly, add the following to your init file:

  (add-hook 'yowsup-mode-hook
            (lambda ()
              (yowsup-logging-mode -1)))"
    (interactive)
    (if (buffer-exists? yowsup-buffer-name)
        (switch-to-buffer yowsup-buffer-name)
      (r5-let ((buf (generate-new-buffer yowsup-buffer-name))
               (args (cons yowsup-cli-command yowsup-cli-args)))
        (switch-to-buffer buf)
        (yowsup-mode)
        (apply #'make-comint-in-buffer
               yowsup-process-name
               yowsup-buffer-name
               yowsup-cli
               yowsup-init
               args)))))


(provide 'yowsup)