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

This is fairly close to working properly. There's a sizeable chunk of debuging code starting at line 182 as well as various messages that should be commented or nuked in my local version eventually, maybe. I've disabled support for including a raw lisp expression as the first element of the sequence. I'm thinking about the wisdom of using a token stream instead of plucking things from the head and recursing when something has to wrap &rest. It's quite possible this is close enough to what I need that I don't reach a conclusion for some time.

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.