[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] scratch/hook-helpers e253e03 11/19: Implemented new design for an
From: |
Ian Dunn |
Subject: |
[elpa] scratch/hook-helpers e253e03 11/19: Implemented new design for anonymous helpers |
Date: |
Sun, 23 Apr 2017 12:50:40 -0400 (EDT) |
branch: scratch/hook-helpers
commit e253e03ba5d298d52bb201bdf5b1045d0f9e24ae
Author: Ian Dunn <address@hidden>
Commit: Ian Dunn <address@hidden>
Implemented new design for anonymous helpers
This involved a complete refactoring of hook-helpers.el that users
shouldn't notice. Functions are no longer created in the background, but
instead lambda functions are used.
* hook-helpers-tests.el: Created tests for the new functions and macros.
* README.org: Updated documentation.
---
hook-helpers.el | 189 +++++++++++++++++++++++++++++++++++++++++++-------------
1 file changed, 147 insertions(+), 42 deletions(-)
diff --git a/hook-helpers.el b/hook-helpers.el
index c4b781b..cc793a3 100644
--- a/hook-helpers.el
+++ b/hook-helpers.el
@@ -1,11 +1,11 @@
-;;; hook-helpers.el --- Functions and macros to help with handling hooks
+;;; hook-helpers.el --- Anonymous, modifiable hook functions
;; Copyright (C) 2016 Ian Dunn
;; Author: Ian Dunn <address@hidden>
;; Keywords: development, hooks
;; URL: https://savannah.nongnu.org/projects/hook-helpers-el/
-;; Version: 1.0
+;; Version: 1.1alpha1
;; Created: 06 May 2016
;; Modified: 21 May 2016
@@ -32,11 +32,110 @@
;; The ‘define-hook-helper’ macro is a solution to this. Think of it as an
;; anaphoric ‘add-hook’, but one that can be called many times without risking
;; redundant hook functions. It gives a cleaner look and feel to Emacs
-;; configuration files, and could even be used in actual libraries.
+;; configuration files.
;;; Code:
-(defconst hook-helper--helper-prefix "hook-helper")
+(defvar hkhlp--helpers-map nil
+ "Map of IDs to helpers.")
+
+(cl-defstruct hook-helper
+ id function hooks source-file)
+
+(defun hkhlp-normalize-hook-spec (hook-spec)
+ "Turns HOOK-SPEC into a list of cons-cells, each one (HOOK . APPEND)
+
+HOOK is the name of the full variable to use
+APPEND is a Boolean"
+ (cond
+ ((symbolp hook-spec)
+ ;; HOOK
+ (list (cons hook-spec nil)))
+ ((and (consp hook-spec)
+ (booleanp (cdr hook-spec)))
+ ;; (HOOK . APPEND)
+ (list hook-spec))
+ ((listp hook-spec)
+ ;; List of specs
+ (apply 'append (mapcar (lambda (spec) (hkhlp-normalize-hook-spec spec))
hook-spec)))
+ (t
+ (warn "Unrecognized hook-spec %s" hook-spec))))
+
+(defun add-hook-helper (id hook-spec)
+ "Adds an existing helper ID to HOOK-SPEC."
+ (let ((normalized-spec (hkhlp-normalize-hook-spec hook-spec))
+ (helper (alist-get id hkhlp--helpers-map)))
+ (pcase-dolist (`(,hook . ,append) normalized-spec)
+ (add-hook hook (hook-helper-function helper) append)
+ (cl-pushnew hook (hook-helper-hooks helper) :test 'equal))))
+
+(defun remove-hook-helper (id hook-spec)
+ "Removes the helper ID from each element of HOOK-SPEC."
+ (let ((normalized-spec (hkhlp-normalize-hook-spec hook-spec))
+ (helper (alist-get id hkhlp--helpers-map)))
+ (pcase-dolist (`(,hook . _) normalized-spec)
+ (remove-hook hook (hook-helper-function helper))
+ (cl-delete hook (hook-helper-hooks helper) :test 'equal))))
+
+(cl-defmethod hkhlp-update-helper ((old hook-helper) (new hook-helper))
+ "Updates instances of OLD to NEW.
+
+For each hook HOOK in the original:
+
+ - If HOOK is not in NEW, remove OLD from it
+ - Else, update OLD to NEW
+"
+ (let* ((old-func (hook-helper-function old))
+ (new-func (hook-helper-function new))
+ (old-hooks (hook-helper-hooks old))
+ (new-hooks (hook-helper-hooks new)))
+ (dolist (hook old-hooks)
+ (let ((hook-val (and (boundp hook) (symbol-value hook))))
+ (cond
+ ((not hook-val) nil)
+ ((member hook new-hooks)
+ ;; Update the helper in hooks
+ (when-let ((elt (cl-position old-func hook-val :test 'equal)))
+ (setf (nth elt hook-val) new-func)))
+ (t
+ ;; Delete the helper from the hooks
+ (cl-delete old-func (symbol-value hook) :test 'equal)))))))
+
+(defmacro create-hook-helper (id args &optional docstring &rest body)
+ "Creates a new hook helper ID for the hooks in HOOKS.
+
+If a hook helper with id ID already exists, it's overridden. All instances of
+the helper in its associated hooks are replaced.
+
+See `hkhlp-normalize-hook-spec' for an explanation of HOOKS.
+
+\(fn ID ARGS &optional DOCSTRING &keys HOOKS &rest BODY)"
+ (declare (indent defun) (doc-string 3))
+ (when (and docstring (not (stringp docstring)))
+ ;; Some trickiness, since what appears to be the docstring may really be
+ ;; the first element of the body.
+ (push docstring body)
+ (setq docstring nil))
+ ;; Process the key words
+ (let ((hook-spec nil))
+ (while (keywordp (car body))
+ (pcase (pop body)
+ (`:hooks (setq hook-spec (pop body)))
+ (_ (pop body))))
+ `(let* ((id-sym (quote ,id))
+ (func (lambda ,args ,docstring ,@body))
+ (normalized-hooks (hkhlp-normalize-hook-spec (quote ,hook-spec)))
+ (source-file ,(or load-file-name buffer-file-name))
+ (helper (make-hook-helper :id id-sym
+ :function func
+ :source-file source-file
+ :hooks (mapcar 'car normalized-hooks))))
+ ;; Update an old helper
+ (when-let ((old-helper (alist-get id-sym hkhlp--helpers-map)))
+ (hkhlp-update-helper old-helper helper))
+ (setf (alist-get id-sym hkhlp--helpers-map) helper)
+ ;; Add to the new hook-spec
+ (add-hook-helper id-sym (quote ,hook-spec)))))
;;;###autoload
(defmacro define-hook-helper (hook args &optional docstring &rest body)
@@ -74,22 +173,15 @@ quoted. The keywords are:
(`:append (setq append (pop body)))
(`:suffix (setq suffix (pop body)))
(_ (pop body))))
- (let ((func-sym (intern (format "%s--%s%s" hook-helper--helper-prefix
(symbol-name hook) (if name (concat "/" (symbol-name name)) "")))))
- `(progn
- (defun ,func-sym ,args
- ,(format "Function to run for %s-%s" (symbol-name hook) suffix)
- ,@body)
- (add-hook (quote ,(intern (concat (symbol-name hook) "-" suffix)))
- (function ,func-sym)
- ,append)))))
-
-(cl-defmacro remove-hook-helper (hook &key name (suffix "hook"))
- "Remove a hook helper from HOOK-hook.
-
-NAME and SUFFIX are exactly as in ‘define-hook-helper’, and can
-be used to find the exact helper to remove."
- (let ((func-sym (intern (format "%s--%s%s" hook-helper--helper-prefix
(symbol-name hook) (if name (concat "/" (symbol-name name)) "")))))
- `(remove-hook (quote ,(intern (concat (symbol-name hook) "-" suffix)))
(function ,func-sym))))
+ (let* ((suffix-string (if (stringp suffix) suffix (symbol-name suffix)))
+ (hook-name (concat (symbol-name hook) "-" suffix-string))
+ (func-sym (intern (format "%s%s" hook-name
+ (if name (concat "/" (symbol-name name))
""))))
+ (hook (intern hook-name)))
+ `(create-hook-helper ,func-sym ,args
+ ,docstring
+ :hooks ((,hook . ,append))
+ ,@body))))
;;;###autoload
(defmacro define-hook-function (function args &optional docstring &rest body)
@@ -98,27 +190,40 @@ be used to find the exact helper to remove."
The hooks to add are specified by the :hooks keyword. This is a
simple list of hooks, unquoted, and the new function is added to
each one."
- (declare (indent defun) (doc-string 3))
- ;; From `define-derived-mode'
- (when (and docstring (not (stringp docstring)))
- ;; Some trickiness, since what appears to be the docstring may really be
- ;; the first element of the body.
- (push docstring body)
- (setq docstring nil))
- ;; Process the key words
- (let ((hooks nil))
- (while (keywordp (car body))
- (pcase (pop body)
- ;; Hooks is a keyword to allow it to be specified, without requiring
the
- ;; docstring.
- (`:hooks (setq hooks (pop body)))
- (_ (pop body))))
- `(progn
- (defun ,function ,args
- ,docstring
- ,@body)
- (dolist (h (quote ,hooks))
- (add-hook h (function ,function))))))
+ (declare (indent defun)
+ (doc-string 3)
+ (obsolete create-hook-helper "1.1"))
+ `(create-hook-helper ,function ,args ,docstring ,@body))
+
+;; TODO Link to source file
+(cl-defmethod hkhlp--pp ((helper hook-helper) indent)
+ (let* ((func (hook-helper-function helper))
+ (pp-string (pp-to-string func))
+ (id (hook-helper-id helper))
+ (indent-first (min (- indent (length (symbol-name id))) 1))
+ (pp-lines (split-string pp-string "\n" t)))
+ (concat (symbol-name id) (make-string indent-first ?\ ) (car pp-lines) "\n"
+ (mapconcat
+ (lambda (str)
+ (concat (make-string indent ?\ )
+ str))
+ (cdr pp-lines)
+ "\n")
+ "\n")))
+
+(defun describe-hook-helpers ()
+ "Describe the currently defined hook helpers."
+ (interactive)
+ (let ((hook-alist nil))
+ (pcase-dolist (`(_ . ,helper) hkhlp--helpers-map)
+ (dolist (hook (hook-helper-hooks helper))
+ (push helper (alist-get hook hook-alist))))
+ (with-output-to-temp-buffer "*Hook Helpers*"
+ (pcase-dolist (`(,hook . ,helpers) hook-alist)
+ (princ (format "%s\n%s\n" hook (make-string 40 ?-)))
+ (dolist (helper helpers)
+ (princ (hkhlp--pp helper 16)))
+ (princ "\n")))))
;; Add font lock for both macros.
(font-lock-add-keywords
@@ -126,7 +231,7 @@ each one."
'(("(\\(define-hook-helper\\)\\_>[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?"
(1 font-lock-keyword-face)
(2 font-lock-function-name-face nil t))
- ("(\\(define-hook-function\\)\\_>[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?"
+ ("(\\(create-hook-helper\\)\\_>[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?"
(1 font-lock-keyword-face)
(2 font-lock-function-name-face nil t))))
- [elpa] branch scratch/hook-helpers created (now 365d8de), Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers 597fce1 03/19: Updated README to include savannah project link., Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers 7981caf 06/19: Removed docstring argument from `hook-helpers'., Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers 17f7d5d 07/19: Restored docstring argument in `define-hook-helper'., Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers b373c79 08/19: Removed define-mode-hook-helpers, since it only moves the word "mode" around., Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers f1409ec 05/19: Updated README to include new usage., Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers 73d0cb5 13/19: Added gitignore file, Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers e253e03 11/19: Implemented new design for anonymous helpers,
Ian Dunn <=
- [elpa] scratch/hook-helpers 5e4a3a8 02/19: Added remove-hook-helper to README., Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers 706af98 15/19: Clean up describe-hook-helpers, Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers 3bb2282 09/19: Updated README, removing define-mode-hook-helper., Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers 7f1eccf 16/19: Fixed bug in hkhlp-normalize-hook-spec, Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers 0386e23 04/19: Modified define-hook-helper to more closely match defun., Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers 0fc0b3d 14/19: Fixed bug in define-hook-helper, Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers dff9910 10/19: Added `define-hook-function' to allow defining a function to be added to multiple hooks., Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers a46803b 17/19: Fixed failing tests, Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers 93ae501 12/19: Finished last commit., Ian Dunn, 2017/04/23
- [elpa] scratch/hook-helpers 7970dcf 01/19: Initial commit., Ian Dunn, 2017/04/23