emacs_el/tiny-tools/tiny/tinymacro.el

   1 ;;; tinymacro.el --- Fast way to assign newly created macro to a key
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   6
   7 ;; Copyright (C) 1995-2007 Jari Aalto
   8 ;; Keywords:     extensions
   9 ;; Author:       Jari Aalto
  10 ;; Maintainer:   Jari Aalto
  11 ;;
  12 ;; To get information on this program, call M-x tinymacro-version.
  13 ;; Look at the code with folding.el
  14
  15 ;; COPYRIGHT NOTICE
  16 ;;
  17 ;; This program is free software; you can redistribute it and/or modify it
  18 ;; under the terms of the GNU General Public License as published by the Free
  19 ;; Software Foundation; either version 2 of the License, or (at your option)
  20 ;; any later version.
  21 ;;
  22 ;; This program is distributed in the hope that it will be useful, but
  23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  24 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  25 ;; for more details.
  26 ;;
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with program; see the file COPYING. If not, write to the
  29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  30 ;; Boston, MA 02110-1301, USA.
  31 ;;
  32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  33
  34 ;;}}}
  35 ;;{{{ Install
  36
  37 ;;; Intall:
  38
  39 ;; ........................................................ &t-install ...
  40 ;;   Put this file on your Emacs-Lisp load path, add following into your
  41 ;;   ~/.emacs startup file. Rip code with tinylib.el/ti::package-rip-magic
  42 ;;
  43 ;;       ;;  To use default keybinding "C-x("  and "C-x)", add this:
  44 ;;      (add-hook 'tinymacro-:load-hook 'tinymacro-install-default-keybindings)
  45 ;;      (require 'tinymacro)
  46 ;;
  47 ;;   or use autoload and your $HOME/.emacs starts faster
  48 ;;
  49 ;;      (global-set-key "\C-x)" 'tinymacro-end-kbd-macro-and-assign)
  50 ;;      (autoload 'tinymacro-end-kbd-macro-and-assign  "tinymacro" "" t)
  51 ;;
  52 ;;   If you have any questions, feedback, use this function
  53 ;;
  54 ;;      M-x tinymacro-submit-bug-report
  55
  56 ;;}}}
  57 ;;{{{ Documentation
  58
  59 ;; ..................................................... &t-commentary ...
  60
  61 ;;; Commentary:
  62
  63 ;;  Preface, 1995
  64 ;;
  65 ;;      This started as a very little project when
  66 ;;      <mosh@ramanujan.cs.albany.edu> (Mohsin-Ahmed) 1995-03-17 in
  67 ;;      gnu.emacs.help post asked for easy way to assign newly created
  68 ;;      macro to some key. In reponse the author sent a simple function to do
  69 ;;      it, but he informaed that one macro, which was recycled every time,
  70 ;;      was too little. Author started modifying code more, and that was
  71 ;;      the birth of this package.
  72 ;;
  73 ;; Description
  74 ;;
  75 ;;      o   Two keystrokes to make a macro: one to record, one to
  76 ;;          assign it to key.
  77 ;;      o   To see the macro assignments to keys, just call `tinymacro-macro-info'
  78 ;;      o   Default macro count is 10, increase with `tinymacro-:stack-max'
  79
  80 ;;}}}
  81
  82 ;;; Change log:
  83
  84 ;;; Code:
  85
  86 ;;{{{ setup: require
  87
  88 (require 'tinylibm)
  89
  90 (eval-when-compile (ti::package-use-dynamic-compilation))
  91
  92 (ti::package-defgroup-tiny TinyMacro tinymacro-: extensions
  93   "Fast way to assign newly created macro to key
  94   Overview of features.
  95
  96         o   Two keystrokes to make a macro: one to record, one to
  97             assign it to key.
  98         o   To see the macro assignments to keys, just call tinymacro-macro-info")
  99
 100 ;;}}}
 101 ;;{{{ setup: hooks, private
 102
 103 (defcustom tinymacro-:macro-assigned-hook nil
 104   "*If new macro were asiigned, this hook will be run. The function
 105 SYMBOL that was used is in variable tinymacro-:last-macro-func"
 106   :type  'hook
 107   :group 'TinyMacro)
 108
 109 (defcustom tinymacro-:load-hook nil
 110   "*Hook run when file has been loaded."
 111   :type  'hook
 112   :group 'TinyMacro)
 113
 114 ;;}}}
 115 ;;{{{ setup: public, user configurable
 116
 117 (defcustom tinymacro-:macro-function-name-prefix "tinymacro--macro"
 118   "*The function name prefix to use, when assigning name to last kbd macro"
 119   :type  'string
 120   :group 'TinyMacro)
 121
 122 (defcustom tinymacro-:ask-when-stack-wrap-flag nil
 123   "*Non-nil means ask user if used function stack wraps."
 124   :type  'boolean
 125   :group 'TinyMacro)
 126
 127 (defcustom tinymacro-:stack-max 10
 128   "*Maximum stack depth of unique macronames.
 129  The name run from 0..max, and wraps to 0 after max."
 130   :type  'integer
 131   :group 'TinyMacro)
 132
 133 (defcustom tinymacro-:tmp-buffer "*temp*"
 134   "*Temporary buffer. Eg. displaying the macro bindings to keys."
 135   :type  'string
 136   :group 'TinyMacro)
 137
 138 ;;}}}
 139 ;;{{{ setup: private variables
 140
 141 (defvar tinymacro-:stack-ptr 0
 142   "Keep record of available stack space.")
 143
 144 (defvar tinymacro-:last-macro-func nil
 145   "Hold last function SYMBOL that were used in assignment.")
 146
 147 (defvar tinymacro-:last-macro-key nil
 148   "Hold last key STRING or VECTOR that were used in assignment.")
 149
 150 (defvar tinymacro-:function-list nil
 151   "List of original KEY -- FUNCTION pairs, whic are currently occupied
 152 by macros")
 153
 154 ;;}}}
 155 ;;{{{ setup: version
 156
 157 ;;;###autoload (autoload 'tinymacro-version "tinymacro" "Display commentary." t)
 158 (eval-and-compile
 159   (ti::macrof-version-bug-report
 160    "tinymacro.el"
 161    "tinymacro"
 162    tinymacro-:version-id
 163    "$Id: tinymacro.el,v 2.43 2007/05/01 17:20:50 jaalto Exp $"
 164    '(tinymacro-:version-id
 165      tinymacro-:stack-ptr
 166      tinymacro-:last-macro-func
 167      tinymacro-:last-macro-key
 168      tinymacro-:function-list
 169      tinymacro-:macro-assigned-hook
 170      tinymacro-:load-hook
 171      tinymacro-:macro-function-name-prefix
 172      tinymacro-:ask-when-stack-wrap-flag
 173      tinymacro-:stack-max
 174      tinymacro-:tmp-buffer)))
 175
 176 ;;}}}
 177 ;;{{{ code: misc
 178
 179 ;;; ----------------------------------------------------------------------
 180 ;;;
 181 (defun tinymacro-restore ()
 182   "Restores all macro bindings, so that keys that occupy macros
 183 are restored to original functions.
 184
 185 References:
 186   tinymacro-:function-list     list is cleared too."
 187   (interactive)
 188   (let* ((list  tinymacro-:function-list))
 189     (if (null list)
 190         (if (interactive-p)
 191             (message "TinyMacro: No macros active."))
 192       (dolist (elt  list)
 193         (global-set-key (nth 0 elt) (nth 1 elt)))
 194       (setq  tinymacro-:function-list nil))))
 195
 196 ;;}}}
 197 ;;{{{ code: symbol
 198
 199 ;;; ----------------------------------------------------------------------
 200 ;;;
 201 (defun tinymacro-create-symbol()
 202   "Creates macro variable. Returns NEW or EXISTING SYMBOL."
 203   (let* ((max   tinymacro-:stack-max)
 204          (sp    tinymacro-:stack-ptr)
 205          (q     tinymacro-:ask-when-stack-wrap-flag)
 206          (name  tinymacro-:macro-function-name-prefix)
 207          sym2
 208          new
 209          ret)
 210     (if (or (null q)
 211             (< sp max))                 ; yes, go ahead with new
 212         (setq new (format "%s%d"
 213                           name
 214                           (if (< sp max) ; 0..max
 215                               (setq sp (1+ sp))
 216                             (setq sp 0))))
 217       (if (y-or-n-p "Macro stack full, wrap? ")
 218           (setq new
 219                 (if (< sp max)          ; 0..max
 220                     (setq sp (1+ sp))
 221                   (setq sp 0)))))
 222
 223     (when new                           ;  Must update stack
 224       (setq tinymacro-:stack-ptr sp
 225             ret (intern-soft new))      ; return symbol
 226       (if ret nil                       ; Already exist
 227         ;;   a) make it b)s et to nil c) put into ret val
 228         (setq sym2 (intern new))
 229         (set sym2 nil)
 230         (setq ret sym2)))
 231     ret))
 232
 233 ;;; ----------------------------------------------------------------------
 234 ;;;
 235 (defun tinymacro-create-name ()
 236   "Creates macro name."
 237   (let* ((max   tinymacro-:stack-max)
 238          (sp    tinymacro-:stack-ptr)
 239          (q     tinymacro-:ask-when-stack-wrap-flag)
 240          (n     tinymacro-:macro-function-name-prefix)
 241          new)
 242     (if (or q (< sp max))               ; yes, go ahead with new
 243         (setq new
 244               (concat n (if (< sp max)  ; 0..max
 245                             (setq sp (1+ sp))
 246                           (setq sp 0))))
 247       (if (y-or-n-p "Macro stack full, wrap? ")
 248           (setq new (concat n (if (< sp max) ; 0..max
 249                                   (setq sp (1+ sp))
 250                                 (setq sp 0))))))
 251     (if new                             ; Must update stack
 252         (setq tinymacro-:stack-ptr sp))
 253     new))
 254
 255 ;;}}}
 256 ;;{{{ code: main
 257
 258 ;;; ----------------------------------------------------------------------
 259 ;;;
 260 (defun tinymacro-macro-info ()
 261   "Show which macros are assigned to which keys."
 262   (interactive)
 263   (let* ((sp    tinymacro-:stack-ptr)
 264          (max   tinymacro-:stack-max)
 265          (buf   tinymacro-:tmp-buffer)
 266          (base  tinymacro-:macro-function-name-prefix)
 267          (i     0)
 268          (round 0)
 269          bp                             ;buffer pointer
 270          name
 271          key)
 272     (while (< i (1+ max))
 273       (setq name (concat base i)   i (1+ i)   key "")
 274       (if (null (intern-soft name)) nil ;not use yet
 275         (if (> round 0) nil             ;do only once
 276           (setq bp (get-buffer-create buf))
 277           (set-buffer bp) (erase-buffer)
 278           (insert (format "Stack pointer : %d\n" sp )))
 279         (if (null (setq key (ti::keymap-function-bind-info (intern name))))
 280             (setq key "[??]"))          ;should never happen
 281         (insert (format "%-10s %s\n" key name))
 282         (setq round (1+ round))))
 283     (if (and (interactive-p)
 284              (eq 0 round))
 285         (message "TinyMacro: No macros bound or set."))
 286     (switch-to-buffer-other-window bp)))
 287
 288 ;;; ----------------------------------------------------------------------
 289 ;;;
 290 ;;;###autoload
 291 (defun tinymacro-end-kbd-macro-and-assign ()
 292   "Terminate reading macro and assign it to key."
 293   (interactive)
 294   (end-kbd-macro)
 295   (call-interactively 'tinymacro-assign))
 296
 297 ;;; ----------------------------------------------------------------------
 298 ;;;
 299 (defun tinymacro-install-default-keybindings ()
 300   "Install keybinding C-x) to record and assign macro to a key."
 301   (interactive)
 302   (global-set-key "\C-x)" 'tinymacro-end-kbd-macro-and-assign)
 303   (message
 304    (substitute-command-keys
 305     (concat
 306      "Tinymacro: command tinymacro-end-kbd-macro-and-assign set to key "
 307      "\\[tinymacro-end-kbd-macro-and-assign]"))))
 308
 309 ;;; ----------------------------------------------------------------------
 310 ;;;
 311 ;;;###autoload
 312 (defun tinymacro-assign (&optional key verb)
 313   "Name last macro and assigns it to user defined KEY.
 314 Runs tinymacro-:macro-assigned-hook if key macro gets installed.
 315 The query options should be turned off if you call this within
 316 function, since it always return nil if the options are on.
 317
 318 Input:
 319
 320   KEY   Should be valid emacs key-bind-sequence/key-vector
 321   VERB  Boolean, verbose messages
 322
 323 Return:
 324
 325   t    is assigned
 326   nil  not assigned `keyboard-quit'"
 327   (interactive)
 328
 329   (let* ((f-name    "")                 ;func name
 330          do-it
 331          macro-name                     ;our new macro !
 332          lookup                         ;what was found
 333
 334          ;; --- 1 ---
 335          ;; The bullet proof way to find key bind for abort
 336          ;; (ti::keymap-function-bind-info 'keyboard-quit global-map)
 337
 338          ;; --- 2 --
 339          ;; - Or we just say where it is... Nobody relocates it anyway
 340          ;; - We use this because function2key does not work in XEmacs
 341
 342          (abort-ch (char-to-string ?\007)))
 343     (ti::verb)
 344     (if (null key)
 345         (setq key
 346               (read-key-sequence "Tinymacro: Set last macro to key(s): ")))
 347     (if (equal key abort-ch)
 348         (progn
 349           (if (interactive-p)
 350               (message "Tinymacro: Skipping abort key. Not assigned."))
 351           nil)
 352       ;;  Search the key, if it's already assigned
 353       (setq lookup
 354             (or (and (current-local-map) ;in fundamental-mode this is nil.
 355                      (lookup-key (current-local-map) key))
 356                 (lookup-key global-map key) key))
 357       ;; ................................................... occupied? ...
 358       (when lookup
 359         (if (and (symbolp lookup)
 360                  (fboundp lookup))      ;just plain function
 361             (setq f-name (symbol-name lookup))
 362           (setq f-name  (prin1-to-string lookup))))
 363       ;; ............................................. ask permission? ...
 364       (when
 365           (and verb
 366                (not (null lookup)))
 367         (setq do-it
 368               (y-or-n-p
 369                (format
 370                 "Key already occupied by %s; continue? " f-name))))
 371       ;; ................................................ assign macro ...
 372       (cond
 373        ((and verb (null do-it))
 374         (message
 375          (substitute-command-keys
 376           "Tinymacro: Cancelled. Use \\[tinymacro-assign] to rebind.")))
 377        (t
 378         (setq macro-name (tinymacro-create-symbol))
 379         (name-last-kbd-macro macro-name)
 380         ;;  save previous
 381         (when (and (symbolp lookup)
 382                    (fboundp lookup)
 383                    (not (string-match "^tim" f-name))
 384                    (not (assoc key tinymacro-:function-list)))
 385           (push (list key lookup) tinymacro-:function-list))
 386         (global-set-key key macro-name)
 387         (setq tinymacro-:last-macro-func  macro-name ;set >> GLOBALS <<
 388               tinymacro-:last-macro-key   key)
 389         (if verb
 390             (message
 391              "TinyMacro: Created function: %s" (symbol-name macro-name)))
 392         (run-hooks 'tinymacro-:macro-assigned-hook)
 393         t)))))
 394
 395 ;;}}}
 396
 397 (provide   'tinymacro)
 398 (run-hooks 'tinymacro-:load-hook)
 399
 400 ;;; tinymacro.el ends here