1 ;;; tinylisp.el --- Emacs lisp programming help grab-bag
3 ;; This file is not part of Emacs
7 ;; Copyright (C) 1997-2007 Jari Aalto
10 ;; Maintainer: Jari Aalto
12 ;; To get information on this program use M-x tinylisp-version
13 ;; Look at the code with folding.el
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)
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
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.
32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
39 ;; ....................................................... &t-install ...
40 ;; Put this file on your Emacs-Lisp load path, add following into your
41 ;; ~/.emacs startup file.
43 ;; ;; Select some unused, non-shifted, fast prefix key.
44 ;; ;; My kbd accesses $ without shiff and it is seldom used
45 ;; ;; in lisp. Other alternatives: "!", "_" ":"
47 ;; (setq tinylisp-:mode-prefix-key "$")
48 ;; (setq tinylisp-:load-hook 'tinylisp-install)
49 ;; (require 'tinylisp)
51 ;; (setq tinylisp-:load-hook nil)
52 ;; Or prefer following autoload: your Emacs loads this package only
55 ;; (autoload 'tinylisp-mode "tinylisp" "" t)
56 ;; (autoload 'turn-on-tinylisp-mode "tinylisp" "" t)
57 ;; (add-hook 'emacs-lisp-mode-hook 'turn-on-tinylisp-mode)
58 ;; (add-hook 'lisp-interaction-mode-hook 'turn-on-tinylisp-mode)
60 ;; (setq tinylisp-:load-hook 'tinylisp-install)
61 ;; (global-set-key "\C-ce" 'tinylisp-mode) ; mode on/off
62 ;; (global-set-key "\C-cmE" 'eldoc-mode) ; In lastest Emacs
64 ;; If you don't want to use the echo-menu, but regular keymap calls
65 ;; instead, put following into your ~/.emacs. This must be before any
66 ;; other TinyLisp settings. You must reload package every time if you
67 ;; change this setting.
69 ;; (setq tinylisp-:menu-use-flag nil)
71 ;; To manually install or uninstall mode, call:
73 ;; M-x tinylisp-install
74 ;; M-x tinylisp-uninstall
76 ;; If you have any questions, use this function
78 ;; M-x tinylisp-submit-bug-report
83 ;; ..................................................... &t-commentary ...
89 ;; Private lisp help functions were scattered around files and
90 ;; in other private libraries. One day the author decided to write
91 ;; a minor mode to access all those tools that were written one by one
92 ;; and he I didn't want to continue stacking up `lisp-mode-hook'
93 ;; for all the growing features. So, if you're programming in Emacs
94 ;; Lisp, this minor mode may slightly increase your productivity.
96 ;; Overview of features
100 ;; o Create list of all variables from the buffer. (or occur menu)
101 ;; You can use this list to update your bug report function or just
102 ;; to get an overview of the variables. Check names and the order how
103 ;; you have used them (The order is important if you use defcustom)
104 ;; o Create function list (or occur menu)
105 ;; o Create autoload list
106 ;; o Evaluate current definition under point (re-parse function,
107 ;; reset defvar or even defcustom variable)
108 ;; o Print variable's value under point, set variable's value
109 ;; under point (backs up the original value which you can restore)
110 ;; o Call function under point (to test it immediately)
111 ;; o Indent function/variable around point.
112 ;; o FINDS LISP CODE ERROR POINT.
113 ;; o In DEBUGGER *Backtrace* hit 'R' to record the content of the value
114 ;; to *tinylisp-record* This is great when you want to send bug report
115 ;; to maintainer and you can attach the state of the variables
118 ;; o Code flow help: jump to variable of function definition even if
119 ;; it is located in different file. Does not use TAGS; but assumes
120 ;; that function is `known' to Emacs.
121 ;; o Two extra echo area modes: Show underlying properties/overlays or
122 ;; Show characters' syntax information.
126 ;; o Cursor at function name and calling `tinylisp-edebug-instrument'
127 ;; will instrument remote function. If you used just
128 ;; plain edebug, then you'd have to manually load the function into
129 ;; current point and hit `edebug-eval-defun', for each function.
130 ;; (Note that "i" auto-instrument doesn't always work from
132 ;; o Easily uninstrument functions: at point, in buffer
134 ;; Elp support -- Lisp code profiling
136 ;; o Access elp commands from echo menu
137 ;; o Profile your package or buffer's functions easily.
138 ;; Sit somewhere in function and un/instrument it with one command.
139 ;; Un/instrument all functions in the buffer with one command.
141 ;; Elint support -- Lint your elisp code
143 ;; o Code by Peter liljenberg, code location unknown.
144 ;; o catches misspellings and undefined variables
145 ;; o function calls with the wrong number of arguments, and
146 ;; some typos such as (let (a (car b)) ...)
148 ;; Checkdoc support -- Check doc strings for style requirements
150 ;; o ftp://ftp.ultranet.com/pub/zappo
151 ;; o Easy interface to checkdoc commands.
152 ;; o A tool that makes sure your package follows the guidelines
153 ;; presented in File: elisp, Node: Documentation Tips.
155 ;; Find-func.el support
157 ;; o Use this package as backup if symbol lookup fails.
161 ;; o Please take a look new XEmacs package bench.el (19.15 and 20.2)
164 ;; Tutorial, how do you check your package
166 ;; o $ f Take a look at your function names: are they well named,
167 ;; so that same categories begin with same words. Below it would be
168 ;; a mistake to have latter as xxx-ti::erase-buffer, because then
169 ;; you cant find all common function with `lisp-complete-symbol'
170 ;; command on xxx-buffer-*. Code is not a spoken language but
171 ;; meant to be used by programmers (Compare function naming in
172 ;; XEmacs and Emacs, where XEmacs does the the right thing)
174 ;; xxx-buffer-handling
177 ;; Check also that your macros are defined first before functions.
178 ;; If possible, maintain this definition order in your file
180 ;; defvar, defconst, defcustom (on top of file)
185 ;; o C-u $ v Check variable names as the function names above,
186 ;; but also see that you have defined right user variables which
187 ;; should be using `defcustom'. The extra C-u argument will print
189 ;; o $ x Check the lisp package layout: first line and footer must
190 ;; be in proper format and that Author etc. tags are in
192 ;; o Check the documentation strings with Checkdoc.
193 ;; To get overview of errors, do: $ c - and $ c RET
194 ;; which a) turned off query b) checked whole buffer for errors.
195 ;; When you have got a clear look, then start correcting mistakes
196 ;; and do $ c a (semiautomatic correction) $ c BACKSPACE to correct
199 ;; Defcustom.el and evaluating an `defcustom' variable
201 ;; If you don't know what defcustom is, or if you don't use it, you
202 ;; can ignore this section. The defcustom variables are evaluated
203 ;; pretending like they were `defconst', but because this evaluation
204 ;; is a bit special, pay attention to following paragraph.
206 ;; If you got thrown to error during evaluation, pay attention now,
207 ;; CALL COMMAND $ Z or `M-x' `tinylisp-emergency' IMMEDIATELY. For full
208 ;; details, see function documentation strings in the source file for
211 ;; (defadvice defconst
212 ;; (defun tinylisp-eval-at-point
214 ;; Find lisp code error position
216 ;; The most useful functions in this package are the two error
217 ;; finding functions which try their best to put you on a line that
218 ;; generates the lisp error. You can use this feature to e.g. check
219 ;; your ~/.emacs startup files and find the spot where
220 ;; `eval-current-buffer' fails.
222 ;; The best function, `tinylisp-error-find-1', was programmed by Mikael
223 ;; Djurfeldt <mdj@sanscalc.nada.kth.se> and is included here with his
224 ;; permission. Thanks Mikael, the function saves lot lisp debugging.
226 ;; Following lisp code call chain
228 ;; The traditional way to follow lisp code is to use TAGS file (See
229 ;; 'etags' or 'ctags' shell binary and C-h a "tags") which reads bunch
230 ;; of *el files and builds up internal representation of all defined
231 ;; symbols and their locations.
233 ;; But using tags is not very flexible if you write the code yourself,
234 ;; because when you add new function or new variable, the TAGS file is
235 ;; immediately out of date. Hm. The TAGS is general tool for many
236 ;; programming languages, but in Emacs lisp, we can take advantage of
237 ;; the fact that Emacs already knows where the symbols are defined.
238 ;; The information is stored to `load-history' whenever you run `load'
239 ;; `require' `load-file' or `load-library'.
241 ;; In this package, there are two functions that make use of
242 ;; `load-history' and if the symbol is not in the history, they try to
243 ;; find definition from the current buffer. You see, if you do
244 ;; `eval-current-buffer' the definition information is _not_ stored to
245 ;; `load-history'. With these commands you can browse some packages
246 ;; without any extra TAGS file.
248 ;; [The only assumption is that you have `loaded' the file !!]
250 ;; $ ' tinylisp-jump-to-definition (do not record call chain)
251 ;; $ + tinylisp-jump-to-definition-chain (record call chain)
252 ;; $ \177 tinylisp-back-to-definition (probably your backspace key)
253 ;; This returns to previously saved call-chain point
255 ;; The jump command also know following prefix arguments
257 ;; M-0 $ ' tinylisp-jump-to-definition (empty call chain)
258 ;; C-u $ ' tinylisp-jump-to-definition (record call-chain)
260 ;; Examining text properties and overlays in buffer
262 ;; If you have ever played with text properties or overlays (called
263 ;; extents in XEmacs), you know how hard it is to examine buffer's
264 ;; characters and debug where the properties are.
266 ;; In this package there is "constant char browsing mode" where every
267 ;; time you move your cursor, the face info and/or overlay info is
268 ;; displayed in the echo-area. If you supply `3' `C-u' arguments, the
269 ;; information is also recored to the separate buffer. This is the
270 ;; most easiest way to examine some character properties in arbitrary
271 ;; buffer positions. See C-h f on following function:
273 ;; $ p tinylisp-property-show-mode
275 ;; Examining charcter syntax
277 ;; Major modes define syntax tables for characters and sometimes you
278 ;; want to see the syntax class of a character under cursor. This mode
279 ;; behaves in the same manner as text property display, just turn it on
280 ;; and it will constantly show char info.
282 ;; $ y tli-syntax-show-mode
284 ;; Snooping interesting variables
286 ;; Has is happened to you that you're debugging package and it
287 ;; installs many hooks and and sets many different variables and then
288 ;; you suddenly realize that it went all wrong? You may even have
289 ;; noticed that some ill behaving package keeps preventing file
292 ;; No problem, you can define interesting variable sets to peek their
293 ;; contents, e.g. checking all file related hooks for problems. And if
294 ;; you supply C-u prefix arg, your editing is updated to the
295 ;; variables. With any other non-nil arg, the contents of the
296 ;; variables are recorded (kinda before install -- after install
297 ;; snooping) See function:
299 ;; $ s tinylisp-snoop-variables
301 ;; And additional prefix arguments: You can save variables states,
302 ;; modify them as you like, and go back to restores values.
306 ;; [excerpt from Barry's elp.el]
307 ;; ...Elp can instrument byte-compiled functions just as easily as
308 ;; interpreted functions, but it cannot instrument macros. However,
309 ;; when you redefine a function (e.g. with eval-defun), you'll need to
310 ;; re-instrument it with M-x `elp-instrument-function'. This will also
311 ;; reset profiling information for that function. Elp can handle
312 ;; interactive functions (i.e. commands), but of course any time spent
313 ;; idling for user prompts will show up in the timing results.
315 ;; To elp functions right, follow these steps. _*important*_ "(defun"
316 ;; must be left flushed in order the function to be found. If there is
317 ;; any leading spaces before the '(' or 'defun', then function won't
318 ;; be found and will not be (un)instrumented.
320 ;; o $ e A Restore (a)ll elp'd functions
321 ;; o $ - Eval buffer containing functions (or eval single function)
322 ;; o $ e I Instrument all functions in buffer (or single function)
323 ;; o $ e h Run the harness test that calls the functions
325 ;; Elp: Summary mode's sort capabilities
327 ;; When you call `$' ´E' `s' to show the elp result(s), the results
328 ;; buffer is put into `tinylisp-elp-summary-mode' where you can sort
329 ;; the columns with simple keystrokes. The sort keys correspond to the
332 ;; f)unction Name c)all Count e)lapsed Time a)verage Time
333 ;; ============== =========== ============= =============
335 ;; Elp: customizations
337 ;; You should be aware of this variable in elp; which resets the list
338 ;; every time you display it. You can toggle it's value from the echo
341 ;; elp-reset-after-results
345 ;; To instrument function for edebug, you'd normally have cursor inside
346 ;; current function and call `C-u' `M-x' `edebug-eval-defun'. But
347 ;; suppose you only see function call like this:
349 ;; (my-function arg arg arg)
351 ;; then you'd have to a) find out where the function is defined
352 ;; b) load that file c) position cursor over the fuction definition
353 ;; d) call edebug to instrument it. That's too much of a work. Instead
354 ;; there are commands that do this for you. See edebug submap `C-e'
355 ;; for edebug commands
357 ;; $ C-e RET Instrument function _named_ at point
358 ;; $ C-e DEL Uninstrument function _named_ at point
359 ;; $ C-e SPC Instrument all functions in buffer
360 ;; $ C-e x Uninstrument all functions in buffer
361 ;; $ C-e X Uninstrument all functions instrumented by $ C-e RET
365 ;; In standard Emacs there seems to be underused package trace.el.
366 ;; Add direct support for it.
368 ;; The regress.el provides support for writing and executing
369 ;; regression tests for Emacs Lisp code. Could that be supported too?
371 ;; Add support to xray.el
382 ;;; ......................................................... &require ...
386 (ti::package-require-view) ;; TinyLisp must be first in the minor-mode-list
389 (require 'advice) ;; For apropos.el
390 ;; XEmacs 21.2 NT had a problem loading the edug.el. After
391 ;; debug.el was loaded first, the edebug.el load succeeded.
393 ;; In older XEmacs 20.4 edebug does not "provide", so this uses
394 ;; plain old `load' method.
395 (or (featurep 'debug)
397 (or (featurep 'edebug)
399 ;; Don't show "obsolete function warning", because we know what
400 ;; we're doing below. Emulation in handled in tinylibb.el
401 (put 'frame-parameters 'byte-compile nil))
404 (ti::package-use-dynamic-compilation)
405 (autoload 'tinypath-cache-match-fullpath "tinypath")
406 (autoload 'remprop "cl-extra")
407 (autoload 'edebug-eval-defun "edebug" "" t)
408 ;; Silence bytecompiler
409 (defvar edebug-all-defs)
410 (defvar folding-mode)
411 (defvar checkdoc-arguments-in-order-flag)
412 (defvar checkdoc-verb-check-experimental-flag)
413 (defvar checkdoc-spellcheck-documentation-flag)
414 (defvar checkdoc-bouncy-flag)
415 (defvar checkdoc-bouncy-flag)
416 (defvar checkdoc-autofix-flag)
417 ;; During bute compiling it's best to see from where the
418 ;; libraries are loaded. You can also check *Messages*
419 (defun tinylisp-locate-library (lib)
420 "Print message if located LIB."
421 (let ((loc (locate-library lib)))
423 (message "tinyLisp.el: %s" loc)
427 ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. eldoc ..
428 (when (and nil ;; 2004-10-10 disabled.
429 (not (tinylisp-locate-library "eldoc")))
432 ** tinylisp.el: Hm, no eldoc.el found.
433 Emacs function parameter coding help is not available.
434 This package is included in latest Emacs versions.
435 You have to upgrade your Emacs."))
436 ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. . rsz ..
437 (when (and nil ;; 2004-10-10 disabled.
438 ;; XEmacs package is in different name
439 (null (or (tinylisp-locate-library "rsz-minibuf")
440 (tinylisp-locate-library "rsz-mini"))))
443 ** tinylisp.el: Hm, no rsz-mini.el or rsz-minibuf.el found.
444 This package is included in latest Emacs versions.
445 You have to upgrade your Emacs."))
446 ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. . find-func ..
448 ;; in XEmacs-20.3(beta) there is no
449 ;; "find-func.el", instead `find-function' is in "help.el" and so
450 ;; in fact dumped with xemacs.
451 (fboundp 'find-function)
452 ;; In Emacs 20 it is in separate package.
453 (locate-library "find-func"))
456 ** tinylisp.el: Hm, no find-func.el found.
457 Upgrade tot latest Emacs and XEmacs."))
458 ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. elint ..
459 (if (and nil ;; 2004-10-10 disabled.
460 (not (tinylisp-locate-library "elint")))
464 ** tinylisp.el: Hm, no elint.el found. No code check features available.
465 Package is included in latest Emacs."))
466 (autoload 'elint-initialize "elint")
467 (autoload 'elint-current-buffer "elint" "" t)
468 (autoload 'elint-defun "elint" "" t))
469 ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. xray ..
470 (unless (tinylisp-locate-library "xray")
473 ** tinylisp.el: Hm, no xray.el found.
474 No lisp symbol \"explain\" features available.
475 2001-10 it was at http://www.cpqd.com.br/~vinicius"))
476 ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. checkdoc ..
477 (defvar checkdoc-version)
478 (if (and nil ;; 2004-10-10 disabled.
479 (not (tinylisp-locate-library "checkdoc")))
483 ** tinylisp.el: Hm, no checkdoc.el found.
484 No lisp package syntax checks available.
485 Upgrade your Emacs."))
486 (autoload 'checkdoc-interactive "checkdoc" "" t)
487 (autoload 'checkdoc-eval-current-buffer "checkdoc" nil t)
488 (autoload 'checkdoc-current-buffer "checkdoc" nil t)
489 (autoload 'checkdoc "checkdoc" nil t)
490 (autoload 'checkdoc-continue "checkdoc" nil t)
491 (autoload 'checkdoc-comments "checkdoc" nil t)
492 (autoload 'checkdoc-rogue-spaces "checkdoc" nil t)
493 (autoload 'checkdoc-eval-defun "checkdoc" nil t)
494 (autoload 'checkdoc-defun "checkdoc" nil t)
495 (autoload 'checkdoc-minor-mode "checkdoc" nil t)
496 (autoload 'checkdoc-find-error-mouse "checkdoc" nil t)
497 (autoload 'checkdoc-find-error "checkdoc" nil t))
498 ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. . elp ..
499 (if (and nil ;; 2004-10-10 disabled.
500 (not (tinylisp-locate-library "elp")))
504 ** tinylisp.el: Hm, no elp.el found.
505 Lisp profiling functions are not available.
506 This package is included in latest Emacs and XEmacs."))
507 ;; This pretends the functions exist and avoids byte compiler errors.
508 (defvar elp-all-instrumented-list nil)
509 (defvar elp-function-list nil)
510 (defvar elp-master nil)
511 (defvar elp-results-buffer "*ELP Profiling Results*")
512 (defvar elp-reset-after-results nil)
513 (autoload 'elp-instrument-function "elp" "" t)
514 (autoload 'elp-restore-function "elp" "" t)
515 (autoload 'elp-instrument-list "elp" "" t)
516 (autoload 'elp-instrument-package "elp" "" t)
517 (autoload 'elp-restore-list "elp" "" t)
518 (autoload 'elp-restore-all "elp" "" t)
519 (autoload 'elp-reset-function "elp" "" t)
520 (autoload 'elp-reset-list "elp" "" t)
521 (autoload 'elp-reset-all "elp" "" t)
522 (autoload 'elp-set-master "elp" "" t)
523 (autoload 'elp-unset-master "elp" "" )
524 (autoload 'elp-wrapper "elp" "" )
525 (autoload 'elp-sort-by-call-count "elp" "" )
526 (autoload 'elp-sort-by-total-time "elp" "" )
527 (autoload 'elp-sort-by-average-time "elp" "" )
528 (autoload 'elp-output-result "elp" "" )
529 (autoload 'elp-results "elp" "" t)
530 (autoload 'elp-submit-bug-report "elp" "" t))
531 (unless (zerop count)
533 ** tinylisp.el: Some files were not found. This is not fatal.
534 The package will adjust accoding to available features.
535 Byte compiled file will be ok."))))
537 (ti::package-defgroup-tiny TinyLisp tinylisp-: tools
538 "Lisp programming help module.
539 Overview of features.
543 o Create list of all variables from the buffer.
544 Uou can use the list in your bug report function or just
545 to get an overview of the variables: names and the order how
546 you have used them (The order is important if you use defcustom)
547 o Create function list (or occur menu)
548 o Create autoload list (or occur menu)
549 o Evaluate current definition under point (reparse function,
550 reset defvar or defcustom variable)
551 o Print variable's value under point, set variable's value
553 o Call function under point (to test it immediately)
554 o Indent function/variable around point.
555 o Two tun on Modes: Show underlying properties/overlays or
556 charcter symbol information.
557 o FIND LISP CODE ERROR POINT.")
560 ;;{{{ setup: mode definition
562 (defcustom tinylisp-:menu-use-flag t
563 "*Non-nil means to use echo-area facilities from tinymenu.el."
567 ;; Creating a minor mode
569 ;; This macro creates the full minor mode and all needed variables
571 ;; Mode name "E" for minor name
573 ;; A general lisp helper mode; please see these too:
580 ;; Prefix variable "$"
582 ;; You seldom use end anchor $ in lisp. Use $$ to self insert it
583 ;; Another characters you could choose: "!", "_"
584 ;; If possible, select some character that is non-shifted
585 ;; for maximum accessibility of this minor mode.
587 ;; You can change the prefix key by adding this statement before
588 ;; loading this package:
590 ;; (setq tinylisp-:mode-prefix-key "C-cE")
594 ;;;###autoload (autoload 'tinylisp-commentary "tinylisp" "" t)
595 ;;;###autoload (autoload 'tinylisp-mode "tinylisp" "" t)
596 ;;;###autoload (autoload 'turn-on-tinylisp-mode "tinylisp" "" t)
597 ;;;###autoload (autoload 'turn-off-tinylisp-mode "tinylisp" "" t)
599 (ti::macrof-minor-mode-wizard
600 "tinylisp-" " E" "$" "E" 'TinyLisp "tinylisp-:" ;1-6
602 "This minor mode is used along with the lisp major modes. You can
603 evaluate expressions, reread functions, check your lisp packages
604 syntax, create autoloads and do many more things.
608 \\{tinylisp-:mode-prefix-map}"
610 "Emacs Lisp extras" ;7
614 "Emacs Lisp menu." ;9
617 tinylisp-:mode-easymenu-name
618 ["Eval whole buffer" tinylisp-eval-current-buffer t]
619 ["Eval whole buffer, `load'" tinylisp-eval-current-buffer-from-file t]
620 ["Eval whole buffer as defconst" tinylisp-eval-current-buffer-defconst t]
621 ["Eval statement at point" tinylisp-eval-at-point t]
622 ["Eval reverse statement at point" tinylisp-eval-reverse t]
623 ["Eval and edit line " tinylisp-eval-edit t]
624 ["Eval and print result" tinylisp-eval-print-last-sexp t]
625 ["Macroexpand macro funcall" tinylisp-macroexpand t]
627 ["Call statement at point" tinylisp-call-at-point t]
628 ["Set value at point" tinylisp-set-value-at-point t]
629 ["Jump to definiton" tinylisp-jump-to-definition t]
630 ["Jump to definiton (call-chain)" tinylisp-jump-to-definition-chain t]
631 ["Back to definiton (call-chain)" tinylisp-back-to-definition t]
633 ["Forward user var or func" tinylisp-forward-user-option t]
634 ["Backward user var or func" tinylisp-backward-user-option t]
637 "Modes, find error, debug"
638 ["Mode, property show" tinylisp-property-show-mode t]
639 ["Mode, char syntax show" tinylisp-syntax-show-mode t]
640 ["Find lisp error, method 1" tinylisp-error-find-1 t]
641 ["Find lisp error, method 2" tinylisp-error-find-2 t]
642 ["Add code debug tags" tinylisp-error-debug-add-tags t])
646 ["Show symbol load path" tinylisp-library-find-symbol-load-info t]
647 ["show loaded libraries" tinylisp-library-info-emacs t]
648 ["Load one" tinylisp-library-info-emacs t]
649 ["Load by regexp" tinylisp-library-load-by-regexp t]
650 ["Find file" tinylisp-library-find-file t]
651 ["Display documentation" tinylisp-library-documentation t])
653 "Variables and Symbols"
654 ["Occur" tinylisp-occur-verbose t]
655 ["Occur, select next" tinylisp-occur-select-forward t]
656 ["Collect variable list" tinylisp-find-variable-list t]
657 ["Collect variable list, occur" tinylisp-find-variable-list-occur t]
658 ["Collect function list" tinylisp-find-function-list t]
659 ["Collect function list, occur" tinylisp-find-function-list-occur t]
661 ["Info, buffer local variables" tinylisp-find-buffer-local-variables t]
663 ["Construct autoloads from buffer" tinylisp-autoload-generate-buffer t]
664 ["Construct autoloads from file" ti::package-autoload-create-on-file t]
665 ["Describe library's symbols" tinylisp-library-symbol-information t]
666 ["Snoop variables" tinylisp-snoop-variables t]
668 ["Grep adviced functions" tinylisp-ad-match t]
669 ["Grep Hooks" tinylisp-find-match-from-hooks t]
670 ["Grep variables" tinylisp-find-match-from-variables t]
671 ["Grep symbols" ti::system-describe-symbols t])
675 ["Emergency - defcustom" tinylisp-emergency t]
676 ["Indent function or variable" tinylisp-indent-around-point t]
677 ["Narrow to function" tinylisp-narrow-to-function t]
679 ["Convert word to defmacro var." tinylisp-defmacro-surround-word t]
680 ["Byte compile current function." tinylisp-byte-compile-sexp t]
682 ["Show call tree for file"
683 tinylisp-byte-compile-display-call-tree t]
685 ["Face, show font lock faces" tinylisp-face-list-font-lock-faces t]
686 ["Face, show all faces" tinylisp-face-list-known-faces t]
687 ["Process kill" tinylisp-process-kill t]
688 ["Process list" list-processes t])
690 "Package layout check"
691 ["Check overall layout syntax" tinylisp-lisp-mnt-verify t]
693 ["Check or fix layout tags in buffer"
694 tinylisp-lisp-mnt-tag-check-and-fix-buffer t]
696 ["Check or fix layout tags in file"
697 tinylisp-lisp-mnt-tag-check-and-fix-file t]
699 ["Check or fix layout tags in directory"
700 tinylisp-lisp-mnt-tag-check-and-fix-dir t])
705 "Documentation check."
706 ["Check forward" tinylisp-checkdoc t]
707 ["Check buffer, take notes" tinylisp-checkdoc-notes t]
708 ["Check comments" checkdoc-comments t]
709 ["Check comments, take notes" tinylisp-checkdoc-comment-notes t]
710 ["Check defun, current point" checkdoc-eval-defun t]
711 ["Checkdoc minor mode" checkdoc-minor-mode t])
715 ["Check buffer" tinylisp-elint-buffer t]
716 ["Check defun" tinylisp-elint-defun t])
720 ["Instrument function" tinylisp-edebug-instrument t]
721 ["Uninstrument function" tinylisp-edebug-uninstrument t]
722 ["Instrument buffer" tinylisp-edebug-instrument-buffer t]
723 ["Uninstrument buffer" tinylisp-edebug-uninstrument-buffer t]
724 ["Uninstrument everything" tinylisp-edebug-uninstrument-everything t])
727 "Elp lisp profiling menu"
728 ["Instrument function" tinylisp-elp-instrument-function t]
729 ["Instrument buffer" tinylisp-elp-instrument-buffer t]
730 ["Instrument by regexp" tinylisp-elp-instrument-by-regexp t]
731 ["Uninstrument function" tinylisp-elp-restore-function t]
732 ["Uninstrument buffer" tinylisp-elp-restore-buffer t]
733 ["Uninstrument all" tinylisp-elp-restore-all t]
734 ["Reparse instrumentation" tinylisp-reparse-instrumentation t]
738 ["List instrumented functions" tinylisp-elp-function-list-partial t]
739 ["List All instrumented functions" tinylisp-elp-function-list t]
740 ["Harness test (eval from point)" tinylisp-elp-harness t]
741 ["Master set" tinylisp-elp-set-master t]
742 ["Master reset" elp-unset-master t]
743 ["Reset timing list" tinylisp-elp-reset-list t]
744 ["Show timing list" tinylisp-elp-results t])
746 ["Keyboard menu" tinylisp-menu-main t]
747 ["Mode on for all lisp buffers" turn-on-tinylisp-mode-all-buffers t]
748 ["Mode off for all lisp buffers" turn-on-tinylisp-mode-all-buffers t]
749 ["Package version" tinylisp-version t]
750 ["Package commentary" tinylisp-commentary t]
751 ["Mode help" tinylisp-mode-help t]
752 ["Mode off" tinylisp-mode t]
758 (tinylisp-:menu-use-flag
759 ;; Using menu to remeber commands is easier if you don't use
761 (define-key root-map p 'tinylisp-menu-main))
764 (tinylisp-install-menu)
766 (define-key map "\C-m" 'tinylisp-eval-print-last-sexp)
768 (define-key map "Z" 'tinylisp-emergency)
770 (define-key map "-" 'tinylisp-eval-current-buffer)
771 (define-key map "*" 'tinylisp-eval-current-buffer-from-file)
772 (define-key map "=" 'tinylisp-eval-current-buffer-defconst)
773 (define-key map "." 'tinylisp-eval-at-point)
774 (define-key map "\\" 'tinylisp-eval-reverse)
776 (define-key map "m" 'tinylisp-macroexpand) ;; if @ is inaccessible
778 (define-key map "cc" 'tinylisp-byte-compile-buffer)
779 (define-key map "cs" 'tinylisp-byte-compile-sexp)
780 (define-key map "ct" 'tinylisp-byte-compile-display-call-tree)
782 (define-key map "," 'tinylisp-call-at-point)
783 (define-key map ";" 'tinylisp-set-value-at-point)
784 (define-key map "!" 'tinylisp-error-find-1)
785 (define-key map "#" 'tinylisp-error-find-2)
786 (define-key map "%" 'tinylisp-error-debug-add-tags)
787 (define-key map "'" 'tinylisp-jump-to-definition)
788 (define-key map "+" 'tinylisp-jump-to-definition)
789 (define-key map "'\177" 'tinylisp-back-to-definition)
790 (define-key map "`" 'tinylisp-defmacro-surround-word)
792 (define-key map "{" 'tinylisp-backward-user-option)
793 (define-key map "}" 'tinylisp-forward-user-option)
795 (define-key map "<" 'tinylisp-indent-around-point)
797 (define-key map "a" 'tinylisp-autoload-generate-buffer)
798 (define-key map "A" 'tinylisp-autoload-generate-file)
800 (define-key map "ia" 'tinylisp-ad-match)
801 (define-key map "ie" 'tinylisp-library-info-emacs)
802 (define-key map "ih" 'tinylisp-find-match-from-hooks)
803 (define-key map "il" 'tinylisp-library-symbol-information)
804 (define-key map "iL" 'tinylisp-find-buffer-local-variables)
805 (define-key map "is" 'ti::system-describe-symbols)
806 (define-key map "iv" 'tinylisp-find-match-from-variables)
808 (define-key map "I" 'tinylisp-eval-edit)
810 (define-key map "f" 'tinylisp-find-function-list)
811 (define-key map "F" 'tinylisp-find-function-list-occur)
813 (define-key map "lf" 'tinylisp-library-find-file)
814 (define-key map "ll" 'tinylisp-library-load-library)
815 (define-key map "lL" 'tinylisp-library-load-by-regexp)
816 (define-key map "ls" 'tinylisp-library-find-symbol-load-info)
817 (define-key map "ld" 'tinylisp-library-documentation)
819 (define-key map "n" 'tinylisp-narrow-to-function)
821 (define-key map "o" 'tinylisp-occur-verbose)
822 (define-key map "+" 'tinylisp-occur-select-forward)
824 (define-key map "p" 'tinylisp-property-show-mode)
825 (define-key map "S" 'tinylisp-snoop-variables)
827 (define-key map "v" 'tinylisp-find-variable-list)
828 (define-key map "V" 'tinylisp-find-variable-list-occur)
830 (define-key map "w" 'widen)
831 (define-key map "x" 'tinylisp-checkdoc)
832 (define-key map "y" 'tinylisp-syntax-show-mode)
834 (define-key map "Xv" 'tinylisp-lisp-mnt-verify)
835 (define-key map "Xt" 'tinylisp-lisp-mnt-tag-check-and-fix-buffer)
836 (define-key map "Xf" 'tinylisp-lisp-mnt-tag-check-and-fix-file)
837 (define-key map "Xd" 'tinylisp-lisp-mnt-tag-check-and-fix-dir)
839 (define-key map "bv" 'tinylisp-b-variables)
840 (define-key map "bf" 'tinylisp-b-funcs)
841 (define-key map "br" 'tinylisp-b-record)
842 (define-key map "bR" 'tinylisp-b-record-empty)
843 (define-key map "bt" 'tinylisp-b-eval)
845 (define-key map "ei" 'tinylisp-elp-instrument-function)
846 (define-key map "eI" 'tinylisp-elp-instrument-buffer)
847 (define-key map "eI" 'tinylisp-elp-instrument-by-regexp)
848 (define-key map "eu" 'tinylisp-elp-restore-function)
849 (define-key map "eU" 'tinylisp-elp-restore-buffer)
850 (define-key map "eA" 'tinylisp-elp-restore-all)
851 (define-key map "ee" 'tinylisp-reparse-instrumentation)
852 (define-key map "eh" 'tinylisp-elp-harness)
854 (define-key map "ef" 'tinylisp-elp-function-list-partial)
855 (define-key map "eF" 'tinylisp-elp-function-list)
856 (define-key map "er" 'tinylisp-elp-reset-list)
857 (define-key map "es" 'tinylisp-elp-results)
858 (define-key map "em" 'tinylisp-elp-set-master)
859 (define-key map "eM" 'elp-unset-master)
861 (define-key map "E\C-m" 'tinylisp-elint-buffer)
862 (define-key map "E " 'tinylisp-elint-defun)
864 (define-key map "\C-e\C-m" 'tinylisp-edebug-instrument)
865 (define-key map "\C-e\C-h" 'tinylisp-edebug-uninstrument)
866 (define-key map "\C-e " 'tinylisp-edebug-instrument-buffer)
867 (define-key map "\C-ex" 'tinylisp-edebug-uninstrument-buffer)
868 (define-key map "\C-eX" 'tinylisp-edebug-uninstrument-everything)
870 (define-key map "1f" 'tinylisp-face-list-font-lock-faces)
871 (define-key map "1f" 'tinylisp-face-list-known-faces)
872 (define-key map "1p" 'tinylisp-process-kill)
873 (define-key map "1P" 'list-processes))))))
875 ;;; ................................................... &&mode-summary ...
877 ;;;###autoload (autoload 'tinylisp-elp-summary-mode "tinylisp" "" t)
878 ;;;###autoload (autoload 'turn-on-tinylisp-elp-summary-mode "tinylisp" "" t)
879 ;;;###autoload (autoload 'turn-off-tinylisp-elp-summary-mode "tinylisp" "" t)
883 (ti::macrof-minor-mode-wizard
884 "tinylisp-elp-summary-" " Elp-sum" nil " Elp-sum" 'TinyLisp
885 "tinylisp-:elp-summary-" ;1-6
887 "Commands to help sorting elp summary buffer.
890 \\{tinylisp-:elp-summary-prefix-mode-map}"
892 "Elp summary sort" ;7
896 "Elp summary sort menu." ;9
899 tinylisp-:elp-summary-mode-easymenu-name
900 ["Sort by function name" tinylisp-elp-summary-sort-column-1 t]
901 ["Sort by call count" tinylisp-elp-summary-sort-column-2 t]
902 ["Sort by elapsed time" tinylisp-elp-summary-sort-column-3 t]
903 ["Sort by average time" tinylisp-elp-summary-sort-column-4 t])
905 ;; Function Name Call Count Elapsed Time Average Time
906 ;; ============= ========== ============ ============
907 (define-key map "f" 'tinylisp-elp-summary-sort-column-1)
908 (define-key map "c" 'tinylisp-elp-summary-sort-column-2)
909 (define-key map "e" 'tinylisp-elp-summary-sort-column-3)
910 (define-key map "a" 'tinylisp-elp-summary-sort-column-4))))
915 (defcustom tinylisp-:load-hook nil
916 "*Hook that is run when package is loaded.
917 A good value could be '(turn-on-tinylisp-mode-all-buffers) to activate
918 the minor mode in every Emac slisp buffer."
922 (defcustom tinylisp-:find-func-list-hook 'tinylisp-highlight-default
923 "*Hook run when tinylisp-find-function-list-hook has displayed the list."
927 (defcustom tinylisp-:find-var-list-hook 'tinylisp-highlight-default
928 "*Hook run when `tinylisp-find-function-list' has displayed the list."
932 (defcustom tinylisp-:with-current-buffer-hook '(turn-on-tinylisp-mode)
933 "*Hook run after ´tinylisp-with-current-buffer'."
938 ;;{{{ setup: public, user configurable
940 (defcustom tinylisp-:register ?\'
941 "*An Emacs register that is used e.g. for saving point or copying text."
945 (defcustom tinylisp-:macroexpand-function-list
946 '("cl-prettyexpand" "macroexpand")
947 "*Completion list of function STRINGS to expand macro call.
948 You can use commands `cl-prettyexpand', which sometimes does
949 good formatting, but does not necessarily expand to what you want to see.
950 The default command is `macroexpand'."
951 :type '(repeat string)
954 (defcustom tinylisp-:table-reverse-eval-alist
955 '((add-hook . remove-hook)
956 (remove-hook . add-hook))
957 "*Table of reverse commands. Format '((ORIG-FSYM . REVERSE-FSYM) ..)."
961 (defcustom tinylisp-:table-snoop-variables
965 post-command-idle-hook))
979 message-signature-setup-hook
980 message-header-setup-hook
987 post-command-idle-hook
992 "*List of interesting variables printed from `tinylisp-snoop-variables'.
993 Non existing variables can also be listed but they are not checked.
997 '((\"LIST-NAME\" (var var var ..))
1002 (string :tag "Completion name")
1003 (repeat (symbol :tag "Var"))))
1007 ;;{{{ setup: private variables
1009 (defvar tinylisp-:harness-flag nil
1010 "Described in function `tinylisp-elp-harness'.
1011 This variable is set to t when harness is on going and set to
1012 nil when harness test is over.")
1014 (defvar tinylisp-:call-chain nil
1015 "List of buffers and buffer positions. '(mark mark ..)
1016 Whenever you call `tinylisp-jump-to-definition' the current positions
1017 is recoded and one more element to the _beginning_ of list is added.
1018 You can navigate back with `tinylisp-back-to-definition' and the first
1019 element from the list is removed.")
1021 (defvar tinylisp-:buffer-elp "*tinylisp-elp*"
1022 "Temporary elp info buffer.")
1024 (defvar tinylisp-:buffer-autoload "*tinylisp-autoloads*"
1025 "Temporary buffer.")
1027 (defvar tinylisp-:buffer-variables "*tinylisp-variables*"
1028 "Temporary buffer.")
1030 (defvar tinylisp-:buffer-data "*tinylisp-data*"
1031 "Temporary buffer.")
1033 (defvar tinylisp-:buffer-library "*tinylisp-library*"
1034 "Temporary buffer.")
1036 (defvar tinylisp-:buffer-record "*tinylisp-record*"
1037 "Record variable contents to this buffer.")
1039 (defvar tinylisp-:buffer-tmp "*tinylisp-tmp*"
1040 "Temporary buffer.")
1042 (defvar tinylisp-:buffer-macro "*tinylisp-macroexpand*"
1043 "Temporary buffer.")
1045 (defvar tinylisp-:buffer-eval " *tinylisp-eval*"
1046 "Temporary buffer.")
1048 (defconst tinylisp-:regexp-macro-definition
1049 "^\\(defun\\*\\|defcustom\\|defgroup\\|defadvice\\)"
1050 "Regexp for commands that define macros, like `defcustom' `defgroup'.")
1052 (defconst tinylisp-:regexp-function
1055 ;; cl DEFINES defun* macro
1056 "defun\\*?\\|defsubst\\|defmacro"
1058 "\\|defun-maybe\\|defmacro-maybe\\|defalias-maybe"
1059 ;; see Gnus nntp.el for deffoo
1060 "\\|deffoo\\|defadv"
1061 "\\)[ \t]+\\([^ \t\n]+\\)")
1062 "Regexp to match functions.
1063 This must have SUBMATCH1 and SUBMATCH2 which represent function
1066 (defconst tinylisp-:regexp-variable
1069 ;; Normal lisp variables
1071 ;; Custom.el defined variables in 19.35
1072 "\\|defgroup\\|defcustom"
1073 "\\)[ \t]+\\([^ \t\n]+\\)")
1074 "Regexp to match variables.
1075 This must have SUBMATCH1 and SUBMATCH2 which represent
1076 variable type and name.")
1078 (defvar tinylisp-:variable-not-charset "^][()'`\", \t\n\r"
1079 "When reading variable from buffer, unse this is character set.
1080 Notice that ^ at the beginning of character set reverses it.")
1082 (defvar tinylisp-:find-error nil
1083 "'Find error' function's data.")
1085 (defvar tinylisp-:occur-history nil
1088 (defvar tinylisp-:elp-regexp-history nil
1091 (defvar tinylisp-:elp-not-regexp-history nil
1094 (defvar tinylisp-:elp-master-history nil
1097 ;; Too bad this is hard coded in emacs..
1098 (defvar tinylisp-:occur-buffer-name "*Occur*"
1099 "Emacs Occur buffer.")
1101 (defvar tinylisp-:edebug-instrument-table nil
1102 "Edebug instrumentation information.
1106 '((function buffer-pointer buffer-file-name)
1107 (function buffer-pointer buffer-file-name)
1111 ;;{{{ setup: private, mode
1113 ;;; These must not be made buffer local.
1115 (defvar tinylisp-:property-show-mode nil
1116 "Property show mode (flag).")
1118 (defvar tinylisp-:syntax-show-mode nil
1119 "Property show mode (flag).")
1124 (defvar tinylisp-:menu-main) ;; Just a forward declaration
1126 (defun tinylisp-install-menu ()
1127 "Install `tinylisp-:menu-main'."
1128 ;; this is a function because if user changes prefix key and
1129 ;; calls tinylisp-install, we must reflect the change here in
1130 ;; self insert command.
1133 (defconst tinylisp-:menu-main ;bookmark -- &menu
1136 ;; All commands do not fit to echo menu, but here are at least
1137 ;; the most used ones.
1141 %s -=*.\\rmE)val ,;'+)call wn)ar py)mode o)ccur aA)load vVfF xSdD >beEcilX C-e"
1142 (if current-prefix-arg
1143 (format "%s" (prin1-to-string current-prefix-arg))
1146 (cons ?? 'tinylisp-:menu-help)
1147 (cons ?\C-m (list '(tinylisp-eval-print-last-sexp)))
1148 (cons ?- (list '(call-interactively 'tinylisp-eval-current-buffer)))
1149 (cons ?* (list '(call-interactively
1150 'tinylisp-eval-current-buffer-from-file)))
1151 (cons ?= (list '(call-interactively
1152 'tinylisp-eval-current-buffer-defconst)))
1153 (cons ?. (list '(call-interactively 'tinylisp-eval-at-point)))
1154 (cons ?, (list '(tinylisp-call-at-point current-prefix-arg)))
1155 (cons ?\\ (list '(call-interactively 'tinylisp-eval-reverse)))
1156 (cons ?\; (list '(call-interactively 'tinylisp-set-value-at-point)))
1157 (cons ?! (list '(call-interactively 'tinylisp-error-find-1)))
1158 (cons ?# (list '(call-interactively 'tinylisp-error-find-2)))
1159 (cons ?% (list '(call-interactively 'tinylisp-error-debug-add-tags)))
1160 (cons ?+ (list '(call-interactively 'tinylisp-jump-to-definition-chain)))
1161 (cons ?' (list '(call-interactively 'tinylisp-jump-to-definition)))
1162 (cons ?\177 (list '(tinylisp-back-to-definition)))
1163 (cons ?{ (list '(call-interactively 'tinylisp-backward-user-option)))
1164 (cons ?} (list '(call-interactively 'tinylisp-forward-user-option)))
1165 (cons ?[ (list '(call-interactively 'tinylisp-backward-user-option)))
1166 (cons ?] (list '(call-interactively 'tinylisp-forward-user-option)))
1167 (cons ?< (list '(call-interactively 'tinylisp-indent-around-point)))
1168 (cons ?` (list '(call-interactively 'tinylisp-defmacro-surround-word)))
1169 (cons ?a (list '(call-interactively 'tinylisp-autoload-generate-buffer)))
1170 (cons ?A (list '(call-interactively 'tinylisp-autoload-generate-file)))
1171 (cons ?B (list '(call-interactively 'tinylisp-byte-compile-sexp)))
1172 (cons ?f (list '(call-interactively 'tinylisp-find-function-list)))
1173 (cons ?F (list '(call-interactively 'tinylisp-find-function-list-occur)))
1174 (cons ?I (list '(call-interactively 'tinylisp-eval-edit)))
1175 ;; Small "h" is reserved for echo-menu help
1176 (cons ?n (list '(call-interactively 'tinylisp-narrow-to-function)))
1177 (cons ?m (list '(call-interactively 'tinylisp-macroexpand)))
1178 (cons ?o (list '(call-interactively 'tinylisp-occur-verbose
1179 current-prefix-arg)))
1180 (cons ?+ (list '(tinylisp-occur-select-forward current-prefix-arg)))
1181 (cons ?p (list '(tinylisp-property-show-mode current-prefix-arg 'verb)))
1182 (cons ?S (list '(let* ((i (tinylisp-snoop-variables-i-args)))
1183 (tinylisp-snoop-variables
1184 (nth 0 i) (nth 1 i)))))
1185 (cons ?v (list '(tinylisp-find-variable-list current-prefix-arg)))
1186 (cons ?V (list '(call-interactively 'tinylisp-find-variable-list-occur)))
1187 (cons ?w (list '(call-interactively 'widen)))
1188 (cons ?y (list '(tinylisp-syntax-show-mode current-prefix-arg 'verb)))
1189 (cons ?Z (list '(call-interactively 'tinylisp-emergency)))
1190 (cons ?\C-c (list '(call-interactively 'tinylisp-commentary)))
1191 (cons ?\C-e 'tinylisp-:menu-edebug)
1192 (cons ?\C-v (list '(call-interactively 'tinylisp-version)))
1193 (cons ?i 'tinylisp-:menu-info)
1194 (cons ?e 'tinylisp-:menu-elp)
1195 (cons ?E 'tinylisp-:menu-elint)
1196 (cons ?H 'tinylisp-:menu-help)
1197 (cons ?b 'tinylisp-:menu-buffers)
1198 (cons ?c 'tinylisp-:menu-checkdoc)
1199 (cons ?C 'tinylisp-:menu-compile)
1200 (cons ?l 'tinylisp-:menu-lisp-library)
1201 (cons ?1 'tinylisp-:menu-misc-1)
1202 (cons ?X 'tinylisp-:menu-lisp-mnt)
1203 ;; Self insert command
1204 ;; User may have defined multichararcter minor map entry
1205 ;; like C-cE, we only do self insert if it is NOT
1207 (cons (string-to-char ;get first char
1208 (substring tinylisp-:mode-prefix-key 0 1))
1210 '(let ((key (ti::keymap-single-key-definition-p
1211 tinylisp-:mode-prefix-key)))
1212 (if (characterp key)
1213 (insert tinylisp-:mode-prefix-key)
1215 TinyLisp: Can't self-insert. Prefix is not one charcracter.")))))))
1216 "Emacs Lisp coding help menu.
1217 Documentation of variable `tinylisp-:menu-main' which is main menu
1218 for mode function `tinylisp-mode'. You can access the mode with
1219 \\[tinylisp-mode]. Prefix key for the minor mode is defined in
1220 `tinylisp-:mode-prefix-key'.
1224 / Return to previous menu (if in sub-menu)
1225 h Echo-menu help. Output this screen and quit
1227 H TinyLisp Help menu.
1233 * Reload buffer from file with load command. This has the effect that
1234 the function and variable definitions are recorded to load
1235 history and you can use \\[tinylisp-jump-to-definition] command.
1237 = Treat all variables as defconst and eval buffer. (With this
1238 you can read the defaults if you're in package buffer)
1240 . Eval current statement. If you have made changes to the function or
1241 variable, which can be also defvar, this command evaluates it again
1242 so that it gets the new definition. (defvar is treated as defconst)
1244 \\ Reverse command around point and eval the statement. See
1245 variable `tinylisp-:table-reverse-eval-alist'. E.g. if you see
1246 `add-hook', the statement is interpreted as `remove-hook'.
1250 Eval statement _preceeding_ the cursor. This will output the
1251 returned values one by one. E.g.
1253 (cutrrent-buffer)RET
1256 r Reload packages to Emacs by regexp. If you have downloaded
1257 new packages and your Emacs session is open, this is easy
1258 way to refresh packages to your Emacs.
1260 Finding errors and debugging
1262 m Macroexpand a macro symbol. [See also (comma) to expand functions]
1264 I Read current line, allow ed(I)ting it, then eval the statement.
1266 ! Find errors. Go to `point-min' and evaluate buffer portions
1269 # Find Lisp error with method 2. Try this if previous failed.
1271 % Insert permanent debug tags. With \\[universal-argument] remove
1272 debug tags. If the byte compilation gives a weird error and does not
1273 tell the function and keys ! or # claim that all lisp code is valid,
1274 you should instrument debug tags and try byte compiling again.
1276 Z Emergency! If you evaled `defcustom' variable and you were thrown
1277 to error buffer, call this command immediately to
1278 restore TinyLisp. The defcustom is adviced and this fixes it.
1280 Function and code flow
1282 ' Jump to a definition of variable or function.
1283 With \\[universal-argument], save the call-chain point.
1284 With non-nil prefix argument, clear the call chain. Use
1285 BACKSPACE or \\177 (C-h) key to go back the saved call chain.
1287 + Record position to call chain before jump to the definition. This
1288 is shortcut to calling key \".\" with the prefix arg.
1290 DEL Back to previous definition and remove mark from call chain.
1292 }] Go to next user option; a star mark, or to user
1293 function; interactive.
1294 {[ Same as above, but backward.
1298 , Call current word around point. If the word is a variable, print
1299 value. If word is a function, call function or show `symbol-function'
1301 ; Set new value for variable at point. If the read word is not an
1302 existing variable, then this only prints warning messages.
1303 old value is saved if there is no previous backup.
1305 \\[universal-argument] Restore backup'd value
1306 \\[universal-argument]\\[universal-argument] Force setting backup value to current value.
1308 ` Surround current word with defmacro statement (, WORD)
1310 S Snoop variables. See `tinylisp-:table-snoop-variables'
1311 Following prefix arguments are recognized:
1312 1 Record snooped values to
1313 to buffer `tinylisp-:buffer-record'
1315 9 Restore values from saved state.
1317 5 Set all snooped variables to nil.
1318 \\[universal-argument] edit variable
1320 Symbol find or autoload generation
1322 a Create autoloads by reading current buffer (must have
1323 `buffer-file-name'). With prefix argument, ask package
1324 name and locate it in `load-path'.
1326 A Create autoloads from directory's files matching regular epression
1328 d Describe symbols. This scans whole Emacs obarray to find all
1329 matching symbols. --> See also [I]nfo menu for more targetted
1332 D Describe loaded package. You can rip all the documentation from
1333 a file by doing this 1) load file into Emacs 2) eval it and finally
1334 3) call this function and give file path. It collects all variable
1335 and function documentation to a single display.
1337 Listing and occur commands:
1339 o Run occur for full buffer and filter out comments. Prefix arg says
1340 _not_ to filter out full comment lines.
1342 + Go to next occur line in buffer. With \\[universal-argument] backward.
1344 f Find all functions from the buffer
1345 F Find function and create occur menu.
1347 l Show symbol Load information (file where is was defined)
1348 L Library information, examine all packages in Emacs.
1350 v Find all variables from buffer. Prefix args classifies variables.
1351 V Find variables and create occur menu.
1355 p Property show mode. Three \\[universal-argument]'s turn on recording.
1356 y syntax mode, Show syntax of charcter under cursor.
1358 X Check variable and function documentation strings. Do they follow
1359 Emacs Lisp code guidelines? File: elisp, Node: Documentation Tip.
1360 (Uses package lisp-mnt.el)
1364 n Narrow to current lisp function.
1368 < Indent current function or variable around point.
1372 B Byte compile defun around point. With prefix arg DISSASSEBMLE.
1374 See [C]ompile menu for more options.
1378 b Buffer menu. Jump to TinyLisp temp buffers.
1379 c Checkdoc, docstring syntax checker menu
1380 C Byte (C)ompilation menu.
1381 e Elp menu. Emacs lisp profiler menu
1382 E Elint menu. Emacs Lisp code syntax checker menu
1384 i Info menu. Find adviced functions, find from hooks/variables
1385 l Library menu. Load, find lisp libraries for editing.
1386 1 Misc menu 1: Display face settings, process kill menu
1388 C-e Edebug, Emacs Lisp debugger menu"))
1390 ;;; ----------------------------------------------------------------------
1392 (defconst tinylisp-:menu-misc-1
1394 '(format "%sMisc 1: f)onts F)onts all p)rocess-kill P)rocess list"
1395 (if current-prefix-arg
1396 (format "%s " (prin1-to-string current-prefix-arg))
1399 (cons ?f (list '(tinylisp-face-list-font-lock-faces)))
1400 (cons ?F (list '(tinylisp-face-list-known-faces)))
1401 (cons ?p (list '(tinylisp-process-kill)))
1402 (cons ?P (list '(list-processes)))
1403 (cons ?/ 'tinylisp-:menu-main)))
1404 "*Miscellaneous interface: Processes and fonts.
1407 f List font lock colors available.
1408 F List ALL known faces.
1409 p Kill running processes interactively.
1410 P List running processes.")
1412 ;;; ----------------------------------------------------------------------
1414 (defconst tinylisp-:menu-lisp-library
1417 "%sLibrary: s)sym-where l)load L)oad-re f)ind pP)kg-where d)doc"
1418 (if current-prefix-arg
1419 (format "%s " (prin1-to-string current-prefix-arg))
1422 (cons ?f (list '(call-interactively 'tinylisp-library-find-file)))
1423 (cons ?l (list '(call-interactively 'tinylisp-library-load-library)))
1424 (cons ?L (list '(call-interactively 'tinylisp-library-load-by-regexp)))
1425 (cons ?s (list '(tinylisp-library-find-symbol-load-info)))
1426 (cons ?p (list '(tinylisp-library-locate
1427 (tinylisp-library-read-name)
1428 current-prefix-arg)))
1429 (cons ?P (list '(progn
1430 (tinylisp-library-locate-by-fullpath-intercative))))
1431 (cons ?d (list '(call-interactively 'tinylisp-library-documentation)))
1433 (cons ?/ 'tinylisp-:menu-main)))
1434 "*Lisp library interface:
1438 s Try to loate file where symbol was defined. This relies on
1439 internal representation of symbols inside Emacs `load-history'.
1441 l Load one Lisp library with completion into Emacs. (evaluate)
1443 L Load again libraries inside Emacs matching regexp. E.g. if you want to
1444 reload all of present gnus, supply regexp `gnus'
1446 f `find-file' a library for editing.
1448 p Package search: like `locate-library' but find all occurrances
1449 of package. With prefix argument, insert data into buffer.
1451 P Package search: Search packages whose full path name matches
1452 regexp. In order to use this feature, package `tinypath.el'
1453 must be available. This command calls directly its functions.
1455 d Display Lisp file's documentation.
1456 With prefix argument insert documentation to current point.")
1458 ;;; ----------------------------------------------------------------------
1460 (defconst tinylisp-:menu-compile
1462 '(format "%sByte-Compile: c)ompile t)tree for compile"
1463 (if current-prefix-arg
1464 (format "%s " (prin1-to-string current-prefix-arg))
1467 (cons ?c '( (tinylisp-byte-compile-buffer)))
1468 (cons ?s '( (tinylisp-byte-compile-sexp)))
1469 (cons ?t '( (tinylisp-byte-compile-display-call-tree)))
1470 (cons ?/ 'tinylisp-:menu-main)))
1471 "*Elint interface: Check code syntax.
1477 ;;; ----------------------------------------------------------------------
1479 (defmacro tinylisp-require (sym)
1480 "Require package SYM."
1481 (` (unless (featurep (, sym))
1482 (require (, sym)))))
1484 ;;; ----------------------------------------------------------------------
1486 (defconst tinylisp-:menu-elp
1488 (tinylisp-require 'elp)
1490 "%selp: iIRuUAe)instrument fF)unc rsS%s)time H)arness mM)aster%s"
1491 ;; Is there functions instrumented?
1492 (if elp-all-instrumented-list
1493 (if (eq 0 (setq val (length elp-all-instrumented-list)))
1497 (if elp-reset-after-results
1501 (concat ":" (symbol-name elp-master))
1503 ((?i . ( (call-interactively 'tinylisp-elp-instrument-function)))
1504 (?I . ( (call-interactively 'tinylisp-elp-instrument-buffer)))
1505 (?R . ( (call-interactively 'tinylisp-elp-instrument-by-regexp)))
1506 (?u . ( (call-interactively 'tinylisp-elp-restore-function)))
1507 (?U . ( (call-interactively 'tinylisp-elp-restore-buffer)))
1508 (?A . ( (call-interactively 'tinylisp-elp-restore-all)))
1509 (?H . ( (tinylisp-elp-harness current-prefix-arg 'verb)))
1510 (?e . ( (call-interactively 'tinylisp-reparse-instrumentation)))
1511 (?m . ( (call-interactively 'elp-set-master)))
1512 (?M . ( (call-interactively 'elp-unset-master)))
1513 (?f . ( (tinylisp-elp-function-list-partial current-prefix-arg 'verb)))
1514 (?F . ( (tinylisp-elp-function-list current-prefix-arg 'verb)))
1515 (?r . ( (call-interactively 'tinylisp-elp-reset-list)))
1516 (?s . ( (tinylisp-elp-results current-prefix-arg)))
1517 (?S . (t (tinylisp-elp-reset-after-results)))
1518 (?/ . tinylisp-:menu-main)))
1520 The menu shows some status parameters in the echo area.
1522 '[COUNT] elp: [:t]list'
1524 | See 'S' key when this is shown
1525 Count of currently instrumented functions
1532 i Instrument current function at point
1533 u Uninstrument function at point
1535 I Instrument all functions in buffer.
1536 U Uninstrument all functions in buffer.
1538 R Instrument by regexp mapping all Emacs functions.
1539 If given prefix arg, then uninstrument instead.
1541 A Uninstrument all functions in elp list (reastore all)
1543 e r(e)parse instrumentation: forget all instrumented functions,
1544 eval buffer to read new function definitions, and instrument those
1549 h Harness test. Eval everything 3 times from current point forward
1550 and record results. See `tinylisp-elp-harness' for full explanation.
1551 Prefix arg determines harness rounds.
1552 m Set master function. When functions below master are called, the timing
1553 infomation is gathered.
1554 M Unset master function.
1556 Function information:
1558 f List _all_ instrumented functions . Prefix arg to display the functions
1560 F Same as above, but list all only specific functions in
1561 `elp-function-list'.
1565 s Show timing results. With prefix arg save results to RECORD buffer.
1566 S rese(:t) flag, Toggle setting of variable `elp-reset-after-results'.
1567 r Reset timing list.")
1569 (defconst tinylisp-:menu-info
1570 '("info: a)d e)macs f)ile-sym o)hooks l)ocal-vars s)ym v)ar A)utoload"
1571 ((?A . ( (call-interactively 'tinylisp-find-autoload-functions)))
1572 (?a . ( (call-interactively 'tinylisp-ad-match)))
1573 (?e . ( (call-interactively 'tinylisp-library-info-emacs)))
1574 (?f . ( (call-interactively 'tinylisp-library-symbol-information)))
1575 (?o . ( (call-interactively 'tinylisp-find-match-from-hooks)))
1576 (?l . ( (call-interactively 'tinylisp-find-buffer-local-variables)))
1577 (?v . ( (call-interactively 'tinylisp-find-match-from-variables)))
1578 (?s . ( (call-interactively 'ti::system-describe-symbols)))
1579 (?/ . tinylisp-:menu-main)))
1580 "Display information about lisp symbols in Emacs
1585 a List all adviced functions that match advice NAME. E.g. to find all
1588 e Show all libraries and symbols loaded into Emacs known by `load-history'.
1590 f Describe file symbols. Gather all documentation from symbols in FILE.
1591 You have to load the file into Emacs first (eval it with \\[load-file]),
1592 because this function reads the documentation properties from memory.
1594 h Search a match from contents of all -hook -function -functions symbols
1595 E.g. you can locate all hooks that have function matching 'my'.
1597 l Decribe library symbols. This is like `f', but you do not need to give
1598 the full path name, but the file will be located along `load-path'.
1600 L Show buffer local variables.
1602 s Search any symbol (variable or function) from Emacs obrray with REGEXP.
1604 v Search all variables matching variable-REGEXP and whose value match
1607 (defconst tinylisp-:menu-buffers
1608 '("go buffer: a)utoload rR)ecord v)vars f)uncs e)val E)lp"
1609 ((?a . ( (tinylisp-b-autoload)))
1610 (?r . ( (tinylisp-b-record)))
1611 (?R . ( (tinylisp-b-record-empty)))
1612 (?v . ( (tinylisp-b-variables)))
1613 (?f . ( (tinylisp-b-funcs)))
1614 (?e . ( (tinylisp-b-eval)))
1615 (?E . ( (tinylisp-b-elp)))
1616 (?/ . tinylisp-:menu-main)))
1617 "Display TinyLisp buffers.
1619 / Back to root menu.
1621 a Display autoload buffer
1622 r Display the record buffer where the variable contents
1623 are stored when you call \\[universal-argument] `tinylisp-call-at-point'
1624 R Kill record buffer.
1629 ;;; ----------------------------------------------------------------------
1631 (defconst tinylisp-:menu-elint
1632 '("Elint: RET)buffer SPC)defun"
1634 (?\C-m . ( (tinylisp-elint-buffer)))
1635 (?\ . ( (tinylisp-elint-defun)))
1636 (?/ . tinylisp-:menu-main)))
1637 "Elint interface: Check code syntax.
1643 ;;; ----------------------------------------------------------------------
1645 (defconst tinylisp-:menu-help
1646 '("Help: m)mode c)commentary v)ersion"
1647 ((?m . ( (tinylisp-mode-help)))
1648 (?c . ( (tinylisp-commentary)))
1649 (?v . ( (tinylisp-version)))
1650 (?/ . tinylisp-:menu-main)))
1654 m `tinylisp-mode' Mode description
1655 v `tinylisp-version'
1656 c `tinylisp-commentary'")
1658 ;;; ----------------------------------------------------------------------
1660 (defconst tinylisp-:menu-lisp-mnt
1661 '("Lisp-mnt: RET)verify SPC)fix tags f)file d)directory"
1662 ((?\C-m . ( (tinylisp-lisp-mnt-verify)))
1663 (?\ . ( (tinylisp-lisp-mnt-tag-check-and-fix-buffer 'error)))
1664 (?f . ( (tinylisp-lisp-mnt-tag-check-and-fix-file 'error))) ;;#todo:
1665 (?d . ( (tinylisp-lisp-mnt-tag-check-and-fix-dir 'error))) ;;#todo:
1666 (?/ . tinylisp-:menu-main)))
1667 "Lisp-mnt.el interface: check package layout syntax.
1671 RET Check whole buffer with `lm-verify'
1672 SPC Check whole buffer tags and automatically fix them
1674 d Check all files in directory")
1676 ;;; ----------------------------------------------------------------------
1678 (defconst tinylisp-:menu-edebug
1679 '("Edebug: un/instrument DEL/RET)func x/SPC)buffer l)list e)lint xX)it"
1680 ((?\C-m . ( (tinylisp-edebug-instrument)))
1681 (?\b . ( (tinylisp-edebug-uninstrument)))
1682 (?\177 . ( (tinylisp-edebug-uninstrument)))
1683 (?\C-h . ( (tinylisp-edebug-uninstrument)))
1684 (?\ . ( (tinylisp-edebug-instrument-buffer)))
1685 (?l . ( (tinylisp-edebug-display-instrumented-list)))
1686 (?x . ( (tinylisp-edebug-uninstrument-buffer)))
1687 (?X . ( (tinylisp-edebug-uninstrument-everything)))
1688 (?e . ( (tinylisp-elint-defun)))
1689 (?/ . tinylisp-:menu-main)))
1695 RET Instrument function call (the name) at point. E.g. if you cursor is
1696 on top of `my-function' symbol. this is not the same as
1697 instrumenting with \\[universal-argument] \\[eval-defun], which
1698 instruments _whole_ function at point.
1700 DEL Uninstrument as above. Backspace key works too.
1702 SPC Instrument all functions in this buffer
1704 x Uninstrument all functions in this buffer
1706 X Uninstrument everything known to TinyLisp. This requires that
1707 you have have had TinyLisp running before you started
1708 instrumenting function with \\[tinylisp-edebug-instrument] or with
1709 \\[universal-argument] \\[eval-defun].
1711 e Elint current function (code check).
1713 l List all known instrumented functions.")
1715 ;;; ----------------------------------------------------------------------
1717 (defconst tinylisp-:menu-checkdoc
1720 (tinylisp-require 'checkdoc)
1721 (setq spell checkdoc-spellcheck-documentation-flag)
1723 ((not (featurep 'checkdoc))
1724 (error "No checkdoc available (not loaded)."))
1725 ((not (boundp 'checkdoc-verb-check-experimental-flag))
1726 (error "You have old checkdoc.el version.")))
1729 "%s%s%s%s%s checkdoc: "
1730 "SPC)point RET)notes DEL)fwd cC)om m)ode Flags: aA~- Bb Ss Tt")
1732 ((eq checkdoc-autofix-flag nil) "-")
1733 ((eq checkdoc-autofix-flag 'automatic) "Auto")
1734 ((eq checkdoc-autofix-flag 'semiautomatic) "Semi")
1735 ((eq checkdoc-autofix-flag 'query) "Query")
1736 ((null checkdoc-autofix-flag) "")
1739 ((null checkdoc-bouncy-flag) "")
1740 ((eq checkdoc-bouncy-flag 'never) "")
1743 ((null checkdoc-arguments-in-order-flag) "")
1745 (if checkdoc-verb-check-experimental-flag "E" "")
1747 ((eq spell 'defun) "sD")
1748 ((eq spell 'buffer) "sB")
1749 ((eq spell 'interactive) "sI")
1753 (let ((sym 'checkdoc-triple-semi-comment-check-flag))
1754 (if (and (boundp sym)
1758 ((?\ . ( (checkdoc-eval-defun)))
1759 (?\177 . ( (tinylisp-checkdoc)))
1760 (?\b . ( (tinylisp-checkdoc)))
1761 (?\C-m . ( (tinylisp-checkdoc-notes current-prefix-arg)))
1762 (?\C-j . ( (tinylisp-checkdoc-notes current-prefix-arg)))
1763 (?m . ( (call-interactively 'checkdoc-minor-mode)))
1764 (?c . ( (checkdoc-comments)))
1765 (?C . ( (tinylisp-checkdoc-comment-notes)))
1766 (?a . (t (progn (setq checkdoc-autofix-flag 'semiautomatic))))
1767 (?A . (t (progn (setq checkdoc-autofix-flag 'automatic))))
1768 (?~ . (t (progn (setq checkdoc-autofix-flag 'query))))
1769 (?- . (t (progn (setq checkdoc-autofix-flag nil))))
1770 (?B . (t (progn (setq checkdoc-bouncy-flag t))))
1771 (?b . (t (progn (setq checkdoc-bouncy-flag nil))))
1772 (?O . (t (progn (setq checkdoc-arguments-in-order-flag t))))
1773 (?o . (t (progn (setq checkdoc-arguments-in-order-flag nil))))
1774 (?E . (t (progn (setq checkdoc-verb-check-experimental-flag t))))
1775 (?e . (t (progn (setq checkdoc-verb-check-experimental-flag nil))))
1776 (?S . (t (progn (setq checkdoc-spellcheck-documentation-flag t))))
1777 (?s . (t (progn (setq checkdoc-spellcheck-documentation-flag nil))))
1778 (?d . (t (progn (setq checkdoc-spellcheck-documentation-flag
1780 (?r . (t (progn (setq checkdoc-spellcheck-documentation-flag
1783 (when (boundp 'checkdoc-triple-semi-comment-check-flag)
1784 (setq checkdoc-triple-semi-comment-check-flag t)))))
1786 (when (boundp 'checkdoc-triple-semi-comment-check-flag)
1787 (setq checkdoc-triple-semi-comment-check-flag
1789 "According to checkdoc manual:
1790 ...The Emacs Lisp manual has a nice chapter on how to write
1791 documentation strings. Many stylistic suggestions are fairly
1792 deterministic and easy to check for programatically, but also easy
1793 to forget. The main checkdoc engine will perform the stylistic
1794 checks needed to make sure these styles are remembered.
1796 The echo area menu shows following status information
1798 [-|O|E|V|S|T] checkdoc:
1800 | | | | | `checkdoc-triple-semi-comment-check-flag'
1801 | | | | `checkdoc-spellcheck-documentation-flag'
1802 | | | `checkdoc-verb-check-experimental-flag'
1803 | | `checkdoc-arguments-in-order-flag'
1804 | `checkdoc-bouncy-flag' state
1805 `checkdoc-autofix-flag'
1809 / Back to root menu.
1810 SPC `checkdoc-eval-defun'
1811 DEL Check code from current point forward.
1812 RET `tinylisp-checkdoc-notes' Start checking from current point forward.
1813 Supply prefix argument, if you want to check whole buffer.
1814 c `checkdoc-comments'
1815 C `tinylisp-checkdoc-comment-notes'
1817 Checkdoc mode flags that can be changed:
1819 m Turn on minor mode which checks docstring while you write them
1820 Aa~- Change `checkdoc-autofix-flag' A)uto a)semi ~)query -)never
1821 Bb Change `checkdoc-bouncy-flag' B)on b)off
1822 Oo Change `checkdoc-arguments-in-order-flag' O)n o)ff
1823 Ee Change `checkdoc-verb-check-experimental-flag' E)on e)off
1824 Tt Change `checkdoc-triple-semi-comment-check-flag' T)on t)off
1825 Ssdr Change checkdoc-spellcheck-documentation-flag'
1826 s)off S)interactive d)efun r)buffer
1828 ======================================================================
1829 Excerpts from Checkdoc 0.5
1830 ======================================================================
1832 `checkdoc-autofix-flag'
1834 Non-nil means attempt auto-fixing of doc-strings.
1835 If this value is the symbol 'query, then the user is queried before
1836 any change is made. If the value is 'automatic, then all changes are
1837 made without asking unless the change is very-complex. If the value
1838 is 'semiautomatic, or any other value, then simple fixes are made
1839 without asking, and complex changes are made by asking the user first.
1840 The value 'never is the same as nil, never ask or change anything.
1841 checkdoc-bouncy-flag
1843 `checkdoc-bouncy-flag'
1845 Non-nil means to 'bounce' to auto-fix locations.
1846 Setting this to nil will silently make fixes that require no user
1847 interaction. See `checkdoc-autofix-flag' for auto-fixing details.
1849 `checkdoc-force-docstrings-flag'
1851 Non-nil means that all checkable definitions should have documentation.
1852 Style guide dictates that interactive functions MUST have documentation,
1853 and that its good but not required practice to make non user visible items
1856 `checkdoc-arguments-in-order-flag'
1858 Non-nil means warn if arguments appear out of order.
1859 Setting this to nil will mean only checking that all the arguments
1860 appear in the proper form in the documentation, not that they are in
1861 the same order as they appear in the argument list. No mention is
1862 made in the style guide relating to order.
1864 `checkdoc-verb-check-experimental-flag'
1866 Non-nil means to attempt to check the voice of the doc-string.
1867 This check keys off some words which are commonly misused. See the
1868 variable `checkdoc-common-verbs-wrong-voice' if you wish to add your
1871 `checkdoc-spellcheck-documentation-flag'
1873 Non-nil means run Ispell on doc-strings based on value.
1874 This will be automatically set to nil if Ispell does not exist on your
1875 system. Possible values are:
1877 nil - Don't spell-check during basic style checks.
1878 'defun - Spell-check when style checking a single defun
1879 'buffer - Spell-check only when style checking the whole buffer
1880 'interactive - Spell-check only during `checkdoc-interactive'
1881 t - Always spell-check
1883 `checkdoc-triple-semi-comment-check-flag'
1885 Non-nil means to check for multiple adjacent occurrences of ;;; comments.
1886 According to the style of Emacs code in the lisp libraries, a block
1887 comment can look like this:
1893 But when inside a function, code can be commented out using the ;;;
1894 construct for all lines. When this variable is nil, the ;;; construct
1895 is ignored regardless of it's location in the code.
1899 There are four classifications of style errors in terms of how
1900 easy they are to fix. They are simple, complex, really complex,
1901 and impossible. (Impossible really means that checkdoc does not
1902 have a fixing routine yet.) Typically white-space errors are
1903 classified as simple, and are auto-fixed by default. Typographic
1904 changes are considered complex, and the user is asked if they want
1905 the problem fixed before checkdoc makes the change. These changes
1906 can be done without asking if `checkdoc-autofix-flag' is properly
1907 set. Potentially redundant changes are considered really complex,
1908 and the user is always asked before a change is inserted. The
1909 variable `checkdoc-autofix-flag' controls how these types of errors
1912 Spell checking doc-strings:
1914 The variable `checkdoc-spellcheck-documentation-flag' can be set
1915 to customize how spell checking is to be done. Since spell
1916 checking can be quite slow, you can optimize how best you want your
1917 checking done. The default is 'defun, which spell checks each time
1918 `checkdoc-defun' or `checkdoc-eval-defun' is used. Setting to nil
1919 prevents spell checking during normal usage.
1920 Setting this variable to nil does not mean you cannot take
1921 advantage of the spell checking. You can instead use the
1922 interactive functions `checkdoc-Ispell-*' to check the spelling of
1924 There is a list of lisp-specific words which checkdoc will
1925 install into Ispell on the fly, but only if Ispell is not already
1926 running. Use `Ispell-kill-Ispell' to make checkdoc restart it with
1927 these words enabled.")
1932 ;;; ....................................................... &v-version ...
1934 ;;;###autoload (autoload 'tinylisp-version "tinylisp" "Display commentary" t)
1936 (ti::macrof-version-bug-report
1939 tinylisp-:version-id
1940 "$Id: tinylisp.el,v 2.88 2007/05/01 17:20:46 jaalto Exp $"
1941 '(tinylisp-:version-id
1944 tinylisp-:find-func-list-hook
1945 tinylisp-:find-var-list-hook
1946 tinylisp-:menu-use-flag
1947 tinylisp-:macroexpand-function-list
1948 tinylisp-:table-reverse-eval-alist
1949 tinylisp-:table-snoop-variables
1950 tinylisp-:regexp-macro-definition
1951 tinylisp-:regexp-function
1952 tinylisp-:regexp-variable)
1953 '(tinylisp-:debug-buffer)))
1958 ;;; ----------------------------------------------------------------------
1960 (put 'tinylisp-with-current-buffer 'lisp-indent-function 1)
1961 (defmacro tinylisp-with-current-buffer (buffer &rest body)
1962 "Make BUFFER and run hook `tinylisp-:with-current-buffer-hook'."
1964 (with-current-buffer (, buffer)
1966 (run-hooks 'tinylisp-with-current-buffer-hook))))
1968 ;;; ----------------------------------------------------------------------
1970 (defsubst tinylisp-read-word ()
1971 "Read word under point."
1972 (let ((str (or (ti::remove-properties
1973 (ti::buffer-read-word tinylisp-:variable-not-charset))
1976 (concat "^[^ \t\n\r]*\\(["
1977 tinylisp-:variable-not-charset
1981 ;; Remove trainling colon
1982 (if (string-match "\\(.+\\):$" str)
1983 (match-string 1 str)
1986 ;;; ----------------------------------------------------------------------
1988 (defsubst tinylisp-safety-belt (function &optional msg arg)
1989 "If FUNCTION does not exists, signal error and refer to MSG.
1990 Call FUNCTION with ARG if it exists."
1991 (unless (fboundp function)
1992 (error "TinyLisp: %s not exist. %s" (symbol-name function) (or msg "" )))
1994 (ti::funcall function arg)
1995 (ti::funcall function)))
1997 ;;; ----------------------------------------------------------------------
1999 (defsubst tinylisp-get-symbol (string)
2000 "Return symbol from STRING.
2001 If function does not exist or is string cannot be read, then return nil
2003 \"(function arg1\" --> 'function
2004 \"(defvar xx\" --> 'xx
2005 'xxx-symbol --> 'xxx-symbol"
2006 (let* ((re-f (substring tinylisp-:regexp-function
2007 1 (length tinylisp-:regexp-function)))
2009 (re-v (substring tinylisp-:regexp-variable
2010 1 (length tinylisp-:regexp-variable)))
2013 ((and (or (string-match re-f string)
2014 (string-match re-v string))
2015 (setq sym (intern-soft
2016 (match-string 2 string)))))
2017 ;; Read first word then
2018 ((setq sym (ti::string-match "[^()'\",.; \t\n\]+" 0 string))
2020 ;; Delete trailing garbage "this-function:" --> "this-function"
2021 (if (string-match "\\(.*\\)[^a-zA-Z0-9*]$" sym)
2022 (setq sym (match-string 1 sym)))
2024 (setq sym (intern-soft sym))))
2027 ;;; ----------------------------------------------------------------------
2029 (defsubst tinylisp-push-call-chain (&optional pop data verb)
2030 "Push current point to call chain.
2033 POP flag, instead of push, do pop to last saved positions
2034 DATA push DATA to chain.
2035 VERB print verbose messages.
2037 Optionally POP. VERB prints message."
2039 (push data tinylisp-:call-chain)
2040 (if (null tinylisp-:call-chain)
2041 (error "tinylisp-:call-chain is empty, nothing to pop.")
2042 (let* ((mark (pop tinylisp-:call-chain)))
2043 (goto-char mark)))))
2045 ;;; ----------------------------------------------------------------------
2047 (put 'tinylisp-symbol-do-macro 'lisp-indent-function 2)
2048 (defmacro tinylisp-symbol-do-macro (string noerr &rest body)
2049 "Execute body if string is interned.
2051 STRING function or variable name
2052 NOERR If nil, then call error. if Non-nil then print message if
2053 STRING was not interned.
2056 (if (intern-soft (, string))
2058 (setq (, string) (intern-soft (, string)))
2061 (message "TinyLisp: No symbol in obarray: %s" (, string))
2062 (error "TinyLisp: No symbol in obarray: %s" (, string))))))
2064 ;;; ----------------------------------------------------------------------
2066 (put 'tinylisp-record-macro 'lisp-indent-function 1)
2067 (defmacro tinylisp-record-macro (flag &rest body)
2068 "If FLAG is non-nil execute BODY in record buffer."
2071 (tinylisp-with-current-buffer (ti::temp-buffer tinylisp-:buffer-record)
2075 ;;; ----------------------------------------------------------------------
2077 (put 'tinylisp-defun-macro 'lisp-indent-function 0)
2078 (defmacro tinylisp-defun-macro (&rest body)
2079 "(&rest body) Determine sexp bounds and execute BODY.
2080 Uses `end-of-defun' `forward-sexp' to determine sexp.
2082 Bound variables in macro:
2084 `beg' `end' sexp bounds.
2085 `str' full line read from 'beg' point
2086 `buffer' points to the current buffer
2088 You use this macro to bounds of Lisp defun, defvar, defconst
2091 (let* ((buffer (current-buffer))
2096 (setq buffer nil)) ;No-op, byteComp silencer
2101 ;; If no used, ByteComp nags -- silence it so that this macro
2106 (setq str (ti::read-current-line))
2110 ;;; ----------------------------------------------------------------------
2112 (defsubst tinylisp-read-function-name-info (&optional string)
2113 "Return '(name . sym) After 'defxxxxx'. at point or STRING."
2114 (let* ((name (ti::string-match "def[a-zA-Z]+ +\\([^() \t\n\]+\\)" 1
2115 (or string (ti::read-current-line))))
2116 (sym (and name (intern-soft name))))
2120 ;;; ----------------------------------------------------------------------
2122 (put 'tinylisp-defun-sym-macro 'lisp-indent-function 0)
2123 (defmacro tinylisp-defun-sym-macro (&rest body)
2124 "Run BODY when defun sym is found.
2125 Same as `tinylisp-defun-macro' But define `name' and `sym' for function name."
2127 (tinylisp-defun-macro
2128 (let* ((info (tinylisp-read-function-name-info str))
2129 (name (car-safe info))
2130 (sym (cdr-safe info)))
2131 (if (null info) ;Bytecomp silencer.
2133 (if (null sym) ;Bytecomp silencer.
2137 ;;; ----------------------------------------------------------------------
2139 (put 'tinylisp-defcustom-macro 'lisp-indent-function 0)
2140 (defmacro tinylisp-defcustom-macro (&rest body)
2141 "Activate advice 'tinylisp' for `defconst' _only_ during BODY."
2145 (ad-enable-advice 'defconst 'around 'tinylisp)
2146 (ad-activate 'defconst)
2148 ;; Make sure this is always executed.
2149 (tinylisp-emergency))))
2154 ;;; ----------------------------------------------------------------------
2156 (defun tinylisp-menu-main (&optional arg)
2157 "Show echo area menu and pass ARG to `ti::menu-menu'."
2159 (unless tinylisp-:menu-main
2160 (tinylisp-install-menu))
2161 (ti::menu-menu 'tinylisp-:menu-main arg))
2163 ;;; ----------------------------------------------------------------------
2165 (defun turn-on-tinylisp-mode-all-buffers (&optional off)
2166 "Turn function `tinylisp-mode' on in every Lisp buffer. Optionally turn OFF."
2168 (ti::dolist-buffer-list
2169 (string-match "lisp\\|debugger-mode" (downcase (symbol-name major-mode)))
2173 (when (eq major-mode 'debugger-mode)
2174 (tinylisp-debugger-setup))
2176 (unless (null tinylisp-mode)
2177 (turn-off-tinylisp-mode))
2178 (unless tinylisp-mode
2179 (turn-on-tinylisp-mode))))))
2181 ;;; ----------------------------------------------------------------------
2183 (defun turn-off-tinylisp-mode-all-buffers ()
2184 "Call turn-on-tinylisp-mode-all-buffers' with argument off."
2185 (turn-on-tinylisp-mode-all-buffers 'off))
2187 ;;; ----------------------------------------------------------------------
2189 (defun tinylisp-install-hooks (&optional uninstall)
2190 "Install or UNINSTALL hooks that activate TinyLisp minor mode."
2192 (ti::add-hooks '(emacs-lisp-mode-hook
2193 lisp-interaction-mode-hook
2196 gnus-edit-form-mode-hook
2198 'turn-on-tinylisp-mode
2200 (unless (boundp 'apropos-mode-hook)
2201 ;; Standard Emacs does not have this hook
2202 (defvar apropos-mode-hook nil
2203 "*Hook run when mode is turned on.")
2204 (defadvice apropos-mode (after tinylisp act)
2205 "Run `apropos-mode-hook'."
2206 (run-hooks 'apropos-mode-hook)))
2207 (if (boundp 'apropos-mode-hook)
2208 (ti::add-hooks 'apropos-mode-hook 'turn-on-tinylisp-mode uninstall))
2209 (ti::add-hooks 'tinylisp-:mode-define-keys-hook
2210 'tinylisp-mode-define-keys uninstall)
2211 ;; tinylisp-elp-summary-install-mode
2212 (ti::add-hooks 'tinylisp-:elp-summary-mode-define-keys-hook
2213 'tinylisp-elp-summary-mode-define-keys
2216 ((boundp 'debugger-mode-hook)
2217 (ti::add-hooks '(tinylisp-debugger-setup turn-on-tinylisp-mode)
2221 (ti::advice-control 'debugger-mode "^tinylisp" 'disable))
2223 ;; 19.x-20.2 doesn't have the debugger hook
2224 (defadvice debugger-mode (after tinylisp act)
2225 "Run `tinylisp-debugger-setup'."
2226 (tinylisp-debugger-setup)
2227 (turn-on-tinylisp-mode))))))
2229 ;;; ----------------------------------------------------------------------
2231 (defun tinylisp-install (&optional uninstall)
2232 "Install package and activate mode in every Emacs lisp buffer.
2233 To turn on mode on by buffer basis, call `tinylisp-mode'."
2235 (tinylisp-install-hooks uninstall)
2236 (turn-on-tinylisp-mode-all-buffers uninstall))
2238 ;;; ----------------------------------------------------------------------
2240 (defun tinylisp-uninstall ()
2241 "Uninstall package."
2243 (tinylisp-install 'uninsall))
2248 ;;; ----------------------------------------------------------------------
2250 (defadvice byte-compile-file (around tinylisp act)
2251 "Change interactive prompt and offer current buffer for compiling(.el)."
2253 ;; byte-compile-file (filename &optional load)
2257 (if current-prefix-arg
2258 "TinyLisp: Byte compile and load file: "
2259 "TinyLisp: byte compile file: ")
2261 (if (and buffer-file-name
2262 (string-match "\\.el$" buffer-file-name))
2264 (file-name-directory (or (buffer-file-name)
2265 default-directory))))
2266 current-prefix-arg))
2269 ;;; ----------------------------------------------------------------------
2271 (defadvice defconst (around tinylisp (sym val &optional doc &rest args) dis)
2272 "This advice is only used in TinyLisp and elsewhere inactivated.
2273 It ignores any extra arguments passed to defconst. In order to
2274 evaluate following statement
2276 (defcustom my nil \"docs\" :type 'string :group my)
2278 TinyLisp first converts it to
2280 (defconst my nil \"docs\" :type 'string :group my)
2282 And turns on this advice to ignore additional :type and :group arguments.
2283 This all is needed, because defcustom defines the variable as defvar
2284 and it cannot be re-evaluated/reset without this trick.
2286 After the eval has been done, this advice is turned off.
2287 If you see this message when calling following, there is bug in TinyLisp.
2289 (describe-function 'defconst)"
2290 (ad-with-originals (defconst)
2291 ;; advice prior 19.36 will not work properly with special forms
2292 ;; like defconst. Hans explained is as follows to me:
2294 ;; | > (ad-with-originals (defconst)
2295 ;; | > (defconst sym val doc) ;; Nothing happens?
2297 ;; The reason nothing happens here, is that 'sym' does not get evaluated
2298 ;; (since 'defconst' is a special form), instead it actually assigns the
2299 ;; value to the constant with the name "sym". What you would need to do
2300 ;; is use `eval', e.g.,
2302 ;; (ad-with-originals (defconst)
2303 ;; (eval `(defconst ,sym ,val ,doc)))
2305 ;; Hans Chalupsky <hans@ISI.EDU>
2307 (eval (` (defconst (, sym) (, val) (, doc))))))
2312 ;;; ----------------------------------------------------------------------
2314 (defun tinylisp-process-kill ()
2315 "Kill running processes with y-n-p."
2316 (let* ((list (process-list)))
2318 (message "TinyLisp: no running processes to kill.")
2320 (dolist (proc (process-list))
2321 (when (y-or-n-p (format "Kill: %s " (prin1-to-string proc)))
2322 (delete-process proc))))))
2324 ;;; ----------------------------------------------------------------------
2326 (defun tinylisp-face-list-unique (face-list)
2327 "Return unique faces '((var face) ..) from FACE-LIST."
2329 (let* ((getface 'get-face)
2332 (dolist (var face-list)
2334 (not (string-match "^:" (symbol-name var)))
2335 (or (and (fboundp 'face-font) ;; XEmacs
2336 (ignore-errors (face-font var))
2338 (if (or (and (fboundp getface) ;; XEmacs
2339 (funcall getface var))
2340 ;; Only works in Emacs. Returns nil in XEmacs
2343 ;; Filter out duplicates like 'bold
2344 (not (member var list)))
2345 (push (list var face) list)))
2348 ;;; ----------------------------------------------------------------------
2349 ;;; (load-library "flyspell")
2350 ;;; (tinylisp-face-print (current-buffer) '(flyspell-incorrect-face))
2352 (defun tinylisp-face-print (buffer face-list)
2353 "Insert description to BUFFER for each symbol in FACE-LIST."
2354 (let* ((list (tinylisp-face-list-unique face-list))
2359 (setq buffer (ti::temp-buffer tinylisp-:buffer-tmp 'clear))
2360 (with-current-buffer buffer
2364 (insert (format "%-35s" (symbol-name var)))
2366 (insert "abcdef12345 ")
2367 (set-text-properties beg (point) (list 'face face))
2369 (insert (format " fg: %-15s bg: %s\n"
2370 (face-foreground face)
2371 (face-background face)))
2372 (insert (format "\n fg: %-15s\n bg: %s\n"
2373 (face-foreground face)
2374 (face-background face)))))
2375 (sort-lines nil (point-min) (point-max)))
2378 ;;; ----------------------------------------------------------------------
2380 (defun tinylisp-face-list-font-lock-faces ()
2381 "List known font lock faces and colors used."
2384 ((not (featurep 'font-lock))
2385 (message "tinylisp.el: font-lock.el is not loaded. No faces."))
2388 (ti::system-get-symbols "^font-lock-.*face$" '(boundp sym))))
2390 (let ((buffer (ti::temp-buffer tinylisp-:buffer-tmp 'clear)))
2391 (tinylisp-face-print buffer symbols)
2392 (display-buffer buffer)))))))
2394 ;;; ----------------------------------------------------------------------
2396 (defun tinylisp-face-list-known-faces ()
2397 "List all known 'face' variables."
2399 (let* ((symbols (ti::system-get-symbols
2402 (and (fboundp 'get-face) ;; XEmacs
2404 ;; Only works in Emacs. Returns nil in XEmacs
2406 (buffer (ti::temp-buffer tinylisp-:buffer-tmp 'clear)))
2407 (tinylisp-face-print buffer symbols)
2408 (display-buffer buffer)))
2410 ;;; ----------------------------------------------------------------------
2412 (defun tinylisp-highlight-default ()
2413 "Highlight functions and variables, see tinylisp-*[func,var}*-hook."
2414 (when (ti::colors-supported-p) ;; does it make sense to show colors?
2415 (save-excursion (ti::text-re-search-forward "defmacro" 0 'highlight))
2416 (save-excursion (ti::text-re-search-forward "defsubst" 0 'bold))
2417 (save-excursion (ti::text-re-search-forward "defconst" 0 'highlight))))
2419 ;;; ----------------------------------------------------------------------
2421 (defun tinylisp-show-register-message (&optional msg)
2422 "Show what to do with register and show optional MSG."
2425 (substitute-command-keys
2428 "TinyLisp: Jump back to previous positon with "
2429 "\\[jump-to-register-compatibility-binding] %s")
2430 (char-to-string tinylisp-:register))))))
2432 ;;; ----------------------------------------------------------------------
2434 (defun tinylisp-symbol-type (symbol &optional noerr)
2435 "Return 'var or 'func according to SYMBOL.
2436 If NOERR is non-nil, do not call error if symbol type isn't known.
2437 That usually means that symbol is not yet defined to obarray."
2439 ((and (fboundp symbol)
2441 (if (y-or-n-p (format "select %s: Y = variable, N = Function "
2442 (symbol-name symbol)))
2450 (error "Don't know symbol type; not a variable or function %s"
2453 ;;; ----------------------------------------------------------------------
2455 (defun tinylisp-backward-opening-paren ()
2456 "Go backward until parenthesis found."
2457 (if (char= ?\( (following-char))
2459 (re-search-backward "(" nil t)))
2461 ;;; ----------------------------------------------------------------------
2463 (defun tinylisp-read-symbol-at-point ()
2464 "Read function name around point.
2466 o Check if cursor is at the beginning of line whitespace
2467 and sees ' +(', then valuate next statement
2468 o Go backward to opening parenthesis and evaluate command.
2471 (point function-name-string statement)"
2472 (let* ((opoint (point))
2473 (word (save-excursion (tinylisp-read-word)))
2479 ((and (stringp word) (intern-soft word))
2480 (skip-chars-backward "^ \t"))
2481 ((line-end-position) ;;move to opening paren in this line
2482 (re-search-backward "(" (line-beginning-position) t))
2484 ;; if there is whitespace '^ (autoload 'tinylisp-mode...'
2485 ;; Then go to first opening paren in the line.
2487 ;; - there must be whitespace between bol and opoint
2488 ;; - next we must see '(' in the current line (eol)
2490 (if (not (and (re-search-forward "^[ \t]*" opoint t)
2491 (re-search-forward "(" (line-end-position) t)))
2493 (goto-char opoint))))
2494 (when (and (tinylisp-backward-opening-paren)
2495 (setq point (point))
2496 (re-search-forward "[^ \t\n(]" nil t))
2498 (setq func (or word (tinylisp-read-word)))
2500 (ignore-errors ;In comment; this breaks.
2502 (setq statement (buffer-substring point (point))))
2504 (list point func statement))))))
2506 ;;; ----------------------------------------------------------------------
2508 (defun tinylisp-find-package-prefix ()
2509 "Read function from the beginning of file and first word from the name.
2511 (defun XXX-do-it-like-this ()
2515 nil can't find one."
2518 (if (re-search-forward "^(defun[ \t]+\\([^ \t]+-\\)" nil t)
2521 ;;; ----------------------------------------------------------------------
2523 (defun tinylisp-eval (str1 str2 type &optional arg1 arg2 arg3)
2524 "Substitute STR1 with STR2 in string and eval all in temporary buffer..
2527 Read string from buffer ARG1, position ARG2 and ARG3.
2530 ARG1 contains string
2533 `tinylisp-:buffer-eval'"
2534 (tinylisp-with-current-buffer
2535 (ti::temp-buffer tinylisp-:buffer-eval 'clear)
2538 (if (not (get-buffer arg1))
2539 (error "arg1 must be (existing) buffer")
2540 (insert-buffer-substring arg1 arg2 arg3)))
2542 (replace-string str1 str2)
2543 (tinylisp-eval-fix-defconst)
2544 (tinylisp-eval-current-buffer)
2545 ;;; (erase-buffer) ;May be big
2549 ;;{{{ Internally used buffers
2551 ;;; --------------------------------------------------------- &buffers ---
2553 (defun tinylisp-b-display (buffer point-min)
2554 "Display BUFFER (must be string) if it exists and go to optional POINT-MIN.
2555 Shrink and print message if not exist."
2556 (let* ((win (get-buffer-window buffer))
2557 (frame-win (get-buffer-window buffer t))
2558 (owin (selected-window)))
2559 (if (not (buffer-live-p (get-buffer buffer)))
2560 (message "TinyLisp: Buffer does not exist, %s" buffer)
2561 ;; Do nothing special if window is already visible
2565 (select-window win) (ti::pmin)
2566 (select-window owin)))
2568 (raise-frame (window-frame frame-win))
2569 (select-window frame-win))
2571 (display-buffer buffer)
2572 (with-current-buffer buffer
2573 (shrink-window-if-larger-than-buffer)
2574 (if point-min (ti::pmin))))))))
2576 ;;; ----------------------------------------------------------------------
2577 ;;; (defun tinylisp-b-eval (&optional pmin)
2578 ;;; (interactive) (tinylisp-b-display tinylisp-:buffer-eval pmin))
2580 ;;; This is just byteComp forward declaration, kinda.
2582 (defun tinylisp-b-record (&rest args)
2586 ;; Real functions are defined here.
2591 (let ((sym (intern (format "tinylisp-b-%s" x)))
2592 (var (intern (format "tinylisp-:buffer-%s" x)))
2595 (` (defun (, sym) (&optional pmin)
2597 (tinylisp-b-display (, var) pmin))))
2599 '("eval" "record" "variables" "funcs" "autoload" ))
2601 ;;; ----------------------------------------------------------------------
2603 (defun tinylisp-b-record-empty (&optional verb)
2604 "Empty buffer `tinylisp-:buffer-record'. VERB."
2607 (if (buffer-live-p (get-buffer tinylisp-:buffer-record))
2608 (ti::erase-buffer tinylisp-:buffer-record))
2610 (message "TinyLisp: record buffer emptied.")))
2612 ;;; ----------------------------------------------------------------------
2614 (defun tinylisp-b-elp (&optional verb)
2615 "Go to Elp summary buffer. VERB."
2618 (if (buffer-live-p (get-buffer elp-results-buffer))
2619 (display-buffer elp-results-buffer)
2621 (message "TinyLisp: No Elp Profiling results buffer."))))
2626 ;;; ----------------------------------------------------------------------
2628 (defun tinylisp-ad-match-1 (regexp)
2629 "Return '((function class name) ..) that are adviced matching NAME REGEXP."
2632 (ad-do-advised-functions (advised-function)
2633 (dolist (class '(before after around))
2634 (dolist (info (ad-get-advice-info-field advised-function class))
2635 (setq sym-name (symbol-name (car info)))
2636 (when (string-match regexp sym-name)
2637 (push (list advised-function class (car info)) list)))))
2640 ;;; ----------------------------------------------------------------------
2642 (defun tinylisp-ad-match (regexp &optional verb)
2643 "Loop through adviced functions to find all that match REGEXP. VERB."
2644 (interactive "sAd name match Regexp: ")
2645 (if (ti::nil-p regexp)
2646 (error "Invalid regexp"))
2647 (let* ((list (tinylisp-ad-match-1 regexp)))
2649 (tinylisp-with-current-buffer
2650 (ti::temp-buffer tinylisp-:buffer-data 'clear)
2655 (symbol-name (nth 0 elt))
2656 (symbol-name (nth 1 elt))
2657 (symbol-name (nth 2 elt))))))
2659 (pop-to-buffer tinylisp-:buffer-data)
2665 ;;; ----------------------------------------------------------------------
2667 (defun tinylisp-elp-function-list-partial (&optional arg verb)
2668 "Call `tinylisp-elp-function-list'. See ARG and VERB parameters there."
2671 ;; elp-all-instrumented-list. The
2672 ;; `elp-function-list' is list of functions to profile
2673 (tinylisp-elp-function-list arg elp-function-list verb))
2675 ;;; ----------------------------------------------------------------------
2677 (defun tinylisp-elp-function-list (arg &optional list verb)
2678 "Print list of functions that are currently being profiled.
2679 If functions can fit in echo area they are printed there unless
2680 prefix ARG is given.
2682 LIST defaults to `elp-all-instrumented-list`. VERB."
2687 elp-all-instrumented-list)
2689 (prin1-to-string list)))
2693 (message "TinyLisp: No functions elp'd"))
2694 ;; function return code
2697 (< (length str) 80))
2699 (tinylisp-with-current-buffer
2700 (ti::temp-buffer tinylisp-:buffer-elp 'clear)
2702 (insert (symbol-name elt) "\n"))
2703 (sort-lines nil (point-min) (point-max))
2704 (pop-to-buffer (current-buffer))
2705 (message "TinyLisp: %d functions have been elp'd"
2706 (length elp-all-instrumented-list))))
2709 ;;; ----------------------------------------------------------------------
2711 (defun tinylisp-elp-reset-after-results (&optional arg)
2712 "Toggle variable `elp-reset-after-results' according to ARG."
2714 (ti::bool-toggle elp-reset-after-results))
2716 ;;; ----------------------------------------------------------------------
2718 (defun tinylisp-elp-restore-all (&optional verb)
2719 "Remove all instrumented functions. VERB."
2724 (message "TinyLisp: ELP, all functions restored.")))
2726 ;;; ----------------------------------------------------------------------
2728 (defun tinylisp-elp-reset-list (&optional verb)
2729 "Reset timing list. VERB."
2733 (if (get-buffer-window elp-results-buffer)
2734 (tinylisp-elp-results)) ;Clear the window
2736 (message "TinyLisp: ELP, Timing list cleared.")))
2738 ;;; ----------------------------------------------------------------------
2740 (defun tinylisp-elp-results (&optional record string verb)
2741 "Show results, but do not change window.
2742 if RECORD is non-nil; then copy t
2743 iming to record buffer.
2744 Insert STRING after the record stamp. VERB."
2746 (let ((obuffer (current-buffer)))
2750 (tinylisp-elp-summary-mode 1)
2751 (tinylisp-record-macro record
2752 (insert "\nELP: " (ti::date-standard-date) " " (buffer-name)
2753 (if string string "\n"))
2754 (insert-buffer elp-results-buffer)
2756 (message "TinyLisp: Results RECORDED.")))
2757 (pop-to-buffer obuffer)))
2759 ;;; ----------------------------------------------------------------------
2761 (defun tinylisp-elp-instrument-buffer-i-args (pfx-arg iact)
2762 "Ask args for `tinylisp-elp-instrument-buffer'.
2763 PFX-ARG is usually `current-prefix-arg' if you know that already.
2764 IACT signifies interactive spec."
2767 (read-from-minibuffer
2769 "%sInstrument using package prefix [empty=examine functions]: "
2770 (if pfx-arg "Un)" ""))
2771 (or (tinylisp-find-package-prefix)
2774 (list nil pfx-arg 'find iact)
2775 (list pfx pfx-arg nil iact))))
2777 ;;; ----------------------------------------------------------------------
2779 (defun tinylisp-elp-instrument-buffer (prefix &optional remove type verb)
2780 "Instrument all functions in the current buffer.
2782 There are two possibilities when you run this in the buffer
2784 o Buffer contains a lisp package. Each function is prefixed
2785 with some unique identifier.
2787 o You're in scratch buffer or badly formed package where
2788 the names of the functions are not prefixed properly.
2790 Interactive call note:
2792 The choice how to instrument functions is asked.
2796 PREFIX can be nil if type is non-nil.
2797 REMOVE uninstrument functions. (Interactive call's prefix arg)
2798 TYPE if nil then instrument using PREFIX
2799 if non-nil, force finding all function names and
2800 instrument them. This uses `defun' keyword seach.
2803 (tinylisp-elp-instrument-buffer-i-args current-prefix-arg 'iact))
2805 (let* ((str (if remove "un" ""))
2811 (setq list (tinylisp-find-function-list 'no-show 'alternative))
2814 (message "TinyLisp: Can't find functions from buffer"))
2817 (setq type (car func))
2818 (setq func (cdr func)) ;("defun" . "t1")
2819 ;; elp can only insrument functions
2820 (when (string-match "defun\\|defsubst" type)
2822 (tinylisp-symbol-do-macro func nil
2823 (elp-restore-function func) ;do this first
2825 (elp-instrument-function func))))))
2827 (message "TinyLisp: %sinstrumented %d functions" str count))))
2831 (elp-instrument-package prefix))
2834 TinyLisp: %sinstrumented package '%s'. Count of functions is unknown."
2837 ;;; ----------------------------------------------------------------------
2839 (defun tinylisp-elp-instrument-function ()
2840 "Instrument current function. Search the function name."
2842 (let* ((func (ti::buffer-defun-function-name)))
2844 (message "TinyLisp: Can't find function name.")
2845 ;; This evaluates the function prior elp'ing it.
2846 (tinylisp-eval-at-point)
2847 (tinylisp-symbol-do-macro func nil
2848 (elp-restore-function func) ;do this first
2849 (elp-instrument-function func))
2850 (message (format "TinyLisp: ELP instrumented [%s]" func)))))
2852 ;;; ----------------------------------------------------------------------
2854 (defun tinylisp-elp-mapsym (regexp &optional not-regexp real-name)
2855 "Return list of function matching REGEXP NOT-REGEXP REAL-NAME.
2856 See `tinylisp-elp-instrument-by-regexp'."
2864 ;; What's the real function?
2865 (setq real (or (ti::defalias-p sym) sym))
2866 (when (not (memq (car-safe (symbol-function real))
2869 (setq sym real)) ;yes this is real function name.
2870 (setq name (symbol-name sym))
2871 (when (and (string-match regexp name)
2872 (not (string-match "ad-Orig-" name))
2873 ;; Don't instrument adviced functions
2874 (or (not (featurep 'advice))
2875 ;; real an sym must hnot have any advice active
2877 ((ad-has-any-advice real)
2878 (not (ad-is-active real)))
2879 ((ad-has-any-advice sym)
2880 (not (ad-is-active sym)))
2883 (or (not (stringp not-regexp))
2884 (not (string-match not-regexp name))))
2885 (push sym list)))))))
2888 ;;; ----------------------------------------------------------------------
2890 (defun tinylisp-elp-instrument-by-regexp
2891 (regexp &optional not-regexp real-name uninstrument verb)
2892 "Elp all functions that match REGEXP and NOT-REGEXP.
2893 Note, calling this function is slow, because it will map
2894 through every single defined atom in Emacs. (there are thousands).
2898 Adviced functions starting with `ad-' are not instrumented.
2902 REGEXP Regexp to match functon name
2903 NOT-REGEXP If REGEXP matches, function must not match this. If nil,
2904 then only REGEXP is used.
2905 REAL-NAME If non-nil then look function name behind
2906 defalias statements. After we get non-alias name the REGEXP
2908 UNINSTRUMENT Flag, if non-nil. Do the opposite: Uninstrument functions.
2909 This is the prefix argument.
2910 VERB Verbose message."
2914 (if current-prefix-arg
2915 "Elp uninstrument Regexp: "
2917 nil 'tinylisp-:elp-regexp-history)
2918 (read-string "Not Regexp: " nil 'tinylisp-:elp-not-regexp-history)
2919 (y-or-n-p "Match against real names? (look under alias name) ")
2920 current-prefix-arg))
2923 (if (ti::nil-p not-regexp) ;It's "" after RET in interactive
2924 (setq not-regexp nil))
2926 (let* ((list (tinylisp-elp-mapsym regexp not-regexp real-name))
2927 (msg (if uninstrument "un" "")))
2929 (elp-restore-list list)
2930 (elp-instrument-list list))
2932 (message "TinyLisp: %d functions %sinstrumented"
2936 ;;; ----------------------------------------------------------------------
2938 (defun tinylisp-elp-set-master (function)
2939 "Set master FUNCTION."
2949 'tinylisp-:elp-master-history))))
2950 (elp-set-master function))
2952 ;;; ----------------------------------------------------------------------
2954 (defun tinylisp-elp-restore-buffer ()
2955 "Read functions from the buffer and cancel elp for them."
2957 (let* ((args (tinylisp-elp-instrument-buffer-i-args 'pfx 'iact)))
2958 (tinylisp-elp-instrument-buffer
2964 ;;; ----------------------------------------------------------------------
2966 (defun tinylisp-elp-restore-function ()
2967 "Remove elp code from current function. Search the function name."
2969 (let* ((func (ti::buffer-defun-function-name)))
2971 (message "TinyLisp: ELP, Can't find function name.")
2972 (tinylisp-symbol-do-macro func nil
2973 (elp-restore-function func))
2974 (message (format "TinyLisp: ELP, restored [%s]" func)))))
2976 ;;; ----------------------------------------------------------------------
2978 (defun tinylisp-reparse-instrumentation (&optional verb)
2979 "Uninstrument all currently instrumented functions.
2980 Then eval current buffer (to get new function definitions) and last instrument
2981 all found functions in the buffer.
2983 In short: remove previous instrumentation and do new one. VERB."
2986 (tinylisp-elp-restore-all)
2987 (tinylisp-eval-current-buffer)
2988 (tinylisp-elp-instrument-buffer nil nil 'find verb))
2990 ;;; ----------------------------------------------------------------------
2992 (defun tinylisp-elp-harness (&optional count verb)
2993 "Call elp multiple times to get reliable results.
2994 Default is call count is 3,but you can supply numeric prefix COUNT. VERB.
2996 ** You must have instrumented the functions before you call this function
2998 This is bit exotic function and it requires that you have written
2999 following test setup in the clear Lisp buffer. Let's say we're
3000 interested if 'let*' is slower that 'let'.
3002 (defun t-1 () (let* () ))
3003 (defun t-2 () (let () ))
3006 [* point/cursor is before this statement]
3007 ;; The trick here is that when you instrument whole
3008 ;; buffer and eval all the functions with '$ -' ,
3009 ;; the when forms are bypassed
3011 ;; When you have Evaled/instrumented buffer, then change
3012 ;; it to 'when t' and call the harness function.
3014 ;; The variable tinylisp-:harness-flag is set to t when you can this
3015 ;; function and set to nil when this function finishes.
3017 (when tinylisp-:harness-flag
3018 (ti::dotimes count 1 500 ; run 500 times
3023 This function evals everything from current point forward ARG times.
3024 If there is word tinylisp-:harness-flag in the buffer, the current point is not
3025 used but the eval is started from the beginning of that line forward.
3027 After each eval round it records the elp result to `tinylisp-:buffer-record'.
3028 In the above setup, this means that we repeat the test setup 3 times
3029 to get 3 elp timing results. Since using elp only once for small functions,
3030 doesn't give reliable results; we have to repeat the test at least 3 times.
3032 The `tinylisp-:buffer-record' buffer is displayed after the harness run is over."
3034 (let* (case-fold-search
3039 (setq count (or count 3)
3041 ;; See if there this word in the buffer
3044 (when (re-search-forward "tinylisp-:harness-flag" nil t)
3045 (setq beg (line-beginning-position) h-found t)))
3046 (or beg ;we already found it
3047 (setq beg (point))) ;nope, use current point
3048 (if (null elp-all-instrumented-list)
3049 (error "No functions in elp list"))
3055 "tinylisp-:harness-flag %s times, ok? "
3056 "Harness %s times, from current point forward, ok? ")
3060 (y-or-n-p "Do you want to clear RECORD buffer first? "))
3061 (tinylisp-b-record-empty))
3062 (unwind-protect ;; make sure tinylisp-:harness-flag is set to nil
3064 (setq tinylisp-:harness-flag t)
3065 (ti::dotimes iterator 0 count
3066 (tinylisp-elp-reset-list) ;wipe timings
3067 (if verb (message "TinyLisp: Eval round %d/%d ... "
3068 (1+ iterator) rounds))
3069 (eval-region beg (point-max))
3070 (tinylisp-elp-results
3071 'record (format " -- %d/%d\n" (1+ iterator) rounds)))
3073 (message "TinyLisp: Eval rounds done."))
3074 (tinylisp-b-record 'pmin))
3075 (setq tinylisp-:harness-flag nil))))
3080 ;;; ----------------------------------------------------------------------
3085 (let ((sym (intern (format "tinylisp-elp-summary-sort-column-%d" x)))
3088 (` (defun (, sym) (&optional arg)
3089 ;;; "Sort by field. ARG to reverse sort."
3091 (tinylisp-elp-summary-sort-column (, x) arg))))
3093 '(1 2 3 4 5 6 7 8 9))
3095 ;;; ----------------------------------------------------------------------
3097 (defun tinylisp-elp-summary-sort-column (nbr &optional reverse)
3098 "Sort column NBR or REVERSE."
3100 ;; (setq nbr (if reverse (- nbr) nbr))
3101 (untabify (point-min) (point-max))
3102 (ti::save-with-marker-macro
3104 (forward-line 2) ;Skip header.
3106 ((memq nbr '(2 3 4))
3107 (sort-numeric-fields nbr (point) (point-max)))
3109 (sort-fields nbr (point) (point-max))))))
3112 ;;{{{ code help: debug, find-error
3114 ;;; ----------------------------------------------------------------------
3116 (defun tinylisp-error-debug-add-tags (&optional remove verb)
3117 "Add simple debug code before every left flushed parenthesis. REMOVE. VERB.
3118 When you compile a file, sometimes it is very hard to find the error
3119 position from the output; which gives no further clues:
3121 While compiling toplevel forms in file xxx.el:
3122 !! Wrong type argument ((number-or-marker-p nil))
3125 The funny thing might be that this happens only when file is compiled. By
3126 evaluating each piece of code with `eval-region' the error does not occur.
3127 To help spotting the place, this function inserts random tags in the buffer
3128 which are shown during compilation. DO NOT change the inserted tags. After
3129 you have corrected errors, you can REMOVE the extra debug tags with prefix
3132 DebugTag: 21-56 file.el
3133 !! Wrong type argument ((number-or-marker-p nil))
3134 DebugTag: 22-56 file.el
3137 (let* ((tag ";;__LISP-DEBUG__")
3139 " (eval-and-compile "
3140 "(message \"DebugTag: %d-%d %s\"))"))
3141 (re (regexp-quote tag))
3143 ;; We have to randomize the tag, because suppose
3144 ;; - user inserts tags. He runs debug and doesn find the spor
3145 ;; - He left flushed more code
3146 ;; - He inserts tags again, but because there is already tags,
3147 ;; the _new_ tags must be different ==> randomized tags.
3149 (name (buffer-name)))
3154 (while (re-search-forward tag nil t)
3155 (if verb (message "TinyLisp: uninstrumenting tag %d" i))
3159 (when (or (null (re-search-forward tag nil t))
3161 "TinyLisp: Debug tags already instrumented. Proceed? "))
3162 (setq re (concat ".*" re))
3163 (while (re-search-forward "^(" nil t)
3165 (ti::save-with-marker-macro
3167 (unless (looking-at re)
3168 (insert (format fmt i rand name))
3169 (insert tag "\n") ))
3172 (message "TinyLisp: instrumenting tag %d" i))
3174 (when (and verb (not (zerop i)))
3176 (message "TinyLisp: Debug tags removed.")
3177 (message "TinyLisp: %d Debug tags inserted." i)))))
3179 ;;; ----------------------------------------------------------------------
3182 (defun tinylisp-error-find-2 ()
3183 "Start from point min and Eval region at time until error occurs."
3189 (setq last-p (point))
3190 (while (not (eq p (point)))
3192 (eval-region last-p (point))
3193 (setq last-p (point))
3195 ;; The while loop never finishes if there was error
3196 (message "TinyLisp: No lisp errors found.")
3197 (goto-char opoint)))
3199 ;;; ----------------------------------------------------------------------
3201 (defun tinylisp-error-find-1 ()
3202 "Find code error position and put point near the error."
3204 (let ((lower-bound 1))
3205 (setq tinylisp-:find-error nil)
3209 (high (tinylisp-error-count-sexps)))
3210 (if tinylisp-:find-error ;See tinylisp-error-count-sexps
3211 (setq lower-bound (point))
3212 (setq high (1+ high))
3214 (if (tinylisp-error-try-parse lower-bound
3215 (tinylisp-error-sexp-position
3216 (setq half (/ (+ low high) 2))))
3217 (progn (setq low (1+ half))
3222 (setq lower-bound (point)))
3225 (setq lower-bound (point)))))
3227 (if (not tinylisp-:find-error)
3228 (message "TinyLisp: No errors found.")
3229 (goto-char lower-bound)
3230 (message "TinyLisp: %s" tinylisp-:find-error))))
3232 ;;; ----------------------------------------------------------------------
3234 (defun tinylisp-error-try-parse (from to)
3235 "Eval regions and try to find error in FROM TO."
3237 (progn (eval-region from to) t)
3240 (setq tinylisp-:find-error err)
3243 ;;; ----------------------------------------------------------------------
3245 (defun tinylisp-error-count-sexps ()
3246 "Eval regions and try to find error."
3247 (goto-char (point-max))
3254 (error (setq tinylisp-:find-error err))))
3256 ;;; ----------------------------------------------------------------------
3258 (defun tinylisp-error-sexp-position (n)
3262 (if (or (not (eobp))
3265 (forward-sexp (1- n))
3266 (skip-chars-forward " \t\n")
3272 ;;{{{ code help: jump, eval
3274 ;;; ----------------------------------------------------------------------
3276 (defun tinylisp-symbol-file-location (symbol)
3277 "Search SYMBOL from Emacs obarrays and try to find file location."
3279 (or (ti::system-load-history-where-is-source symbol)
3280 (ti::system-doc-where-is-source symbol)
3281 (and (ti::autoload-p symbol)
3282 (let ((lib (ti::autoload-file symbol)))
3284 (locate-library lib)))))))
3286 ;;; ----------------------------------------------------------------------
3288 (defun tinylisp-jump-to-definition (&optional save word verb nodisplay)
3289 "Search function or variable definition in the same file or from outside.
3290 This function relies on the `load-history' and if there is no such
3291 symbol, this function can't jump to definition. If you have evaled buffer
3292 or function inside Emacs and not used the load* commands then the
3293 definition information is not in `load-history'.
3297 SAVE \\[universal-argument]: then save the point so
3298 that you can build call-chain and use
3299 \\[tinylisp-back-to-definition] to return this point.
3301 non-nil: then clear the call chain, save point, and jump to
3302 definition. This lets you start building call chain again.
3304 WORD String. Symbol to search.
3306 VERB Flag. Allows displaying verbose messages.
3308 NODISPLAY Flag. If non-nil, don't display the found point.
3312 `tinylisp-:call-chain'"
3314 (interactive (list current-prefix-arg
3315 (tinylisp-read-word)))
3318 (concat "^(\\(defun\\*?\\|defmacro\\*?\\|defsubst\\|deffoo"
3319 "\\|defun-maybe\\|defsubst-maybe"
3320 "\\|define-derived-mode"
3321 "\\|defalias\\|fset"
3322 ;; See grep.el::define-compilation-mode
3323 "\\|define-[^ \t\r\n]+-mode"
3324 "\\)[ \t']+%s[ \t\r\n]"))
3326 "^(\\(defvar\\|defconst\\|defcustom\\|defvoo\\)[ \t]+%s[ \t\r\n]")
3327 (reg tinylisp-:register)
3328 (call-chain-data (point-marker))
3337 (if (ti::nil-p word)
3338 (error "TinyLisp: searched WORD is nil.")
3339 (when (setq sym (intern-soft word))
3340 (when (setq alias (ti::defalias-p sym))
3341 (message "TinyLisp: Symbol `%s `==> alias to `%s'" sym alias)
3343 (setq type (tinylisp-symbol-type sym 'noerr)))
3344 ;; ..................................... Search from this buffer ...
3347 (let ((function (if alias
3352 (setq re (format f-re function)))
3354 (setq re (format v-re function)))
3356 ;; since the symbol is not defined in Emacs we can't
3357 ;; know which one to search, variable or function.
3360 ;; This could also be and alias, like
3361 ;; used in many Gnus files.
3362 (format f-re function)
3364 (format v-re word)))))
3365 (when (re-search-forward re nil t)
3366 (setq buffer (current-buffer))
3367 (setq point (line-beginning-position)))))
3368 ;; If the definition is not in current buffer where user is,
3369 ;; Then try to search somewhere else.
3372 (setq file (tinylisp-symbol-file-location sym)))
3373 ;; Still no luck? Loosen the REGEXP so that do not require the
3374 ;; function to be to the left "^", but allow adding spaces, like in:
3376 ;; (eval-and-compile
3377 ;; (defun this-here ()
3379 (unless (or point file)
3380 (setq re (concat (format (substring f-re 1) word)
3382 (format (substring v-re 1) word)))
3385 (when (re-search-forward re nil t)
3386 (setq buffer (current-buffer))
3387 (setq point (line-beginning-position)))))
3389 ;; ............................................... check intern ...
3390 ((when (and (null point)
3391 (null (intern-soft word)))
3392 (message "TinyLisp: Can't find definition for %s (undef)" word)))
3393 ;; .................................................... external ...
3394 ((and (null point) ;; See re-search above which set the point
3397 (ti::subrp-p (or alias sym)))
3399 (not (eq alias sym)))
3401 "TinyLisp: alias `%s' => `%s' points to built-in function."
3403 (symbol-name alias))
3405 "TinyLisp: `%s' is built-in function." word)))
3406 ((and (null point) ;; See re-search above which set the point
3408 ;; Can't find from this file, does load history entry say
3409 ;; from which file it was loaded ?
3411 "TinyLisp: Can't find `load-history' definition for %s" word))
3413 (unless (ti::file-name-path-p file)
3415 "TinyLisp: Couldn't find absolute path %s %s. Contact maintainer"
3417 (when (string-match "\\(.*\\.el\\)c$" file)
3418 (setq file (match-string 1 file))
3419 (unless (file-exists-p file)
3420 (error "TinyLisp: There is only compiled file at %s" file)))
3422 (when (or (find-buffer-visiting file) ;Already loaded
3424 (y-or-n-p (format "TinyLisp: Go to: %s ? " file)))
3425 (unless (string-match "\\.el$" file)
3426 (setq file (concat file ".el")))
3427 (unless (ti::file-name-path-absolute-p file)
3428 (let ((path (locate-library file)))
3431 (unless (file-exists-p file)
3432 (error "Tinylisp: cannot find file %s" file))
3433 (setq buffer (find-file-noselect file))
3434 (with-current-buffer buffer
3435 (setq point (point))
3437 (ti::buffer-outline-widen)
3438 (if (re-search-forward re nil t)
3439 (setq point (point))
3440 (goto-char point) ;back to original position
3441 (setq point nil) ;Clear flag
3442 (message "TinyLisp: Strange... cant't find definition: %s"
3446 (if (and save (not (equal save '(4))))
3447 (setq tinylisp-:call-chain nil)
3448 (tinylisp-push-call-chain nil call-chain-data verb)
3451 "TinyLisp: Call chain %d"
3452 (length tinylisp-:call-chain)))))))
3454 ;; No load-history so try searching all buffers in Emacs
3456 (dolist (buf (buffer-list))
3459 (when (re-search-forward re nil t)
3460 (setq buffer (current-buffer))
3461 (setq point (line-beginning-position))
3463 ;; ....................................................... other ...
3464 (point ;; point is set
3466 (if (and save (not (equal save '(4))))
3467 (setq tinylisp-:call-chain nil)
3468 (tinylisp-push-call-chain nil call-chain-data verb)
3470 (message "TinyLisp: Call chain %d"
3471 (length tinylisp-:call-chain)))))
3472 (point-to-register reg)
3475 (message "TinyLisp: Warning, this symbol is not in obarray.")
3477 (tinylisp-show-register-message))))
3478 ;; ........................................... display found point ...
3481 (not (eq buffer (current-buffer))))
3482 (ti::pop-to-buffer-or-window buffer point))
3485 ;;; ----------------------------------------------------------------------
3487 (defun tinylisp-back-to-definition ()
3488 "Jump back to last call chain point in `tinylisp-:call-chain'."
3490 (tinylisp-push-call-chain 'pop)
3491 (message "TinyLisp: Call chain %d" (length tinylisp-:call-chain)))
3493 ;;; ----------------------------------------------------------------------
3495 (defun tinylisp-jump-to-definition-chain (&optional verb)
3496 "Save position to call chain and jump to definition.
3497 See `tinylisp-jump-to-definition'. VERB."
3500 (tinylisp-jump-to-definition '(4) (tinylisp-read-word) verb))
3502 ;;; ----------------------------------------------------------------------
3504 (defun tinylisp-backward-user-option ()
3505 "See `tinylisp-forward-user-option'."
3507 (tinylisp-forward-user-option 'back (interactive-p)))
3509 ;;; ----------------------------------------------------------------------
3511 (defun tinylisp-forward-user-option (&optional back verb)
3512 "Search forward or BACK a user variable or user callable function. VERB."
3514 (let* ((opoint (point))
3521 (while (and (null point)
3522 (prog1 (setq beg (if back
3523 (tinylisp-forward-def 'back)
3524 (tinylisp-forward-def)))
3526 (message "TinyLisp: No more user options.")
3527 ;; If you have 'paren' package on and your cursor is
3531 ;; then the paren will show "Matches (((...."
3532 ;; and you wouldn't ever see this message without sit-for
3534 ;; Same goes for eldoc.el
3537 ((looking-at tinylisp-:regexp-variable)
3538 (setq type (match-string 1)
3539 sym (intern-soft (match-string 2))))
3540 ((looking-at "^(defun[ \t]+\\([^ \t]+\\)")
3542 sym (intern-soft (match-string 1)))))
3543 ;; ..................................................... examine ...
3544 ;; Okay we're somewhere at the beginning of variable of
3546 ((looking-at "defcustom") ;Yes, this is user variable
3547 (setq point (point)))
3548 ((and sym ;Is this sym _defined_ ?
3550 (and (not (string-match "defun" type))
3551 (boundp sym) ;Then check is easy
3552 (user-variable-p sym))
3553 (and (string-match "defun" type)
3556 (setq point (point)))
3558 ;; ................................................ not loaded ...
3559 ;; package is not loaded into memory, we may be looking at
3560 ;; varible or function. Determine var/func region first.
3563 (setq end (save-excursion
3565 (forward-sexp 1) (point)))
3567 ;; This fails only if variable docs at flushed left, but
3568 ;; then you don't follow guidelines...
3573 (if (if (looking-at "^(defun")
3574 (re-search-forward "(interactive[) ]" end t)
3575 (re-search-forward "^[ \t]+\"\\*" end t)) ;It's variable
3577 ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. . continue ..
3588 (message "TinyLisp: no more user variables or functions.")))
3591 ;;; ----------------------------------------------------------------------
3593 ;;; You can also do this in program code like this.
3596 ;;; (byte-compile-sexp
3597 ;;; (lambda () nil)))
3599 (defun tinylisp-byte-compile-sexp (&optional disassemble verb)
3600 "Byte compile function around point.
3601 If you give prefix argument DISASSEMBLE, then the function is also
3602 disassembled to byte code format. VERB."
3604 (let* ((debug-on-error t)
3607 (tinylisp-defun-macro
3608 (setq name (ti::string-match "def[a-zA-Z]+ +\\([^() \t\n\]+\\)" 1 str))
3610 ((not (stringp name))
3612 (message "TinyLisp:No sexp to compile here...")))
3613 ((null (intern-soft name))
3615 (message "TinyLisp:%s is not interned symbol." name)))
3616 ((null (fboundp (setq name (intern name))))
3618 (message "TinyLisp:%s is not a function name." name)))
3624 (message "TinyLisp: byte compiled [%s]" name)))))))
3626 ;;; ----------------------------------------------------------------------
3627 ;;; #todo: how do you detect the emacs binary used ?
3628 ;;; #todo: unfinished
3630 (defun tinylisp-byte-compile-buffer ()
3631 "Compile current buffer as if Emacs were newer loaded.
3632 Since your current Emacs has already loaded packages, it's not
3633 wise to compile using `byte-compile-file'.
3635 Instead we cal anmother copy of Emacs to do the compilation so that
3636 you would catch any errors with undefined variables and functions."
3638 (let* ((byte-compile-generate-call-tree nil)
3639 (file (buffer-file-name)))
3641 (message "TinyLisp: Buffer %s is not visiting file." (buffer-name))
3642 (call-interactively 'byte-compile-file))))
3644 ;;; ----------------------------------------------------------------------
3646 (defun tinylisp-byte-compile-display-call-tree ()
3647 "See bytecomp.el `display-call-tree'."
3649 (let* ((byte-compile-generate-call-tree t)
3650 (file (buffer-file-name)))
3652 (message (concat "TinyLisp: Buffer %s is not visiting file."
3653 " Cannot display call tree.")
3655 (call-interactively 'byte-compile-file)
3656 (let ((buffer (get-buffer "*Call-Tree*")))
3657 (when (buffer-live-p buffer)
3658 (with-current-buffer buffer
3659 (let (buffer-read-only)
3664 ** TinyLisp: [NOTE] 'Noninteractive functions not known to be called' usually
3665 means that the functions were declared defsubst.\n"))
3668 ;;; ----------------------------------------------------------------------
3670 (defun tinylisp-byte-compile-parse-needed-packages ()
3671 "Byte Compile file and check what packages it needs.
3672 With this function you can find out what other packages are needed to
3675 (let* ((buffer (tinylisp-byte-compile-display-call-tree)))))
3677 ;;; ----------------------------------------------------------------------
3679 (defun tinylisp-set-value-at-point (&optional arg)
3680 "Read word under point and if it's variable, ask new value for it.
3682 \\[universal-argument] 'restore variable's content
3683 \\[universal-argument]\\[universal-argument] 'backup variable's value"
3685 (let* ((var (tinylisp-read-word))
3687 ((equal arg '(4)) 'restore)
3688 ((equal arg '(16)) 'bup))) ;Back it up
3691 (message "TinyLisp: Couldn't read variable at point")
3692 (tinylisp-symbol-do-macro var 'noerr
3693 (if (not (boundp var))
3694 (message "TinyLisp: There is no %s variable" (symbol-name var))
3695 (unless (or (eq cmd 'bup) (memq 'original (symbol-plist var)))
3696 (put var 'original (symbol-value var)))
3699 (set var (get var 'original))
3701 "TinyLisp:%s restored to original value" (symbol-name var)))
3704 (read-from-minibuffer
3705 (format "Set %s to lisp expression: " (symbol-name var))
3706 (prin1-to-string (symbol-value var))))
3708 (setq val (read val)) ;Convert to lisp
3709 (set var val))))))))
3711 ;;; ----------------------------------------------------------------------
3713 (defun tinylisp-call-at-point (&optional record)
3714 "Call object at point.
3715 If prefix arg RECORD is given, the content of the variable
3716 is appended to record buffer.
3718 - If read object is not in obarray, do nothing.
3719 - If it is function; ask what to do
3720 Show symol-function, so that you can tell if it is byte compiled.
3721 Call it, possibly interactively
3722 - If it's variable, eval it, possibly yielding the content."
3724 (let* ((str (tinylisp-read-word))
3727 (if (or (ti::nil-p str)
3728 (null (setq sym (intern-soft str))))
3729 (message "TinyLisp: Can't use word to eval (void?): %s "
3730 (or str "<no word read>" ))
3731 (if (and (fboundp sym)
3733 (if (y-or-n-p (format
3734 "Which %s eval: Y = variable, N = function " str))
3737 ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. . func type ..
3739 ((or (eq type 'func)
3743 ((null (y-or-n-p "Y = Next choice, N = see symbol-function "))
3744 ;; We can't use `message', because it would go nuts; eg if
3745 ;; function would contain "%" which are formatting directives
3746 (pop-to-buffer (ti::temp-buffer tinylisp-:buffer-macro 'clear))
3747 (insert (pp (symbol-function sym)))
3750 (if (and (commandp sym)
3751 (y-or-n-p (format "Call interactively '%s' " str)))
3752 (call-interactively sym)
3753 (setq str (ti::function-args-p 'tinylisp-find-function-list)))
3755 ((or (ti::nil-p str)
3757 (format "Seems to need args %s; call anyway? " str)))
3758 (setq str (funcall sym))
3759 (message "TinyLisp: function returned: %s"
3760 (prin1-to-string str)))))))
3761 ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. . var type ..
3765 (setq str (prin1-to-string (eval sym)))
3766 (tinylisp-record-macro record
3767 (insert "\n" (symbol-name sym) ":\n" str)
3768 (message "TinyLisp: Content of variable recorded.")
3770 (setq str (ti::remove-properties str))
3771 (if (< (length str) 73)
3772 (message (format "TinyLisp: %s => %s" (symbol-name sym) str))
3773 (tinylisp-with-current-buffer
3774 (get-buffer-create tinylisp-:buffer-macro)
3775 (let ((win (get-buffer-window (current-buffer)))
3776 (str (pp (symbol-value sym))))
3777 (display-buffer (current-buffer))
3779 ;; Record this to *Message* buffer too as what we did
3780 ;; if the content fit the screen (size 73)
3781 ;; User can copy paste the results from Message bufer
3783 (message (format "%s => %s" (symbol-name sym) str))
3784 (ti::save-with-marker-macro
3785 (insert "\n" (symbol-name sym) " =>\n" str))
3786 (set-window-point (get-buffer-window (current-buffer)) (point))
3787 ;; If window was not previously visible, resize the content.
3788 ;; If the buffer was visible, let it alone, perhaps
3789 ;; user wants to keep the size as it.
3791 (shrink-window-if-larger-than-buffer))))))))))
3793 ;;; ----------------------------------------------------------------------
3795 (defun tinylisp-eval-at-point ()
3796 "Evaluate variable or function around point.
3800 The definition must be written like this
3802 (defvar , (defconst , (defun ..
3804 And there must be no spaces after the opening parenthesis. The following
3805 statement is not recognised
3811 When we evaluate defcustom variable, we don't actually evaluate statement
3812 as is, but pretend that the defcustom is read like 'defconst'. this has the
3813 effect of setting new value for the variable. If you really want to
3814 evaluate variable as it stand there: as defcustom, you have to put cursor
3815 manually behind the definition and call \\[eval-last-sexp]. In this case
3816 defcustom treats the variable as `defvar' and only defcustom properties are
3821 When you evaluate `defcustom` variable with this function, be very careful
3822 that you have written it correctly, so that you won't get thrown out to
3823 error. If this happens, you're in BIG TROUBLE; repeat ; BE ON YOUR TOES
3824 and think carefully your next move.
3826 An error condition prevented restoring an advice that was enabled for
3827 special form 'defconst' during the evaluation of `defcustom' definition.
3828 The advice is still in effect and you should immediately disable it
3829 before you do anything else.
3831 Call \\[tinylisp-emergency] NOW! After that things are back to normal.
3832 and you can continue as usual."
3834 (let* ((debug-on-error t)) ;Make sure this is on!
3835 (tinylisp-defun-macro
3836 ;; We handle defvar as defconst so that new value takes in
3839 ((string-match "defcustom" str)
3840 (tinylisp-defcustom-macro
3841 (tinylisp-eval "defcustom" "defconst" nil buffer beg end)))
3842 ((string-match "defvar" str)
3843 (tinylisp-eval "defvar" "defconst" nil buffer beg end))
3845 (eval-last-sexp nil)))
3846 (message (concat "TinyLisp: evaled " (or str "<nothing>"))))))
3848 ;;; ----------------------------------------------------------------------
3850 (defun tinylisp-eval-fix-defconst ()
3851 "Fix defconst that has no argument.
3853 (defvar var) ;; valid,
3857 (defconst var) ;; invalid
3859 The defconst must have initial value: we supply 'nil"
3861 (while (re-search-forward "^(defconst[ \t]+[^ \t]+\\([ \t]\\)*)" nil t)
3866 ;;; ----------------------------------------------------------------------
3868 (defun tinylisp-eval-print-last-sexp ()
3869 "Like `eval-print-last-sexp', but print --> at front."
3871 (let ((standard-output (current-buffer)))
3879 ;;; ----------------------------------------------------------------------
3881 (defun tinylisp-eval-current-buffer-defconst ()
3882 "Eval buffer as defconst and print message."
3884 (let* ((obuffer (current-buffer))
3885 (name (buffer-name))
3886 (beg (point-min)) ;maybe narrowed?
3888 (tinylisp-with-current-buffer
3889 (ti::temp-buffer tinylisp-:buffer-tmp 'clear)
3890 (insert-buffer-substring obuffer beg end)
3892 (while (re-search-forward "^(defvar \\|^(defcustom " nil t)
3893 (replace-match "(defconst "))
3894 ;; We have to do another sweep
3895 (tinylisp-eval-fix-defconst)
3896 (tinylisp-defcustom-macro (tinylisp-eval-current-buffer)))
3897 (message "TinyLisp: ok, evaled buffer %s as defconst." name)))
3899 ;;; ----------------------------------------------------------------------
3901 (defun tinylisp-eval-current-buffer-from-file ()
3902 "Evaluate buffer by doing `load-file' from disk.
3903 This effectively stored the function and variable definitions
3906 If current buffer has no file, call `tinylisp-eval-current-buffer'."
3909 ((null buffer-file-name)
3910 (tinylisp-eval-current-buffer))
3912 (if (and (buffer-modified-p)
3913 (y-or-n-p "Save before loading? "))
3915 ;; `load' prints message for user
3916 (load buffer-file-name))))
3918 ;;; ----------------------------------------------------------------------
3920 (defun tinylisp-eval-current-buffer ()
3921 "Eval buffer and print message."
3923 ;; This silences byte compiler
3924 (if (fboundp 'eval-buffer)
3925 (ti::funcall 'eval-buffer) ;XEmacs
3926 (ti::funcall 'eval-current-buffer))
3927 (message "TinyLisp: ok, evaled buffer %s" (buffer-name)))
3929 ;;; ----------------------------------------------------------------------
3931 (defun tinylisp-eval-reverse ()
3932 "Search backward for opening parenthesis and Reverse the statement.
3933 See variable `tinylisp-:table-reverse-eval-alist'"
3935 (let* ((stat (tinylisp-read-symbol-at-point))
3936 (table tinylisp-:table-reverse-eval-alist)
3942 (ti::nil-p (setq func (nth 1 stat))))
3943 (message "TinyLisp: Can't find command around point.")
3945 (tinylisp-symbol-do-macro func 'noerr
3946 (setq str1 (symbol-name func))
3947 (if (null (setq func (cdr-safe (assq func table))))
3948 (message "TinyLisp: Can't find reverse command for %s" str1)
3949 (setq str2 (symbol-name func)
3950 statement (nth 2 stat))
3952 ;; Do some special handling, e.g. add hook may have
3953 ;; additional argument 'add , remove it.
3955 (when (string-match "add-hook +[^ ]+ +[^ ]+\\( +[^ )]+\\))"
3957 (setq statement (ti::replace-match 1 "" statement)))
3959 (tinylisp-eval str1 str2 'string statement)
3960 (message "TinyLisp: evaled as %s" str2))))))
3962 ;;; ----------------------------------------------------------------------
3964 (defun tinylisp-eval-edit ()
3965 "Read current line and allow editing the statement before evaling it."
3967 (let* ((line (ti::string-remove-whitespace (ti::read-current-line)))
3969 (setq ret (eval (read (read-from-minibuffer "tinylisp-Eval: " line))))
3970 (message "TinyLisp: returned: %s" (prin1-to-string ret))))
3973 ;;{{{ code help: functions and variables
3975 ;;; ----------------------------------------------------------------------
3977 (defun tinylisp-find-function-list-occur ()
3978 "Run occur to find functions from whole buffer."
3980 (ti::occur-macro tinylisp-:regexp-function nil
3981 (ti::text-re-search-forward "(defmacro")))
3983 ;;; ----------------------------------------------------------------------
3985 (defun tinylisp-find-function-list (&optional no-show mode)
3986 "Find functions from buffer (macros too).
3990 [DEF][!?] FUNCTION-NAME INTERACTIVE-SPEC
3992 The DEF can defmacro, defun and defsubst.
3994 [!] If you see exclamation mark then it means that you have mixed
3995 defsubst and interactive function, which is very dangerous situation,
3996 because when function is in-lined the (interactive-p) tests from functions
3997 are in-lined too. Check that you really want to do in-lining for
3998 interactive functions.
4000 [?]Question mark means that the function does not exist in obarray
4001 and the possible interactive property is unknown.
4005 NO-SHOW if non-nil, then the result buffer is not shown.
4006 MODE if 'alternative then if there are no left flushed functions then
4007 try finding indented ones.
4011 '((type-string . name) ...)"
4013 (let* ((re tinylisp-:regexp-function)
4014 (buffer tinylisp-:buffer-data)
4025 (while (re-search-forward re nil t)
4026 (setq type (match-string 1)
4027 var (match-string 2))
4029 (ti::nconc list (cons type var))))
4030 (if (and (null list)
4031 (eq mode 'alternative))
4032 (setq loop t ;try again
4034 re (substring re 1)))))
4035 (if (and list (null no-show))
4036 (tinylisp-with-current-buffer (ti::temp-buffer buffer 'clear)
4038 (setq str nil) ;Clear this
4039 ;; Is it symbol? Yes; okay is there really such function?
4040 ;; Okay, read the interactive arguments the, OTW
4041 ;; it was not a function.
4042 (if (setq func (intern-soft (cdr var)))
4044 (setq str (commandp func))
4046 (insert (format "%-12s%s%s %-40s %s\n"
4048 ;; Interactive and defsubst? this is dangerous!
4051 (string= "defsubst" (car var)))
4053 (if (null func) " ?" "")
4057 (pop-to-buffer (current-buffer))
4059 (run-hooks 'tinylisp-:find-func-list-hook)))
4062 ;;; ----------------------------------------------------------------------
4064 (defun tinylisp-find-variable-list-occur ()
4065 "Run occur to find variables from whole buffer."
4067 (ti::occur-macro tinylisp-:regexp-variable nil
4068 (ti::text-re-search-forward "(defconst")))
4070 ;;; ----------------------------------------------------------------------
4072 (defun tinylisp-find-variable-list (&optional show-type)
4073 "Get all defvars and defconst from current buffer.
4074 you can e.g. call this function to get all variables and update them
4075 to your M - x xxx-submit-bug-report function's variable list.
4077 the appearing list will wave defvar's first, then defconst.
4080 SHOW-TYPE if non-nil, then show `user-variable-p' and
4081 `defcustom' information too."
4083 (let* ((re tinylisp-:regexp-variable)
4084 (buffer tinylisp-:buffer-variables)
4089 cl ;def(c)onst (l)ist
4093 (while (re-search-forward re nil t)
4094 (setq type (match-string 1)
4095 var (match-string 2))
4096 (if (string-match "defvar\\|defcustom" type)
4097 (push (cons type var) vl)
4098 (push (cons type var) cl))))
4099 (if (not (or vl cl))
4100 (message "TinyLisp: Can't' find any variables.")
4101 (with-current-buffer (ti::temp-buffer buffer 'clear)
4102 (display-buffer (current-buffer))
4103 ;; Preserve order with reverse
4104 (setq vl (nreverse vl)
4106 (setq list (list vl cl))
4107 (dolist (elt list) ;loop both lists
4109 (setq type (car var)
4111 str ";; #symbol not found")
4112 (tinylisp-symbol-do-macro sym 'noerr
4114 (if (user-variable-p sym)
4115 (setq str "user variable"))
4116 (if (string= type "defcustom")
4117 (setq str (concat str " defcustom")))
4118 (if (not (ti::nil-p str)) ;Add comment prefix if not empty
4119 (setq str (concat ";; " str))))
4120 (if (null show-type)
4121 (insert (cdr var) "\n")
4122 (insert (format "%-40s%s\n" (cdr var) str))))
4125 (run-hooks 'tinylisp-:find-var-list-hook))))
4128 ;;; ----------------------------------------------------------------------
4130 (defun tinylisp-narrow-to-function ()
4131 "Narrow to current function around point."
4133 (let* ((re tinylisp-:regexp-function)
4138 (if (not (looking-at re))
4139 (re-search-backward tinylisp-:regexp-function))
4140 ;; find first empty line
4141 (re-search-backward "^[ \t]*$" nil t)
4145 (narrow-to-region beg end)))
4147 ;;; ----------------------------------------------------------------------
4149 (defun tinylisp-library-symbol-information (file &optional verb)
4150 "Display symbol information from FILE (full path name). VERB.
4151 FILE must be loaded into Emacs to gather all the variable
4152 and function definitions."
4156 (tinylisp-library-read-name 'el))
4157 current-prefix-arg))
4158 (let* ((feature-name (intern-soft
4159 (file-name-sans-extension
4160 (file-name-nondirectory file)))))
4161 ;; If the feature is not same as file name, we have no
4162 ;; other choice to load the file. If feature-name was
4163 ;; set, then the feature is already in Emacs (file was loaded
4165 (unless feature-name
4167 (with-current-buffer (ti::system-get-file-documentation file verb)
4168 (turn-on-tinylisp-mode))))
4170 ;;; ----------------------------------------------------------------------
4172 (defun tinylisp-library-info-emacs (&optional verb)
4173 "Examine load history and print libraries loaded into Emacs.
4174 The summary for each library is in following format:
4176 [*]xxx.el NN /usr/local/Emacs/lisp tinylibm tinylib
4178 | | | | What it `required'
4179 | | Where it is according to `load-path' order.
4180 | How many symbols defined
4181 If star, then the load history had full path name for library
4183 If VERB parameter is nil, then the buffer is not shown and no
4184 messages are displayed.
4188 buffer `tinylisp-:buffer-data'"
4190 (let* ((max (length load-history ))
4191 (buffer (ti::temp-buffer tinylisp-:buffer-library 'clear))
4193 (unknown "--unknown--")
4198 (tinylisp-with-current-buffer buffer
4199 (dolist (pkg load-history)
4200 (when (stringp (setq name (car pkg)))
4201 (setq path (ti::system-load-history-where-is-source name)))
4202 ;; Go to next element, these will have dependency information
4203 ;; ("tinycom" (require . tinylibm) byte-compile-dynamic ...
4207 (while (ti::consp (car pkg))
4208 (push (cdr (car pkg)) dep-list)
4210 ;; User has evaled the package 'in place' and not loaded it.
4211 (unless (stringp name)
4212 (setq name unknown))
4215 "%-15s %3d %-35s %s %s\n"
4217 (if (string-match "^/" (or name ""))
4220 (file-name-nondirectory name))
4223 (file-name-directory path)
4226 (function (lambda (x) (symbol-name x)))
4229 ;; - If the package name is unknow, print some symbol
4230 ;; names that it defined so that user can use grep later
4231 ;; to find out what packagage it was
4233 (if (not (string= name unknown))
4235 (format "%s ..." (ti::string-left (prin1-to-string pkg) 80)))))
4237 (message "TinyLisp: lib info %d/%d %s" i max name))
4241 (tinylisp-with-current-buffer buffer
4243 (sort-lines nil (point-min) (point-max)))
4245 (pop-to-buffer buffer)
4250 ;;; ----------------------------------------------------------------------
4252 (defun tinylisp-read-something ()
4253 "Position point to over some words near point."
4255 (if (looking-at "[ \t\n]") ;only spaces ahead?
4256 (ti::read-current-line)
4257 ;; go backward until space(word) or function call
4258 (unless (char= (following-char) ?\( )
4259 (re-search-backward "[( \t\n]" nil t)
4260 (skip-chars-forward " \t\n")))
4261 (buffer-substring (point) (line-end-position))))
4263 ;;; ----------------------------------------------------------------------
4265 (defun tinylisp-library-read-name (&optional el)
4266 "Read lisp library name with possible completion. If EL, return with .el"
4267 (let* ((cache (fboundp 'tinypath-emacs-lisp-file-list))
4270 ;; tinyPath caches all files for fast loading
4271 ;; Use it if available
4272 (ti::funcall 'tinypath-emacs-lisp-file-list 'from-cache))
4274 (ti::list-to-assoc-menu
4275 (ti::system-load-history-emacs-lisp-files)))))
4276 (word (ti::string-match "[a-z0-9]+[a-z0-9-.]+" 0
4277 (or (tinylisp-read-word) "" )))
4281 (format "%sLisp Library: "
4290 (when (string-match "^\\(.*\\)\\.elc$" file)
4291 (setq file (concat (match-string 1 file))))
4292 (unless (string-match "\\.el" file)
4293 (setq file (concat file ".el")))))
4296 ;;; ----------------------------------------------------------------------
4297 ;;; The name is not a mistake although it may sound repetitive. All
4298 ;;; function in TinyLisp have prefix "tinylisp-library" if they deal with
4299 ;;; load-path libraries.
4301 ;;; The second part is `locate-library' which is standard Emacs function.
4302 ;;; If you do a C-h a `locate-library' you will correctly find both
4303 ;;; of these implementations.
4305 (defun tinylisp-library-locate-library-1 (file &optional extensions)
4306 "Like `locate-library' but find all possible occurrances of FILE.
4307 This also finds compressed files. Path portion and file extensions
4308 in FILE are ignored.
4310 Extensiosn are by default '(\".el\" \".elc\")."
4311 (let* ((compressions '("" ".gz" ".Z" ".z" ".bz2" ".zip"))
4314 (setq file (file-name-sans-extension
4315 (file-name-nondirectory file)))
4317 (setq extensions '(".el" ".elc")))
4318 (dolist (path load-path)
4319 (setq path (expand-file-name path))
4320 (dolist (end extensions)
4321 (dolist (z compressions)
4322 (setq try (format "%s%s%s%s"
4323 (file-name-as-directory path) file end z))
4324 (if (file-exists-p try)
4325 (pushnew try ret :test 'string=)) )))
4326 ;; Preserve search order (due to push)
4329 ;;; ----------------------------------------------------------------------
4331 (defun tinylisp-library-locate-by-fullpath-intercative ()
4332 "Call `tinylisp-library-locate-by-fullpath' interactive with a check."
4335 ((not (featurep 'tinylisp))
4336 (message "Tinylisp: [ERROR] Fullpath locate requires tinypath.el."))
4339 'tinylisp-library-locate-by-fullpath))))
4341 ;;; ----------------------------------------------------------------------
4343 (defun tinylisp-library-locate-by-fullpath (regexp)
4344 "Find all packages whose full path name match REGEXP.
4345 This function requires that feature 'tinypath is present.
4346 List is outputted to message buffer."
4347 (interactive "sMatch package fullpath by regexp: ")
4348 (message "Tinylisp: Locate by FULLPATH regexp '%s' -- begin"
4350 (dolist (path (tinypath-cache-match-fullpath regexp 'names))
4352 (message "Tinylisp: Locate by FULLPATH regexp '%s' -- end"
4354 (display-buffer (ti::buffer-pointer-of-messages)))
4356 ;;; ----------------------------------------------------------------------
4358 (defun tinylisp-library-locate (file &optional insert)
4359 "Like `locate-library' but find all possible occurrances of FILE.
4360 Optionally. INSERT found filenames to point."
4361 (interactive (list (tinylisp-library-read-name) current-prefix-arg))
4362 (let ((list (tinylisp-library-locate-library-1 file)))
4364 (message "TinyLisp: no library found %s" file)
4365 (message "TinyLisp: %s" (ti::list-to-string list))
4367 (insert (ti::list-to-string list "\n"))))
4370 ;;; ----------------------------------------------------------------------
4372 (defun tinylisp-library-documentation (file &optional insert)
4373 "Print the documentation of lisp FILE and possibly INSERT it to point.
4374 This relies on the fact that documentation is at the beginning of file.
4378 buffer Content of Commentary: section"
4380 (list (tinylisp-library-read-name 'el) current-prefix-arg))
4381 (let* ((list (tinylisp-library-locate-library-1 file '(".el") ))
4386 (when (interactive-p)
4387 (setq file (car list))
4388 (if (> (length list) 1)
4390 (completing-read "TinyLisp: [Choose] "
4391 (ti::list-to-assoc-menu list)
4394 ;; Same what finder-commentary uses.
4395 ;; One problem: lm-commentary has a bug, which causes killing
4396 ;; the file from emacs after it's done. But we don't want that
4397 ;; if use is viewing or loaded it to emacs before us.
4399 ;; Work around that bug.
4400 (let ((buffer (find-buffer-visiting file)))
4403 (lm-commentary file)
4405 (insert-buffer buffer)
4407 (if (not (stringp str))
4408 (message "TinyLisp: No commentary in %s" file)
4411 (ti::pmin) (ti::buffer-replace-regexp "^;+" 0 "")
4412 (ti::pmin) (ti::buffer-replace-regexp "\r" 0 "")
4413 (setq str (buffer-string)))
4417 (setq buffer (current-buffer)))
4419 (setq buffer (ti::temp-buffer tinylisp-:buffer-library 'clear))
4420 (with-current-buffer tinylisp-:buffer-library
4422 (ti::pmin) ;;#todo: how to display it at start?
4423 (display-buffer (current-buffer))))))))
4426 ;;; ----------------------------------------------------------------------
4428 (defun tinylisp-library-find-file (file)
4429 "`find-file' a lisp library FILE along `load-path'.
4430 In interactive call, the FILE is completed using `load-path' libraries."
4431 (interactive (list (tinylisp-library-read-name 'el)))
4432 (let* ((path (locate-library file)))
4434 (message "TinyLisp: file %s not along `load-path'" file)
4437 ;;; ----------------------------------------------------------------------
4439 (defun tinylisp-library-load-library (file)
4440 "Like `load-library' but offer completion of lisp files."
4441 (interactive (list (tinylisp-library-read-name)))
4442 (let* ((file (locate-library file)))
4444 (message "TinyLisp: file %s not along `load-path'" file)
4445 (load-library file))))
4447 ;;; ----------------------------------------------------------------------
4449 (defun tinylisp-load-history-grep (regexp)
4450 "Grep load history with REGEXP."
4452 (mapcar 'car load-history)
4456 (string-match arg (or elt ""))))
4459 ;;; ----------------------------------------------------------------------
4461 (defun tinylisp-library-load-by-regexp (regexp &optional no-elc verb)
4462 "Reload all packages (that are inside Emacs) matching REGEXP.
4463 NO-ELC says to load non-compiled packages. VERB."
4466 (read-from-minibuffer "Reload packages matching regexp: ")
4467 (y-or-n-p "Load uncompiled versions ")))
4474 (string-match "el$" regexp))
4475 (message "Tinylisp: Reload, regexp should not need to match .el$"))
4476 (setq list (tinylisp-load-history-grep regexp))
4478 (setq elt (expand-file-name elt))
4479 ;; Remove extension and use .el always,
4480 ;; Note, that the elt may not have extension at all
4481 ;; when we do del-re
4484 (setq elt (replace-regexp-in-string "\\.elc?$" "" elt))
4485 (setq elt (concat elt ".el")))
4487 ;; Remove whole extension
4488 (setq elt (replace-regexp-in-string "\\.elc?$" "" elt))))
4489 (unless (member elt done)
4490 ;; In XEmacs; the packages are stored as absolute path names.
4491 ;; In Emacs, just "package.el".
4492 ;; Try loading absolute, if it does not work; try without.
4495 ((or (and (ti::file-name-path-p elt)
4498 (setq elt (file-name-nondirectory elt))
4502 (message "TinyLisp: Reload failed %s" elt)))))
4504 (message "TinyLisp: %s packages reloaded" count))
4507 ;;; ----------------------------------------------------------------------
4508 ;;; See XEmacs ilisp.el :: describe-symbol-find-file
4510 ;;; (defun describe-symbol-find-file (symbol)
4511 ;;; (loop for (file . load-data) in load-history
4512 ;;; do (when (memq symbol load-data)
4513 ;;; (return file))))
4515 (defun tinylisp-library-find-symbol-load-info ()
4516 "Try to look up load history to determine from where functions was defined.
4517 read current line from point forward.
4519 displayed message format:
4521 [m]{AD} symbol-xxx: package.el (~/elisp/mime/)
4522 [m]{AD} symbol-xxx: ~/elisp/xxx.el
4526 The first line says that the load history entry contains only
4527 \"package.e\" and according to `load-path' information the package was
4528 found from directory ~/elisp/mime/.
4530 The second line: `load-history' contained full path for the package
4534 Additional characters at the beginning: `m' function is macro.
4536 The additional 'AD' String appears on the line of the function has
4537 any advice code attached to it. To check the advice documentation
4538 string, call \\[describe-function].
4540 BUT, this flag only tells if there is advice code, it does not tell
4541 whether the acvice is active or not (If you don't see advice mentioned
4542 after \\[describe-function], then the aadvice is instrumented, but
4543 latent, and not working currently)."
4545 (let* ((str (tinylisp-read-something))
4546 (sym (tinylisp-get-symbol str))
4547 (alias (or (ti::defalias-p sym) sym))
4548 (autoload (ti::autoload-p sym))
4554 (message "TinyLisp: \
4555 Can't find _defined_ variable or function on the line (eval buffer first).")
4556 (if (memq 'ad-advice-info (symbol-plist sym))
4557 (setq ad-info "AD "))
4559 ((null (fboundp alias))
4560 (setq msg "not a function"))
4561 ((ti::subrp-p alias)
4562 (setq msg "<Built-in function>"))
4564 (let* ( ;; (autoload "dired-aux" "Copy all..")
4565 (file (ti::string-match
4567 (prin1-to-string (symbol-function autoload))))
4568 (name (symbol-name autoload))
4569 (path (locate-library file)))
4571 (format "[autoload] %s %s (%s)"
4572 (if (not (eq autoload sym))
4573 (concat "defalias->" name)
4576 (file-name-nondirectory path)
4579 (file-name-directory path)
4580 "<no path found>")))))
4581 ;; ............................................... load-history ...
4582 ((setq package (car-safe
4583 (ti::system-load-history-where-is-source alias)))
4584 (if (setq path (ti::system-load-history-where-is-source package))
4587 (file-name-nondirectory path)
4588 (file-name-directory path)))
4589 (setq msg "<no path found>")))
4590 ;; ...................................................... other ...
4592 ;; See if we have find-func available and call it
4593 (if (not (and (fboundp 'find-function)
4594 (ignore-errors (ti::funcall 'find-function alias))))
4595 (setq msg "no `load-history' entry; maybe evaled locally?"))))
4596 ;; ..................................................... message ...
4597 (message "%s%s%s: %s"
4598 (if (ti::defmacro-p sym) "(macro)" "")
4601 (not (eq alias sym)))
4602 (format "[%s alias --> %s]"
4604 (symbol-name alias))
4609 ;;{{{ code help: misc
4611 ;;; ----------------------------------------------------------------------
4613 (defun tinylisp-autoload-generate-library (library)
4614 "Read all defuns and construct autoloads from LIBRARY on `load-path'."
4616 (list (tinylisp-library-read-name)))
4617 (let* ((path (if (file-name-absolute-p library)
4619 (or (locate-library library)
4620 (error "TinyLisp: Can't locate library %s" library)))))
4621 ;; The name MUST end to .el, because that is the source of autoloads
4623 ((string-match "\\.elc$" path)
4624 (setq path (replace-match ".el" nil t path)))
4625 ((not (string-match "\\.el$" path))
4626 (setq path (concat path ".el"))))
4628 (ti::package-autoload-create-on-file
4629 path (get-buffer-create tinylisp-:buffer-autoload))))
4631 ;;; ----------------------------------------------------------------------
4633 (defun tinylisp-autoload-generate-buffer (&optional arg)
4634 "Read all defuns and construct autoloads from buffer's file on disk.
4635 The autoloads cannot be generated from anonymous buffer, because the
4638 (autoload 'function \"file\" ..)
4642 ARG Ask lisp library name and locate it in `load-path' and generate
4647 (tinylisp-autoload-generate-library
4648 (tinylisp-library-read-name)))
4650 (ti::package-autoload-create-on-file
4651 (buffer-file-name) (get-buffer-create tinylisp-:buffer-autoload)))
4653 (message "TinyLisp: Autoloads can only be generated from file."))))
4655 ;;; ----------------------------------------------------------------------
4657 (defun tinylisp-autoload-generate-file
4658 (file &optional regexp no-desc buffer verb)
4659 "Generate autoload from FILE matching REGEXP.
4662 FILE file or directory.
4663 REGEXP if FILE was directory, include fiels matching REGEXP.
4664 NO-DESC If non-nil, do not include function desctiotion comments.
4665 Interactively supply \\[universal-argument].
4666 BUFFER Buffer where to gateher autoload; default
4667 `tinylisp-:buffer-autoload'
4668 VERB Flag, Pop to autoload buffer."
4669 (interactive "DAutoload directory: \nsFiles Matching regexp: \nP")
4670 (let* ((files (if (file-directory-p file)
4671 (ti::directory-files file regexp 'abs
4672 '(and (not (file-directory-p arg))
4673 (string-match "\\.el$" arg)))
4674 (list file)))) ;single filename
4676 (setq buffer (get-buffer-create tinylisp-:buffer-autoload)))
4678 (dolist (file files)
4679 (ti::package-autoload-create-on-file
4686 ;;; ----------------------------------------------------------------------
4688 (defun tinylisp-forward-def (&optional back verb)
4689 "Go to next `def' forrward or `BACK'. VERB."
4691 (let* ((opoint (point))
4694 ;; Before doing slow loop, try this. This may fail; because
4695 ;; the 'defun macro' doesn't land always to right spot. Try negative
4696 ;; indent inside fuction
4700 ;; ...other function code
4703 ;; And the defu macro would go to `negative' indent position and not
4704 ;; to the `defun'. That's why regexp text.
4707 (beginning-of-defun)
4709 ((looking-at "^(def")
4711 ((re-search-backward "^(def" nil t)
4712 (setq ret (match-beginning 0)))))
4715 (if (re-search-forward "^(def" nil t)
4716 (setq ret (match-beginning 0)))))
4720 (if verb "No more `def' matches"))
4723 ;;; ----------------------------------------------------------------------
4725 (defun tinylisp-indent-around-point (&optional verb )
4726 "Indent current statement around the point. typically a function.
4733 (and (save-excursion
4734 (and (setq beg (tinylisp-forward-def 'back))
4735 (setq msg (ti::string-left (ti::read-current-line) 60)))
4738 (goto-char beg) (end-of-defun)
4739 (setq end (point))))
4741 (if (not (and beg end))
4742 (if verb (message "TinyLisp: can't find anything to indent here."))
4743 ;; Reset the prefix or disaster occur
4744 (let (fill-prefix) (indent-region beg end nil))
4745 (if verb (message "TinyLisp: [indented] %s" msg)))))
4747 ;;; ----------------------------------------------------------------------
4749 (defun tinylisp-defmacro-surround-word ()
4750 "Surround current word with (, ) defmacro statement."
4752 (unless (ti::char-in-list-case (preceding-char) '(?\ ?\t ?\n))
4758 ;;; ----------------------------------------------------------------------
4760 (defun tinylisp-macroexpand (&optional expand-function)
4761 "Expand macro call with EXPAND-FUNCTION which is string.
4762 If point is sitting inside call to macro, expand it.
4763 in the following example the cursor is at point [*].
4765 (macro-function-call arg1 * arg2 arg3)
4768 `tinylisp-:buffer-macro'
4769 `tinylisp-:macroexpand-function-list'"
4775 "Expand with function: "
4776 (ti::list-to-assoc-menu tinylisp-:macroexpand-function-list)
4779 (car tinylisp-:macroexpand-function-list)))))
4780 (let* ((mac-re tinylisp-:regexp-macro-definition)
4786 (when (not (and (symbolp expand-function)
4787 (fboundp expand-function)))
4788 (error "Not a function %s" expand-function))
4789 (tinylisp-defun-macro
4790 (if (setq symbol (ti::string-match "[^() \t\n\]+" 0 str))
4791 (setq sym (intern-soft symbol)))
4793 ((and (stringp symbol)
4795 (not (string-match mac-re symbol))
4796 ;; Others are supposed to be function definitions
4797 (string-match "^def" symbol)
4798 (not (ti::defmacro-p sym)))
4800 "TinyLisp: grabbed %s, but it is not a macro's call statement"
4802 ((and (stringp symbol)
4804 (ti::defmacro-p sym))
4805 (setq to-buffer (ti::temp-buffer tinylisp-:buffer-macro 'clear))
4806 (append-to-buffer to-buffer beg end)
4807 (goto-char opoint) ;restore position
4808 (pop-to-buffer to-buffer)
4811 (insert "(" (symbol-name expand-function) " '\n" )
4812 (ti::pmax) (insert ")")
4813 (setq point (point))
4814 (eval-last-sexp 'output)
4815 (delete-region (point-min) point)
4817 ((and (stringp symbol)
4819 (message "TinyLisp: macroexpand, sexp was function: %s" symbol))
4821 (message "TinyLisp: macroexpand, skipped: %s"
4822 (or str "<can't read>")))))))
4825 ;;{{{ properties display
4827 ;;; ----------------------------------------------------------------------
4829 (defun tinylisp-post-command-config (&optional restore)
4830 "Disable modes that echo something to the echo-ares.
4831 User can't see string echoed otherwise. Optionally RESTORE."
4833 ("lisp" . eldoc-mode)
4834 ("." . paren-message-offscreen)))
4838 (setq re (car elt) sym (cdr elt))
4839 (when (and (boundp sym)
4840 (string-match re (symbol-name major-mode)))
4841 (put 'tinylisp-mode sym (symbol-value sym))
4842 (set sym (if restore t nil))))))
4844 ;;; ----------------------------------------------------------------------
4846 (defun tinylisp-post-command-run-p ()
4847 "Check if running post command is allowed."
4848 (and (not (eq (selected-window) (minibuffer-window)))
4849 (not (minibuffer-window-active-p (minibuffer-window)))))
4851 ;;; ----------------------------------------------------------------------
4853 (defun tinylisp-syntax-post-command ()
4854 "Show syntax information for current point."
4855 (when (tinylisp-post-command-run-p)
4856 (message "[TinyLisp syntax info] %s: %s"
4857 (char-to-string (following-char))
4858 (ti::string-syntax-info (following-char)))))
4860 ;;; ----------------------------------------------------------------------
4862 (defun tinylisp-syntax-show-mode (&optional arg verb)
4863 "Constantly show character syntax info, ARG behaves like mode arg. VERB."
4867 (tinylisp-:property-show-mode
4868 (error "Turn off property show mode first."))
4870 (ti::bool-toggle tinylisp-:syntax-show-mode arg)
4872 (tinylisp-:syntax-show-mode
4873 (make-local-hook 'post-command-hook)
4874 (add-hook 'post-command-hook 'tinylisp-syntax-post-command)
4875 (tinylisp-post-command-config))
4877 (remove-hook 'post-command-hook 'tinylisp-syntax-post-command)
4878 (tinylisp-post-command-config 'restore)))))
4881 "TinyLisp: syntax show mode is %s"
4882 (if tinylisp-:syntax-show-mode
4886 ;;; ----------------------------------------------------------------------
4888 (defun tinylisp-property-info (&optional arg)
4889 "See `tinylisp-property-show' and ARG. Return string 'face-info ov-info'."
4895 (if (member arg '(1 (16) (64)))
4899 (prin1-to-string (text-properties-at (point))))))
4900 (when (member arg '((4) (16) (64)))
4901 (setq ovl (ti::compat-overlays-at (point)))
4902 ;; When there is only one verlay at point, the message should say
4903 ;; "ov" and reserve "ov1" "ov2" for multiple overlays.
4904 (if (> (length ovl) 1)
4913 (int-to-string count)
4915 (prin1-to-string (ti::compat-overlay-properties elt))))))
4916 (concat face-str " " ov-str)))
4918 ;;; ----------------------------------------------------------------------
4920 (defun tinylisp-property-post-command ()
4921 "Display property info according to `tinylisp-:property-show-mode'.
4922 This is post command."
4923 (when (tinylisp-post-command-run-p)
4924 (let* ((record (equal '(64) tinylisp-:property-show-mode))
4925 (ch (char-to-string (following-char)))
4931 (tinylisp-property-info tinylisp-:property-show-mode)))
4932 (tinylisp-record-macro record (insert ch str "\n"))
4933 (message "TinyLisp: %s%s" (if record "r" "") str))))
4935 ;;; ----------------------------------------------------------------------
4937 (defun tinylisp-property-show-mode (arg &optional verb)
4938 "Toggle permanent text property info mode with ARG. VERB.
4939 Utilises local `post-command-hook'.
4941 The echo-area will show following message; definition first, then example.
4942 It says that there is one face and two overlays in current position 12.
4943 The little 'r' appeared at the beginning if the record mode is selected.
4945 [r]POINT:FACE-PROPERTIES[ovN:OVERLAY-PROPERTIES]
4946 12:(face highlight)ov1(face region)ov2(owner my)
4949 nil toggle between 0 and '(16)
4951 1 show face properties
4952 '(4) C -u show overlay properties.
4953 '(16) C -u C -u show both text properties and overlays.
4954 '(64) C -u C -u C -u show both text properties and overlays AND
4955 record info in buffer `tinylisp-:buffer-record'.
4959 (if tinylisp-:syntax-show-mode
4960 (error "Please turn off Syntax show mode first.")
4963 (if (null tinylisp-:property-show-mode)
4964 (setq tinylisp-:property-show-mode '(16))
4965 (setq tinylisp-:property-show-mode nil)))
4966 ((member arg '((4) (16) (64)))
4967 (setq tinylisp-:property-show-mode arg)))
4969 (tinylisp-:property-show-mode
4970 (tinylisp-post-command-config)
4973 "TinyLisp: Property show mode is on %s"
4974 (if (equal arg '(64)) "(RECORDING)" "")))
4975 (make-local-hook 'post-command-hook)
4976 (add-hook 'post-command-hook 'tinylisp-property-post-command))
4978 (tinylisp-post-command-config 'restore)
4979 (remove-hook 'post-command-hook 'tinylisp-property-post-command)
4980 (if verb (message "TinyLisp: Property show mode is off"))))))
4985 ;;; ----------------------------------------------------------------------
4987 (defun tinylisp-snoop-variables-i-args ()
4988 "Ask arguments to `tinylisp-snoop-variables'."
4995 "Name of variable snoop list: "
4996 (ti::list-to-assoc-menu
4997 (mapcar 'car tinylisp-:table-snoop-variables))
5000 tinylisp-:table-snoop-variables))))
5002 ;;; ----------------------------------------------------------------------
5004 (defun tinylisp-find-buffer-local-variables (&optional buffer)
5005 "Print buffer local variables to BUFFER."
5012 (string< (symbol-name (car a))
5013 (symbol-name (car b)))))))
5019 (string< (symbol-name a)
5020 (symbol-name b)))))))
5024 (setq buffer (current-buffer)))
5025 (pop-to-buffer (get-buffer-create tinylisp-:buffer-variables))
5027 (insert "\nbuffer-local-variables: " (buffer-name buffer) "\n\n" )
5028 (dolist (elt (my-sort2 (buffer-local-variables buffer)))
5029 (setq var (car elt))
5030 (when (and (symbolp var) ;skip markers etc.
5031 (not (memq var '(buffer-undo-list
5032 font-lock-syntax-table))))
5033 (insert (format "%-30s => %s\n"
5036 (insert "\nframe-parameters: " (buffer-name buffer) "\n\n" )
5037 (dolist (elt (my-sort2 (frame-parameters)))
5038 (insert (format "%-30s => %s\n"
5039 (symbol-name (car elt))
5041 (insert "\ncoding variables: " (buffer-name buffer) "\n\n" )
5042 (dolist (elt (my-sort1
5043 (ti::system-get-symbols "coding" '(boundp sym))))
5044 (unless (memq elt '(coding-system-alist
5045 coding-category-list
5047 set-coding-system-map))
5048 (setq val (symbol-value elt))
5049 (insert (format "%-30s => %s%s\n"
5050 (if (ti::listp val) ;; Start separate line
5056 ;;; ----------------------------------------------------------------------
5058 (defun tinylisp-find-autoload-functions (&optional buffer)
5059 "Display all autoload functions."
5061 (let* ((list (ti::system-autoload-function-list))
5064 (message "TinyLisp: No autoload functions found in Emacs.")
5067 (get-buffer-create tinylisp-:buffer-autoload)))
5068 (pop-to-buffer buffer)
5070 (insert "\n[TinyLisp] Autoload functions currently in Emacs:\n\n")
5072 (setq doc (documentation func))
5075 (setq doc "<no documentation>"))
5077 (setq doc "<empty documentation string>")))
5078 (insert (format "%s: %s\n%s\n\n"
5080 (or (ti::function-autoload-file func)
5081 "<autoload file unknown>")
5084 ;;; ----------------------------------------------------------------------
5086 (defun tinylisp-find-match-from-hooks (regexp)
5087 "Search all functions that match REGEXP in -hooks -function[s] symbols."
5088 (interactive "sSearch match from hooks: ")
5089 (tinylisp-with-current-buffer
5090 (get-buffer-create tinylisp-:buffer-data)
5092 (pop-to-buffer (ti::system-match-in-hooks regexp tinylisp-:buffer-data))
5093 (sort-lines nil (point-min) (point-max)))
5095 ;;; ----------------------------------------------------------------------
5097 (defun tinylisp-find-match-from-variables (var-regexp val-regexp)
5098 "Search variables for VAR-REGEXP and values matching VAL-REGEXP."
5099 (interactive "sMatch variable name: \nsMatch content in variable: ")
5100 (pop-to-buffer tinylisp-:buffer-data)
5105 (lambda (sym &optional val)
5106 (when (and (boundp sym)
5107 (string-match var-regexp (symbol-name sym))
5108 (string-match val-regexp
5109 (setq val (prin1-to-string
5110 (symbol-value sym)))))
5111 (insert (format "[%s] %s\n\n" (symbol-name sym) val)))))))
5113 ;;; ----------------------------------------------------------------------
5115 (defun tinylisp-snoop-variables (&optional arg list)
5116 "Display contents of hooks. See `tinylisp-:table-snoop-variables'.
5119 1 With prefix arg, variables values are recorded to
5120 to buffer `tinylisp-:buffer-record' and
5122 0 Save variables values.
5123 9 Restore variables values from the saved copies.
5124 8 Kill saved variable state
5125 5 Set all variables to nil in list
5127 C -u allows editing the variables.
5129 LIST list of variables.
5131 Flags when viewing, editing echo-area:
5133 +w Is shown when you're actually modifying the contents.
5134 ! is shown if the variable's state has been saved and is non-nil."
5135 (interactive (tinylisp-snoop-variables-i-args))
5136 (let* ((write (equal arg '(4)))
5140 (restore (eq arg 9))
5146 (mapconcat 'symbol-name list " ")))
5147 (prop 'tinylisp-original)
5152 (setq ok (boundp elt))
5154 ((or read write record)
5156 (setq val (prin1-to-string (symbol-value elt)))
5157 (setq val "<variable does not exist>"))
5158 (tinylisp-record-macro record
5159 (insert (format "%s %s\n" (symbol-name elt) val)))
5160 ;; Using rsz-mini we can show whole content.
5161 (setq str (read-from-minibuffer
5169 (if write ;replace content?
5170 (set elt (read str))))
5172 (put elt prop (symbol-value elt)))
5176 (set elt (get elt prop)))
5180 (message "TinyLisp: Unknown arg %s" (prin1-to-string arg)))))
5182 (save (message "TinyLisp: Saved %s" msg))
5183 (save (message "TinyLisp: Restored %s" msg))
5184 (kill (message "TinyLisp: Killed saved value copies %s" msg))
5185 (kill (message "TinyLisp: Set to nil %s" msg)))))
5190 ;;; ----------------------------------------------------------------------
5192 (defun tinylisp-occur-i-args ()
5193 "Ask arg1 to `tinylisp-occur'."
5194 (read-from-minibuffer
5196 (nth 1 (tinylisp-read-symbol-at-point))
5199 'tinylisp-:occur-history))
5201 ;;; ----------------------------------------------------------------------
5203 (defun tinylisp-occur (regexp &optional arg)
5204 "Run occur on REGEXP for whole buffer.
5205 If ARG is non-nil, do not filter comment lines."
5206 (interactive (list (tinylisp-occur-i-args) current-prefix-arg))
5207 (let* ((obuffer (current-buffer)))
5208 (ti::occur-macro regexp nil
5209 (ti::text-re-search-forward regexp)
5213 (let (buffer-read-only)
5214 (while (re-search-forward "^ *+[0-9]+:\\([ \t]*;.*\\)" nil t)
5215 (delete-region (line-beginning-position)
5216 (min (1+ (line-end-position))
5218 ;; Keep cursor in original buffer
5219 (pop-to-buffer obuffer)))
5221 ;;; ----------------------------------------------------------------------
5223 (defun tinylisp-occur-verbose (regexp &optional arg)
5224 "Call `tinylisp-occur' as user would with ARG."
5225 (interactive (list (tinylisp-occur-i-args) current-prefix-arg))
5226 (when (and (stringp regexp)
5227 (not (string= "" regexp)))
5228 (tinylisp-occur regexp arg)))
5230 ;;; ----------------------------------------------------------------------
5232 (defun tinylisp-occur-select-forward (&optional back)
5233 "Select next line from the occur buffer. You must first run `tinylisp-occur'.
5234 Optionally goes BACK."
5236 (let* ((buffer (get-buffer tinylisp-:occur-buffer-name))
5242 (message "TinyLisp: No occur buffer exist.")
5243 (tinylisp-with-current-buffer buffer
5244 ;; This is ugly, but I don't know other way to move
5245 ;; point permanently in the buffer. The select-window
5246 ;; is the crucial command to make the point move.
5247 (save-window-excursion
5248 (pop-to-buffer (current-buffer))
5249 (select-window (selected-window))
5253 (setq str (ti::read-current-line))
5254 (if (null (setq line (ti::buffer-match "^\\([0-9]+\\):" 1)))
5255 (message "TinyLisp: Can't find line number from occur buffer.")
5256 (setq line (string-to-int line))
5257 ;; first line in occur buffer has
5258 ;; "Lines matching "tipgpd" in buffer xxx.el"
5259 (if (null (setq file
5260 (ti::re-search-check "^Lines matching.* \\(.*\\).$"
5263 "TinyLisp: Can't find file name from occur buffer."))))
5265 (null (setq go-buffer (get-buffer file))))
5266 (message "TinyLisp: buffer not exist %s" file)
5267 (pop-to-buffer go-buffer)
5272 ;;{{{ debugger: std Emacs
5274 ;;; ----------------------------------------------------------------------
5276 (defun tinylisp-debugger-setup ()
5277 "Define new commands to *Backtrace*."
5278 (defvar debugger-mode-map nil) ;no-op ByteComp silencer
5279 (define-key debugger-mode-map "R" 'tinylisp-debugger-record-value))
5281 ;;; ----------------------------------------------------------------------
5283 (defun tinylisp-debugger-record-value (exp)
5284 "Read EXP and record it's value to `tinylisp-:buffer-record' buffer."
5286 (list (read-from-minibuffer
5288 (ti::remove-properties (ti::buffer-read-word "^( \t\n'"))
5289 read-expression-map t
5290 'read-expression-history)))
5291 (let* ((buffer (ti::temp-buffer tinylisp-:buffer-record))
5292 (standard-output buffer))
5293 (defvar debugger-old-buffer nil) ;No-op ByteComp silencer.
5295 (if (null (buffer-name debugger-old-buffer))
5296 ;; old buffer deleted
5297 (setq debugger-old-buffer (current-buffer)))
5298 (princ (format "Debugger (%s): " exp))
5299 (princ (eval-expression exp))
5301 (tinylisp-with-current-buffer buffer
5304 (message (ti::read-current-line))))))
5307 ;;{{{ Additional support functions
5309 ;;; ----------------------------------------------------------------------
5311 (defun tinylisp-emergency (&optional verb)
5312 "Restore any dangerously advised functions.
5313 See `tinylisp-eval-at-point'. VERB."
5316 (ad-disable-advice 'defconst 'around 'tinylisp)
5317 (ad-activate 'defconst)
5320 "TinyLisp: Function states restored; you can continue as usual.")))
5322 ;;; ----------------------------------------------------------------------
5324 (defun tinylisp-elint-init ()
5325 "Prepare buffer for Elint."
5326 (unless (get 'tinylisp-mode 'elint)
5327 (tinylisp-safety-belt 'elint-initialize "See elint.el")
5328 (put 'tinylisp-mode 'elint 'initialized)))
5330 ;;; ----------------------------------------------------------------------
5332 (defun tinylisp-elint-buffer ()
5335 (tinylisp-elint-init)
5336 (tinylisp-safety-belt 'elint-current-buffer "See elint.el"))
5338 ;;; ----------------------------------------------------------------------
5340 (defun tinylisp-elint-defun ()
5343 (tinylisp-elint-init)
5344 (tinylisp-safety-belt 'elint-defun "See elint.el"))
5346 ;;; ----------------------------------------------------------------------
5348 (defadvice edebug-eval-defun (after tinylisp-record-instrumented-function act)
5349 "Record the function info to `tinylisp-:edebug-instrument-table'.
5350 See function `tinylisp-edebug-uninstrument-everything' for more information."
5351 (tinylisp-defun-sym-macro
5355 (message "TinyLisp: instrumented and cached %s (Edebug advice)" name)
5361 tinylisp-:edebug-instrument-table
5364 (tinylisp-edebug-table-remove-entry sym)))))
5366 (ti::advice-control 'eval-defun "^tinylisp"))
5368 ;;; ----------------------------------------------------------------------
5370 (defadvice eval-last-sexp (after tinylisp-remove-instrumented-function act)
5371 "Remove possibly edebug instrumented function info.
5372 See `tinylisp-edebug-table-remove-entry'"
5374 (ignore-errors (forward-sexp -1))
5375 (let ((info (tinylisp-read-function-name-info)))
5376 (when (cdr-safe info)
5377 (tinylisp-edebug-table-remove-entry (cdr-safe info))))))
5379 ;;; ----------------------------------------------------------------------
5381 (defun tinylisp-edebug-table-remove-entry (function)
5382 "Remove FUNCTION from `tinylisp-:edebug-instrument-table'."
5384 (let* ((elt (assq function tinylisp-:edebug-instrument-table)))
5385 (setq tinylisp-:edebug-instrument-table
5386 (delete elt tinylisp-:edebug-instrument-table))))
5388 ;;; ----------------------------------------------------------------------
5390 (defun tinylisp-edebug-uninstrument-buffer ()
5391 "This is same as `eval-buffer', which cancels all edebug information."
5392 (tinylisp-eval-current-buffer))
5394 ;;; ----------------------------------------------------------------------
5396 (defun tinylisp-edebug-instrument-buffer ()
5397 "Read whole buffer and instrument every found left flushed `defun'."
5399 (let* (edebug-all-defs)
5402 (while (re-search-forward "^(defun " nil t)
5403 ;; thi makes Edebug instrument the function
5404 (message "TinyLisp: instrumenting %s" (ti::read-current-line))
5405 (eval-defun 'instrument)))))
5407 ;;; ----------------------------------------------------------------------
5409 (defun tinylisp-edebug-display-instrumented-list ()
5410 "List all instrumented function from cache `tinylisp-:edebug-instrument-table'.
5411 Show results in `tinylisp-:buffer-record'. The display shows
5413 FUNCTION-NAME BUFFER-OF-EVAL LIVE-BUFFER FILE-NAME-FOR-BUFFER"
5415 (let* ((buffer (ti::temp-buffer tinylisp-:buffer-record))
5421 (display-buffer buffer)
5422 (tinylisp-with-current-buffer buffer
5424 (dolist (elt tinylisp-:edebug-instrument-table)
5425 (setq function (nth 0 elt)
5426 name (symbol-name function)
5428 live-buffer (if (buffer-live-p buffer) (get-buffer buffer))
5429 live-name (if live-buffer (buffer-name live-buffer))
5430 ;;; key (or live-buffer file)
5432 (insert (format "\n%-20s %-15s %-15s %s"
5433 name buffer live-name file))))))
5435 ;;; ----------------------------------------------------------------------
5437 (defun tinylisp-edebug-uninstrument-everything ()
5438 "Uninstrument every function instrumented via `tinylisp-edebug-instrument'.
5439 When you Edebug you functions, you instrument function here, function
5440 there in different packages and soon you'll find that you don't
5441 remember any more what you have instrumented. You want to get rid of
5442 all Edebug instrumentation when you think you no longer need them.
5444 This function looks up `tinylisp-:edebug-instrument-table' and with raw
5445 force reloads every package again thus wiping out Edebug instrumentation."
5457 (dolist (elt tinylisp-:edebug-instrument-table)
5458 (setq function (nth 0 elt)
5459 name (symbol-name function)
5461 live-buffer (if (buffer-live-p buffer) (get-buffer buffer))
5462 live-name (if live-buffer (buffer-name live-buffer))
5464 key (or live-buffer file))
5466 ((or (and (stringp key) (member key file-list))
5467 (and (bufferp key) (memq key buffer-list)))
5468 (message "TinyLisp: (edebug) %s %s already wiped"
5474 (with-current-buffer live-buffer
5475 (tinylisp-eval-current-buffer))
5476 (message "TinyLisp: (edebug) wiped %s by re-evaluating buffer %s"
5478 (push buffer buffer-list))
5481 (message "TinyLisp: (edebug) wiped %s by loading file %s" name file)
5482 (ti::kill-buffer-safe tmp)
5483 (push file file-list))))
5484 (setq tinylisp-:edebug-instrument-table nil)))
5486 ;;; ----------------------------------------------------------------------
5488 (defun tinylisp-edebug-uninstrument (&optional verb)
5489 "Uninstrument function whose _name_ is at current point. VERB.
5490 See `tinylisp-edebug-instrument'."
5492 (tinylisp-edebug-instrument 'restore (ti::verb)))
5494 ;;; ----------------------------------------------------------------------
5496 (defun tinylisp-edebug-instrument (&optional uninstrument verb)
5497 "Instrument or UNINSTRUMENT function _name_ at current point. VERB.
5499 If there is a functon call at cursor position, instrument that function.
5500 This is not same as edebug instrumenting \\[universal-argument]
5501 \\[eval-defun] in `emacs-lisp-mode'. The function name at current point is
5502 located and file is loaded to make edebug to instrument that function.
5504 If there is no function call at point, behave like standard
5505 `edebug-eval-defun' accessed via \\[edebug-eval-defun].
5509 ;; If point is over the word 'my-function2', that function is
5512 (defun my-function ()
5514 (let ((buffer (buffer-name))
5515 (case-fold-search t))
5517 (my-function2 buffer)
5522 `tinylisp-:edebug-instrument-table'"
5526 (save-window-excursion
5529 (tinylisp-jump-to-definition
5531 (tinylisp-read-word)
5536 (edebug-eval-defun 'instrument))
5539 ;; No function at point.
5540 (edebug-eval-defun 'debug))))))
5542 ;;; ----------------------------------------------------------------------
5544 (defun tinylisp-checkdoc ()
5545 "Interactively check document from current point forward.
5546 See `checkdoc-interactive'."
5548 (tinylisp-safety-belt 'checkdoc-interactive "See checkdoc.el" (point)))
5550 ;;; ----------------------------------------------------------------------
5552 (defun tinylisp-checkdoc-notes (&optional start)
5553 "Take notes from current point forward or START from beginning of buffer."
5555 (tinylisp-require 'checkdoc)
5556 (let* ((buffer (symbol-value 'checkdoc-diagnostic-buffer))
5557 (checkdoc-arguments-in-order-flag t)
5558 (checkdoc-verb-check-experimental-flag t)
5559 (checkdoc-bouncy-flag t) ;; No auto fixing
5560 checkdoc-spellcheck-documentation-flag ;; Don't call spell
5561 checkdoc-autofix-flag)
5565 (with-current-buffer (get-buffer-create buffer)
5567 (insert (format "\n\nCheckdoc: %s *** Style check %s"
5568 (symbol-value 'checkdoc-version)
5569 (ti::date-standard-date 'minutes))))
5570 (tinylisp-safety-belt
5574 (unless (get-buffer-window buffer)
5575 (display-buffer buffer))
5576 (with-current-buffer buffer
5577 (if (fboundp 'turn-on-tinyurl-mode-1)
5578 (turn-on-tinyurl-mode-1)))
5579 (when nil ;;#todo: doesn't work
5580 (let ((win (get-buffer-window buffer))
5582 (with-current-buffer buffer
5583 ;; Go to start of the message
5585 (when (re-search-backward "^[\r\n]" nil t)
5586 (setq point (point))
5587 (set-window-point win point)))))
5588 (message "TinyLisp: Checkdoc Take notes done.")))
5590 ;;; ----------------------------------------------------------------------
5592 (defun tinylisp-checkdoc-comment-notes ()
5595 (tinylisp-safety-belt 'checkdoc-comments "See checkdoc.el" t))
5597 ;;; ----------------------------------------------------------------------
5599 (defun tinylisp-lisp-mnt-verify ()
5600 "Check package layout.
5601 The latest Emacs distribution has improved lisp-mnt.el which has
5602 function `lm-verify', which you should run in your package. It helps
5603 ensuring that you have all the proper keywords in place. Here is rough
5604 valid layout format:
5606 ;; XXX.el -- proper first line
5617 ;;; XXX.el ends here
5619 See unix what(1) and GNU RCS indent(1) why you should adopt a style where
5620 you use @(#) and $Keywords$."
5623 (if (not (string= (symbol-value 'lm-history-header)
5624 "Change Log\\|History"))
5626 TinyLisp: your lisp-mnt.el is too old to have improved checking. Get newer.")
5627 (call-interactively 'lm-verify)))
5632 ;;#todo: Sent patch to FSF to include these in lisp-mnt.el
5634 ;;; ----------------------------------------------------------------------
5636 (defun tinylisp-lisp-mnt-tag-check-and-fix (tag &optional on-error)
5637 "Correct misplaced lisp-mnt.el tag. Stop ON-ERROR.
5643 (let* ((regexp (concat "^;+[ \t]*" tag ":[ \t]*$"))
5644 (reference (format ";;; %s:" tag))
5647 (if (not (re-search-forward regexp nil t))
5648 (setq status 'missing)
5649 (unless (string= (match-string 0) reference)
5650 (replace-match reference)
5651 (setq status 'fixed))
5653 (if (looking-at "^[ \t]*$")
5657 (setq status 'fixed))
5659 (unless (looking-at "^[ \t]*$")
5661 (setq status 'fixed)))
5663 (eq status 'missing))
5664 (pop-to-buffer (current-buffer))
5665 (error "Lisp-mnt: missing tags `;;; %s:'" tag))
5668 ;;; ----------------------------------------------------------------------
5670 (defun tinylisp-lisp-mnt-tag-check-and-fix-buffer (&optional on-error)
5671 "Check all Lisp commentary tags and fix as needed. Stop ON-ERROR.
5672 Return: '((missing-tags) (fixed-tags))."
5677 (if (and (featurep 'folding)
5679 (folding-open-buffer))
5680 (dolist (tag '("Commentary" "Change Log" "Code"))
5681 (setq stat (tinylisp-lisp-mnt-tag-check-and-fix tag on-error))
5687 (if (or missing fixed)
5688 (list missing fixed))))
5690 ;;; ----------------------------------------------------------------------
5692 (defun tinylisp-lisp-mnt-tag-check-and-fix-file (file &optional on-error)
5693 "Check all Lisp commentary tags on FILE and fix as needed. Stop ON-ERROR.
5694 Return: '((missing-tags) (fixed-tags))."
5695 (interactive "fLisp file: \nP")
5696 (let* ((buffer (find-buffer-visiting (expand-file-name file)))
5699 (setq buffer (find-file-noselect file)))
5700 (with-current-buffer buffer
5701 (tinylisp-lisp-mnt-tag-check-and-fix-buffer on-error))))
5703 ;;; ----------------------------------------------------------------------
5705 (defun tinylisp-lisp-mnt-tag-check-and-fix-dir (dir &optional on-error)
5706 "Check all Lisp commentary tags and fix as needed. Stop ON-ERROR.
5708 '((file ((missing-tags) (fixed-tags))) ..)."
5709 (interactive "DDir: \nP")
5712 (dolist (file (directory-files dir 'abs "\\.el$"))
5713 (setq stat (tinylisp-lisp-mnt-tag-check-and-fix-file file on-error))
5715 (push (list file stat) list)))
5718 ;; (tinylisp-lisp-mnt-tag-check-and-fix-dir "~/elisp/tiny/lisp" 'err)
5724 ;; These must be set, otherwise the mode setup will not activate
5725 ;; correctly when user calls M-x tinylisp-mode.
5727 (add-hook 'tinylisp-:mode-define-keys-hook
5728 'tinylisp-mode-define-keys)
5729 (add-hook 'tinylisp-:elp-summary-mode-define-keys-hook
5730 'tinylisp-elp-summary-mode-define-keys)
5732 (tinylisp-install-menu)
5733 (run-hooks 'tinylisp-:load-hook)
5735 ;;; tinylisp.el ends here