erc setup sequencing

erc-frames-mode.el

;;; erc-frames-mode.el --- sequence erc setup -*- lexical-bindings:t -*-
;; Copyright (C) 2019 Corwin Brust

;; Author: Corwin Brust <corwin@bru.st>
;; URL: http://dpaste.com/3NFJV60
;; Version: 0.1-pre
;; Package-Requires: ((emacs "26.0"))
;; Keywords: ERC IRC

;; This file is not part of GNU Emacs.

;;; License:
;; This program 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.
;; This program 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;    This started from some samples on EmacsWiki:
;;      https://www.emacswiki.org/emacs/ErcStartupFiles
;;    I was having trouble with `my-irc' multi-connect solution playing
;;    nicely with autojoin, particularly when joining multiple channels
;;    of the same name when making several connections at around the
;;    same time.   I also wanted to have my ERC start-up sequence
;;    include my display setup, like frame creation and window sizing.
;;
;;    Emacs init sample:
;;
;;      (require 'erc-frames-mode)
;;      (setq erc-connection-alist
;;         '(label . (:frame (title . "ERC")
;;		      :use-tls
;;	              :open (:nick "sk33t3r"
;;   			     :password "007"
;;    			     :server irc.freenode.net
;;   			     :port 6667
;;     			     )
;;     		      :join "#channel"  ;;  join
;;		      :split            ;;  50% horizontal
;;		      :switch           ;;  switch window
;;		      :join "#another"  ;;  channels tiled
;;		      )))
;;      (easy-menu-add-item nil '("tools")
;;                          ["IRC with ERC" efm-start t])
;;      ;; uncomment to connect when Emacs starts
;;      ;;(efm-start)
;;; Code:

(defgroup erc-frames-mode nil
  "Sequence your ERC connections with other actions."
  :group 'erc)

(defcustom  erc-connection-alist '()
  "Action sequences for `erc-frames-mode'.

Entries take the form of con cells:

  \(CONNECTION-LABEL . CONFIG)

Where CONNECTION-LABEL is a symbol available when using
`efm-start' interactively and CONFIG is a mixed list of keywords
and arguments to delegate functions mapped to these keywords.

  (:KEYWORD [ ARGS-OR-NEXT-KEYWORD [ ... ]])

Include sexp with :progn, e.g.

  :progn (message \"Hello, Emacs Lisp!\")

See `efm-open' for additional information on how this variable is used.
See `efm-keyword-plist' for all of the keywords supported by default."
  :type '(alist :key-type symbol)
  :group 'erc-frames-mode)


(defcustom erc-frame-plist '((name . "Emacs IRC")
			     (minibuffer . t)
			     (fullscreen . fullboth))
  "Plist providing default frame properties for `efm-make-frame'."
  :type '(repeat (cons :format "%v"
		       (symbol :tag "Parameter")
		       (sexp :tag "Value")))
  :group 'erc-frames-mode)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; eekmacs --- Emacs ERC Keyword MACroS

(defcustom efm-keyword-plist
  '(:erc      ( ;;:push (:once-on erc-after-connect)
	        ;; :wrap-rest (:once-on erc-after-connect)
		     :prep efm--erc-prep :delegate erc)
    :open     (:prep efm--erc-prep :delegate erc-open)
    :join     (:prep efm--once-on :prep-args (erc-join-hook)
	       :delegate erc-join-channel)
    :use-tls  (:prep efm--with :prep-args (erc-connect-function erc-open-ssl-stream))
    :no-tls   (:prep efm--with :prep-args (erc-connect-function open-network-stream))

    :frame    efm-make-frame
    :switch   (:prep efm--maybe-unset-defaults
	       :delegate other-window
	       :args (1))
    :split    (:delegate split-window :args (nil))

    :with     (:prep efm--with)
    :once-on  (:prep efm--once-on)
    :inhibit  (:prep efm--inhibit)
    ;;stop      (:prep efm--inhibit)

    :message  message
    :progn    progn)
  "Map of KEYWORD to DESIGN for `erc-frames-mode'.

Keywords on the cons side will be available for use in sequences
processed by `efm-start' (and `efm-prep').  In the simplest case,
DESIGN is a function to be executed each time KEYWORD is
encountered.  In more complex cases a plist may be specified including
   :delegate,  function: same as above
   :args, list: preprended to any args to :delegate from the sequence
   :prep, function: called when KEYWORD is encounted during parsing
   :prep-args, list: prepended to any remaing sequence when applying :prep

Unlike other keywords, :frame accepts arguments as a plist which
is merged with any properties supplied within the sequence.  To
modify default :frame properties customize `erc-frame-plist'.

The following keywords are supported by default:
  :erc, open an ERC connection, arguments per `erc'.
  :open, open an ERC connection, arguments per `erc-open'.
  :join, join a channel, arguments per `erc-join-channel'.
  :use-tls, setup ERC to open for TLS connection (args ignored)
  :use-tls, setup ERC to open a non-TLS connection (args ignored)
  :frame, create a display frame when running under a window manager
  :switch, change the currently selected window (args per `other-window'),
  :split, split the currently selected window (args per
  `split-window' omitted the first which would otherwise allow
  selection of a context window other than the current).
  :message, format args for output to the Minibuffer and *Messages*.
  :with, lexically bind a variable for the remainder of the
  sequence (arg is the variable to declare).
  :once-on, Arg is an hook on which remainder of sequence will be
  run (at most) once.
  :inhibit, arguments and any remaining sequence will be ignored.
  :progn, argument is an sexp to evaulate at this point in the sequence."
  :type '(plist :key-type (symbol :tag "Keyword")
		:value-type (choice :tag "Design" symbol plist))
				    ;; (set (group (const :prep) symbol)
				    ;; 	 (group (const :prep-args) plist)
				    ;; 	 (group (const :delegate) symbol)
				    ;; 	 (group (const :args) plist))
  :group 'erc-frames-mode)

;; (setq cust-foo '(x (a 1 b 2 z "zz")))
;; (defcustom cust-foo nil "Testing custom types."
;;   :group 'erc-frames-mode
;;   :type '(plist :value-type ;;plist))
;; 		(choice (group (const a) integer)
;; 			(group (const b) integer)
;; 			(group (const z) string))))

(defvar efm-rest nil
  "Remaining configuration forms while `efm-prep' is running.")

(defvar efm-args nil
  "Arguments to the next delegate while `efm-prep' is running.")

(defvar efm-keyword nil "Keyword being processed when `efm-prep' is running.")

(defvar efm-default-args nil
  "Default arguments to the next deligate while `efm-prep' is running.")

;; nicked from Troy Pracy's list utils - https://github.com/troyp/asoc.el
(defun efm-compress-alists (&rest alists)
  "Dedeuplicate and merge ALISTS.

Take the first value for each property from the last list defining it.  This
function essencially inlines `asoc-merge' with `assoc---uniq' from Troy Pracy's
assoc.el whence it was unabashedly nicked.  This is currently used only to merge
frame properties supplied with a sequence with package defaults and may be
removed in the future if it is not then more heavly required.

  URL: https://github.com/troyp/asoc.el"
  (let (result
	(rest (apply #'append (nreverse alists))))
    (while rest
      (let* ((pair (car rest))
	     (key  (car pair)))
	(unless (equal key result)
	  (push pair result))
	(setq rest (cdr rest))))
    (nreverse result)))
;;(efm-compress-alists'((a . 1) (b . 2) (b . 4)) '((a . 5) (c . 5) (c . 6)))

(defun efm--erc-prep (&rest forms)
  "Preprocess :erc and :erc-open.

Wrap FORMS in a single use `erc-after-connect' function."
  (when (eq efm-keyword ':erc)
    (efm--args-car-args forms))
  (setq efm-rest (append '(:once-on erc-after-connect) efm-rest))
  nil)

(defun efm-make-frame (&optional frame-props)
  "First `make-frame' then `select-frame'.

FRAME-PROPS are properties each of which replace any overlapping
default supplied by `erc-frame-plist'."
  (message "props:%s, display-graphics-p:%s" frame-props (display-graphic-p))
  (when (display-graphic-p)
    (select-frame (make-frame (efm-compress-alists
			       (or erc-frame-plist '())
			       (or frame-props '()))))))

;;(efm-make-frame '((name . "new name")))


;; this is cute but seems slow and without benifit pending better hook support
;; (defun efm-stop ()
;;   "Stop `efm-prep' by adding a stop directive to the head of the seqeunece."
;;   (interactive)
;;   (when (boundp 'efm-rest)
;;     (push 'stop efm-rest)))
(defun efm-truncate ()
  "Stop `efm-prep' by removing the remainig configuration sequence forms."
  (interactive)
  (when (boundp 'efm-rest)
    (setq efm-rest nil)))

(defun efm--args-car-args (&rest forms)
  "Unwrap delegate args given as a list.

Set `efm-args' to its `car' when it is a list.  Neitherprocess nor
alter FORMS.  Return nil.

Hense:
  :k1 (:k2 \"value\")

Becomes:
  (fn :k2 \"value\")

Given `efm-keyword-map' contains something like:
  (:k1 (:delegate fn :prep efm--unpack-keyword-args))."
  (declare (indent 0))
  (when (and efm-args
	     (listp efm-args))
    (setq efm-args (car efm-args)))
  nil)

(defun efm--maybe-unset-defaults (&rest forms)
  "Clear default delegate args when sequence provides any.

Sets `efm-default-args' to nil when efm-args is a non-zero length
list.  Neitherprocess nor alter FORMS.  Return nil."
  (declare (indent 0))
  (when (and efm-args
	     (< 0 (length efm-args)))
    (setq efm-default-args nil))
  nil)

(defun efm--inhibit (&rest forms)
  "Supress processing of any remaining configuration sequence FORMS."
  (declare (indent 0))
  (efm-truncate))

(defun efm--with (var val &rest forms)
  "Wrap FORMS with let form binding VAR to VAL."
  (declare (indent 2))
  (efm-truncate)
  `(let ((,var ,val)) ,@(apply 'efm-prep forms)))
;; (progn (let ((x "y"))
;; 	 (efm--with 'x "z" (message "during: x=%s" x))
;; 	 (message "after: x=%s" x)))
;;(eval (efm--with 'x "z" (message "x=%s" x)))

(defun efm--once-on (hook &rest forms)
  "Execute FORMS exactly once, when HOOK is run."
  (declare (indent 1))
;;;  (message "[efm-1ce] starting for %s => %s" hook forms)
  (efm-truncate)
  (let ((hook-func (make-symbol (concat "efm--once-on-"
					(symbol-name hook)))))
    `(let ((,hook-func (lambda (&rest ignored)
			 (remove-hook ',hook ',hook-func)
			 ,@(apply 'efm-prep forms))))
       ;;(message "[efm-1ce] hook:%s func:%s forms:%s" hook hook-func forms)
       (add-hook ',hook ,hook-func))))

;;(progn (setq my-hook nil) (efm--once-on 'my-hook '(message "hello")) (run-hooks my-hook))
;; (let ((x nil)
;;       (my-hook nil))
;;   (eval (efm-start
;; 	 '(foo . ((message "hi")
;; 		  :with x 1 :split
;; 		  :test ?a :test ?b
;; 		  :once-on my-hook
;; 		  :message "x=%s :)" x))
;; 	 '(bar . (:progn (run-hooks 'my-hook)
;; 		  :progn (message "my-hook:%s" my-hook)
;; 		  :test-2 ?c :test ?d)))))

;; TODO: maybe rewrite for index based parsing?
;;;;;;;;
;; (defun efm-preprocessor (&rest forms)
;;   "Docstring involving FORMS."
;;   (declare (indent 0))
;;   (let ((first-keyword-index (gensym))
;; 	(first-argument-index (gensym)))
;;     ))
(defsubst not-keywordp (object)
  "Return t when keywordp would return nil given OBJECT."
  (not (keywordp object)))

;; this one pretty much works. need to change how raw sexp is
;; plucked from seq head but other than that HUGE BUG...
(defun efm-prep (&rest efm-sequence)
  "Preprocess and expand EFM-SEQUENCE.

Collect and return forms -if any- in reverse the order emitted during keyword
expansion, e.g. keyword delegate invication or from preprocessor functions.
`efm-keyword-plist'."
  (declare (indent 0))
  (let (efm-prep-return-forms)
    (while (when-let ((efm-keyword (car efm-sequence)))
	     (let (;;(efm-sexp (seq-take-while 'not-keywordp
		   ;;			     efm-sequence))
		   (efm-args (seq-take-while 'not-keywordp
					     (cdr efm-sequence)))
		   (efm-rest (seq-drop-while 'not-keywordp
					     (cdr efm-sequence))))
(message "[efmp] start %s args:%s sexp: %s (rest:%s)" efm-keyword efm-args nil efm-rest)
	       (when-let ((efm-delegate  ;; right side of map entry
			   (and (keywordp efm-keyword)
				(cadr (memq efm-keyword
					    efm-keyword-plist)))))
;;;(message "[efmp] delegate for %s: %s" efm-keyword efm-delegate)
		 (let* ((efm-prep-args
			 (plist-get efm-delegate ':prep-args))
			(efm-prep (plist-get efm-delegate ':prep))
			(efm-default-args
			 (plist-get efm-delegate ':args))
			(efm-delegate
			 (if (symbolp efm-delegate)
			     efm-delegate
			   (plist-get efm-delegate ':delegate)))
			(efm-prep-forms
			 (and efm-prep
			      (symbolp efm-prep)
			      (apply efm-prep
				     (append efm-prep-args
					     efm-args
					     efm-rest))))
			(efm-delegate-form
			 (and efm-delegate
			      (symbolp efm-delegate)
			      `(,efm-delegate ,@(append efm-default-args
							efm-args)))))
		   (when efm-prep-forms (push efm-prep-forms efm-prep-return-forms))
		   (when efm-delegate-form (push efm-delegate-form efm-prep-return-forms))
		   ;;(when efm-sexp (push `efm-sexp efm-prep-return-forms))
		   ))
;;;(message "[efmp] end %s (rest: %s)" efm-keyword efm-rest)
	       (setq efm-sequence efm-rest))))
;;;(message "final-prep-forms:\n%s" (pp efm-prep-return-forms))
    (reverse (delete nil efm-prep-return-forms))))

(defun efm-start (&rest config)
  "Execute a sequence of actions based on CONFIG.

When called interactivly CONFIG is a symbol matching car of an
`erc-connection-alist' entry.  When called with no arguments,
process all forms from all entries.  Otherwise CONFIG is the list
of forms to process and execute.

This module started out as a *not* drop in replacement for
`erc-autojoin-mode'.  They almost certianly should not be used
together.  Specificly, behavior is unpredicatble when
`erc-autojoin' and `erc-frames-mode' are both used to join
channels.  Both make use of `erc-after-comment' where Emacs does
not garuntee the execution order of conformant hooks.  As a work
around, if erc-frames-mode is used only to handle the initial
connection but you would like erc-autojoin handle to reconnect:

  :progn (erc-after-connect-mode t)

TODO: interactive auto-completion from `erc-commention-alist' cars."
  (interactive "S")
  (declare (indent 0))
  (if (called-interactively-p 'any)
      (setq config (assoc config erc-connection-alist))
    (unless config
      (setq config erc-connection-alist)))
  (let (efm-forms)
    (when-let* ((efm-config-rest config))
      (while (when-let* ((efm-config (car efm-config-rest))
			 (efm-label (car efm-config))
			 (efm-sequence (cdr efm-config)))
;;;(message "label:%s, seq:%s, config:%s" efm-label efm-sequence efm-config)
	       ;; (push (append (seq-take-while 'not-keywordp efm-sequence)
	       ;; 		     (apply 'efm-prep efm-sequence))
	       ;; 	     efm-forms)
	       (setq efm-forms
		     (append efm-forms
			     ;; disable prefix sexp support, for now
			     ;;(seq-take-while 'not-keywordp efm-sequence)
			     (reverse (apply 'efm-prep efm-sequence))))
;;;(message "[emfs] final-forms:\n%s" (pp efm-forms))
	       (setq efm-config-rest (cdr efm-config-rest)))))
    ;;(eval
     (insert (concat "\n" (pp (append '(progn) (reverse efm-forms))))))
    ;; )
  )

(provide 'erc-frames-mode)
;;; erc-frames-mode.el ends here

Hey -- don't let my propr comment fool you. This is NOT working property and likely has huge bugs I don't even know about. Thanks.