[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/rcirc-update 13f6f78 16/18: Allow for optional arguments using r
From: |
Philip Kaludercic |
Subject: |
feature/rcirc-update 13f6f78 16/18: Allow for optional arguments using rcirc-define-command |
Date: |
Thu, 10 Jun 2021 11:43:41 -0400 (EDT) |
branch: feature/rcirc-update
commit 13f6f78473436ee5e0127f5ae993710cd7cddd4b
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>
Allow for optional arguments using rcirc-define-command
* rcirc.el (rcirc-define-command): Handle &optional arguments
---
lisp/net/rcirc.el | 79 ++++++++++++++++++++++++++-----------------------------
1 file changed, 38 insertions(+), 41 deletions(-)
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index edd5b87..c1f5643 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -2363,25 +2363,33 @@ prefix with another element in PAIRS."
(defmacro rcirc-define-command (command arguments &rest body)
"Define a new client COMMAND in BODY that takes ARGUMENTS.
-Just like `defun', a string at the beginning of BODY is
-interpreted as the documentation string. Following that, an
-interactive form can specified."
+ARGUMENTS may designate optional arguments using a single
+`&optional' symbol. Just like `defun', a string at the beginning
+of BODY is interpreted as the documentation string. Following
+that, an interactive form can specified."
(declare (debug (symbolp (&rest symbolp) def-body))
(indent defun))
(cl-check-type command symbol)
(cl-check-type arguments list)
- (let ((fn-name (intern (concat "rcirc-cmd-" (symbol-name command))) )
- (regexp (with-temp-buffer
- (insert "\\`")
- (when arguments
- (dotimes (_ (1- (length arguments)))
- (insert "\\(.+?\\)[[:space:]]*"))
- (insert "\\(.*\\)"))
- (insert "[[:space:]]*\\'")
- (buffer-string)))
- (argument (gensym))
- documentation
- interactive-spec)
+ (let* ((fn-name (intern (concat "rcirc-cmd-" (symbol-name command))))
+ (total (length (remq '&optional arguments)))
+ (required (- (length arguments) (length (memq '&optional arguments))))
+ (optional (- total required))
+ (regexp (with-temp-buffer
+ (insert "\\`")
+ (when arguments
+ (dotimes (_ (1- (length arguments)))
+ (insert "\\(?:\\(.+?\\)[[:space:]]*"))
+ (insert "\\(.*\\)")
+ (dotimes (i (1- (length arguments)))
+ (when (< i optional)
+ (insert "?"))
+ (insert "\\)")))
+ (insert "[[:space:]]*\\'")
+ (buffer-string)))
+ (argument (gensym))
+ documentation
+ interactive-spec)
(when (stringp (car body))
(setq documentation (pop body)))
(when (eq (car-safe (car-safe body)) 'interactive)
@@ -2393,17 +2401,17 @@ interactive form can specified."
"\nby `rcirc-buffer-process' and `rcirc-target' will be
used.")
(interactive ,@interactive-spec)
(unless (if (listp ,argument)
- (= (length ,argument) ,(length arguments))
+ (not (<= ,required (length ,argument) ,total))
(string-match ,regexp ,argument))
(user-error "Malformed input: %S" ',arguments))
(let ((process (or process (rcirc-buffer-process)))
(target (or target rcirc-target)))
(ignore target process)
(let (,@(cl-loop
- for i from 0 for arg in arguments
+ for i from 0 for arg in (delq '&optional arguments)
collect `(,arg (if (listp ,argument)
- (nth ,i ,argument)
- (match-string ,(1+ i)
,argument)))))
+ (nth ,i ,argument)
+ (match-string ,(1+ i) ,argument)))))
,@body)))
(add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name
command))))))
@@ -2442,30 +2450,22 @@ CHANNELS is a comma- or space-separated string of
channel names."
(read-string "Channel: ")))
(rcirc-send-string process "INVITE" nick channel))
-(rcirc-define-command part (channel)
+(rcirc-define-command part (&optional channel reason)
"Part CHANNEL.
CHANNEL should be a string of the form \"#CHANNEL-NAME REASON\".
If omitted, CHANNEL-NAME defaults to TARGET, and REASON defaults
to `rcirc-default-part-reason'."
- (interactive "sPart channel: ")
- (let ((channel (if (> (length channel) 0) channel target))
- (msg rcirc-default-part-reason))
- (when (string-match "\\`\\([&#+!]\\S-+\\)?\\s-*\\(.+\\)?\\'" channel)
- (when (match-beginning 2)
- (setq msg (match-string 2 channel)))
- (setq channel (if (match-beginning 1)
- (match-string 1 channel)
- target)))
- (rcirc-send-string process "PART" channel : msg)))
-
-(rcirc-define-command quit (reason)
+ (interactive "sPart channel: \nsReason: ")
+ (rcirc-send-string process "PART" (or channel target)
+ : (or reason rcirc-default-part-reason)))
+
+(rcirc-define-command quit (&optional reason)
"Send a quit message to server with REASON."
(interactive "sQuit reason: ")
- (rcirc-send-string process "QUIT" : (if (not (zerop (length reason)))
- reason
- rcirc-default-quit-reason)))
+ (rcirc-send-string process "QUIT"
+ : (or reason rcirc-default-quit-reason)))
-(rcirc-define-command reconnect (_)
+(rcirc-define-command reconnect ()
"Reconnect to current server."
(interactive "i")
(with-rcirc-server-buffer
@@ -2483,15 +2483,12 @@ to `rcirc-default-part-reason'."
(interactive (list (read-string "New nick: ")))
(rcirc-send-string process "NICK" nick))
-(rcirc-define-command names (channel)
+(rcirc-define-command names (&optional channel)
"Display list of names in CHANNEL or in current channel if CHANNEL is nil.
If called interactively, prompt for a channel when prefix arg is supplied."
(interactive (list (and current-prefix-arg
(read-string "List names in channel: "))))
- (let ((channel (if (> (length channel) 0)
- channel
- target)))
- (rcirc-send-string process "NAMES" channel)))
+ (rcirc-send-string process "NAMES" (or channel target)))
(rcirc-define-command topic (topic)
"List TOPIC for the TARGET channel.
- feature/rcirc-update ab49a9a 10/18: Implement batch extension, (continued)
- feature/rcirc-update ab49a9a 10/18: Implement batch extension, Philip Kaludercic, 2021/06/10
- feature/rcirc-update f6e18c6 13/18: Implement invite-notify capability, Philip Kaludercic, 2021/06/10
- feature/rcirc-update 567e288 11/18: Implement message-ids extension, Philip Kaludercic, 2021/06/10
- feature/rcirc-update 95fdd4b 14/18: Allow filtering how nicks are presented, Philip Kaludercic, 2021/06/10
- feature/rcirc-update b67b1ee 15/18: Fix prompt doubling when reconnecting, Philip Kaludercic, 2021/06/10
- feature/rcirc-update 6898816 01/18: Default to libera instead of freenode, Philip Kaludercic, 2021/06/10
- feature/rcirc-update 0b367ec 06/18: Remove custom rcirc-completion implementation, Philip Kaludercic, 2021/06/10
- feature/rcirc-update 4ff1f66 07/18: Replace defun-rcirc-command with rcirc-define-command, Philip Kaludercic, 2021/06/10
- feature/rcirc-update 849e71f 09/18: Implement server-time extension, Philip Kaludercic, 2021/06/10
- feature/rcirc-update 3a61e7b 17/18: Use defvar-local instead of setq-local where applicable, Philip Kaludercic, 2021/06/10
- feature/rcirc-update 13f6f78 16/18: Allow for optional arguments using rcirc-define-command,
Philip Kaludercic <=
- feature/rcirc-update e6c99a7 04/18: Integrate formatting into rcirc-send-string, Philip Kaludercic, 2021/06/10