emacs_el/tiny-tools/tiny/tinyxreg.el

   1 ;;; tinyxreg.el --- Restore points and window configuration with X-popup
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   6
   7 ;; Copyright (C)    1995-2007 Jari Aalto
   8 ;; Keywords:        tools
   9 ;; Author:          Jari Aalto
  10 ;; Maintainer:      Jari Aalto
  11 ;;
  12 ;; To get information on this program, call M-x tinyxreg-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 ;;; Install:
  38
  39 ;; ....................................................... &t-install ...
  40 ;; Put this file on your Emacs-Lisp load path, add following into your
  41 ;; ~/.emacs startup file.
  42 ;;
  43 ;;    (when window-system
  44 ;;      (global-set-key "\C-x/"  'tinyxreg-point-to-register)
  45 ;;      (global-set-key "\C-x\\" 'tinyxreg-remove-register)
  46 ;;      ;;  The non-graphical "jump" is at C-x j
  47 ;;      (global-set-key "\C-cj"  'tinyxreg-jump-to-register)
  48 ;;      (require 'tinyxreg))
  49 ;;
  50 ;; Or use autoload, preferfed, because your emacs starts up faster.
  51 ;;
  52 ;;    (when window-system
  53 ;;      (global-set-key "\C-x/"  'tinyxreg-point-to-register)
  54 ;;      (global-set-key "\C-x\\" 'tinyxreg-remove-register)
  55 ;;      (global-set-key "\C-cj"  'tinyxreg-jump-to-register)
  56 ;;      (autoload 'tinyxreg-jump-to-register        "tinyxreg" "" t)
  57 ;;      (autoload 'tinyxreg-jump-to-register-mouse  "tinyxreg" "" t)
  58 ;;      (autoload 'tinyxreg-point-to-register       "tinyxreg" "" t)
  59 ;;      (autoload 'tinyxreg-point-to-register-mouse "tinyxreg" "" t)
  60 ;;      (autoload 'tinyxreg-remove-reg              "tinyxreg" "" t)
  61 ;;      (autoload 'tinyxreg-trash                   "tinyxreg" "" t))
  62 ;;
  63 ;; If you have any questions or comments, use this function
  64 ;;
  65 ;;      M-x tinyxreg-submit-bug-report
  66
  67 ;;}}}
  68 ;;{{{ Documentation
  69
  70 ;; ..................................................... &t-commentary ...
  71
  72 ;;; Commentary:
  73
  74 ;;  Preface, oct 1995
  75 ;;
  76 ;;      There was a post in comp.emacs by  <cpg@cs.utexas.edu> Carlos Puchol
  77 ;;
  78 ;;          I find that my life would be remarkably eased if only I could
  79 ;;          "jump" to the marks from a menu. Please, let me know if i can
  80 ;;          implement this myself through some sort of macro or something.
  81 ;;
  82 ;;      It was an interesteing idea and some sketching was flying in the air.
  83 ;;      The original plan wasn't to write any serious code; just tossing
  84 ;;      around some experiments with of functions.
  85 ;;      As a result it soon become a complete package and after a while
  86 ;;      a properly packaged set.
  87 ;;
  88 ;;  Overview of features
  89 ;;
  90 ;;      o   Store points and window configurations to registers.
  91 ;;      o   Use popup to pick register associated with the file. In short
  92 ;;          this package offers graphical user interface for the the
  93 ;;          C-x j "jump to register".
  94 ;;
  95 ;; Register update note
  96 ;;
  97 ;;      If you wonder why some of the registers disappear from the popup
  98 ;;      while you were sure you just stored some point to them, the reason
  99 ;;      is that If you kill some buffer, or reload it again with
 100 ;;      find-alternate-file that means that the register reference "dies".
 101 ;;      That's why the main function tinyxreg-jump-to-register calls a
 102 ;;      house keeping function tinyxreg-update to make sure you can't
 103 ;;      select invalid registers. So, trust the poup: it tells what
 104 ;;      registes are available.
 105
 106 ;;}}}
 107
 108 ;;; Change Log:
 109
 110 ;;; Code:
 111
 112 ;;{{{ setup: libraries
 113
 114 (require 'tinylibm)
 115 (eval-when-compile (ti::package-use-dynamic-compilation))
 116
 117 (ti::package-defgroup-tiny TinyXreg tinyxreg-: tools
 118   "Restoring points/win cfg stroed in reg. via X-popup
 119   Overview of features
 120
 121       o   Store points and window configurations to registers.
 122       o   Use popup to pick register associated with the file. In short
 123           this package offers graphical user interface for the the
 124           C-x j \"jump to register\".")
 125
 126 ;;}}}
 127 ;;{{{ setup: hooks
 128
 129 (defcustom tinyxreg-:load-hook nil
 130   "*Hook that is run when package is loaded."
 131   :type  'hook
 132   :group 'TinyXreg)
 133
 134 ;;}}}
 135 ;;{{{ setup: public, user configurable
 136
 137 (defcustom tinyxreg-:x-coord 170
 138   "*Default menu coordinate."
 139   :type  'integer
 140   :group 'TinyXreg)
 141
 142 (defcustom tinyxreg-:y-coord 170
 143   "*Default menu coordinate."
 144   :type  'integer
 145   :group 'TinyXreg)
 146
 147 (defcustom tinyxreg-:description-func  'tinyxreg-description
 148   "*Function to return popup description string.
 149 Function should accept two arguments: REGISTER and WINDOW-ARG"
 150   :type 'function
 151   :group 'TinyXreg)
 152
 153 (defcustom tinyxreg-:title  "Register list"
 154   "*Popup title."
 155   :type  'string
 156   :group 'TinyXreg)
 157
 158 (defcustom tinyxreg-:buffer-fmt "%-20s"
 159   "*Format for filename.
 160 Filename length reserved for default popup description.
 161
 162 Note:  The entries itself are stored in this form, so changing this
 163 affects only new entries."
 164   :type  '(string :tag "Format string")
 165   :group 'TinyXreg)
 166
 167 (defcustom tinyxreg-:wcfg-fmt '(concat "\177 Win " bn)
 168   "*Lisp form to for window configuration.
 169 This is the Window config FORM that is evaled when
 170 the description is put into the list. You can use variable BN
 171 to refer current buffer name.
 172
 173 Remember that list will be sorted later, so you may want to have
 174 common beginning for all win cfg registers."
 175   :type  '(sexp :tag "Lisp form")
 176   :group 'TinyXreg)
 177
 178 ;;}}}
 179 ;;{{{ setup: private
 180
 181 (defvar tinyxreg-:preg  nil
 182   "Hold point markers.")
 183
 184 (defvar tinyxreg-:wreg  nil
 185   "Hold window markers.")
 186
 187 ;;}}}
 188 ;;{{{ setup: version
 189
 190 ;;; ....................................................... &v-version ...
 191
 192 ;;;###autoload (autoload 'tinyxreg-version "tinyxreg" "Display commentary." t)
 193
 194 (eval-and-compile
 195   (ti::macrof-version-bug-report
 196    "tinyxreg.el"
 197    "tinyreg"
 198    tinyxreg-:version-id
 199    "$Id: tinyxreg.el,v 2.43 2007/05/06 23:15:20 jaalto Exp $"
 200    '(tinyxreg-:version-id
 201      tinyxreg-:load-hook
 202      tinyxreg-:preg
 203      tinyxreg-:wreg
 204      tinyxreg-:x-coord
 205      tinyxreg-:y-coord
 206      tinyxreg-:description-func
 207      tinyxreg-:title
 208      tinyxreg-:buffer-fmt
 209      tinyxreg-:wcfg-fmt)))
 210
 211 ;;}}}
 212 ;;{{{ misc
 213
 214 ;;; ----------------------------------------------------------------------
 215 ;;;
 216 (defun tinyxreg-event ()
 217   "Return fake event."
 218   (ti::compat-make-fake-event tinyxreg-:x-coord tinyxreg-:y-coord))
 219
 220 ;;; ----------------------------------------------------------------------
 221 ;;;
 222 (defun tinyxreg-list ()
 223   "Return register list, point list + window list."
 224   (let* ((ptr   tinyxreg-:wreg)
 225          (list  (copy-sequence tinyxreg-:preg)))
 226     ;;  concat two lists
 227     (dolist (elt ptr)
 228       (push elt list))
 229     (nreverse list)))
 230
 231 ;;; ----------------------------------------------------------------------
 232 ;;;
 233 (defun tinyxreg-install-default-key-bindings ()
 234   "Install default key bindings."
 235   (interactive)
 236   ;;  There is no other good use for these
 237   (global-set-key "\C-x/"           'tinyxreg-point-to-register)
 238   (global-set-key "\C-x\\"          'tinyxreg-remove-register)
 239   ;;  The "C-c j" is like C-x j , but showing the popup
 240   (global-set-key "\C-cj"           'tinyxreg-jump-to-register)
 241   ;;  C-x is so easy to reach with left hand... and free
 242   (global-set-key [(control c) (mouse-1)]   'tinyxreg-jump-to-register-mouse)
 243   (global-set-key [(control c) (shift mouse-1)] 'tinyxreg-point-to-register-mouse)
 244   (when (interactive-p)
 245     (message "TinyXreg: Register Keys bound ok.")))
 246
 247 ;;; ----------------------------------------------------------------------
 248 ;;;
 249 ;;;###autoload
 250 (defun tinyxreg-remove-reg (char &optional arg)
 251   "Remove register CHAR from stored window and point lists.
 252 ARG suggests looking in window list."
 253   (interactive "cRemove register: \nP")
 254   (let* ((ptr (if arg tinyxreg-:wreg  tinyxreg-:preg))
 255          elt)
 256     (when (setq elt (rassq char ptr))
 257       (if arg
 258           (setq tinyxreg-:wreg (delete elt tinyxreg-:wreg))
 259         (setq tinyxreg-:preg (delete elt tinyxreg-:preg))))))
 260
 261 ;;; ----------------------------------------------------------------------
 262 ;;;
 263 (defun tinyxreg-update ()
 264   "Kill all registers from lists that are not alive any more.
 265 Eg. marker dies if you revert the buffer; kill and load it again."
 266   (let* ((ptr tinyxreg-:preg)
 267          reg
 268          list)
 269     ;;  We simple copy valid elements to another list
 270     (dolist (elt ptr)
 271       (setq reg (cdr elt))
 272       (if (ti::register-live-p reg)
 273           (push elt list)))
 274     (setq tinyxreg-:preg list)
 275     (setq ptr tinyxreg-:wreg)))
 276
 277 ;;; ----------------------------------------------------------------------
 278 ;;;
 279 ;;;###autoload
 280 (defun tinyxreg-trash ()
 281   "Empties both window and point caches."
 282   (interactive)
 283   (setq tinyxreg-:preg nil   tinyxreg-:wreg nil)
 284   (if (interactive-p)
 285       (message "TinyXreg: Register lists trashed.")))
 286
 287 ;;; ----------------------------------------------------------------------
 288 ;;;
 289 (defun tinyxreg-kill-reg (char)
 290   "Kill register CHAR from all lists."
 291   (tinyxreg-remove-reg char nil)
 292   (tinyxreg-remove-reg char 'window))
 293
 294 ;;; ----------------------------------------------------------------------
 295 ;;;
 296 (defun tinyxreg-add-reg (char arg &optional desc)
 297   "Store register CHAR to window or point list.
 298 ARG tells to store to window list. DESC is string to use."
 299   (let* ((desc (if (stringp desc)
 300                    desc
 301                  (char-to-string char)))
 302          (data (cons desc char)))
 303     (if arg
 304         (push data tinyxreg-:wreg)
 305       (push data tinyxreg-:preg))))
 306
 307 ;;}}}
 308 ;;{{{ storing
 309
 310 ;; ----------------------------------------------------------------------
 311 ;;; So that you call this from mouse
 312 ;;;
 313 (defun tinyxreg-description (register &optional arg)
 314   "Return description text for popup list.
 315 REGISTER is stored register and if ARG is non-nil the register
 316 contains window configuration."
 317   (let* ((bn   (file-name-nondirectory (buffer-name)))
 318          (cfg  tinyxreg-:wcfg-fmt))
 319     (format (concat tinyxreg-:buffer-fmt " %4s %s")
 320             (if arg
 321                 ;;  the 177 should print nice block
 322                 ;;  so that sorting puts cfg entries last
 323                 (eval cfg)
 324               bn)
 325             (if arg
 326                 ""
 327               (int-to-string
 328                (count-lines (point-min-marker) (line-beginning-position))))
 329             (char-to-string register))))
 330
 331 ;;; ----------------------------------------------------------------------
 332 ;;;
 333 ;;;###autoload
 334 (defun tinyxreg-point-to-register-mouse (event)
 335   "Call `tinyxreg-point-to-register' using mouse EVENT."
 336   (interactive "e")
 337   ;;    - User using "flying" mouse paste mode? See var mouse-yank-at-point
 338   ;;    - If he is, then move cursor visually to mouse point first.
 339   (if (null mouse-yank-at-point)
 340       (mouse-set-point event))
 341   (call-interactively 'tinyxreg-point-to-register))
 342
 343 ;;; ----------------------------------------------------------------------
 344 ;;; based on register.el::point-to-register
 345 ;;;
 346 ;;;###autoload
 347 (defun tinyxreg-point-to-register (char &optional arg)
 348   "Store point to CHAR and to X-popup list.
 349 With prefix ARG, store current frame configuration. VERBOSE enables
 350 message printing.
 351
 352 Use \\[tinyxreg-point-to-register]  to go to that location or restore the
 353 configuration."
 354   (interactive
 355    (list
 356     (let (CHAR
 357           (msg
 358            (cond
 359             (current-prefix-arg
 360              "TinyXreg: Store Window cfg to register: " )
 361             (t
 362              "TinyXreg: Store point to register: "))))
 363       (setq CHAR (ti::read-char-safe-until msg))
 364       ;;  Show where it got stored.
 365       (message (concat msg (char-to-string CHAR)))
 366       CHAR)
 367     current-prefix-arg))
 368   (let* ((dfunc   tinyxreg-:description-func)
 369          desc)
 370     (setq desc                          ;get the popup description
 371           (if (fboundp dfunc)
 372               (funcall dfunc char arg)
 373             nil))
 374     (tinyxreg-remove-reg char arg)
 375     (tinyxreg-add-reg    char arg desc)
 376     (set-register ;;   Now the normal emacs thing
 377      char
 378      (if (null arg)
 379          (point-marker)
 380        (current-frame-configuration)))))
 381
 382 ;;}}}
 383 ;;{{{ jumping
 384
 385 ;;; ----------------------------------------------------------------------
 386 ;;;
 387 ;;;###autoload
 388 (defun tinyxreg-remove-register ()
 389   "Remove register from popup list.
 390 See `tinyxreg-jump-to-register-mouse' for more."
 391   (interactive)
 392   (tinyxreg-jump-to-register-mouse nil 'remove))
 393
 394 ;;; ----------------------------------------------------------------------
 395 ;;; - for calling from keybord
 396 ;;;
 397 ;;;###autoload
 398 (defun tinyxreg-jump-to-register (&optional remove)
 399   "Call `tinyxreg-jump-to-register-mouse' with REMOVE."
 400   (interactive)
 401   (tinyxreg-jump-to-register-mouse nil remove))
 402
 403 ;;; ----------------------------------------------------------------------
 404 ;;;
 405 ;;;###autoload
 406 (defun tinyxreg-jump-to-register-mouse (event &optional remove verb)
 407   "Displays list of registers using mouse EVENT.
 408 Restore register or optionally REMOVE register from X-list.
 409 Input:
 410
 411   EVENT     mouse event
 412   REMOVE    flag, if non-nil, remove register.
 413   VERB      flag, Allow verbose messages."
 414   (interactive "e\nP")
 415   (let* ((event  (or event
 416                      (ti::compat-make-fake-event
 417                       tinyxreg-:x-coord tinyxreg-:y-coord)))
 418          (title  (interactive-p))
 419          ref-list
 420          list
 421          data
 422          char)
 423     (ti::verb)
 424     (tinyxreg-update)                   ;update register list
 425     (setq ref-list (tinyxreg-list)
 426           list     (mapcar 'car ref-list))
 427     (cond
 428      ((null (ti::compat-window-system))
 429       (message "TinyXreg: sorry, Requires X to use X-popup"))
 430      ((null list)
 431       (if verb
 432           (message "TinyXreg: sorry, both register lists are empty.")))
 433      (t
 434       (setq data (ti::compat-popup  list event nil title))
 435       (if (null data)
 436           (if verb
 437               (message "TinyXreg: register not selected."))
 438         (setq char (cdr-safe (assoc data ref-list)))
 439         (cond
 440          (remove
 441           ;;  Remove from both lists
 442           (tinyxreg-kill-reg char)
 443           (cond
 444            (verb
 445             (message
 446              (concat "TinyXreg: register ["
 447                      (char-to-string char) "] removed"))
 448             ;;  too fast otw when you move mouse..
 449             (sleep-for 1))))
 450          (t
 451           (jump-to-register char nil))))))))
 452
 453 ;;}}}
 454
 455 (provide   'tinyxreg)
 456 (run-hooks 'tinyxreg-:load-hook)
 457
 458 ;;; tinyxreg.el ends here