emacs_el/tiny-tools/tiny/tinyliby.el

   1 ;;; tinyliby.el --- Library of functions related to Emacs s(y)stem
   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 tiliby-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 ;; ........................................................ &t-install ...
  38 ;; You put this file on your Emacs-Lisp load path, add following into your
  39 ;; .emacs startup file
  40 ;;
  41 ;;     (require 'tinyliby)
  42 ;;
  43 ;; But, normally that is not required. All these functions are autoloaded
  44 ;; from the main library, so simple
  45 ;;
  46 ;;      (require 'tinylibm)
  47 ;;
  48 ;; will also cover these functions.
  49
  50 ;;}}}
  51 ;;{{{ Documentation
  52
  53 ;; ..................................................... &t-commentary ...
  54
  55 ;;; Commentary:
  56
  57 ;;  Briefly
  58 ;;
  59 ;;      o    This is lisp code library. Package itself does nothing.
  60 ;;      o    Collection of Emacs s(y)stem related functions.
  61 ;;
  62 ;;  Examples
  63 ;;
  64 ;;      If you're MH, VM user, don't get upset on this example. If you use
  65 ;;      RMAIL, but one day you accidentally start VM ... your whole
  66 ;;      mail system may be broken. To prevent accidents, you could
  67 ;;      wipe all traces of VM and MH with function below. THe function takes a
  68 ;;      while to execute.
  69 ;;
  70 ;;          (defun my-vm-mh-kill ()
  71 ;;            "Removes VM, MH permanently"
  72 ;;            (require 'tinyliby)
  73 ;;            (let (list)
  74 ;;              (setq list (ti::system-get-symbols "^vm-\\|^vm$"))
  75 ;;              (ti::system-unload-symbols list)
  76 ;;              (setq list (ti::system-get-symbols "^mh-\\|^mh$"))
  77 ;;              (ti::system-unload-symbols list)
  78 ;;              (setq list (ti::system-get-symbols "hook"))
  79 ;;              (ti::system-remove-from-hooks list "^vm\\|mh")))
  80
  81 ;;}}}
  82
  83 ;;; Change Log:
  84
  85 ;;; Code:
  86
  87 ;;{{{ setup: require
  88
  89 (require 'tinylibm)
  90
  91 (eval-and-compile
  92   (autoload 'adelete "assoc"))
  93
  94 (eval-when-compile
  95   (require 'advice)
  96   (ti::package-use-dynamic-compilation))
  97
  98 ;;}}}
  99
 100 ;;{{{ setup: -- variables
 101
 102 (defvar ti::system-:describe-symbols-history nil
 103   "History of used regular expressions.")
 104
 105 (defvar ti::system-:tmp-buffer "*ti::system-tmp*"
 106   "*Temporary buffer name.")
 107
 108 (defvar ti::system-:desc-buffer "*desc*"
 109   "*Describe buffer.")
 110
 111 ;;}}}
 112 ;;{{{ setup: -- version
 113
 114 (defconst tinyliby-version
 115   (substring "$Revision: 2.48 $"11 15)
 116   "Latest version number.")
 117
 118 (defconst tinyliby-version-id
 119   "$Id: tinyliby.el,v 2.48 2007/05/01 17:20:46 jaalto Exp $"
 120   "Latest modification time and version number.")
 121
 122 ;;; ----------------------------------------------------------------------
 123 ;;;
 124 (defun tinyliby-version (&optional arg)
 125   "Show version information. ARG will instruct to print message to echo area."
 126   (interactive "P")
 127   (ti::package-version-info "tinyliby.el" arg))
 128
 129 ;;; ----------------------------------------------------------------------
 130 ;;;
 131 (defun tinyliby-submit-feedback ()
 132   "Submit suggestions, error corrections, impressions, anything..."
 133   (interactive)
 134   (ti::package-submit-feedback "tinyliby.el"))
 135
 136 ;;}}}
 137 ;;{{{ features, load list
 138
 139 ;;; ----------------------------------------------------------------------
 140 ;;;
 141 (defun ti::system-package-where-is-source (package)
 142   "Try to locate PACKAGE as string. the one used in `load` command.
 143 nil parameter is also accepted."
 144   (cond
 145    ((null package))                     ;Skip right away
 146    ((string-match "^\\([a-z]:\\)?[\\/]" package)
 147     package)
 148    ((string-match "\\.el$\\|\\.elc$" package)
 149     (locate-library package))
 150    (t
 151     (locate-library (ti::string-verify-ends package ".el$" ".el")))))
 152
 153 ;;; ----------------------------------------------------------------------
 154 ;;;
 155 (defun ti::system-load-cleanup (ELT)
 156   "Remove ELT from `after-load-alist' by replacing entry with nil."
 157   (let* (forms)
 158     (dolist (elt after-load-alist)
 159       (setq forms (cdr elt))
 160       (dolist (frm forms)
 161         ;; change form to nil
 162         (if (equal frm ELT)
 163             (setcar forms nil))))))
 164
 165 ;;; ----------------------------------------------------------------------
 166 ;;;
 167 (defun ti::system-load-history-emacs-lisp-files ()
 168   "Return lisp of known Emacs lisp files in `load-history'."
 169   (let* (list)
 170     (dolist (entry load-history)        ;point to functions
 171       (push (car entry) list))
 172     list))
 173
 174 ;;; ----------------------------------------------------------------------
 175 ;;;
 176 (defun ti::system-load-history-where-exactly (sym load-history-elt)
 177   "After `ti::system-load-history-where' return the elt whre entry is, check `require'.
 178
 179 Return:
 180
 181   provide-symbol    This function returns the provide name which
 182                     defined the symbol.
 183
 184 Example of LOAD-HISTORY-ELT:
 185
 186 '(\"some-package.el\"
 187   (require . custom)
 188   gnus-undo-limit gnus-undo-mode gnus-undo-mode-hook ...
 189                   |
 190                   Suppose we search this SYM
 191   (provide . gnus-undo)  << This package provided the symbols
 192   ...)"
 193   (let* ( ;; require
 194          provide
 195          item
 196          current
 197          ret)
 198     (dolist (elt load-history-elt)
 199       (cond
 200        ((ti::listp elt)
 201         (setq item (car elt))
 202         (cond
 203          ((eq item 'provide)
 204           (setq provide     (cdr elt))
 205           ;;   if RET has been; indicating that SYM was found,
 206           ;;   terminate on next provide that should be just after the sym list
 207           ;;
 208           ;;   (require ...)
 209           ;;   ...sym sym SYM sym sym
 210           ;;   (provide 'package)
 211           (when ret
 212             (setq ret provide)
 213             (return)))))
 214        ((symbolp elt)
 215         (setq current elt)))
 216       (when (eq sym current)
 217         (setq ret provide)))
 218     ret))
 219
 220 ;;; ----------------------------------------------------------------------
 221 ;;;
 222 (defun ti::system-load-history-where-1 (sym)
 223   "Look `load-history' to find SYM. The SYM may be function or variable name.
 224
 225 Return:
 226
 227   list       feature's load history entry where variable were found.
 228   nil        no information in `load-history' about this variable."
 229   (dolist (entry load-history)          ;point to functions
 230     ;;  (FILE (REQUIRE) (REQ) SYM SYM SYM ...)
 231     (when (memq sym entry)
 232       (return entry))))
 233
 234 ;;; ----------------------------------------------------------------------
 235 ;;;
 236 (defun ti::system-doc-where-is-source (sym)
 237   "Check documentation string of SYM to determine location of definition."
 238   (let* ( ;;  Defined in `textmodes/fill'.
 239          (sfile  (and (fboundp 'symbol-file)
 240                       (ti::funcall 'symbol-file sym)))
 241          (file   (and (stringp sfile)
 242                       ;;  Use Two a-z's because win32 has D:/ at front
 243                       (if (string-match "^[a-z][a-z].*/\\(.*\\)" sfile)
 244                           (match-string 1)
 245                         sfile))))
 246
 247     (or (and file
 248              (or (and (ti::file-name-path-p file)
 249                       file)
 250                  (locate-library file)))
 251
 252         (let ((doc (documentation-property
 253                     sym 'variable-documentation)))
 254           (when (string-match
 255                  (concat
 256                   ;; Emacs: run-at-time is an interactive Lisp function in `timer'.
 257                   "^.*Lisp[ \t]+function[ \t]+in[ \t'`]+\\([^ \n\r\f\t'`\"]+\\)"
 258                   ;; XEmacs:   -- loaded from "e:\usr\local\bin\emacs...
 259                   "\\|--[ \t]+loaded from[ \t\"]+\\([^ \n\r\f\t'`\"]+\\)")
 260                  (or doc "")))))))
 261
 262 ;;; ----------------------------------------------------------------------
 263 ;;; Emacs doc string say: Defined in `frame'.
 264 ;;;
 265 (defun ti::system-load-history-where-is-source (sym)
 266   "Check documentation or `load-history' to find SYM.
 267 The SYM may be function or variable name.
 268
 269 Note:
 270
 271   From Emacs point of view, a variable is defined at the point
 272   where `defconst' or similar `defcustom' or `defvar' is used.
 273
 274 Return:
 275
 276   string     Absolute filename where the symbol was defined."
 277   (let* (elt
 278          provide
 279          file)
 280     (when (setq elt (ti::system-load-history-where-1 sym))
 281       (setq file    (car elt)           ;default
 282             provide (ti::system-load-history-where-exactly sym elt))
 283       (or (and provide
 284                (ti::system-package-where-is-source (symbol-name provide)))
 285           (and (not (ti::file-name-path-p file))
 286                (ti::system-package-where-is-source  file))
 287           file))))
 288
 289 ;;; ----------------------------------------------------------------------
 290 ;;; - Does little garbage collect...but what the heck!
 291 ;;; - lh = load-history
 292 ;;;
 293 (defun ti::system-load-history-get (sym)
 294   "Return variables and functions defined by feature SYM.
 295 The symbols are tested to be [f]boundp, so the list consists of
 296 those elements only that actually exist in emacs.
 297
 298 Return:
 299
 300   ((variable-list ..) (func-list ..))"
 301   (let* ((name  (symbol-name sym))
 302          (list  (cdr (assoc name load-history)))
 303          vl
 304          fl
 305          el
 306          ptr)
 307
 308     (if (null list) nil
 309       ;;  Search the variables' and funtions' start position in list
 310       (while (and list
 311                   (listp (car list)))
 312         (setq list (cdr list)))
 313       (setq ptr list)
 314       (while ptr
 315         (setq el (car ptr))
 316         (if (listp el)
 317             nil
 318           (if (boundp el)
 319               (setq vl (append vl (list el))))
 320           (if (fboundp el)
 321               (setq fl (append fl (list el)))))
 322         (setq  ptr (cdr ptr))))
 323     (if (or vl fl)
 324         (list vl fl)
 325       nil)))
 326
 327 ;;; ----------------------------------------------------------------------
 328 ;;;
 329 (defun ti::system-enable-disabled-options (&optional verb)
 330   "Map all variable symbols and enable options.
 331 by default, Emacs comes with few presetting disabled. You
 332 can enable those features (if you knwo what are disabled) wtih
 333 code like:
 334
 335     (put 'downcase-region 'disabled nil)
 336
 337 However, this function is more general and it can find
 338 all user variables i.e. options, that might be disabled.
 339
 340 INPUT:
 341
 342   verb   Print verbose messages."
 343   (interactive)
 344   (mapatoms
 345    (function
 346     (lambda (sym)
 347       (let (arg)
 348         (when (and (boundp 'sym)
 349                    (setq arg (memq 'disabled (symbol-plist sym)))
 350                    ;;  ARG = '(disabled t ..)
 351                    (nth 1 arg))
 352           (when verb
 353             (message "Tinyliby: Enabling variable `%s'" (symbol-name sym)))
 354           (put sym 'disabled nil)))))))
 355
 356 ;;; ----------------------------------------------------------------------
 357 ;;;  - Be sure what your're doing if using this...
 358 ;;;
 359 (defun ti::system-feature-kill (sym)
 360   "Kill feature SYM and its `load-history' information permanently."
 361   (let* ((name (symbol-name sym)))
 362     ;;  Load history , dependencies remove
 363     (if (assoc name load-history)
 364         (setq load-history (adelete 'load-history name)))
 365
 366     ;;  Kill the symbol from feature list
 367     (if (featurep sym)
 368         (setq features (delete sym features)))))
 369
 370 ;;; ----------------------------------------------------------------------
 371 ;;;
 372 (defun ti::system-unload-symbols (list)
 373   "Unload all variables and functions in LIST of symbols."
 374   (mapcar
 375    (function
 376     (lambda (x)
 377       (cond
 378        ((fboundp x)
 379         (fmakunbound x))
 380        ((boundp x)
 381         (makunbound x)))))
 382    list))
 383
 384 ;;; ----------------------------------------------------------------------
 385 ;;;
 386 (defun ti::system-unload (mode list)
 387   "According to MODE, unload all variables/features/functions in LIST.
 388
 389 MODE can be
 390 'var        list of variables
 391 'func       list of functions
 392 'feature    list of features  , caution !! Be sure to get
 393             feature's variable and function list before you use this,
 394             since it'll delete all information that `unload-feature' needs.
 395             The `unload-feature' is not always good cmd, because it checks
 396             dependencies and may not allow you to delete a feature.
 397
 398 References:
 399
 400   `ti::system-get-symbols'."
 401   (let* (test-func
 402          kill-func)
 403     (cond
 404      ((eq 'var mode)
 405       (setq  test-func 'boundp
 406              kill-func 'makunbound))
 407      ((eq  'func mode)
 408       (setq  test-func 'fboundp
 409              kill-func 'fmakunbound))
 410      ((eq 'feature mode)
 411       ;;  - Emacs don't let us remove a feature if it contains some
 412       ;;    require statement. Be sure to get the information
 413       ;;    about the variables and func first before killing feature,
 414       ;;    since we destroy load-history information also!!
 415       ;;
 416       (setq  test-func 'featurep
 417              kill-func 'unload-feature))
 418      (t
 419       (error "unknown mode" mode)))
 420     (dolist (var list)
 421       ;; Test if exist
 422       (when (funcall test-func var)
 423         (cond
 424          ((eq kill-func 'unload-feature)
 425           ;;  Feature kill is special
 426           (ti::system-feature-kill var))
 427          ((eq kill-func 'fmakunbound)
 428           ;;  This is shooting with rocks, by calling advice,
 429           ;;  but it's safest this way.
 430           (ad-unadvise var)
 431           (funcall kill-func var))
 432          (t
 433           (funcall kill-func var)))))))
 434
 435 ;;; ----------------------------------------------------------------------
 436 ;;;
 437 (defun ti::system-unload-feature (sym &optional verb)
 438   "Unload feature SYM, by cleaning `load-history' for all SYM symbols. VERB.
 439 This is far more extensive wipeout than `unload-feature': All variables,
 440 functions and ´load-history' is cleaned.
 441
 442 Return:
 443   t          If feature existed _and_ removed.
 444   nil        If feature does not exist."
 445   (interactive
 446    (list
 447     (intern-soft
 448      (completing-read
 449       "Complete feature to unload: "
 450       (ti::list-to-assoc-menu (mapcar 'prin1-to-string features))
 451       nil 'must-match))))
 452
 453   (let* (list)
 454     (ti::verb)
 455
 456     (when sym
 457       (when (setq list  (ti::system-load-history-get sym)) ;get (\var func\) list
 458         (ti::system-unload 'feature (list sym)) ;feature + load-history clean
 459         (ti::system-unload 'var     (nth 0 list) )
 460         (ti::system-unload 'func    (nth 1 list) ))
 461       (ti::system-feature-kill sym))
 462
 463     (if verb
 464         (message "Feature now completely unloaded."))))
 465
 466 ;;; ----------------------------------------------------------------------
 467 ;;;
 468 (defun ti::system-unload-feature-list (list)
 469   "Remove feature LIST, their variables and functions.
 470 Input is list of features. Does not check any dependencies between features."
 471   (dolist (feature list)
 472     (ti::system-unload-feature feature)))
 473
 474 ;;; ----------------------------------------------------------------------
 475 ;;;
 476 (put 'ti::system-symbol-dolist-macro 'lisp-indent-function 1)
 477 (defmacro ti::system-symbol-dolist-macro (symlist &rest body)
 478   "Map throught SYMLIST and execute BODY for each hook function.
 479 You can refer to variables `hook' and `function' in BODY."
 480   (`
 481    (let* (hook-functions)
 482      (dolist (hook (, symlist))
 483        (when (boundp hook)
 484          (setq hook-functions (symbol-value hook))
 485
 486          (if (and (not (ti::bool-p hook-functions))
 487                   (symbolp hook-functions))
 488              ;; single function in hook
 489              (setq hook-functions (list hook-functions)))
 490
 491          (when (listp hook-functions)
 492            (dolist (function hook-functions)
 493              (when (and (not (eq function 'lambda)) ;skip lambda notation
 494                         (symbolp function))
 495                (,@ body)))))))))
 496
 497 ;;; ----------------------------------------------------------------------
 498 ;;;
 499 (defun ti::system-remove-from-hooks (symlist re)
 500   "Look hook SYMLIST and remove all symbols matching RE.
 501
 502 If hook element is in form of  'lambda' instead of callable function symbol,
 503 this element is ignored. This function cannot remove lambda functions
 504 from hook, because match is done against `symbol-name'."
 505   (mapcar
 506    (function
 507     (lambda (hook)                      ;one hook at the time
 508       (if (null (boundp hook))          ;is list element variable ?
 509           nil                           ;cannot handle it
 510         (cond
 511
 512          ;;  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ add-hook form ^^^
 513
 514          ((listp (eval hook))           ;is hook in '(...) form ?
 515 ;;;      (ti::d! "list" hook)
 516           (mapcar                       ;step functions in list
 517            (lambda (el)
 518              (if (and (not (eq el 'lambda)) ;skip lambda notation
 519                       (symbolp el)
 520                       (string-match re (symbol-name el)))
 521                  (remove-hook hook el)))
 522            (eval hook)))
 523
 524          ;;  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ setq form ^^^
 525
 526          ((and (symbolp (eval hook)))
 527           (if (string-match re (symbol-name hook))
 528               (set hook nil)))))))
 529    symlist))
 530
 531 ;;; ----------------------------------------------------------------------
 532 ;;;
 533 (defun ti::system-match-in-hooks  (regexp &optional buffer)
 534   "Search SYMLIST for every hook functions that match REGEXP.
 535 Write results i temporary buffer or BUFFER."
 536   (interactive
 537    (list
 538     (read-string "Regesp: ")))
 539
 540   (or buffer
 541       (setq buffer (ti::temp-buffer ti::system-:desc-buffer 'clear)))
 542
 543   (with-current-buffer buffer
 544     (ti::system-symbol-dolist-macro
 545      (ti::system-get-symbols "-hook$\\|-functions$")
 546      (when (string-match regexp (symbol-name function))
 547        (insert (format "%-34s %s\n" (symbol-name hook)
 548                        (symbol-name function))))))
 549
 550   (if (interactive-p)
 551       (pop-to-buffer buffer))
 552
 553   buffer)
 554
 555 ;;}}}
 556 ;;{{{ internal Symbols
 557
 558 ;;; ----------------------------------------------------------------------
 559 ;;;
 560 (defun ti::system-get-symbols (re &optional test-form)
 561   "Return list of symbols that match RE.
 562
 563 The function 'mapatom' will return ALL symbols, no matter if they don't
 564 even exist any more [fboundp, boundp].
 565
 566 You can supply your own TEST-FORM to cause it drop away certain atoms.
 567 the current atom is stored in variable 'sym'.
 568
 569 Eg. test-form = '(or (fboundp sym) (boundp sym))"
 570   (let* (list)
 571     (mapatoms
 572      (function
 573       (lambda (sym)
 574         (if (and (string-match re (symbol-name sym))
 575                  (or (null test-form)
 576                      (eval test-form)))
 577             (push sym list)))))
 578     list))
 579
 580 ;;; ----------------------------------------------------------------------
 581 ;;;
 582 (defun ti::system-autoload-function-list ()
 583   "Return list of autoload function."
 584   (let* (list)
 585     (mapatoms
 586      (function
 587       (lambda (sym)
 588         (when (ti::autoload-p sym)
 589           (pushnew sym list :test 'equal)))))
 590     list))
 591
 592 ;;; ----------------------------------------------------------------------
 593 ;;;
 594 (defun ti::system-autoload-function-file-list (function-list)
 595   "Return unique filenames of autoload functions."
 596   (let* (list
 597          str)
 598     (dolist (func function-list)
 599       (when (setq str (inline (ti::function-autoload-file func)))
 600         (pushnew (match-string 1 str) list :test 'string-equal)))
 601     list))
 602
 603 ;;; ----------------------------------------------------------------------
 604 ;;; - There is another possibility, step through `load-history', but
 605 ;;;   since it's not in all emacs and it's buggy (at least in 19.28)
 606 ;;;   we don't use it here...
 607 ;;;
 608 (defun ti::system-get-file-documentation (file &optional verb)
 609   "Gather all documentation from symbols in FILE.
 610 You have to load the file into emacs first (eval it), because this
 611 function reads the documentation properties from memory.
 612
 613 Input:
 614
 615   FILE       absolute file name
 616   VERB       if non-nil, verbose messages are printed and
 617              the buffer is displayed when function finishes.
 618
 619 Return:
 620
 621   buffer     pointer where documentation is stored."
 622   (interactive
 623    (let* (file
 624           feature)
 625      (setq file
 626            (call-interactively
 627             (function
 628              (lambda (f)
 629                (interactive "FDocs from lisp package file: ") f))))
 630      ;;  We must find the FILE.el name
 631      (or (setq feature (ti::string-match ".*/\\(.*\\)\\.el$" 1 file))
 632          (error "Can't read .el filename. %s " file))
 633      ;; there must be 'FILE feature
 634      (or (and (intern-soft feature)
 635               (setq feature (intern-soft feature)))
 636          (y-or-n-p (format "\
 637 No '%s feature found, are you absolutely sure you have loaded the file? "
 638                            feature))
 639          (error "Abort."))
 640      (list file)))
 641   (let* ((tmp-buffer    (ti::temp-buffer ti::system-:tmp-buffer 'clear))
 642          (file-buffer   (ti::find-file-literally file))
 643          (all-re        (concat "^[(]\\([ \t]*"
 644                                 "defsubst\\|defvar\\|defconst"
 645                                 "\\|defmacro\\|defun"
 646                                 "\\|defadvice\\|deffoo\\|defvoo"
 647                                 "\\)[ \t]*\\([^ \t\n\f()]+\\)"))
 648          (func-re       (concat "defsubst\\|defmacro\\|defun"
 649                                 "\\|defadvice\\|deffoo\\|defvoo"))
 650          (verb          (or verb (interactive-p)))
 651          (count         0)
 652          ok-flag
 653          doc
 654          type
 655          sym-name
 656          sym
 657          paren)
 658     (unwind-protect
 659         (with-current-buffer file-buffer
 660           (ti::pmin)
 661           (while (re-search-forward all-re nil t)
 662
 663             (setq type      (match-string 1)
 664                   sym-name  (match-string 2)
 665
 666                   ;;  (defvar list)  --> (boundp 'list) = nil !! suprise
 667                   ;;
 668                   paren     (and (member type '("defvar" "defconst"))
 669                                  (looking-at "[ \t]*)"))
 670                   sym       (intern-soft sym-name)
 671                   doc       nil)
 672             (incf  count)
 673             ;;  print messages for every 10th only, it's too fast to
 674             ;;  show every symbol...
 675             (if (and verb
 676                      (= 0 (% count 10)))
 677                 (message (concat (int-to-string count) ": " sym-name)))
 678             ;; ... ... ... ... ... ... ... ... ... ... ... ... .. func ...
 679             (cond
 680              ((and (string-match "defadvice" type)
 681                    (or (null sym)
 682                        (not (fboundp sym))))
 683               (setq doc
 684                     (format
 685                      "tinyad: %s does nto exist yet. Can't read documentation."
 686                      sym-name)))
 687              ((string-match func-re type)
 688               (if (or (null sym)
 689                       (not (fboundp sym)))
 690                   (error (concat "Tinyliby: function not bound " sym-name))
 691
 692                 (setq doc
 693                       (format
 694                        "%-40s%s\n%s\n\n"
 695                        sym-name
 696                        "Function: "
 697                        (or (documentation  sym)
 698                            "not documented")))))
 699              ;; ... ... ... ... ... ... ... ... ... ... ... ... .. var  ..
 700              ((not paren)
 701               (if (or (null sym)
 702                       (not (boundp sym)))
 703                   (error (concat "Tinyliby: variable not bound " sym-name))
 704                 (setq sym (intern-soft sym-name))
 705                 (setq doc
 706                       (format "%-40s%s\n%s\n\n"
 707                               sym-name
 708                               (if (user-variable-p sym)
 709                                   "Option: " "Variable: ")
 710                               (or (documentation-property
 711                                    sym 'variable-documentation)
 712                                   "not documented"))))))
 713
 714             (if doc
 715                 (ti::append-to-buffer tmp-buffer doc)))
 716           (setq ok-flag t))             ;all completed
 717       ;; ... ... ... ... ... ... ... ... ... ... ... ... ... . cleanup . .
 718       ;; - Recover from Ctrl-g, remove the loaded file.
 719       ;;
 720       (kill-buffer file-buffer))
 721     (if (and verb ok-flag)
 722         (pop-to-buffer tmp-buffer))     ;show contents
 723     (if verb
 724         (message ""))                   ;clear the echo area
 725     tmp-buffer))
 726
 727 ;;; ----------------------------------------------------------------------
 728 ;;;
 729 (defun ti::system-describe-symbols-i-args (&optional arg)
 730   "Ask interactive arguments for `ti::system-describe-symbols'. ARG is prefix arg."
 731   (let* (prompt
 732          char
 733          ans)
 734     ;;  When user calls us without arguments, offer menu to pick
 735     ;;  search item
 736     (unless arg
 737       (setq char (ti::read-char-safe "\
 738  v)ars o)options non-(O)options i)nteractive funcs f)uncs all RET)all"))
 739       (cond
 740        ((char= char ?v) (setq arg '(4)))
 741        ((char= char ?o) (setq arg '(16)))
 742        ((char= char ?O) (setq arg '64))
 743        ((char= char ?i) (setq arg 0))
 744        ((char= char ?f) (setq arg 9))))
 745     (setq prompt
 746           (cond
 747            ((equal arg '(4))
 748             "Describe <vars all> matching: ")
 749            ((equal arg '(16))
 750             "Describe <var options> matching: ")
 751            ((equal arg '(64))
 752             "Describe <var non-options> matching: ")
 753            ((equal arg 0)
 754             "Describe <funcs interactive> matching: ")
 755            ((equal arg 9)
 756             "Describe <funcs non-interactive> matching: ")
 757            ((integerp arg)
 758             "Describe <funcs all> matching: ")
 759            (t
 760             "Describe <all> symbols matching: ")))
 761     (list
 762      (read-from-minibuffer              ;ARG 1
 763       prompt nil
 764       nil nil
 765       'ti::system-:describe-symbols-history)
 766      arg                                ;ARG 2
 767      ;;  Now handle exclude regexp       ;ARG 3
 768      (if (ti::nil-p (setq ans (read-from-minibuffer "exclude: ")))
 769          nil
 770        ans)
 771      (if (not (ti::listp arg))          ;ARG
 772          (y-or-n-p "Try to find key binding info too (takes longer)? "))
 773      nil)))                             ;ARG 5
 774
 775 ;;; ----------------------------------------------------------------------
 776 ;; - This originates from the elisp manual pages somewhere,
 777 ;;   but I have made major additions and modifications to it.
 778 ;; - Actually this is massive add-on to the original one e.g.  it can look
 779 ;;   behind aliased functions  (fset, defalias) and has nice
 780 ;;   interactive interface.
 781 ;;
 782 ;; - I suggest that you add this to your .emacs, since
 783 ;;   this function is utterly useful for locating anything.
 784 ;;* (autoload 'describe-symbols  "tinyliby" t t)
 785 ;;* (if (not (fboundp 'describe-symbols))
 786 ;;*     (defalias 'describe-symbols 'ti::system-describe-symbols))
 787 ;;
 788 ;;
 789 (defun ti::system-describe-symbols
 790   (pattern &optional mode exclude-re bind-info out-buffer)
 791   "Describe the Emacs Lisp symbols matching PATTERN.
 792 All symbols that have PATTERN in their name are described.
 793
 794 MODE can be
 795
 796   nil        return everything
 797
 798   list 4     return variables           prefix arg \\[universal-argument]
 799   list 16    return only options,       prefix arg \\[universal-argument] \\[universal-argument]
 800   list 64    return only non-options,   prefix arg \\[universal-argument] \\[universal-argument] \\[universal-argument]
 801
 802   nbr        return only functions
 803   nbr 0      return only interactive functions
 804   nbr 9      return only non-interactive functions
 805
 806 EXCLUDE-RE
 807
 808   Excludes matches.
 809
 810 BIND-INFO
 811
 812    If non-nil, then try to find binding info too. Note: if this flag
 813    is on, the time function executes decreases dramatically.
 814
 815 OUT-BUFFER
 816
 817    Where to print the info.
 818
 819 References:
 820
 821   `ti::system-:desc-buffer'"
 822   ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ interactive ^^^
 823   (interactive (ti::system-describe-symbols-i-args current-prefix-arg))
 824
 825   ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ interactive end ^^^
 826   (let* ((buffer (or out-buffer ti::system-:desc-buffer))
 827          subrp-test
 828          MF MFI MFF                     ;mode func
 829          MV MVO MVV                     ;mode var
 830          sym-list
 831          ALIAS
 832          FUNC
 833          (DEF "")
 834          tmp
 835          ;;  Build up the function cell into variable 'describe-func'
 836          (describe-func
 837           (function
 838            (lambda (s) ;; <-- symbol IN
 839              ;; ............................................. function ...
 840              ;; Print description of symbol.
 841              (cond
 842               ((and MF (fboundp s))
 843                ;;             (ti::d! 'function mode s MF MFI MFF)
 844                (setq ALIAS (ti::defalias-p s))
 845                (setq FUNC (or  ALIAS s))
 846                (cond                       ;; what is the main class ?
 847                 ((and MFI (commandp FUNC)) ;; means interactive
 848                  (setq DEF "Command: "))
 849                 ((and MFF)
 850                  (setq DEF "Function: ")))
 851                (if ALIAS
 852                    (setq DEF (concat DEF "Alias: " (symbol-name ALIAS))))
 853                (if (ti::autoload-p FUNC)
 854                    (setq DEF (concat DEF " Autoload: ")))
 855                (princ
 856                 (format
 857                  "%-40s %s\n%s%s%s%s\n\n"
 858                  s
 859                  DEF
 860                  (or (and (setq tmp (ti::function-args-p FUNC))
 861                           (progn
 862 ;;;                    (ti::d! FUNC "ARGS" tmp (symbol-function FUNC))
 863
 864                             ;; in xe, this doesn't print functions arguments,
 865                             ;; but the pacakge load information
 866                             ;; '(from "ange-ftp.elc")', but that's good to
 867                             ;; know too.
 868                             ;;
 869                             (concat tmp "\n")))
 870                      (and (ti::lambda-p FUNC)
 871                           (concat
 872                            (ti::string-left (prin1-to-string
 873                                              (symbol-function FUNC)) 75)
 874                            "..\n"))
 875                      "<Can't read func arglist>")
 876                  ;; .................................... function info ...
 877                  (when (or MF MFI MFF)
 878                    (concat
 879                     (cond
 880                      ((setq subrp-test (subrp (symbol-function s)))
 881                       "<Built-in-Lisp-primitive>\n")
 882                      ((ti::byte-compile-defun-compiled-p s)
 883                       "<Byte-compiled> ")
 884                      ((ti::defmacro-p s)
 885                       "<Macro> ")
 886                      (t
 887                       ""))
 888
 889                     (if subrp-test
 890                         ""
 891                       (concat
 892                        "<Package: "
 893                        (or (car-safe (ti::system-load-history-where-is-source s))
 894                            "unknown")
 895                        ">"))))
 896                  (if (and
 897                       bind-info
 898                       (and (or MF MFI MFF)
 899                            (setq tmp (ti::keymap-function-bind-info s))))
 900                      (concat "\t" tmp "\n")
 901                    "\n")
 902                  (or (condition-case ()
 903                          (documentation  FUNC)
 904                        (error "<Function does not exist; not defined>"))
 905                      "not documented")))) ;; cond-function
 906               ;; ............................................. variable ...
 907               ((and MV (boundp s))
 908                ;;             (ti::d! 'variable mode s MV MVO MVV)
 909                (cond
 910                 ((and MVO (user-variable-p s)) ;; option var
 911                  (princ
 912                   (format "%-40s %-9s%s\n%s\n\n"
 913                           s
 914                           "Option: "
 915                           (prin1-to-string (eval s))
 916                           (or (documentation-property
 917                                s 'variable-documentation)
 918                               "not documented"))))
 919                 ((and MVV )
 920                  (princ
 921                   (format "%-40s %-9s%s\n%s\n\n"
 922                           s
 923                           "Variable: "
 924                           (prin1-to-string (eval s))
 925                           (or (documentation-property
 926                                s 'variable-documentation)
 927                               "not documented")))))))))))
 928
 929     ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ let end ^^^
 930     (cond
 931      ((and (not (null mode))
 932            (listp mode))
 933       (setq MV t MVO t MVV t)
 934       (cond
 935        ((equal mode '(16))
 936         (setq MVV nil ))
 937        ((equal mode '(64))
 938         (setq MVO nil ))))
 939      ((integerp mode)
 940       (setq MF t MFI t MFF t)
 941       (cond
 942        ((= 0 mode)
 943         (setq MFF nil))
 944        ((= 9 mode)
 945         (setq MFI nil))))
 946      (t
 947       (setq MV t MVO t MVV t MF t MFI t MFF t)))
 948     ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ options end ^^^
 949     ;; Build a list of symbols that match pattern.
 950     (mapatoms (function
 951                (lambda (sym)
 952                  (if (and (string-match pattern (symbol-name sym))
 953                           (or (null exclude-re)
 954                               (and (stringp exclude-re)
 955                                    (not
 956                                     (string-match exclude-re
 957                                                   (symbol-name sym))))))
 958                      (setq sym-list (cons sym sym-list))))))
 959
 960     ;; Display the data.
 961     (if (null sym-list)
 962         (message "Describe symbols: No matches for given criterias.")
 963       (with-output-to-temp-buffer buffer
 964         (mapcar describe-func (sort sym-list 'string<))
 965         (print-help-return-message)))))
 966
 967 ;;; ----------------------------------------------------------------------
 968 ;;;
 969 (defun ti::system-describe-symbol-summary (re &optional verb)
 970   "Make elisp script out of variables and functions that match RE. VERB.
 971 Supposes that point is on buffer that is produced by
 972 `ti::system-describe-symbols'
 973
 974 Return:
 975
 976   buffer        where is ready output"
 977   (interactive "sRe: ")
 978   (let* ((out-buffer    (ti::temp-buffer ti::system-:tmp-buffer 'clear))
 979          (verb          (or verb (interactive-p)))
 980          list
 981          words
 982          var
 983          vlist
 984          flist)
 985     (setq list
 986           (ti::buffer-grep-lines
 987            (concat (or re "")
 988                    ".*\\(command\\|variable\\|option\\|function\\):")))
 989     (save-excursion
 990       (set-buffer out-buffer)
 991       ;; ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ...
 992
 993       (dolist (line list)
 994         (setq words     (split-string line)
 995               var       (nth 0 words))
 996         (cond
 997          ((string-match "Variable\\|option" line)
 998           (push var vlist))
 999          ((string-match "Command\\|Function" line)
1000           (push var flist))
1001          (t
1002           ;;  problem with line ?
1003           (insert (concat "#" line "\n")))))
1004       ;; ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ...
1005       (lisp-mode)
1006       (insert "(defconst vlist\n  '(\n")
1007       (setq vlist (nreverse vlist))
1008       (dolist (elt vlist)
1009         (insert (concat elt "\n")))
1010       (insert ")\n \"Variables\")\n\n")
1011       (insert "(defconst flist\n  '(\n")
1012       (setq flist (nreverse flist))
1013       (dolist (elt flist)
1014         (insert (concat elt "\n")))
1015       (insert ")\n \"Functions\")\n\n")
1016       (indent-region (point-min) (point-max) nil))
1017     (if verb
1018         (pop-to-buffer out-buffer))
1019     out-buffer))
1020
1021 ;;}}}
1022
1023 (provide    'tinyliby)
1024
1025 ;;; tinyliby.el ends here