;;; hippie-lib.el --- Hippie Lib; define library functions and macros ;; Copyleft (C) 2009 Cecil Curry . ;; Author: Cecil Curry ;; Maintainer: Cecil Curry ;; Time-stamp: "2009-06-15 22:45:05 leycec" ;; Created: 1 Mar 2009 ;; Version: 0.0.1.0 ;; URL: http://hippie.raiazome.com ;; Keywords: abbrev,c,convenience,data,emulations,faces,files,lisp,matching,tools ;; This file is not part of GNU Emacs. ;;; Commentary: ; --------------------( SYNOPSIS )-------------------- ; `hippie-lib' defines state-less functions and macros intended to be called by ; other Hippie features. As these functions and macros do not maintain ; state, they may be safely called from any other function or macro without ; concern for side-effects. ; ; --------------------( IMPLEMENTATION )-------------------- ; All functions and macros declared by this feature should be prepended with the ; autoload cookie (e.g., ";;;###autoload"), so as to avoid having to explicitly ; `require' this subfeature in all other subfeatures. ; ; All functions and macros declared by this feature should also have names ; prepended with the string "hippie/": that is, all functions and macros ; declared by this feature should belong to the top-level "hippie/" namespace. ; This prevents other subfeatures from having to consider the exact subfeature ; in which these functions and macros might have been defined in; by declaring ; them as "hippie/" definitions, such considerations are removed. (It's always ; "hippie/", bro!) ; ; Short snippets of code should be defined as macros, for speed; longer snippets ; should be defined as functions, for clarity. ; ; --------------------( TODO )-------------------- ;;; History: ;; ;; 2009-05-01 Cecil Curry ;; * Created. ;;; Code: ; ....................{ DEPENDENCIES }.................... (require 'hippie) ; ....................{ FUNCTION CALLS }.................... ;;;###autoload (defmacro hippie/funcall-if-fboundp (function-name &rest arguments) "Call function with ARGUMENTS, if FUNCTION-NAME signifies a defined function. If this is the case, call that function and return its return value; otherwise, return nil." ; `hippie/funcall-if-fboundp-function' is so named so as to guarantee ; uniqueness across variable namespaces. `(let ((hippie/funcall-if-fboundp-function (intern-soft ,function-name))) (when (and hippie/funcall-if-fboundp-function (fboundp hippie/funcall-if-fboundp-function)) (apply hippie/funcall-if-fboundp-function ,arguments)))) ;;;###autoload (defmacro hippie/funcall-if-boundp (function variable-name &rest arguments) "Call FUNCTION with ARGUMENTS, if VARIABLE-NAME signifies a defined variable. If this is the case, call that function and return its return value; otherwise, return nil." ; `hippie/funcall-if-boundp-variable' is so named so as to guarantee ; uniqueness across variable namespaces. `(let ((hippie/funcall-if-boundp-variable (intern-soft ,variable-name))) (when (and hippie/funcall-if-boundp-variable (boundp hippie/funcall-if-boundp-variable)) (apply ,function ,arguments)))) ;;;###autoload (defun hippie/noop (&rest arguments) "Return the first argument in ARGUMENTS or, if ARGUMENTS is empty, t. This function implements an efficient no-op, for use as a function alias or as argument to another function." (if arguments (car arguments) t)) ; ....................{ ASSOCIATION LISTS }.................... ;;;###autoload (defmacro hippie/assq-setcdr (key value alist) "Set the cdr of the first element of ALIST whose car is KEY to VALUE. Return VALUE as is. If there is no such element, push a new element on ALIST whose car is KEY and set the cdr of that to VALUE. This modifies ALIST in place." `(setf (hippie/assq-cdr ,key ,alist) ,value)) ;;;###autoload (defmacro hippie/assq-cdr (key alist) "Return the cdr of the first element of ALIST whose car is KEY. If there is no such element, push a new element on ALIST whose car is KEY and return the cdr of that (which should be an empty list). This modifies ALIST in place, if pushing a new element onto it. Also, the cdr returned is settable via the `setf' Common Lisp macro, ala: (setf (hippie/assq-cdr 'key \"old-value\" alist) \"new-value\")" `(cdr (hippie/assq-pushnew ,key ,alist))) ;;;###autoload (defmacro hippie/assq-pushnew (key alist &optional pushnew-function) "Return the first element of ALIST whose car is KEY. If there is no such element, push a new element on ALIST whose car is KEY and return that. And no: the bathroom humour in this macro's name isn't lost on us. If pushing a new element on to ALIST, this modifies that list in place and, if PUSHNEW-FUNCTION is non-nil, also calls that function with an argument list resembling: (pushnew-function key alist new-list) NEW-LIST, here, is the newly created list whose car is KEY." ; For slight efficiency, provide two different definitions: the first in ; which `pushnew-function' is nil and therefore ignored and the second in ; which `pushnew-function' is non-nil and called. (if (null pushnew-function) ; This avoids evaluating macro arguments more than once. But we do not ; include `alist' here, since that would make a copy of `alist' rather ; than manipulating it in place. (let ((key-sym (gensym))) `(let ((,key-sym ,key)) (or (assq ,key-sym ,alist) (and (push (list ,key-sym) ,alist))))) (let ((key-sym (gensym)) (new-sym (gensym))) `(let ((,key-sym ,key)) (or (assq ,key-sym ,alist) (and (let ((,new-sym (list ,key-sym))) (pushnew-function ,key-sym ,alist ,new-sym) (push ,new-sym ,alist) ,new-sym))))))) ; ....................{ ADVICE }.................... ;;;###autoload (defmacro hippie/ad-enable-activate (function advice-name &optional advice-class) "Enable and activate advice named ADVICE-NAME in ADVICE-CLASS for FUNCTION. ADVICE-CLASS should be explicitly specified for efficiency, but, if not, defaults to `any', which matches all three advice classes: `before', `after', and `around'. This macro takes argument in a slightly different order from the `ad-enable-advice' function, for sanity's sake." `(progn (ad-enable-advice ,function ,(or advice-class 'any) ,advice-name) (ad-activate ,function))) ;;;###autoload (defmacro hippie/ad-disable-activate (function advice-name &optional advice-class) "Disable and activate advice named ADVICE-NAME in ADVICE-CLASS for FUNCTION. ADVICE-CLASS should be explicitly specified for efficiency, but, if not, defaults to `any', which matches all three advice classes: `before', `after', and `around'. This macro takes argument in a slightly different order from the `ad-disable-advice' function, for sanity's sake." `(progn (ad-disable-advice ,function ,(or advice-class 'any) ,advice-name) (ad-activate ,function))) ;;;###autoload (defmacro hippie/ad-enable-activate-regexp (regexp) "Enable advice whose name matches REGEXP for all advised functions. Activate the advice for such functions, so as to ensure that advised functions definitions are updated to reflect that enabled advice. This matches all advice classes: 'before, 'after, and 'about'." (hippie/ad-mapc (lambda (advised-function advices advice advice-class advice-name) (ad-enable-advice advised-function advice-class advice-name)) ,regexp t)) ;;;###autoload (defmacro hippie/ad-disable-activate-regexp (regexp) "Disable advice whose name matches REGEXP for all advised functions. Activate the advice for such functions, so as to ensure that advised functions definitions are updated to reflect that disabled advice. This matches all advice classes: 'before, 'after, and 'about'." (hippie/ad-mapc (lambda (advised-function advices advice advice-class advice-name) (ad-disable-advice advised-function advice-class advice-name)) ,regexp t)) ;;;###autoload (defmacro hippie/ad-remove-regexp (regexp) "Remove REGEXP-matched advice from all advised functions. Advice whose advice name matches REGEXP will be removed via `ad-remove'. This matches all advice classes: 'before, 'after, and 'about." (hippie/ad-mapc (lambda (advised-function advices advice advice-class advice-name) (ad-set-info-field advised-function advice-class (delq advice advices))) ,regexp)) ;;;###autoload (defun hippie/ad-mapc (function regexp &optional activate-flag) "Apply FUNCTION to each advice matching REGEXP on all advised functions. This function should accept an argument list resembling: lambda (advised-function advices advice advice-class advice-name) If at least one advice is modified for any advised function, that function's definition is updated and, if ACTIVATE-FLAG is non-nil, also activated." (check-type function function) (check-type regexp string "a regular expression") (ad-do-advised-advised-functions (advised-function) (let ((advice-changed-flag nil)) (ad-dolist (advice-class ad-classes) (let ((advices (ad-get-info-field advised-function advice-class))) (ad-dolist (advice advices) (let (advice-name (symbol-name (ad-name advice))) (when (string-match regexp advice-name) (funcall function advised-function advices advice advice-class advice-name) (setq advice-changed-flag t)))))) (when advice-changed-flag (ad-update advised-function)) (when activate-flag (ad-activate advised-function))))) ;;;###autoload (defun hippie/ad-activated-enabled-p (function advice-name &optional advice-class) "Return non-nil if ADVICE-NAME in ADVICE-CLASS is activated and enabled. (For this specific FUNCTION.) Return nil if advice for FUNCTION is deactivated or if there is no advice with ADVICE-NAME in ADVICE-CLASS for FUNCTION. ADVICE-CLASS defaults to `any' when nil, but should be specified for efficiency." (check-type function function) (check-type advice-name string) (when (null advice-class) (setq advice-class 'any)) (if (ad-is-active function) (catch 'hippie/activated-enabled-flag (ad-dolist (advice-advice-class (if (eq advice-class 'any) ad-advice-classes (list advice-class))) (ad-dolist (advice (ad-get-info-field function advice-advice-class)) (and (string= (ad-name advice) advice-name) (ad-enabled advice) (throw 'hippie/activated-enabled-flag t))))) nil)) ; ....................{ KEYMAPS }.................... ;;;###autoload (defmacro hippie/make-sparse-child-keymap (parent) "Return a new sparse keymap having PARENT as its parent keymap. Keymap lookup will search for key bindings not already defined for this keymap in this PARENT keymap, instead." (let ((keymap (gensym))) `(let ((,keymap (make-sparse-keymap))) (set-keymap-parent ,keymap ,parent) ,keymap))) ;;;###autoload (defmacro hippie/copy-keymap-into (source-keymap target-keymap) "Copy all key bindings in SOURCE-KEYMAP into existing TARGET-KEYMAP. Return TARGET-KEYMAP. Also recursively copy all key bindings in all parent keymaps of SOURCE-KEYMAP into TARGET-KEYMAP if SOURCE-KEYMAP has such a parent keymap. The related `copy-keymap' primitive always returns a new copy of SOURCE-KEYMAP. This macro, on the other hand, returns the TARGET-KEYMAP passed to it without creating a new copy." `(progn (map-keymap (lambda (key binding) ; Keymap keys should always be strings or vectors. When not the case, ; constrain the corresponding key to be a vector having the key as its ; first and only element. (unless (or (stringp key) (vectorp key)) (setq key (vector key))) ; Add this key binding to `target-keymap', now. (define-key ,target-keymap key binding)) ,source-keymap) ,target-keymap)) ; ....................{ OBSOLETE }.................... ;FIXME: This is still an interesting approach. Retain as a new ;`hippie/add-autoload-hook' function, with appropriate changes. ; Also, `function-list' is an autoload stub for this function as created for ; that function by the `autoload' primitive. An autoload stub is just a list ; resembling ('autoload FILE-NAME DOC-STRING FORMS...). ; ; Last, `arg-interactive' is a symbol chosen for uniqueness, which this ; function's new autoload stub arbitrarily assigns to its argument list when ; called interactively so as to ascertain whether the function was, indeed, ; called interactively or not. ;; (let* ((function-symbol (ad-get-arg 0)) ;; (function-list (symbol-function function-symbol)) ;; (function-docstring ()) ;; (feature-base-name (ad-get-arg 1)) ;; (feature-file-name (concat hippie/features-directory ;; feature-base-name)) ;; (arg-interactive '***autoload\ stub\ called\ interactively***)) ;; (unless (and (listp function-list) ;; (eq (car function-list) 'autoload)) ;; (error "autoload (hippie): '%s' not an autoload stub." function-symbol)) ;; ;FIXME: Other functions elsewhere probably depend on this being a ;; ;traditional autoload rather a lambda function. See to it, if possible. ;; (fset function-symbol ;; `(lambda (&rest args) ;; ; This is this function's docstring. ;; ,(nth 2 function-list) ;; ; When called interactively, this function's argument list becomes ;; ; an autoload "magic cookie". Note that this does not consume ;; ; interactive input, if there is any; that input will still be ;; ; available to `call-interactively', later, if called. ;; (interactive (list ,arg-interactive)) ;; ; Call `hippie/require' rather than `require', so as to bootstrap ;; ; this feature if not found. If all goes well, destroy this ;; ; autoload stub immediately prior to loading the "real thing." ;; (hippie/require ,feature-file-name nil ;; (lambda (file-name) ;; (fmakunbound ,function-symbol) ;; (load ,feature-file-name))) ;; (unless (fboundp ,function-symbol) ;; (error "autoload (hippie): '%s' not defined by '%s." ;; ,(symbol-name function-symbol) ;; ,feature-file-name)) ;; ; The function corresponding to `function-symbol' is now defined. ;; ; Call it according to whether it should be interactively or not. ;; (if (eq (car args) ,arg-interactive) ;; (call-interactively ,function-symbol) ;; (apply ,function-symbol args)))))) ; --------------------( COPYRIGHT AND LICENSE )-------------------- ; The information below applies to everything in this distribution, ; except where noted. ; ; Copyleft 2009 by Cecil Curry . ; ; 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 this program. If not, see L. ; ; --------------------( LIBRARY )-------------------- (provide 'hippie-lib) ;;; hippie-lib.el ends here