]> git.donarmstrong.com Git - lib.git/blob - emacs_el/tiny-tools/tiny/tinylisp.el
add tiny-tools
[lib.git] / emacs_el / tiny-tools / tiny / tinylisp.el
1 ;;; tinylisp.el --- Emacs lisp programming help grab-bag
2
3 ;; This file is not part of Emacs
4
5 ;;{{{ Id
6
7 ;; Copyright (C)    1997-2007 Jari Aalto
8 ;; Keywords:        tools
9 ;; Author:          Jari Aalto
10 ;; Maintainer:      Jari Aalto
11 ;;
12 ;; To get information on this program use M-x tinylisp-version
13 ;; Look at the code with folding.el
14
15 ;; COPYRIGHT NOTICE
16 ;;
17 ;; This program is free software; you can redistribute it and/or modify it
18 ;; under the terms of the GNU General Public License as published by the Free
19 ;; Software Foundation; either version 2 of the License, or (at your option)
20 ;; any later version.
21 ;;
22 ;; This program is distributed in the hope that it will be useful, but
23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
24 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
25 ;; for more details.
26 ;;
27 ;; You should have received a copy of the GNU General Public License
28 ;; along with program; see the file COPYING. If not, write to the
29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
30 ;; Boston, MA 02110-1301, USA.
31 ;;
32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
33
34 ;;}}}
35 ;;{{{ Install
36
37 ;;; Install:
38
39 ;; ....................................................... &t-install ...
40 ;; Put this file on your Emacs-Lisp load path, add following into your
41 ;; ~/.emacs startup file.
42 ;;
43 ;;      ;;  Select some unused, non-shifted, fast prefix key.
44 ;;      ;;  My kbd accesses $ without shiff and it is seldom used
45 ;;      ;;  in lisp. Other alternatives: "!", "_" ":"
46 ;;
47 ;;      (setq tinylisp-:mode-prefix-key  "$")
48 ;;      (setq tinylisp-:load-hook 'tinylisp-install)
49 ;;      (require 'tinylisp)
50 ;;
51 ;;      (setq tinylisp-:load-hook nil)
52 ;; Or prefer following autoload: your Emacs loads this package only
53 ;; when you need it.
54 ;;
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)
59 ;;
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
63 ;;
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.
68 ;;
69 ;;      (setq tinylisp-:menu-use-flag nil)
70 ;;
71 ;; To manually install or uninstall mode, call:
72 ;;
73 ;;      M-x     tinylisp-install
74 ;;      M-x     tinylisp-uninstall
75 ;;
76 ;; If you have any questions, use this function
77 ;;
78 ;;      M-x tinylisp-submit-bug-report
79
80 ;;}}}
81 ;;{{{ Documentation
82
83 ;; ..................................................... &t-commentary ...
84
85 ;;; Commentary:
86
87 ;;  Preface, Feb 1997
88 ;;
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.
95 ;;
96 ;;  Overview of features
97 ;;
98 ;;      Lisp coding help
99 ;;
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
116 ;;          with it.
117 ;;
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.
123 ;;
124 ;;      Edebug support
125 ;;
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
131 ;;          edebug)
132 ;;      o   Easily uninstrument functions: at point, in buffer
133 ;;
134 ;;      Elp support -- Lisp code profiling
135 ;;
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.
140 ;;
141 ;;      Elint support -- Lint your elisp code
142 ;;
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)) ...)
147 ;;
148 ;;      Checkdoc support --  Check doc strings for style requirements
149 ;;
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.
154 ;;
155 ;;      Find-func.el support
156 ;;
157 ;;      o   Use this package as backup if symbol lookup fails.
158 ;;
159 ;;      Remarks
160 ;;
161 ;;      o   Please take a look new XEmacs package bench.el (19.15 and 20.2)
162 ;;          for bechmarking.
163 ;;
164 ;;  Tutorial, how do you check your package
165 ;;
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)
173 ;;
174 ;;              xxx-buffer-handling
175 ;;              xxx-buffer-clear
176 ;;
177 ;;          Check also that your macros are defined first before functions.
178 ;;          If possible, maintain this definition order in your file
179 ;;
180 ;;              defvar, defconst, defcustom  (on top of file)
181 ;;              defsubst
182 ;;              defmacro
183 ;;              defun
184 ;;
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
188 ;;          this information.
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
191 ;;          their places.
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
197 ;;          full buffer.
198 ;;
199 ;;  Defcustom.el and evaluating an `defcustom' variable
200 ;;
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.
205 ;;
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
209 ;;      these:
210 ;;
211 ;;          (defadvice defconst
212 ;;          (defun     tinylisp-eval-at-point
213 ;;
214 ;;  Find lisp code error position
215 ;;
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.
221 ;;
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.
225 ;;
226 ;;  Following lisp code call chain
227 ;;
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.
232 ;;
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'.
240 ;;
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.
247 ;;
248 ;;        [The only assumption is that you have `loaded' the file !!]
249 ;;
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
254 ;;
255 ;;      The jump command also know following prefix arguments
256 ;;
257 ;;          M-0 $ ' tinylisp-jump-to-definition (empty call chain)
258 ;;          C-u $ ' tinylisp-jump-to-definition (record call-chain)
259 ;;
260 ;;  Examining text properties and overlays in buffer
261 ;;
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.
265 ;;
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:
272 ;;
273 ;;          $ p     tinylisp-property-show-mode
274 ;;
275 ;;  Examining charcter syntax
276 ;;
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.
281 ;;
282 ;;          $ y     tli-syntax-show-mode
283 ;;
284 ;;  Snooping interesting variables
285 ;;
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
290 ;;      writing!
291 ;;
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:
298 ;;
299 ;;          $ s     tinylisp-snoop-variables
300 ;;
301 ;;      And additional prefix arguments: You can save variables states,
302 ;;      modify them as you like, and go back to restores values.
303 ;;
304 ;;  Elp: notes
305 ;;
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.
314 ;;
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.
319 ;;
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
324 ;;
325 ;;  Elp: Summary mode's sort capabilities
326 ;;
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
330 ;;      column names.
331 ;;
332 ;;          f)unction Name  c)all Count  e)lapsed Time  a)verage Time
333 ;;          ==============  ===========  =============  =============
334 ;;
335 ;;  Elp: customizations
336 ;;
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
339 ;;      menu.
340 ;;
341 ;;          elp-reset-after-results
342 ;;
343 ;;  Edebug support
344 ;;
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:
348 ;;
349 ;;          (my-function arg arg arg)
350 ;;
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
356 ;;
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
362 ;;
363 ;;  Todo section
364 ;;
365 ;;      In standard Emacs there seems to be underused package trace.el.
366 ;;      Add direct support for it.
367 ;;
368 ;;      The regress.el provides support for writing and executing
369 ;;      regression tests for Emacs Lisp code. Could that be supported too?
370 ;;
371 ;;      Add support to xray.el
372
373 ;;}}}
374 ;;{{{ history
375
376 ;;; Change Log:
377
378 ;;; Code:
379
380 ;;{{{ require
381
382 ;;; ......................................................... &require ...
383
384 (require 'tinylibm)
385
386 (ti::package-require-view) ;; TinyLisp must be first in the minor-mode-list
387
388 (eval-when-compile
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.
392   ;;
393   ;; In older XEmacs 20.4 edebug does not "provide", so this uses
394   ;; plain old `load' method.
395   (or (featurep 'debug)
396       (load "debug"))
397   (or (featurep 'edebug)
398       (load "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))
402
403 (eval-and-compile
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)))
422       (when loc
423         (message "tinyLisp.el: %s" loc)
424         t)))
425
426   (let ((count 0))
427     ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. eldoc ..
428     (when (and nil ;; 2004-10-10 disabled.
429                (not (tinylisp-locate-library "eldoc")))
430       (incf count)
431       (message "\
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"))))
441       (incf count)
442       (message "\
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 ..
447     (unless (or
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"))
454       (incf count)
455       (message "\
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")))
461         (progn
462           (incf count)
463           (message "\
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")
471       (incf count)
472       (message "\
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")))
480         (progn
481           (incf count)
482           (message "\
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")))
501         (progn
502           (incf count)
503           (message "\
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)
532       (message "\
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."))))
536
537 (ti::package-defgroup-tiny TinyLisp tinylisp-: tools
538   "Lisp programming help module.
539   Overview of features.
540
541       Lisp coding help
542
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
552           under point.
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.")
558
559 ;;}}}
560 ;;{{{ setup: mode definition
561
562 (defcustom tinylisp-:menu-use-flag t
563   "*Non-nil means to use echo-area facilities from tinymenu.el."
564   :type  'boolean
565   :group 'TinyLisp)
566
567 ;;  Creating a minor mode
568 ;;
569 ;;      This macro creates the full minor mode and all needed variables
570 ;;
571 ;;  Mode name "E" for minor name
572 ;;
573 ;;      A general lisp helper mode; please see these too:
574 ;;
575 ;;      (e)lisp-mode
576 ;;      (e)lp.el
577 ;;      (e)ldoc.el
578 ;;      (e)xpand.el
579 ;;
580 ;;  Prefix variable "$"
581 ;;
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.
586 ;;
587 ;;      You can change the prefix key by adding this statement before
588 ;;      loading this package:
589 ;;
590 ;;          (setq tinylisp-:mode-prefix-key "C-cE")
591
592 (eval-and-compile
593
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)
598
599   (ti::macrof-minor-mode-wizard
600    "tinylisp-" " E" "$" "E" 'TinyLisp "tinylisp-:" ;1-6
601
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.
605
606 Defined keys:
607
608 \\{tinylisp-:mode-prefix-map}"
609
610    "Emacs Lisp extras"                  ;7
611
612    nil                                  ;8
613
614    "Emacs Lisp menu."                   ;9
615
616    (list                                ;arg 10
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]
626     "----"
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]
632     "----"
633     ["Forward  user var or func"      tinylisp-forward-user-option           t]
634     ["Backward user var or func"      tinylisp-backward-user-option          t]
635     "----"
636     (list
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])
643
644     (list
645      "Lisp Library"
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])
652     (list
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]
660      "----"
661      ["Info, buffer local variables"   tinylisp-find-buffer-local-variables  t]
662      "----"
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]
667      "----"
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])
672
673     (list
674      "Miscellaneous"
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]
678      ["Widen"                          widen                                 t]
679      ["Convert word to defmacro var."  tinylisp-defmacro-surround-word       t]
680      ["Byte compile current function." tinylisp-byte-compile-sexp            t]
681
682      ["Show call tree for file"
683       tinylisp-byte-compile-display-call-tree t]
684
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])
689     (list
690      "Package layout check"
691      ["Check overall layout syntax"  tinylisp-lisp-mnt-verify                t]
692
693      ["Check or fix layout tags in buffer"
694       tinylisp-lisp-mnt-tag-check-and-fix-buffer t]
695
696      ["Check or fix layout tags in file"
697       tinylisp-lisp-mnt-tag-check-and-fix-file t]
698
699      ["Check or fix layout tags in directory"
700       tinylisp-lisp-mnt-tag-check-and-fix-dir t])
701
702     "----"
703
704     (list
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])
712
713     (list
714      "Elint"
715      ["Check buffer"                 tinylisp-elint-buffer                   t]
716      ["Check defun"                  tinylisp-elint-defun                    t])
717
718     (list
719      "Edebug"
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])
725
726     (list
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]
735
736      "----"
737
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])
745
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]
753
754     "----")
755
756    (progn                               ;arg 11
757      (cond
758       (tinylisp-:menu-use-flag
759        ;;  Using menu to remeber commands is easier if you don't use
760        ;;  menu bar at all.
761        (define-key root-map p 'tinylisp-menu-main))
762
763       (t
764        (tinylisp-install-menu)
765
766        (define-key map "\C-m" 'tinylisp-eval-print-last-sexp)
767
768        (define-key map "Z" 'tinylisp-emergency)
769
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)
775
776        (define-key map "m"   'tinylisp-macroexpand) ;; if @ is inaccessible
777
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)
781
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)
791
792        (define-key map "{"   'tinylisp-backward-user-option)
793        (define-key map "}"   'tinylisp-forward-user-option)
794
795        (define-key map "<"   'tinylisp-indent-around-point)
796
797        (define-key map "a"   'tinylisp-autoload-generate-buffer)
798        (define-key map "A"   'tinylisp-autoload-generate-file)
799
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)
807
808        (define-key map "I"   'tinylisp-eval-edit)
809
810        (define-key map "f"   'tinylisp-find-function-list)
811        (define-key map "F"   'tinylisp-find-function-list-occur)
812
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)
818
819        (define-key map "n"   'tinylisp-narrow-to-function)
820
821        (define-key map "o"   'tinylisp-occur-verbose)
822        (define-key map "+"   'tinylisp-occur-select-forward)
823
824        (define-key map "p"   'tinylisp-property-show-mode)
825        (define-key map "S"   'tinylisp-snoop-variables)
826
827        (define-key map "v"   'tinylisp-find-variable-list)
828        (define-key map "V"   'tinylisp-find-variable-list-occur)
829
830        (define-key map "w"   'widen)
831        (define-key map "x"   'tinylisp-checkdoc)
832        (define-key map "y"   'tinylisp-syntax-show-mode)
833
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)
838
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)
844
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)
853
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)
860
861        (define-key map "E\C-m" 'tinylisp-elint-buffer)
862        (define-key map "E "    'tinylisp-elint-defun)
863
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)
869
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))))))
874
875 ;;; ................................................... &&mode-summary ...
876
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)
880
881 (eval-and-compile
882
883   (ti::macrof-minor-mode-wizard
884    "tinylisp-elp-summary-" " Elp-sum" nil " Elp-sum" 'TinyLisp
885    "tinylisp-:elp-summary-"             ;1-6
886
887    "Commands to help sorting elp summary buffer.
888 Defined keys:
889
890 \\{tinylisp-:elp-summary-prefix-mode-map}"
891
892    "Elp summary sort"                   ;7
893
894    nil                                  ;8
895
896    "Elp summary sort menu."             ;9
897
898    (list                                ;arg 10
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])
904    (progn                               ;arg 11
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))))
911
912 ;;}}}
913 ;;{{{ setup: hooks
914
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."
919   :type  'hook
920   :group 'TinyLisp)
921
922 (defcustom tinylisp-:find-func-list-hook 'tinylisp-highlight-default
923   "*Hook run when tinylisp-find-function-list-hook has displayed the list."
924   :type  'hook
925   :group 'TinyLisp)
926
927 (defcustom tinylisp-:find-var-list-hook 'tinylisp-highlight-default
928   "*Hook run when `tinylisp-find-function-list' has displayed the list."
929   :type  'hook
930   :group 'TinyLisp)
931
932 (defcustom tinylisp-:with-current-buffer-hook '(turn-on-tinylisp-mode)
933   "*Hook run after Â´tinylisp-with-current-buffer'."
934   :type  'hook
935   :group 'TinyLisp)
936
937 ;;}}}
938 ;;{{{ setup: public, user configurable
939
940 (defcustom tinylisp-:register ?\'
941   "*An Emacs register that is used e.g. for saving point or copying text."
942   :type  'character
943   :group 'TinyLisp)
944
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)
952   :group 'TinyLisp)
953
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) ..)."
958   :type  'list
959   :group 'TinyLisp)
960
961 (defcustom tinylisp-:table-snoop-variables
962   '(("hook-command"
963      (pre-command-hook
964       post-command-hook
965       post-command-idle-hook))
966     ("hook-file"
967      (write-file-hooks
968       find-file-hooks
969       after-save-hook))
970     ("hook-mail"
971      (mail-mode-hook
972       mail-setup-hook
973       mail-citation-hook
974       mail-yank-hooks
975       mail-send-hook))
976     ("hook-message"
977      (message-mode-hook
978       message-setup-hook
979       message-signature-setup-hook
980       message-header-setup-hook
981       message-header-hook
982       message-send-hook
983       message-sent-hook))
984     ("hook-basic"
985      (pre-command-hook
986       post-command-hook
987       post-command-idle-hook
988       write-file-hooks
989       find-file-hooks
990       after-save-hook
991       after-init-hook)))
992   "*List of interesting variables printed from `tinylisp-snoop-variables'.
993 Non existing variables can also be listed but they are not checked.
994
995 Format:
996
997  '((\"LIST-NAME\" (var var var ..))
998    ...)"
999
1000   :type '(repeat
1001           (list
1002            (string :tag "Completion name")
1003            (repeat (symbol :tag "Var"))))
1004   :group 'TinyLisp)
1005
1006 ;;}}}
1007 ;;{{{ setup: private variables
1008
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.")
1013
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.")
1020
1021 (defvar tinylisp-:buffer-elp "*tinylisp-elp*"
1022   "Temporary elp info buffer.")
1023
1024 (defvar tinylisp-:buffer-autoload "*tinylisp-autoloads*"
1025   "Temporary buffer.")
1026
1027 (defvar tinylisp-:buffer-variables "*tinylisp-variables*"
1028   "Temporary buffer.")
1029
1030 (defvar tinylisp-:buffer-data "*tinylisp-data*"
1031   "Temporary buffer.")
1032
1033 (defvar tinylisp-:buffer-library "*tinylisp-library*"
1034   "Temporary buffer.")
1035
1036 (defvar tinylisp-:buffer-record "*tinylisp-record*"
1037   "Record variable contents to this buffer.")
1038
1039 (defvar tinylisp-:buffer-tmp "*tinylisp-tmp*"
1040   "Temporary buffer.")
1041
1042 (defvar tinylisp-:buffer-macro "*tinylisp-macroexpand*"
1043   "Temporary buffer.")
1044
1045 (defvar tinylisp-:buffer-eval " *tinylisp-eval*"
1046   "Temporary buffer.")
1047
1048 (defconst tinylisp-:regexp-macro-definition
1049   "^\\(defun\\*\\|defcustom\\|defgroup\\|defadvice\\)"
1050   "Regexp for commands that define macros, like `defcustom' `defgroup'.")
1051
1052 (defconst tinylisp-:regexp-function
1053   (concat
1054    "^(\\("
1055    ;;  cl DEFINES defun* macro
1056    "defun\\*?\\|defsubst\\|defmacro"
1057    ;; See SEMI poe.el
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
1064 type and name.")
1065
1066 (defconst tinylisp-:regexp-variable
1067   (concat
1068    "^(\\("
1069    ;;  Normal lisp variables
1070    "defvar\\|defconst"
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.")
1077
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.")
1081
1082 (defvar tinylisp-:find-error nil
1083   "'Find error' function's data.")
1084
1085 (defvar tinylisp-:occur-history nil
1086   "History.")
1087
1088 (defvar tinylisp-:elp-regexp-history  nil
1089   "History.")
1090
1091 (defvar tinylisp-:elp-not-regexp-history  nil
1092   "History.")
1093
1094 (defvar tinylisp-:elp-master-history  nil
1095   "History.")
1096
1097 ;;  Too bad this is hard coded in emacs..
1098 (defvar tinylisp-:occur-buffer-name "*Occur*"
1099   "Emacs Occur buffer.")
1100
1101 (defvar tinylisp-:edebug-instrument-table  nil
1102   "Edebug instrumentation information.
1103
1104 Format:
1105
1106   '((function buffer-pointer buffer-file-name)
1107     (function buffer-pointer buffer-file-name)
1108     ..)")
1109
1110 ;;}}}
1111 ;;{{{ setup: private, mode
1112
1113 ;;; These must not be made buffer local.
1114
1115 (defvar tinylisp-:property-show-mode nil
1116   "Property show mode (flag).")
1117
1118 (defvar tinylisp-:syntax-show-mode nil
1119   "Property show mode (flag).")
1120
1121 ;;}}}
1122 ;;{{{ setup: menu
1123
1124 (defvar tinylisp-:menu-main) ;;  Just a forward declaration
1125
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.
1131   ;;
1132
1133   (defconst tinylisp-:menu-main         ;bookmark -- &menu
1134     (list
1135
1136      ;;  All commands do not fit to echo menu, but here are at least
1137      ;;  the most used ones.
1138
1139      '(format
1140        "\
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))
1144          "Lisp:"))
1145      (list
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
1206       ;;     multicharacter.
1207       (cons (string-to-char             ;get first char
1208              (substring tinylisp-:mode-prefix-key 0 1))
1209             (list
1210              '(let ((key (ti::keymap-single-key-definition-p
1211                           tinylisp-:mode-prefix-key)))
1212                 (if (characterp key)
1213                     (insert tinylisp-:mode-prefix-key)
1214                   (message "\
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'.
1221
1222 Menu controls:
1223
1224    /     Return to previous menu (if in sub-menu)
1225    h     Echo-menu help. Output this screen and quit
1226    q     Quit.
1227    H     TinyLisp Help menu.
1228
1229 Eval commands:
1230
1231     -  Eval whole buffer
1232
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.
1236
1237     =  Treat all variables as defconst and eval buffer. (With this
1238        you can read the defaults if you're in package buffer)
1239
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)
1243
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'.
1247
1248     C - m (RET)
1249
1250         Eval statement _preceeding_ the cursor. This will output the
1251         returned values one by one. E.g.
1252
1253             (cutrrent-buffer)RET
1254             --> <buffer>
1255
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.
1259
1260 Finding errors and debugging
1261
1262     m  Macroexpand a macro symbol. [See also (comma) to expand functions]
1263
1264     I  Read current line, allow ed(I)ting it, then eval the statement.
1265
1266     !  Find errors. Go to `point-min' and evaluate buffer portions
1267        until error occurs.
1268
1269     #  Find Lisp error with method 2. Try this if previous failed.
1270
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.
1275
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.
1279
1280 Function and code flow
1281
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.
1286
1287     +  Record position to call chain before jump to the definition. This
1288        is shortcut to calling key \".\" with the prefix arg.
1289
1290     DEL     Back to previous definition and remove mark from call chain.
1291
1292     }]      Go to next user option; a star mark, or to user
1293             function; interactive.
1294     {[      Same as above, but backward.
1295
1296 Symbol manipulation
1297
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'
1300
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.
1304
1305        \\[universal-argument]       Restore backup'd value
1306        \\[universal-argument]\\[universal-argument]  Force setting backup value to current value.
1307
1308     `  Surround current word with defmacro statement (, WORD)
1309
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'
1314        0           Save state
1315        9           Restore values from saved state.
1316        8           Kill saved states
1317        5           Set all snooped variables to nil.
1318        \\[universal-argument]         edit variable
1319
1320 Symbol find or autoload generation
1321
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'.
1325
1326     A  Create autoloads from directory's files matching regular epression
1327
1328     d  Describe symbols. This scans whole Emacs obarray to find all
1329        matching symbols. --> See also [I]nfo menu for more targetted
1330        matching.
1331
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.
1336
1337 Listing and occur commands:
1338
1339     o  Run occur for full buffer and filter out comments. Prefix arg says
1340        _not_ to filter out full comment lines.
1341
1342     +  Go to next occur line in buffer. With \\[universal-argument] backward.
1343
1344     f  Find all functions from the buffer
1345     F  Find function and create occur menu.
1346
1347     l  Show symbol Load information (file where is was defined)
1348     L  Library information, examine all packages in Emacs.
1349
1350     v  Find all variables from buffer. Prefix args classifies variables.
1351     V  Find variables and create occur menu.
1352
1353 Modes and utilities
1354
1355     p  Property show mode. Three \\[universal-argument]'s turn on recording.
1356     y  syntax mode, Show syntax of charcter under cursor.
1357
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)
1361
1362 Function commands:
1363
1364     n  Narrow to current lisp function.
1365
1366     w  Widen (\\[widen])
1367
1368     <  Indent current function or variable around point.
1369
1370 Byte compilation
1371
1372     B  Byte compile defun around point. With prefix arg DISSASSEBMLE.
1373
1374     See [C]ompile menu for more options.
1375
1376 Additional menus
1377
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
1383     H   Help 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
1387
1388     C-e Edebug, Emacs Lisp debugger menu"))
1389
1390 ;;; ----------------------------------------------------------------------
1391 ;;;
1392 (defconst tinylisp-:menu-misc-1
1393   (list
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))
1397               ""))
1398    (list
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.
1405 /       Back to root menu
1406 q       Quit menu
1407 f       List font lock colors available.
1408 F       List ALL known faces.
1409 p       Kill running processes interactively.
1410 P       List running processes.")
1411
1412 ;;; ----------------------------------------------------------------------
1413 ;;;
1414 (defconst tinylisp-:menu-lisp-library
1415   (list
1416    '(format
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))
1420        ""))
1421    (list
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)))
1432
1433     (cons ?/   'tinylisp-:menu-main)))
1434   "*Lisp library interface:
1435 /       Back to root menu
1436 q       Quit menu
1437
1438 s       Try to loate file where symbol was defined. This relies on
1439         internal representation of symbols inside Emacs `load-history'.
1440
1441 l       Load one Lisp library with completion into Emacs. (evaluate)
1442
1443 L       Load again libraries inside Emacs matching regexp. E.g. if you want to
1444         reload all of present gnus, supply regexp `gnus'
1445
1446 f       `find-file' a library for editing.
1447
1448 p       Package search: like `locate-library' but find all occurrances
1449         of package. With prefix argument, insert data into buffer.
1450
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.
1454
1455 d       Display Lisp file's documentation.
1456         With prefix argument insert documentation to current point.")
1457
1458 ;;; ----------------------------------------------------------------------
1459 ;;;
1460 (defconst tinylisp-:menu-compile
1461   (list
1462    '(format "%sByte-Compile: c)ompile t)tree for compile"
1463             (if current-prefix-arg
1464                 (format "%s "  (prin1-to-string current-prefix-arg))
1465               ""))
1466    (list
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.
1472 /       Back to root menu
1473 q       Quit menu
1474 RET     Lint buffer
1475 SPC     Lint defun")
1476
1477 ;;; ----------------------------------------------------------------------
1478 ;;;
1479 (defmacro tinylisp-require (sym)
1480   "Require package SYM."
1481   (` (unless (featurep (, sym))
1482        (require (, sym)))))
1483
1484 ;;; ----------------------------------------------------------------------
1485 ;;;
1486 (defconst tinylisp-:menu-elp
1487   '((let (val)
1488       (tinylisp-require 'elp)
1489       (format
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)))
1494                ""
1495              (format "%d " val))
1496          "")
1497        (if elp-reset-after-results
1498            ":t"
1499          "")
1500        (if elp-master
1501            (concat ":" (symbol-name elp-master))
1502          "")))
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)))
1519   "Elp help menu.
1520 The menu shows some status parameters in the echo area.
1521
1522   '[COUNT] elp:  [:t]list'
1523    |               |
1524    |               See 'S' key when this is shown
1525    Count of currently instrumented functions
1526
1527 Basic commands:
1528
1529 /   Back to root menu
1530 q   Quit menu
1531
1532 i   Instrument current function at point
1533 u   Uninstrument function at point
1534
1535 I   Instrument all functions in buffer.
1536 U   Uninstrument all functions in buffer.
1537
1538 R   Instrument by regexp mapping all Emacs functions.
1539     If given prefix arg, then uninstrument instead.
1540
1541 A   Uninstrument all functions in elp list (reastore all)
1542
1543 e   r(e)parse instrumentation: forget all instrumented functions,
1544     eval buffer to read new function definitions, and instrument those
1545     functions.
1546
1547 Misc:
1548
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.
1555
1556 Function information:
1557
1558 f   List _all_ instrumented functions . Prefix arg to display the functions
1559     in separate buffer.
1560 F   Same as above, but list all only specific functions in
1561     `elp-function-list'.
1562
1563 Timing information:
1564
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.")
1568
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
1581
1582 /   Back to root menu
1583 q   Quit menu
1584
1585 a   List all adviced functions that match advice NAME. E.g. to find all
1586     `my' advices.
1587
1588 e   Show all libraries and symbols loaded into Emacs known by `load-history'.
1589
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.
1593
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'.
1596
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'.
1599
1600 L   Show buffer local variables.
1601
1602 s   Search any symbol (variable or function) from Emacs obrray with REGEXP.
1603
1604 v   Search all variables matching variable-REGEXP and whose value match
1605     VALUE-REGEXP.")
1606
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.
1618
1619 /   Back to root menu.
1620 q   Quit 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.
1625 v   variables buffer
1626 f   functions buffer
1627 e   eval buffer")
1628
1629 ;;; ----------------------------------------------------------------------
1630 ;;;
1631 (defconst tinylisp-:menu-elint
1632   '("Elint: RET)buffer SPC)defun"
1633     (
1634      (?\C-m . ( (tinylisp-elint-buffer)))
1635      (?\    . ( (tinylisp-elint-defun)))
1636      (?/    . tinylisp-:menu-main)))
1637   "Elint interface: Check code syntax.
1638 /       Back to root menu
1639 q       Quit menu
1640 RET     Lint buffer
1641 SPC     Lint defun")
1642
1643 ;;; ----------------------------------------------------------------------
1644 ;;;
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)))
1651   "Help menu:
1652 /       Back to root menu
1653 q       Quit menu
1654 m   `tinylisp-mode' Mode description
1655 v   `tinylisp-version'
1656 c   `tinylisp-commentary'")
1657
1658 ;;; ----------------------------------------------------------------------
1659 ;;;
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.
1668
1669 /       Back to root menu
1670 q       Quit menu
1671 RET     Check whole buffer with `lm-verify'
1672 SPC     Check whole buffer tags and automatically fix them
1673 f       Check file
1674 d       Check all files in directory")
1675
1676 ;;; ----------------------------------------------------------------------
1677 ;;;
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)))
1690   "Edebug interface.
1691
1692 /       Back to root menu
1693 q       Quit menu
1694
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.
1699
1700 DEL     Uninstrument as above. Backspace key works too.
1701
1702 SPC     Instrument all functions in this buffer
1703
1704 x       Uninstrument all functions in this buffer
1705
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].
1710
1711 e       Elint current function (code check).
1712
1713 l       List all known instrumented functions.")
1714
1715 ;;; ----------------------------------------------------------------------
1716 ;;;
1717 (defconst tinylisp-:menu-checkdoc
1718   '((let (spell
1719           val)
1720       (tinylisp-require 'checkdoc)
1721       (setq spell checkdoc-spellcheck-documentation-flag)
1722       (cond
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.")))
1727       (format
1728        (concat
1729         "%s%s%s%s%s checkdoc: "
1730         "SPC)point RET)notes DEL)fwd cC)om  m)ode Flags: aA~- Bb Ss Tt")
1731        (cond
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)               "")
1737         (t "?"))
1738        (cond
1739         ((null checkdoc-bouncy-flag)                "")
1740         ((eq   checkdoc-bouncy-flag 'never)         "")
1741         (t "B"))
1742        (cond
1743         ((null checkdoc-arguments-in-order-flag)    "")
1744         (t "O"))
1745        (if checkdoc-verb-check-experimental-flag    "E" "")
1746        (cond
1747         ((eq spell  'defun)         "sD")
1748         ((eq spell  'buffer)        "sB")
1749         ((eq spell  'interactive)   "sI")
1750         ((eq spell  t)              "S")
1751         ((null spell)               "")
1752         (t                          "s?"))
1753        (let ((sym 'checkdoc-triple-semi-comment-check-flag))
1754          (if (and (boundp sym)
1755                   (symbol-value sym))
1756              "T"
1757            ""))))
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
1779                                'defun))))
1780      (?r    . (t (progn (setq  checkdoc-spellcheck-documentation-flag
1781                                'buffer))))
1782      (?T    . (t (progn
1783                    (when (boundp 'checkdoc-triple-semi-comment-check-flag)
1784                      (setq  checkdoc-triple-semi-comment-check-flag t)))))
1785      (?t    . (t (progn
1786                    (when (boundp 'checkdoc-triple-semi-comment-check-flag)
1787                      (setq checkdoc-triple-semi-comment-check-flag
1788                            nil)))))))
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.
1795
1796 The echo area menu shows following status information
1797
1798   [-|O|E|V|S|T] checkdoc:
1799    | | | | | |
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'
1806
1807 Commands:
1808
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'
1816
1817 Checkdoc mode flags that can be changed:
1818
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
1827
1828 ======================================================================
1829         Excerpts from Checkdoc 0.5
1830 ======================================================================
1831
1832 `checkdoc-autofix-flag'
1833
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
1842
1843 `checkdoc-bouncy-flag'
1844
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.
1848
1849 `checkdoc-force-docstrings-flag'
1850
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
1854     have doc-strings.
1855
1856 `checkdoc-arguments-in-order-flag'
1857
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.
1863
1864 `checkdoc-verb-check-experimental-flag'
1865
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
1869     own.
1870
1871 `checkdoc-spellcheck-documentation-flag'
1872
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:
1876
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
1882
1883 `checkdoc-triple-semi-comment-check-flag'
1884
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:
1888
1889     ;;; Title
1890     ;;  text
1891     ;;  text
1892
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.
1896
1897 Auto-fixing:
1898
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
1910     are fixed.
1911
1912 Spell checking doc-strings:
1913
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
1923     your documentation.
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.")
1928
1929 ;;}}}
1930 ;;{{{ version
1931
1932 ;;; ....................................................... &v-version ...
1933
1934 ;;;###autoload (autoload 'tinylisp-version "tinylisp" "Display commentary" t)
1935 (eval-and-compile
1936   (ti::macrof-version-bug-report
1937    "tinylisp.el"
1938    "tinylisp"
1939    tinylisp-:version-id
1940    "$Id: tinylisp.el,v 2.88 2007/05/01 17:20:46 jaalto Exp $"
1941    '(tinylisp-:version-id
1942      tinylisp-:debug
1943      tinylisp-:load-hook
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)))
1954
1955 ;;}}}
1956 ;;{{{ macros
1957
1958 ;;; ----------------------------------------------------------------------
1959 ;;;
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'."
1963   (`
1964    (with-current-buffer (, buffer)
1965      (,@ body)
1966      (run-hooks 'tinylisp-with-current-buffer-hook))))
1967
1968 ;;; ----------------------------------------------------------------------
1969 ;;;
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))
1974                  (when (bolp)
1975                    (ti::buffer-match
1976                     (concat "^[^ \t\n\r]*\\(["
1977                             tinylisp-:variable-not-charset
1978                             "]+\\)+"))
1979                    0))))
1980     (when str
1981       ;;  Remove trainling colon
1982       (if (string-match "\\(.+\\):$" str)
1983           (match-string 1 str)
1984         str))))
1985
1986 ;;; ----------------------------------------------------------------------
1987 ;;;
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 "" )))
1993   (if arg
1994       (ti::funcall function arg)
1995     (ti::funcall function)))
1996
1997 ;;; ----------------------------------------------------------------------
1998 ;;;
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
2002
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)))
2008
2009          (re-v    (substring tinylisp-:regexp-variable
2010                              1 (length tinylisp-:regexp-variable)))
2011          sym)
2012     (cond
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))
2019
2020       ;;  Delete trailing garbage "this-function:" --> "this-function"
2021       (if (string-match "\\(.*\\)[^a-zA-Z0-9*]$" sym)
2022           (setq sym (match-string 1 sym)))
2023
2024       (setq sym (intern-soft sym))))
2025     sym))
2026
2027 ;;; ----------------------------------------------------------------------
2028 ;;;
2029 (defsubst tinylisp-push-call-chain (&optional pop data verb)
2030   "Push current point to call chain.
2031 Input:
2032
2033   POP       flag, instead of push, do pop to last saved positions
2034   DATA      push DATA to chain.
2035   VERB      print verbose messages.
2036
2037 Optionally POP. VERB prints message."
2038   (if (null pop)
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)))))
2044
2045 ;;; ----------------------------------------------------------------------
2046 ;;;
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.
2050 Input:
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.
2054   BODY."
2055   (`
2056    (if (intern-soft (, string))
2057        (progn
2058          (setq (, string) (intern-soft (, string)))
2059          (,@ body))
2060      (if (, noerr)
2061          (message "TinyLisp: No symbol in obarray: %s" (, string))
2062        (error "TinyLisp: No symbol in obarray: %s" (, string))))))
2063
2064 ;;; ----------------------------------------------------------------------
2065 ;;;
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."
2069   (`
2070    (if (, flag)
2071        (tinylisp-with-current-buffer (ti::temp-buffer tinylisp-:buffer-record)
2072                                      (ti::pmax)
2073                                      (,@ body)))))
2074
2075 ;;; ----------------------------------------------------------------------
2076 ;;;
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.
2081
2082 Bound variables in macro:
2083
2084   `beg' `end'   sexp bounds.
2085   `str'         full line read from 'beg' point
2086   `buffer'      points to the current buffer
2087
2088 You use this macro to bounds of Lisp defun, defvar, defconst
2089 structures."
2090   (`
2091    (let* ((buffer  (current-buffer))
2092           str
2093           beg
2094           end)
2095      (if (null buffer)
2096          (setq buffer nil))             ;No-op, byteComp silencer
2097      (save-excursion
2098        (end-of-defun)
2099        (setq end (point))
2100        (forward-sexp -1)
2101        ;;  If no used, ByteComp nags -- silence it so that this macro
2102        ;;  can be used
2103        (setq beg (point))
2104        (if (null beg)
2105            (setq beg nil))
2106        (setq str (ti::read-current-line))
2107        (goto-char end)
2108        (,@ body)))))
2109
2110 ;;; ----------------------------------------------------------------------
2111 ;;;
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))))
2117     (if name
2118         (cons name sym))))
2119
2120 ;;; ----------------------------------------------------------------------
2121 ;;;
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."
2126   (`
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.
2132           (setq info nil))
2133       (if (null sym)                    ;Bytecomp silencer.
2134           (setq sym nil))
2135       (,@ body)))))
2136
2137 ;;; ----------------------------------------------------------------------
2138 ;;;
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."
2142   (`
2143    (unwind-protect
2144        (progn
2145          (ad-enable-advice 'defconst 'around 'tinylisp)
2146          (ad-activate 'defconst)
2147          (,@ body))
2148      ;;  Make sure this is always executed.
2149      (tinylisp-emergency))))
2150
2151 ;;}}}
2152 ;;{{{ Install
2153
2154 ;;; ----------------------------------------------------------------------
2155 ;;;
2156 (defun tinylisp-menu-main (&optional arg)
2157   "Show echo area menu and pass ARG to `ti::menu-menu'."
2158   (interactive "P")
2159   (unless tinylisp-:menu-main
2160     (tinylisp-install-menu))
2161   (ti::menu-menu 'tinylisp-:menu-main arg))
2162
2163 ;;; ----------------------------------------------------------------------
2164 ;;;
2165 (defun turn-on-tinylisp-mode-all-buffers (&optional off)
2166   "Turn function `tinylisp-mode' on in every Lisp buffer. Optionally turn OFF."
2167   (interactive "P")
2168   (ti::dolist-buffer-list
2169    (string-match "lisp\\|debugger-mode" (downcase (symbol-name major-mode)))
2170    'tmp-buffers-too
2171    nil
2172    (progn
2173      (when (eq major-mode 'debugger-mode)
2174        (tinylisp-debugger-setup))
2175      (if off
2176          (unless (null tinylisp-mode)
2177            (turn-off-tinylisp-mode))
2178        (unless tinylisp-mode
2179          (turn-on-tinylisp-mode))))))
2180
2181 ;;; ----------------------------------------------------------------------
2182 ;;;
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))
2186
2187 ;;; ----------------------------------------------------------------------
2188 ;;;
2189 (defun tinylisp-install-hooks (&optional uninstall)
2190   "Install or UNINSTALL hooks that activate TinyLisp minor mode."
2191   (let* ()
2192     (ti::add-hooks '(emacs-lisp-mode-hook
2193                      lisp-interaction-mode-hook
2194                      debugger-mode-hook
2195                      help-mode-hook
2196                      gnus-edit-form-mode-hook
2197                      Info-mode-hook)
2198                    'turn-on-tinylisp-mode
2199                    uninstall)
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
2214                    uninstall)
2215     (cond
2216      ((boundp 'debugger-mode-hook)
2217       (ti::add-hooks '(tinylisp-debugger-setup turn-on-tinylisp-mode)
2218                      'debugger-mode-hook
2219                      uninstall))
2220      (uninstall
2221       (ti::advice-control 'debugger-mode "^tinylisp" 'disable))
2222      (t
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))))))
2228
2229 ;;; ----------------------------------------------------------------------
2230 ;;;
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'."
2234   (interactive "P")
2235   (tinylisp-install-hooks uninstall)
2236   (turn-on-tinylisp-mode-all-buffers uninstall))
2237
2238 ;;; ----------------------------------------------------------------------
2239 ;;;
2240 (defun tinylisp-uninstall ()
2241   "Uninstall package."
2242   (interactive)
2243   (tinylisp-install 'uninsall))
2244
2245 ;;}}}
2246 ;;{{{ advice
2247
2248 ;;; ----------------------------------------------------------------------
2249 ;;;
2250 (defadvice byte-compile-file (around tinylisp act)
2251   "Change interactive prompt and offer current buffer for compiling(.el)."
2252   ;;
2253   ;; byte-compile-file (filename &optional load)
2254   (interactive
2255    (list
2256     (read-file-name
2257      (if current-prefix-arg
2258          "TinyLisp: Byte compile and load file: "
2259        "TinyLisp: byte compile file: ")
2260
2261      (if (and buffer-file-name
2262               (string-match "\\.el$" buffer-file-name))
2263          buffer-file-name
2264        (file-name-directory (or (buffer-file-name)
2265                                 default-directory))))
2266     current-prefix-arg))
2267   ad-do-it)
2268
2269 ;;; ----------------------------------------------------------------------
2270 ;;;
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
2275
2276   (defcustom my nil \"docs\" :type 'string :group my)
2277
2278 TinyLisp first converts it to
2279
2280   (defconst my nil \"docs\" :type 'string :group my)
2281
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.
2285
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.
2288
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:
2293     ;;
2294     ;;  | >   (ad-with-originals (defconst)
2295     ;;  | >     (defconst sym val doc)    ;; Nothing happens?
2296     ;;
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.,
2301     ;;
2302     ;;    (ad-with-originals (defconst)
2303     ;;      (eval `(defconst ,sym ,val ,doc)))
2304     ;;
2305     ;; Hans Chalupsky <hans@ISI.EDU>
2306     ;;
2307     (eval (` (defconst (, sym) (, val) (, doc))))))
2308
2309 ;;}}}
2310 ;;{{{ misc
2311
2312 ;;; ----------------------------------------------------------------------
2313 ;;;
2314 (defun tinylisp-process-kill ()
2315   "Kill running processes with y-n-p."
2316   (let* ((list (process-list)))
2317     (if (null list)
2318         (message "TinyLisp: no running processes to kill.")
2319       (list-processes)
2320       (dolist (proc (process-list))
2321         (when (y-or-n-p (format "Kill: %s " (prin1-to-string proc)))
2322           (delete-process proc))))))
2323
2324 ;;; ----------------------------------------------------------------------
2325 ;;;
2326 (defun tinylisp-face-list-unique (face-list)
2327   "Return unique faces '((var face) ..) from FACE-LIST."
2328   (interactive)
2329   (let* ((getface 'get-face)
2330          face
2331          list)
2332     (dolist (var face-list)
2333       (when (and
2334              (not (string-match "^:" (symbol-name var)))
2335              (or (and (fboundp 'face-font) ;; XEmacs
2336                       (ignore-errors (face-font var))
2337                       (setq face var))
2338                  (if (or (and (fboundp getface) ;;  XEmacs
2339                               (funcall getface var))
2340                          ;; Only works in Emacs. Returns nil in XEmacs
2341                          (facep var))
2342                      (setq face var)))
2343              ;; Filter out duplicates like 'bold
2344              (not (member var list)))
2345         (push (list var face) list)))
2346     list))
2347
2348 ;;; ----------------------------------------------------------------------
2349 ;;; (load-library "flyspell")
2350 ;;; (tinylisp-face-print (current-buffer) '(flyspell-incorrect-face))
2351 ;;;
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))
2355          beg
2356          var
2357          face)
2358     (when list
2359       (setq buffer (ti::temp-buffer tinylisp-:buffer-tmp 'clear))
2360       (with-current-buffer buffer
2361         (dolist (elt list)
2362           (setq var  (car elt)
2363                 face (nth 1 elt))
2364           (insert (format "%-35s" (symbol-name var)))
2365           (setq beg  (point))
2366           (insert "abcdef12345  ")
2367           (set-text-properties beg (point) (list 'face face))
2368           (if (ti::emacs-p)
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)))
2376       buffer)))
2377
2378 ;;; ----------------------------------------------------------------------
2379 ;;;
2380 (defun tinylisp-face-list-font-lock-faces ()
2381   "List known font lock faces and colors used."
2382   (interactive)
2383   (cond
2384    ((not (featurep 'font-lock))
2385     (message "tinylisp.el: font-lock.el is not loaded. No faces."))
2386    (t
2387     (let ((symbols
2388            (ti::system-get-symbols "^font-lock-.*face$" '(boundp sym))))
2389       (when symbols
2390         (let ((buffer (ti::temp-buffer tinylisp-:buffer-tmp 'clear)))
2391           (tinylisp-face-print buffer symbols)
2392           (display-buffer buffer)))))))
2393
2394 ;;; ----------------------------------------------------------------------
2395 ;;;
2396 (defun tinylisp-face-list-known-faces ()
2397   "List all known 'face' variables."
2398   (interactive)
2399   (let* ((symbols (ti::system-get-symbols
2400                    "face"
2401                    '(or (boundp sym)
2402                         (and (fboundp 'get-face) ;;  XEmacs
2403                              (get-face sym))
2404                         ;; Only works in Emacs. Returns nil in XEmacs
2405                         (facep sym))))
2406          (buffer  (ti::temp-buffer tinylisp-:buffer-tmp 'clear)))
2407     (tinylisp-face-print buffer symbols)
2408     (display-buffer buffer)))
2409
2410 ;;; ----------------------------------------------------------------------
2411 ;;;
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))))
2418
2419 ;;; ----------------------------------------------------------------------
2420 ;;;
2421 (defun tinylisp-show-register-message (&optional msg)
2422   "Show what to do with register and show optional MSG."
2423   (message
2424    (or msg
2425        (substitute-command-keys
2426         (format
2427          (concat
2428           "TinyLisp: Jump back to previous positon with "
2429           "\\[jump-to-register-compatibility-binding] %s")
2430          (char-to-string tinylisp-:register))))))
2431
2432 ;;; ----------------------------------------------------------------------
2433 ;;;
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."
2438   (cond
2439    ((and (fboundp symbol)
2440          (boundp symbol))
2441     (if (y-or-n-p (format "select %s: Y = variable, N = Function "
2442                           (symbol-name symbol)))
2443         'var 'func))
2444    ((fboundp symbol)
2445     'func)
2446    ((boundp symbol)
2447     'var)
2448    (t
2449     (unless noerr
2450       (error "Don't know symbol type; not a variable or function %s"
2451              symbol)))))
2452
2453 ;;; ----------------------------------------------------------------------
2454 ;;;
2455 (defun tinylisp-backward-opening-paren ()
2456   "Go backward until parenthesis found."
2457   (if (char= ?\( (following-char))
2458       (point)
2459     (re-search-backward "(" nil t)))
2460
2461 ;;; ----------------------------------------------------------------------
2462 ;;;
2463 (defun tinylisp-read-symbol-at-point ()
2464   "Read function name around point.
2465
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.
2469
2470 Return:
2471  (point function-name-string statement)"
2472   (let* ((opoint   (point))
2473          (word     (save-excursion (tinylisp-read-word)))
2474          point
2475          func
2476          statement)
2477     (save-excursion
2478       (cond
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))
2483        (t
2484         ;;   if there is whitespace  '^      (autoload 'tinylisp-mode...'
2485         ;;   Then go to first opening paren in the line.
2486         ;;
2487         ;;   - there must be whitespace between bol and opoint
2488         ;;   - next we must see '(' in the current line (eol)
2489         (beginning-of-line)
2490         (if (not (and (re-search-forward "^[ \t]*" opoint t)
2491                       (re-search-forward "(" (line-end-position) t)))
2492             ;;  restore
2493             (goto-char opoint))))
2494       (when (and (tinylisp-backward-opening-paren)
2495                  (setq point (point))
2496                  (re-search-forward "[^ \t\n(]" nil t))
2497
2498         (setq func (or word (tinylisp-read-word)))
2499         (goto-char point)
2500         (ignore-errors                  ;In comment; this breaks.
2501           (forward-sexp 1)
2502           (setq statement (buffer-substring point (point))))
2503         (if statement
2504             (list point func statement))))))
2505
2506 ;;; ----------------------------------------------------------------------
2507 ;;;
2508 (defun tinylisp-find-package-prefix ()
2509   "Read function from the beginning of file and first word from the name.
2510
2511     (defun XXX-do-it-like-this ()
2512
2513 Return:
2514   string    The XXX
2515   nil       can't find one."
2516   (save-excursion
2517     (ti::pmin)
2518     (if (re-search-forward "^(defun[ \t]+\\([^ \t]+-\\)" nil t)
2519         (match-string 1))))
2520
2521 ;;; ----------------------------------------------------------------------
2522 ;;;
2523 (defun tinylisp-eval (str1 str2 type &optional arg1 arg2 arg3)
2524   "Substitute STR1 with STR2 in string and eval all in temporary buffer..
2525
2526 If TYPE is nil
2527   Read string from buffer ARG1, position ARG2 and ARG3.
2528
2529 If TYPE is non-nil
2530   ARG1 contains string
2531
2532 References:
2533  `tinylisp-:buffer-eval'"
2534   (tinylisp-with-current-buffer
2535    (ti::temp-buffer tinylisp-:buffer-eval 'clear)
2536    (if type
2537        (insert arg1)
2538      (if (not (get-buffer arg1))
2539          (error "arg1 must be (existing) buffer")
2540        (insert-buffer-substring arg1 arg2 arg3)))
2541    (ti::pmin)
2542    (replace-string str1 str2)
2543    (tinylisp-eval-fix-defconst)
2544    (tinylisp-eval-current-buffer)
2545 ;;;    (erase-buffer)                   ;May be big
2546    nil))
2547
2548 ;;}}}
2549 ;;{{{ Internally used buffers
2550
2551 ;;; --------------------------------------------------------- &buffers ---
2552 ;;;
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
2562       (cond
2563        (win
2564         (when point-min
2565           (select-window win) (ti::pmin)
2566           (select-window owin)))
2567        (frame-win
2568         (raise-frame (window-frame frame-win))
2569         (select-window frame-win))
2570        (t
2571         (display-buffer buffer)
2572         (with-current-buffer buffer
2573           (shrink-window-if-larger-than-buffer)
2574           (if point-min (ti::pmin))))))))
2575
2576 ;;; ----------------------------------------------------------------------
2577 ;;; (defun tinylisp-b-eval (&optional pmin)
2578 ;;;     (interactive) (tinylisp-b-display tinylisp-:buffer-eval pmin))
2579 ;;;
2580 ;;; This is just byteComp forward declaration, kinda.
2581
2582 (defun tinylisp-b-record (&rest args)
2583   "Ignore ARGS."
2584   nil)
2585
2586 ;; Real functions are defined here.
2587
2588 (mapcar
2589  (function
2590   (lambda (x)
2591     (let ((sym (intern (format "tinylisp-b-%s" x)))
2592           (var (intern (format "tinylisp-:buffer-%s" x)))
2593           def)
2594       (setq def
2595             (` (defun (, sym) (&optional pmin)
2596                  (interactive "P")
2597                  (tinylisp-b-display (, var) pmin))))
2598       (eval def))))
2599  '("eval" "record" "variables" "funcs" "autoload" ))
2600
2601 ;;; ----------------------------------------------------------------------
2602 ;;;
2603 (defun tinylisp-b-record-empty (&optional verb)
2604   "Empty buffer `tinylisp-:buffer-record'. VERB."
2605   (interactive)
2606   (ti::verb)
2607   (if (buffer-live-p (get-buffer tinylisp-:buffer-record))
2608       (ti::erase-buffer tinylisp-:buffer-record))
2609   (if verb
2610       (message "TinyLisp: record buffer emptied.")))
2611
2612 ;;; ----------------------------------------------------------------------
2613 ;;;
2614 (defun tinylisp-b-elp (&optional verb)
2615   "Go to Elp summary buffer. VERB."
2616   (interactive)
2617   (ti::verb)
2618   (if (buffer-live-p (get-buffer elp-results-buffer))
2619       (display-buffer elp-results-buffer)
2620     (if verb
2621         (message "TinyLisp: No Elp Profiling results buffer."))))
2622
2623 ;;}}}
2624 ;;{{{ advice, elp
2625
2626 ;;; ----------------------------------------------------------------------
2627 ;;;
2628 (defun tinylisp-ad-match-1 (regexp)
2629   "Return '((function class name) ..) that are adviced matching NAME REGEXP."
2630   (let* (list
2631          sym-name)
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)))))
2638     list))
2639
2640 ;;; ----------------------------------------------------------------------
2641 ;;;
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)))
2648     (ti::verb)
2649     (tinylisp-with-current-buffer
2650      (ti::temp-buffer tinylisp-:buffer-data 'clear)
2651      (dolist (elt list)
2652        (insert
2653         (format
2654          "%-35s %-7s %s\n"
2655          (symbol-name (nth 0 elt))
2656          (symbol-name (nth 1 elt))
2657          (symbol-name (nth 2 elt))))))
2658     (when verb
2659       (pop-to-buffer tinylisp-:buffer-data)
2660       (ti::pmin))))
2661
2662 ;;}}}
2663 ;;{{{ elp
2664
2665 ;;; ----------------------------------------------------------------------
2666 ;;;
2667 (defun tinylisp-elp-function-list-partial (&optional arg verb)
2668   "Call `tinylisp-elp-function-list'. See ARG and VERB parameters there."
2669   (interactive "P")
2670   (ti::verb)
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))
2674
2675 ;;; ----------------------------------------------------------------------
2676 ;;;
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.
2681
2682 LIST defaults to `elp-all-instrumented-list`. VERB."
2683   (interactive "P")
2684   (let* (str)
2685     (ti::verb)
2686     (setq list (or list
2687                    elp-all-instrumented-list)
2688           str  (if list
2689                    (prin1-to-string list)))
2690     (if (null list)
2691         (progn
2692           (if verb
2693               (message "TinyLisp: No functions elp'd"))
2694           ;; function return code
2695           nil)
2696       (if (and (null arg)
2697                (< (length str) 80))
2698           (message str)
2699         (tinylisp-with-current-buffer
2700          (ti::temp-buffer tinylisp-:buffer-elp 'clear)
2701          (dolist (elt list)
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))))
2707       t)))
2708
2709 ;;; ----------------------------------------------------------------------
2710 ;;;
2711 (defun tinylisp-elp-reset-after-results (&optional arg)
2712   "Toggle variable `elp-reset-after-results' according to ARG."
2713   (interactive "P")
2714   (ti::bool-toggle elp-reset-after-results))
2715
2716 ;;; ----------------------------------------------------------------------
2717 ;;;
2718 (defun tinylisp-elp-restore-all (&optional verb)
2719   "Remove all instrumented functions. VERB."
2720   (interactive)
2721   (ti::verb)
2722   (elp-restore-all)
2723   (if verb
2724       (message "TinyLisp: ELP, all functions restored.")))
2725
2726 ;;; ----------------------------------------------------------------------
2727 ;;;
2728 (defun tinylisp-elp-reset-list (&optional verb)
2729   "Reset timing list. VERB."
2730   (interactive)
2731   (ti::verb)
2732   (elp-reset-all)
2733   (if (get-buffer-window elp-results-buffer)
2734       (tinylisp-elp-results))           ;Clear the window
2735   (if verb
2736       (message "TinyLisp: ELP, Timing list cleared.")))
2737
2738 ;;; ----------------------------------------------------------------------
2739 ;;;
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."
2745   (interactive)
2746   (let ((obuffer (current-buffer)))
2747     (ti::verb)
2748     (elp-results)
2749     (ti::pmin)
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)
2755                            (if verb
2756                                (message "TinyLisp: Results RECORDED.")))
2757     (pop-to-buffer obuffer)))
2758
2759 ;;; ----------------------------------------------------------------------
2760 ;;;
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."
2765   (let* (pfx)
2766     (setq pfx
2767           (read-from-minibuffer
2768            (format
2769             "%sInstrument using package prefix [empty=examine functions]: "
2770             (if pfx-arg "Un)" ""))
2771            (or (tinylisp-find-package-prefix)
2772                "")))
2773     (if (ti::nil-p pfx)
2774         (list nil pfx-arg 'find iact)
2775       (list pfx pfx-arg nil iact))))
2776
2777 ;;; ----------------------------------------------------------------------
2778 ;;;
2779 (defun tinylisp-elp-instrument-buffer (prefix &optional remove type verb)
2780   "Instrument all functions in the current buffer.
2781
2782 There are two possibilities when you run this in the buffer
2783
2784 o  Buffer contains a lisp package. Each function is prefixed
2785    with some unique identifier.
2786
2787 o  You're in scratch buffer or badly formed package where
2788    the names of the functions are not prefixed properly.
2789
2790 Interactive call note:
2791
2792    The choice how to instrument functions is asked.
2793
2794 Input:
2795
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.
2801    VERB     verbose mode"
2802   (interactive
2803    (tinylisp-elp-instrument-buffer-i-args current-prefix-arg 'iact))
2804
2805   (let* ((str   (if remove "un" ""))
2806          (count 0)
2807          list)
2808     (ti::verb)
2809     (cond
2810      (type
2811       (setq list (tinylisp-find-function-list 'no-show 'alternative))
2812       (if (null list)
2813           (if verb
2814               (message "TinyLisp: Can't find functions from buffer"))
2815         (let (type)
2816           (dolist (func list)
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)
2821               (incf count)
2822               (tinylisp-symbol-do-macro func nil
2823                                         (elp-restore-function func) ;do this first
2824                                         (if (null remove)
2825                                             (elp-instrument-function func))))))
2826         (if verb
2827             (message "TinyLisp: %sinstrumented %d functions" str count))))
2828      (t
2829       (if remove
2830           (elp-restore-all)
2831         (elp-instrument-package prefix))
2832       (if verb (message
2833                 "\
2834 TinyLisp: %sinstrumented package '%s'. Count of functions is unknown."
2835                 str prefix))))))
2836
2837 ;;; ----------------------------------------------------------------------
2838 ;;;
2839 (defun tinylisp-elp-instrument-function ()
2840   "Instrument current function. Search the function name."
2841   (interactive)
2842   (let* ((func (ti::buffer-defun-function-name)))
2843     (if (not func)
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)))))
2851
2852 ;;; ----------------------------------------------------------------------
2853 ;;;
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'."
2857   (let* (list
2858          name
2859          real)
2860     (mapatoms
2861      (function
2862       (lambda (sym)
2863         (when (fboundp sym)
2864           ;;  What's the real function?
2865           (setq real (or (ti::defalias-p sym) sym))
2866           (when (not (memq (car-safe (symbol-function real))
2867                            '(autoload macro)))
2868             (if real-name
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
2876                            (cond
2877                             ((ad-has-any-advice real)
2878                              (not (ad-is-active real)))
2879                             ((ad-has-any-advice sym)
2880                              (not (ad-is-active sym)))
2881                             (t          ;Okay, no advice
2882                              t)))
2883                        (or (not (stringp not-regexp))
2884                            (not (string-match not-regexp name))))
2885               (push sym list)))))))
2886     list))
2887
2888 ;;; ----------------------------------------------------------------------
2889 ;;;
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).
2895
2896 Note:
2897
2898   Adviced functions starting with `ad-' are not instrumented.
2899
2900 Input:
2901
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
2907                 is matched.
2908   UNINSTRUMENT  Flag, if non-nil. Do the opposite: Uninstrument functions.
2909                 This is the prefix argument.
2910   VERB          Verbose message."
2911   (interactive
2912    (list
2913     (read-string
2914      (if current-prefix-arg
2915          "Elp uninstrument Regexp: "
2916        "Elp 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))
2921   (ti::verb)
2922
2923   (if (ti::nil-p not-regexp)         ;It's "" after RET in interactive
2924       (setq not-regexp nil))
2925
2926   (let* ((list (tinylisp-elp-mapsym regexp not-regexp real-name))
2927          (msg  (if uninstrument "un" "")))
2928     (if uninstrument
2929         (elp-restore-list list)
2930       (elp-instrument-list list))
2931     (if verb
2932         (message "TinyLisp: %d functions %sinstrumented"
2933                  (length list) msg))
2934     list))
2935
2936 ;;; ----------------------------------------------------------------------
2937 ;;;
2938 (defun tinylisp-elp-set-master  (function)
2939   "Set master FUNCTION."
2940   (interactive
2941    (list
2942     (intern
2943      (completing-read
2944       "Master function: "
2945       obarray
2946       'fboundp
2947       'match
2948       nil
2949       'tinylisp-:elp-master-history))))
2950   (elp-set-master function))
2951
2952 ;;; ----------------------------------------------------------------------
2953 ;;;
2954 (defun tinylisp-elp-restore-buffer ()
2955   "Read functions from the buffer and cancel elp for them."
2956   (interactive)
2957   (let* ((args (tinylisp-elp-instrument-buffer-i-args 'pfx 'iact)))
2958     (tinylisp-elp-instrument-buffer
2959      (nth 0 args)
2960      (nth 1 args)
2961      (nth 2 args)
2962      (nth 3 args))))
2963
2964 ;;; ----------------------------------------------------------------------
2965 ;;;
2966 (defun tinylisp-elp-restore-function ()
2967   "Remove elp code from current function. Search the function name."
2968   (interactive)
2969   (let* ((func (ti::buffer-defun-function-name)))
2970     (if (not func)
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)))))
2975
2976 ;;; ----------------------------------------------------------------------
2977 ;;;
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.
2982
2983 In short: remove previous instrumentation and do new one. VERB."
2984   (interactive)
2985   (ti::verb)
2986   (tinylisp-elp-restore-all)
2987   (tinylisp-eval-current-buffer)
2988   (tinylisp-elp-instrument-buffer nil nil 'find verb))
2989
2990 ;;; ----------------------------------------------------------------------
2991 ;;;
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.
2995
2996    ** You must have instrumented the functions before you call this function
2997
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'.
3001
3002             (defun t-1 () (let* () ))
3003             (defun t-2 () (let  () ))
3004             (defun t-3 () )
3005
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
3010             ;;
3011             ;; When you have Evaled/instrumented buffer, then change
3012             ;; it to 'when t' and call the harness function.
3013             ;;
3014             ;; The variable tinylisp-:harness-flag is set to t when you can this
3015             ;; function and set to nil when this function finishes.
3016             ;;
3017             (when tinylisp-:harness-flag
3018               (ti::dotimes count 1 500  ; run 500 times
3019                 (t-1)
3020                 (t-2)
3021                 (t-3)))
3022
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.
3026
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.
3031
3032 The `tinylisp-:buffer-record' buffer is displayed after the harness run is over."
3033   (interactive "P")
3034   (let* (case-fold-search
3035          beg
3036          h-found
3037          rounds)
3038     (ti::verb)
3039     (setq count  (or count 3)
3040           rounds count)
3041     ;;  See if there this word in the buffer
3042     (save-excursion
3043       (ti::pmin)
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"))
3050     (if (and verb
3051              (null
3052               (y-or-n-p
3053                (format
3054                 (if h-found
3055                     "tinylisp-:harness-flag %s times, ok? "
3056                   "Harness %s times, from current point forward, ok? ")
3057                 count))))
3058         (error "Abort."))
3059     (if (and verb
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
3063         (progn
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)))
3072           (if verb
3073               (message "TinyLisp: Eval rounds done."))
3074           (tinylisp-b-record 'pmin))
3075       (setq tinylisp-:harness-flag nil))))
3076
3077 ;;}}}
3078 ;;{{{ elp results
3079
3080 ;;; ----------------------------------------------------------------------
3081 ;;;
3082 (mapcar
3083  (function
3084   (lambda (x)
3085     (let ((sym (intern (format "tinylisp-elp-summary-sort-column-%d" x)))
3086           def)
3087       (setq def
3088             (` (defun (, sym) (&optional arg)
3089 ;;;              "Sort by field. ARG to reverse sort."
3090                  (interactive "P")
3091                  (tinylisp-elp-summary-sort-column (, x) arg))))
3092       (eval def))))
3093  '(1 2 3 4 5 6 7 8 9))
3094
3095 ;;; ----------------------------------------------------------------------
3096 ;;;
3097 (defun tinylisp-elp-summary-sort-column (nbr &optional reverse)
3098   "Sort column NBR or REVERSE."
3099   ;; Nope...
3100   ;; (setq nbr (if reverse (- nbr) nbr))
3101   (untabify (point-min) (point-max))
3102   (ti::save-with-marker-macro
3103     (ti::pmin)
3104     (forward-line 2)                    ;Skip header.
3105     (cond
3106      ((memq nbr '(2 3 4))
3107       (sort-numeric-fields nbr (point) (point-max)))
3108      (t
3109       (sort-fields nbr (point) (point-max))))))
3110
3111 ;;}}}
3112 ;;{{{ code help: debug, find-error
3113
3114 ;;; ----------------------------------------------------------------------
3115 ;;;
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:
3120
3121     While compiling toplevel forms in file xxx.el:
3122       !! Wrong type argument ((number-or-marker-p nil))
3123     Done
3124
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
3130 argument.
3131
3132 DebugTag: 21-56 file.el
3133       !! Wrong type argument ((number-or-marker-p nil))
3134 DebugTag: 22-56 file.el
3135 ..."
3136   (interactive "*P")
3137   (let* ((tag    ";;__LISP-DEBUG__")
3138          (fmt    (concat
3139                   "  (eval-and-compile "
3140                   "(message \"DebugTag: %d-%d %s\"))"))
3141          (re     (regexp-quote tag))
3142          (i      0)
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.
3148          (rand   (rand1 100))
3149          (name   (buffer-name)))
3150     (ti::verb)
3151     (save-excursion
3152       (ti::pmin)
3153       (if remove
3154           (while (re-search-forward tag nil t)
3155             (if verb (message "TinyLisp:  uninstrumenting tag %d" i))
3156             (incf  i)
3157             (beginning-of-line)
3158             (kill-line 1))
3159         (when (or (null (re-search-forward tag nil t))
3160                   (y-or-n-p
3161                    "TinyLisp: Debug tags already instrumented. Proceed? "))
3162           (setq re (concat ".*" re))
3163           (while (re-search-forward "^(" nil t)
3164
3165             (ti::save-with-marker-macro
3166               (beginning-of-line)
3167               (unless (looking-at re)
3168                 (insert (format fmt i rand name))
3169                 (insert tag "\n") ))
3170             (forward-line 1)
3171             (if verb
3172                 (message "TinyLisp:  instrumenting tag %d" i))
3173             (incf   i)))))
3174     (when (and verb (not (zerop i)))
3175       (if remove
3176           (message "TinyLisp: Debug tags removed.")
3177         (message "TinyLisp: %d Debug tags inserted." i)))))
3178
3179 ;;; ----------------------------------------------------------------------
3180 ;;; Simple solution
3181 ;;;
3182 (defun tinylisp-error-find-2 ()
3183   "Start from point min and Eval region at time until error occurs."
3184   (interactive)
3185   (let* ((p         -1)
3186          (opoint    (point))
3187          last-p)
3188     (ti::pmin)
3189     (setq last-p (point))
3190     (while (not (eq p (point)))
3191       (setq p (point))
3192       (eval-region last-p (point))
3193       (setq last-p (point))
3194       (end-of-defun))
3195     ;; The while loop never finishes if there was error
3196     (message "TinyLisp: No lisp errors found.")
3197     (goto-char opoint)))
3198
3199 ;;; ----------------------------------------------------------------------
3200 ;;;
3201 (defun tinylisp-error-find-1 ()
3202   "Find code error position and put point near the error."
3203   (interactive)
3204   (let ((lower-bound 1))
3205     (setq tinylisp-:find-error nil)
3206     (save-excursion
3207       (let (half
3208             (low 1)
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))
3213           (while (< low 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))
3218                        (forward-sexp 2)
3219                        (backward-sexp)
3220                        (while (not (bolp))
3221                          (backward-sexp))
3222                        (setq lower-bound (point)))
3223               (setq high half)))
3224           (backward-sexp)
3225           (setq lower-bound (point)))))
3226
3227     (if (not tinylisp-:find-error)
3228         (message "TinyLisp: No errors found.")
3229       (goto-char lower-bound)
3230       (message "TinyLisp: %s" tinylisp-:find-error))))
3231
3232 ;;; ----------------------------------------------------------------------
3233 ;;;
3234 (defun tinylisp-error-try-parse (from to)
3235   "Eval regions and try to find error in FROM TO."
3236   (condition-case err
3237       (progn (eval-region from to) t)
3238     (error
3239      (progn
3240        (setq tinylisp-:find-error err)
3241        nil))))
3242
3243 ;;; ----------------------------------------------------------------------
3244 ;;;
3245 (defun tinylisp-error-count-sexps ()
3246   "Eval regions and try to find error."
3247   (goto-char (point-max))
3248   (condition-case err
3249       (let ((n 0))
3250         (while (not (bobp))
3251           (backward-sexp)
3252           (setq n (1+ n)))
3253         n)
3254     (error (setq tinylisp-:find-error err))))
3255
3256 ;;; ----------------------------------------------------------------------
3257 ;;;
3258 (defun tinylisp-error-sexp-position (n)
3259   "Find sexp N."
3260   (goto-char 1)
3261   (forward-sexp n)
3262   (if (or (not (eobp))
3263           (save-excursion
3264             (goto-char 1)
3265             (forward-sexp (1- n))
3266             (skip-chars-forward " \t\n")
3267             (not (eobp))))
3268       (backward-sexp))
3269   (point))
3270
3271 ;;}}}
3272 ;;{{{ code help: jump, eval
3273
3274 ;;; ----------------------------------------------------------------------
3275 ;;;
3276 (defun tinylisp-symbol-file-location (symbol)
3277   "Search SYMBOL from Emacs obarrays and try to find file location."
3278   (when symbol
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)))
3283                (if lib
3284                    (locate-library lib)))))))
3285
3286 ;;; ----------------------------------------------------------------------
3287 ;;;
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'.
3294
3295 Input:
3296
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.
3300
3301             non-nil: then clear the call chain, save point, and jump to
3302             definition. This lets you start building call chain again.
3303
3304 WORD        String. Symbol to search.
3305
3306 VERB        Flag. Allows displaying verbose messages.
3307
3308 NODISPLAY   Flag. If non-nil, don't display the found point.
3309
3310 References:
3311
3312   `tinylisp-:call-chain'"
3313
3314   (interactive (list current-prefix-arg
3315                      (tinylisp-read-word)))
3316
3317   (let* ((f-re
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]"))
3325          (v-re
3326           "^(\\(defvar\\|defconst\\|defcustom\\|defvoo\\)[ \t]+%s[ \t\r\n]")
3327          (reg  tinylisp-:register)
3328          (call-chain-data  (point-marker))
3329          re
3330          type
3331          point
3332          file
3333          sym
3334          alias
3335          buffer)
3336     (ti::verb)
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)
3342           (setq sym alias))
3343         (setq type (tinylisp-symbol-type sym 'noerr)))
3344       ;; ..................................... Search from this buffer ...
3345       (save-excursion
3346         (ti::pmin)
3347         (let ((function (if alias
3348                             (symbol-name alias)
3349                           word)))
3350           (cond
3351            ((eq type 'func)
3352             (setq re (format f-re function)))
3353            ((eq type 'var)
3354             (setq re (format v-re function)))
3355            (t
3356             ;;  since the symbol is not defined in Emacs we can't
3357             ;;  know which one to search, variable or function.
3358             ;;  Try anything.
3359             (setq re (concat
3360                       ;;  This could also be and alias, like
3361                       ;;  used in many Gnus files.
3362                       (format f-re function)
3363                       "\\|"
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.
3370       (when (and sym
3371                  (null point))
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:
3375       ;;
3376       ;; (eval-and-compile
3377       ;;    (defun this-here ()
3378       ;;      ...
3379       (unless (or point file)
3380         (setq re (concat (format (substring f-re 1) word)
3381                          "\\|"
3382                          (format (substring v-re 1) word)))
3383         (save-excursion
3384           (ti::pmin)
3385           (when (re-search-forward re nil t)
3386             (setq buffer (current-buffer))
3387             (setq point (line-beginning-position)))))
3388       (cond
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
3395              (null file)
3396              (or alias sym)
3397              (ti::subrp-p (or alias sym)))
3398         (if (and alias
3399                  (not (eq alias sym)))
3400             (message
3401              "TinyLisp: alias `%s' => `%s' points to built-in function."
3402              word
3403              (symbol-name alias))
3404           (message
3405            "TinyLisp: `%s' is built-in function." word)))
3406        ((and (null point) ;; See re-search above which set the point
3407              (null file))
3408         ;; Can't find from this file, does load history entry say
3409         ;; from which file it was loaded ?
3410         (message
3411          "TinyLisp: Can't find `load-history' definition for %s" word))
3412        ((stringp file)
3413         (unless (ti::file-name-path-p file)
3414           (error
3415            "TinyLisp: Couldn't find absolute path %s %s. Contact maintainer"
3416            sym file))
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)))
3421
3422         (when (or (find-buffer-visiting file) ;Already loaded
3423                   (null verb)
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)))
3429               (if path
3430                   (setq file path))))
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))
3436             (ti::pmin)
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"
3443                        word)
3444               (sit-for 2))
3445             (when save
3446               (if (and save (not (equal save '(4))))
3447                   (setq tinylisp-:call-chain nil)
3448                 (tinylisp-push-call-chain nil call-chain-data verb)
3449                 (if verb
3450                     (message
3451                      "TinyLisp: Call chain %d"
3452                      (length tinylisp-:call-chain)))))))
3453         (when (null file)
3454           ;;  No load-history so try searching all buffers in Emacs
3455           (setq buffer nil)
3456           (dolist (buf (buffer-list))
3457             (save-excursion
3458               (set-buffer buf)
3459               (when (re-search-forward re nil t)
3460                 (setq buffer (current-buffer))
3461                 (setq point  (line-beginning-position))
3462                 (return))))))
3463        ;; ....................................................... other ...
3464        (point ;; point is set
3465         (when save
3466           (if (and save (not (equal save '(4))))
3467               (setq tinylisp-:call-chain nil)
3468             (tinylisp-push-call-chain nil call-chain-data verb)
3469             (if verb
3470                 (message "TinyLisp: Call chain %d"
3471                          (length tinylisp-:call-chain)))))
3472         (point-to-register reg)
3473         (goto-char point)
3474         (when (null type)
3475           (message "TinyLisp: Warning, this symbol is not in obarray.")
3476           (sit-for 1))
3477         (tinylisp-show-register-message))))
3478     ;; ........................................... display found point ...
3479     (when (and buffer
3480                (not nodisplay)
3481                (not (eq buffer (current-buffer))))
3482       (ti::pop-to-buffer-or-window buffer point))
3483     buffer))
3484
3485 ;;; ----------------------------------------------------------------------
3486 ;;;
3487 (defun tinylisp-back-to-definition ()
3488   "Jump back to last call chain point in `tinylisp-:call-chain'."
3489   (interactive)
3490   (tinylisp-push-call-chain 'pop)
3491   (message "TinyLisp:  Call chain %d" (length tinylisp-:call-chain)))
3492
3493 ;;; ----------------------------------------------------------------------
3494 ;;;
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."
3498   (interactive)
3499   (ti::verb)
3500   (tinylisp-jump-to-definition '(4) (tinylisp-read-word) verb))
3501
3502 ;;; ----------------------------------------------------------------------
3503 ;;;
3504 (defun tinylisp-backward-user-option ()
3505   "See `tinylisp-forward-user-option'."
3506   (interactive)
3507   (tinylisp-forward-user-option 'back (interactive-p)))
3508
3509 ;;; ----------------------------------------------------------------------
3510 ;;;
3511 (defun tinylisp-forward-user-option (&optional back verb)
3512   "Search forward or BACK a user variable or user callable function. VERB."
3513   (interactive)
3514   (let* ((opoint    (point))
3515          type
3516          sym
3517          point
3518          beg
3519          end)
3520     (ti::verb)
3521     (while (and (null point)
3522                 (prog1 (setq beg (if back
3523                                      (tinylisp-forward-def 'back)
3524                                    (tinylisp-forward-def)))
3525                   (unless beg
3526                     (message "TinyLisp: No more user options.")
3527                     ;;  If you have 'paren' package on and your cursor is
3528                     ;;  at  (defun
3529                     ;;      *
3530                     ;;
3531                     ;;  then the paren will show "Matches (((...."
3532                     ;; and you wouldn't ever see this message without sit-for
3533                     ;;
3534                     ;; Same goes for eldoc.el
3535                     (sit-for 1))))
3536       (cond
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]+\\)")
3541         (setq type "defun"
3542               sym  (intern-soft (match-string 1)))))
3543       ;; ..................................................... examine ...
3544       ;; Okay we're somewhere at the beginning of variable of
3545       (cond
3546        ((looking-at "defcustom")        ;Yes, this is user variable
3547         (setq point (point)))
3548        ((and sym                        ;Is this sym _defined_ ?
3549              (or
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)
3554                    (fboundp sym)
3555                    (commandp sym))))
3556         (setq point (point)))
3557        (t
3558         ;; ................................................ not loaded ...
3559         ;; package is not loaded into memory, we may be looking at
3560         ;; varible or function. Determine var/func region first.
3561
3562         (setq beg (point))
3563         (setq end (save-excursion
3564                     (beginning-of-line)
3565                     (forward-sexp 1) (point)))
3566         (beginning-of-line)
3567         ;;  This fails only if variable docs at flushed left, but
3568         ;;  then you don't follow guidelines...
3569         ;;
3570         ;;  (defvar nil
3571         ;;  "*docs"
3572         ;;
3573         (if (if (looking-at "^(defun")
3574                 (re-search-forward "(interactive[) ]" end t)
3575               (re-search-forward "^[ \t]+\"\\*" end t)) ;It's variable
3576             (setq point beg))))
3577       ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. . continue  ..
3578       (if beg
3579           (goto-char beg))
3580       ;;  Reset round
3581       (setq sym  nil
3582             type nil
3583             beg  nil
3584             end  nil))
3585     (unless point
3586       (goto-char opoint)
3587       (if verb
3588           (message "TinyLisp: no more user variables or functions.")))
3589     point))
3590
3591 ;;; ----------------------------------------------------------------------
3592 ;;;
3593 ;;;  You can also do this in program code like this.
3594 ;;;
3595 ;;;  (fset 'test
3596 ;;;    (byte-compile-sexp
3597 ;;;      (lambda () nil)))
3598 ;;;
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."
3603   (interactive "P")
3604   (let* ((debug-on-error t)
3605          name)
3606     (ti::verb)
3607     (tinylisp-defun-macro
3608      (setq name (ti::string-match "def[a-zA-Z]+ +\\([^() \t\n\]+\\)" 1 str))
3609      (cond
3610       ((not (stringp name))
3611        (if verb
3612            (message "TinyLisp:No sexp to compile here...")))
3613       ((null (intern-soft name))
3614        (if verb
3615            (message "TinyLisp:%s is not interned symbol." name)))
3616       ((null (fboundp (setq name (intern name))))
3617        (if verb
3618            (message "TinyLisp:%s is not a function name." name)))
3619       (disassemble
3620        (disassemble name))
3621       (t
3622        (byte-compile name)
3623        (if verb
3624            (message "TinyLisp: byte compiled [%s]" name)))))))
3625
3626 ;;; ----------------------------------------------------------------------
3627 ;;; #todo: how do you detect the emacs binary used ?
3628 ;;; #todo: unfinished
3629 ;;;
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'.
3634
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."
3637   (interactive)
3638   (let* ((byte-compile-generate-call-tree  nil)
3639          (file  (buffer-file-name)))
3640     (if (null file)
3641         (message "TinyLisp: Buffer %s is not visiting file." (buffer-name))
3642       (call-interactively 'byte-compile-file))))
3643
3644 ;;; ----------------------------------------------------------------------
3645 ;;;
3646 (defun tinylisp-byte-compile-display-call-tree ()
3647   "See bytecomp.el `display-call-tree'."
3648   (interactive)
3649   (let* ((byte-compile-generate-call-tree  t)
3650          (file  (buffer-file-name)))
3651     (if (null file)
3652         (message (concat "TinyLisp: Buffer %s is not visiting file."
3653                          " Cannot display call tree.")
3654                  (buffer-name))
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)
3660               (save-excursion
3661                 (ti::pmax)
3662                 (insert "
3663
3664 ** TinyLisp: [NOTE] 'Noninteractive functions not known to be called' usually
3665 means that the functions were declared defsubst.\n"))
3666               buffer)))))))
3667
3668 ;;; ----------------------------------------------------------------------
3669 ;;; #todo:
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
3673 run a file."
3674   (interactive)
3675   (let* ((buffer (tinylisp-byte-compile-display-call-tree)))))
3676
3677 ;;; ----------------------------------------------------------------------
3678 ;;;
3679 (defun tinylisp-set-value-at-point (&optional arg)
3680   "Read word under point and if it's variable, ask new value for it.
3681 ARG can be
3682  \\[universal-argument]  'restore variable's content
3683  \\[universal-argument]\\[universal-argument]  'backup variable's value"
3684   (interactive "P")
3685   (let* ((var  (tinylisp-read-word))
3686          (cmd  (cond
3687                 ((equal arg '(4))  'restore)
3688                 ((equal arg '(16)) 'bup))) ;Back it up
3689          val)
3690     (if (ti::nil-p var)
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)))
3697                                   (cond
3698                                    ((eq cmd 'restore)
3699                                     (set var (get var 'original))
3700                                     (message
3701                                      "TinyLisp:%s restored to original value" (symbol-name var)))
3702                                    (t
3703                                     (setq val
3704                                           (read-from-minibuffer
3705                                            (format "Set %s to lisp expression: " (symbol-name var))
3706                                            (prin1-to-string (symbol-value var))))
3707
3708                                     (setq val (read val)) ;Convert to lisp
3709                                     (set var val))))))))
3710
3711 ;;; ----------------------------------------------------------------------
3712 ;;;
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.
3717
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."
3723   (interactive "P")
3724   (let* ((str       (tinylisp-read-word))
3725          sym
3726          type)
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)
3732                (boundp sym))
3733           (if (y-or-n-p (format
3734                          "Which %s eval: Y = variable, N = function " str))
3735               (setq type 'var)
3736             (setq type 'func)))
3737       ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. . func type ..
3738       (cond
3739        ((or (eq type 'func)
3740             (and (eq type nil)
3741                  (fboundp sym)))
3742         (cond
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)))
3748           (ti::pmin))
3749          (t
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)))
3754           (cond
3755            ((or (ti::nil-p str)
3756                 (y-or-n-p
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  ..
3762        ((or (eq type 'var)
3763             (and (eq type nil)
3764                  (boundp sym)))
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.")
3769                                (sit-for 1))
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))
3778              (ti::pmax)
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
3782              ;; if needed later
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.
3790              (unless win
3791                (shrink-window-if-larger-than-buffer))))))))))
3792
3793 ;;; ----------------------------------------------------------------------
3794 ;;;
3795 (defun tinylisp-eval-at-point ()
3796   "Evaluate variable or function around point.
3797
3798 Note:
3799
3800   The definition must be written like this
3801
3802         (defvar , (defconst , (defun ..
3803
3804   And there must be no spaces after the opening parenthesis. The following
3805   statement is not recognised
3806
3807         (  defvar
3808
3809 defcustom note:
3810
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
3817   touched.
3818
3819   DANGER:
3820
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.
3825
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.
3830
3831   Call \\[tinylisp-emergency] NOW! After that things are back to normal.
3832   and you can continue as usual."
3833   (interactive)
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
3837      ;;  effect.
3838      (cond
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))
3844       (t
3845        (eval-last-sexp nil)))
3846      (message (concat "TinyLisp: evaled " (or str "<nothing>"))))))
3847
3848 ;;; ----------------------------------------------------------------------
3849 ;;;
3850 (defun tinylisp-eval-fix-defconst ()
3851   "Fix defconst that has no argument.
3852
3853     (defvar var)    ;; valid,
3854
3855 When converted
3856
3857     (defconst var)  ;; invalid
3858
3859 The defconst must have initial value: we supply 'nil"
3860   (ti::pmin)
3861   (while (re-search-forward "^(defconst[ \t]+[^ \t]+\\([ \t]\\)*)" nil t)
3862     (backward-char 1)
3863     (insert " nil")
3864     (end-of-line)))
3865
3866 ;;; ----------------------------------------------------------------------
3867 ;;;
3868 (defun tinylisp-eval-print-last-sexp  ()
3869   "Like `eval-print-last-sexp', but print --> at front."
3870   (interactive)
3871   (let ((standard-output (current-buffer)))
3872     (terpri)
3873     (eval-last-sexp t))
3874   (save-excursion
3875     (beginning-of-line)
3876     (insert "--> ")
3877     (end-of-line)))
3878
3879 ;;; ----------------------------------------------------------------------
3880 ;;;
3881 (defun tinylisp-eval-current-buffer-defconst ()
3882   "Eval buffer as defconst and print message."
3883   (interactive)
3884   (let* ((obuffer   (current-buffer))
3885          (name      (buffer-name))
3886          (beg       (point-min))        ;maybe narrowed?
3887          (end       (point-max)))
3888     (tinylisp-with-current-buffer
3889      (ti::temp-buffer tinylisp-:buffer-tmp 'clear)
3890      (insert-buffer-substring obuffer beg end)
3891      (ti::pmin)
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)))
3898
3899 ;;; ----------------------------------------------------------------------
3900 ;;;
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
3904 to `load-history'.
3905
3906 If current buffer has no file, call `tinylisp-eval-current-buffer'."
3907   (interactive)
3908   (cond
3909    ((null buffer-file-name)
3910     (tinylisp-eval-current-buffer))
3911    (t
3912     (if (and (buffer-modified-p)
3913              (y-or-n-p "Save before loading? "))
3914         (save-buffer))
3915     ;; `load' prints message for user
3916     (load buffer-file-name))))
3917
3918 ;;; ----------------------------------------------------------------------
3919 ;;;
3920 (defun tinylisp-eval-current-buffer ()
3921   "Eval buffer and print message."
3922   (interactive)
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)))
3928
3929 ;;; ----------------------------------------------------------------------
3930 ;;;
3931 (defun tinylisp-eval-reverse ()
3932   "Search backward for opening parenthesis and Reverse the statement.
3933 See variable `tinylisp-:table-reverse-eval-alist'"
3934   (interactive)
3935   (let* ((stat  (tinylisp-read-symbol-at-point))
3936          (table tinylisp-:table-reverse-eval-alist)
3937          func
3938          str1
3939          str2
3940          statement)
3941     (if (or (null stat)
3942             (ti::nil-p (setq func (nth 1 stat))))
3943         (message "TinyLisp: Can't find command around point.")
3944
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))
3951
3952                                   ;; Do some special handling, e.g. add hook may have
3953                                   ;; additional argument 'add , remove it.
3954
3955                                   (when (string-match "add-hook +[^ ]+ +[^ ]+\\( +[^ )]+\\))"
3956                                                       statement)
3957                                     (setq statement (ti::replace-match 1 "" statement)))
3958
3959                                   (tinylisp-eval str1 str2 'string statement)
3960                                   (message "TinyLisp: evaled as %s" str2))))))
3961
3962 ;;; ----------------------------------------------------------------------
3963 ;;;
3964 (defun tinylisp-eval-edit ()
3965   "Read current line and allow editing the statement before evaling it."
3966   (interactive)
3967   (let* ((line (ti::string-remove-whitespace (ti::read-current-line)))
3968          ret)
3969     (setq ret (eval (read (read-from-minibuffer "tinylisp-Eval: " line))))
3970     (message "TinyLisp: returned: %s" (prin1-to-string ret))))
3971
3972 ;;}}}
3973 ;;{{{ code help: functions and variables
3974
3975 ;;; ----------------------------------------------------------------------
3976 ;;;
3977 (defun tinylisp-find-function-list-occur ()
3978   "Run occur to find functions from whole buffer."
3979   (interactive)
3980   (ti::occur-macro tinylisp-:regexp-function nil
3981     (ti::text-re-search-forward "(defmacro")))
3982
3983 ;;; ----------------------------------------------------------------------
3984 ;;;
3985 (defun tinylisp-find-function-list (&optional no-show mode)
3986   "Find functions from buffer (macros too).
3987
3988 Output line format:
3989
3990   [DEF][!?]   FUNCTION-NAME  INTERACTIVE-SPEC
3991
3992   The DEF can defmacro, defun and defsubst.
3993
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.
3999
4000   [?]Question mark means that the function does not exist in obarray
4001   and the possible interactive property is unknown.
4002
4003 Input:
4004
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.
4008
4009 return:
4010
4011  '((type-string . name) ...)"
4012   (interactive)
4013   (let* ((re        tinylisp-:regexp-function)
4014          (buffer    tinylisp-:buffer-data)
4015          (loop      t)
4016          list
4017          type
4018          var
4019          str
4020          func)
4021     (while loop
4022       (setq loop nil)
4023       (save-excursion
4024         (ti::pmin)
4025         (while (re-search-forward re nil t)
4026           (setq type (match-string 1)
4027                 var  (match-string 2))
4028           (if (and type var)
4029               (ti::nconc list (cons type var))))
4030         (if (and (null list)
4031                  (eq mode 'alternative))
4032             (setq loop t                ;try again
4033                   ;;   remove anchor
4034                   re (substring re 1)))))
4035     (if (and list (null no-show))
4036         (tinylisp-with-current-buffer (ti::temp-buffer buffer 'clear)
4037                                       (dolist (var list)
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)))
4043                                             (if (fboundp func)
4044                                                 (setq str (commandp func))
4045                                               (setq func nil)))
4046                                         (insert (format "%-12s%s%s %-40s %s\n"
4047                                                         (car var)
4048                                                         ;;  Interactive and defsubst? this is dangerous!
4049                                                         ;;
4050                                                         (if (and str
4051                                                                  (string= "defsubst" (car var)))
4052                                                             " !" "")
4053                                                         (if (null func) " ?" "")
4054
4055                                                         (cdr var)
4056                                                         (or str ""))))
4057                                       (pop-to-buffer (current-buffer))
4058                                       (ti::pmin)
4059                                       (run-hooks 'tinylisp-:find-func-list-hook)))
4060     list))
4061
4062 ;;; ----------------------------------------------------------------------
4063 ;;;
4064 (defun tinylisp-find-variable-list-occur ()
4065   "Run occur to find variables from whole buffer."
4066   (interactive)
4067   (ti::occur-macro tinylisp-:regexp-variable nil
4068     (ti::text-re-search-forward "(defconst")))
4069
4070 ;;; ----------------------------------------------------------------------
4071 ;;;
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.
4076
4077 the appearing list will wave defvar's first, then defconst.
4078
4079 input:
4080   SHOW-TYPE     if non-nil, then show `user-variable-p' and
4081                 `defcustom' information too."
4082   (interactive "p")
4083   (let* ((re        tinylisp-:regexp-variable)
4084          (buffer    tinylisp-:buffer-variables)
4085          str
4086          sym
4087          type var
4088          vl                             ;def(v)ar   (l)ist
4089          cl                             ;def(c)onst (l)ist
4090          list)
4091     (save-excursion
4092       (ti::pmin)
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)
4105               cl (nreverse cl))
4106         (setq list (list vl cl))
4107         (dolist (elt list)              ;loop both lists
4108           (dolist (var elt)
4109             (setq type (car var)
4110                   sym  (cdr var)
4111                   str  ";; #symbol not found")
4112             (tinylisp-symbol-do-macro sym 'noerr
4113                                       (setq str "")
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))))
4123           (insert "\n")
4124           (ti::pmin)
4125           (run-hooks 'tinylisp-:find-var-list-hook))))
4126     buffer))
4127
4128 ;;; ----------------------------------------------------------------------
4129 ;;;
4130 (defun tinylisp-narrow-to-function ()
4131   "Narrow to current function around point."
4132   (interactive)
4133   (let* ((re   tinylisp-:regexp-function)
4134          beg
4135          end)
4136     (save-excursion
4137       (beginning-of-line)
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)
4142       (setq beg (point))
4143       (forward-sexp 1)
4144       (setq end (point)))
4145     (narrow-to-region beg end)))
4146
4147 ;;; ----------------------------------------------------------------------
4148 ;;;
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."
4153   (interactive
4154    (list
4155     (locate-library
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
4164     ;;  previously)
4165     (unless feature-name
4166       (load file))
4167     (with-current-buffer (ti::system-get-file-documentation file verb)
4168       (turn-on-tinylisp-mode))))
4169
4170 ;;; ----------------------------------------------------------------------
4171 ;;;
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:
4175
4176      [*]xxx.el NN /usr/local/Emacs/lisp tinylibm tinylib
4177       |        |  |                     |
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
4182
4183 If VERB parameter is nil, then the buffer is not shown and no
4184 messages are displayed.
4185
4186 Return:
4187
4188  buffer     `tinylisp-:buffer-data'"
4189   (interactive)
4190   (let* ((max       (length load-history ))
4191          (buffer    (ti::temp-buffer tinylisp-:buffer-library 'clear))
4192          (i         0)
4193          (unknown   "--unknown--")
4194          dep-list
4195          name
4196          path)
4197     (ti::verb)
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 ...
4204                                     ;;                      |
4205                                     ;;                      Get these
4206                                     (pop pkg)
4207                                     (while  (ti::consp (car pkg))
4208                                       (push (cdr (car pkg)) dep-list)
4209                                       (pop pkg))
4210                                     ;;  User has evaled the package 'in place' and not loaded it.
4211                                     (unless (stringp name)
4212                                       (setq name unknown))
4213                                     (insert
4214                                      (format
4215                                       "%-15s %3d %-35s %s %s\n"
4216                                       (concat
4217                                        (if (string-match "^/" (or name ""))
4218                                            "*"
4219                                          "")
4220                                        (file-name-nondirectory name))
4221                                       (length pkg)
4222                                       (if path
4223                                           (file-name-directory path)
4224                                         "<no path>")
4225                                       (mapconcat
4226                                        (function (lambda (x) (symbol-name x)))
4227                                        dep-list
4228                                        " ")
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
4232                                       ;;
4233                                       (if (not (string= name unknown))
4234                                           ""
4235                                         (format "%s ..." (ti::string-left (prin1-to-string pkg) 80)))))
4236                                     (if verb
4237                                         (message "TinyLisp: lib info %d/%d %s" i max name))
4238                                     (incf  i)
4239                                     (setq dep-list  nil
4240                                           pkg       nil)))
4241     (tinylisp-with-current-buffer buffer
4242                                   (ti::pmin)
4243                                   (sort-lines nil (point-min) (point-max)))
4244     (when verb
4245       (pop-to-buffer buffer)
4246       (ti::pmin)
4247       (message "Done."))
4248     buffer))
4249
4250 ;;; ----------------------------------------------------------------------
4251 ;;;
4252 (defun tinylisp-read-something ()
4253   "Position point to over some words near point."
4254   (save-excursion
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))))
4262
4263 ;;; ----------------------------------------------------------------------
4264 ;;;
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))
4268          (list  (cond
4269                  (cache
4270                   ;;  tinyPath caches all files for fast loading
4271                   ;;  Use it if available
4272                   (ti::funcall 'tinypath-emacs-lisp-file-list 'from-cache))
4273                  (t
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) "" )))
4278          file)
4279     (when (setq file
4280                 (completing-read
4281                  (format "%sLisp Library: "
4282                          (if cache
4283                              "(tinypath cache)"
4284                            "(load-history)"))
4285                  list
4286                  nil
4287                  nil
4288                  word))
4289       (when el
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")))))
4294     file))
4295
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.
4300 ;;;
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.
4304 ;;;
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.
4309
4310 Extensiosn are by default '(\".el\" \".elc\")."
4311   (let* ((compressions '("" ".gz" ".Z" ".z" ".bz2" ".zip"))
4312          try
4313          ret)
4314     (setq file (file-name-sans-extension
4315                 (file-name-nondirectory file)))
4316     (or extensions
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)
4327     (nreverse ret)))
4328
4329 ;;; ----------------------------------------------------------------------
4330 ;;;
4331 (defun tinylisp-library-locate-by-fullpath-intercative ()
4332   "Call `tinylisp-library-locate-by-fullpath' interactive with a check."
4333   (interactive)
4334   (cond
4335    ((not (featurep 'tinylisp))
4336     (message "Tinylisp: [ERROR] Fullpath locate requires tinypath.el."))
4337    (t
4338     (call-interactively
4339      'tinylisp-library-locate-by-fullpath))))
4340
4341 ;;; ----------------------------------------------------------------------
4342 ;;;
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"
4349            regexp)
4350   (dolist (path (tinypath-cache-match-fullpath regexp 'names))
4351     (message path))
4352   (message "Tinylisp: Locate by FULLPATH regexp '%s' -- end"
4353            regexp)
4354   (display-buffer (ti::buffer-pointer-of-messages)))
4355
4356 ;;; ----------------------------------------------------------------------
4357 ;;;
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)))
4363     (if (null list)
4364         (message "TinyLisp: no library found %s" file)
4365       (message "TinyLisp: %s" (ti::list-to-string list))
4366       (if insert
4367           (insert (ti::list-to-string list "\n"))))
4368     list))
4369
4370 ;;; ----------------------------------------------------------------------
4371 ;;;
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.
4375
4376 Return:
4377
4378   buffer  Content of Commentary: section"
4379   (interactive
4380    (list (tinylisp-library-read-name 'el) current-prefix-arg))
4381   (let* ((list (tinylisp-library-locate-library-1 file '(".el") ))
4382          str
4383          file
4384          buffer)
4385     (when list
4386       (when (interactive-p)
4387         (setq file (car list))
4388         (if (> (length list) 1)
4389             (setq file
4390                   (completing-read "TinyLisp: [Choose] "
4391                                    (ti::list-to-assoc-menu list)
4392                                    nil
4393                                    'match)))
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.
4398         ;;
4399         ;; Work around that bug.
4400         (let ((buffer (find-buffer-visiting file)))
4401           (setq str
4402                 (if (null buffer)
4403                     (lm-commentary file)
4404                   (with-temp-buffer
4405                     (insert-buffer buffer)
4406                     (lm-commentary)))))
4407         (if (not (stringp str))
4408             (message "TinyLisp: No commentary in %s" file)
4409           (with-temp-buffer
4410             (insert str)
4411             (ti::pmin) (ti::buffer-replace-regexp "^;+" 0 "")
4412             (ti::pmin) (ti::buffer-replace-regexp "\r" 0 "")
4413             (setq str (buffer-string)))
4414           (cond
4415            (insert
4416             (insert str)
4417             (setq buffer (current-buffer)))
4418            (t
4419             (setq buffer (ti::temp-buffer tinylisp-:buffer-library 'clear))
4420             (with-current-buffer tinylisp-:buffer-library
4421               (insert str)
4422               (ti::pmin) ;;#todo: how to display it at start?
4423               (display-buffer (current-buffer))))))))
4424     buffer))
4425
4426 ;;; ----------------------------------------------------------------------
4427 ;;;
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)))
4433     (if (not path)
4434         (message "TinyLisp: file %s not along `load-path'" file)
4435       (find-file path))))
4436
4437 ;;; ----------------------------------------------------------------------
4438 ;;;
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)))
4443     (if (not file)
4444         (message "TinyLisp: file %s not along `load-path'" file)
4445       (load-library file))))
4446
4447 ;;; ----------------------------------------------------------------------
4448 ;;;
4449 (defun tinylisp-load-history-grep (regexp)
4450   "Grep load history with REGEXP."
4451   (ti::list-find
4452    (mapcar 'car load-history)
4453    regexp
4454    (function
4455     (lambda (arg elt)
4456       (string-match arg (or elt ""))))
4457    'all-matches))
4458
4459 ;;; ----------------------------------------------------------------------
4460 ;;;
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."
4464   (interactive
4465    (list
4466     (read-from-minibuffer "Reload packages matching regexp: ")
4467     (y-or-n-p "Load uncompiled versions ")))
4468
4469   (let* ((count 0)
4470          list
4471          done)
4472     (ti::verb)
4473     (when (and verb
4474                (string-match "el$" regexp))
4475       (message "Tinylisp: Reload, regexp should not need to match .el$"))
4476     (setq list (tinylisp-load-history-grep regexp))
4477     (dolist (elt list)
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
4482       (cond
4483        (no-elc
4484         (setq elt (replace-regexp-in-string "\\.elc?$" "" elt))
4485         (setq elt (concat elt ".el")))
4486        (t
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.
4493         (push elt done)
4494         (cond
4495          ((or (and (ti::file-name-path-p elt)
4496                    (load elt 'noerr))
4497               (progn
4498                 (setq elt (file-name-nondirectory elt))
4499                 (load elt 'noerr)))
4500           (incf  count))
4501          (t
4502           (message "TinyLisp: Reload failed %s" elt)))))
4503     (when verb
4504       (message "TinyLisp: %s packages reloaded" count))
4505     list))
4506
4507 ;;; ----------------------------------------------------------------------
4508 ;;; See XEmacs ilisp.el :: describe-symbol-find-file
4509 ;;;
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))))
4514 ;;;
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.
4518
4519 displayed message format:
4520
4521    [m]{AD} symbol-xxx: package.el (~/elisp/mime/)
4522    [m]{AD} symbol-xxx: ~/elisp/xxx.el
4523
4524 Description:
4525
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/.
4529
4530   The second line: `load-history' contained full path for the package
4531
4532 Note:
4533
4534   Additional characters at the beginning: `m' function is macro.
4535
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].
4539
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)."
4544   (interactive)
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))
4549          (ad-info  "")
4550          package
4551          path
4552          msg)
4553     (if (null 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 "))
4558       (cond
4559        ((null (fboundp alias))
4560         (setq msg "not a function"))
4561        ((ti::subrp-p alias)
4562         (setq msg "<Built-in function>"))
4563        (autoload
4564          (let* ( ;; (autoload "dired-aux" "Copy all..")
4565                 (file (ti::string-match
4566                        " \"\\([^\"]+\\)" 1
4567                        (prin1-to-string (symbol-function autoload))))
4568                 (name (symbol-name autoload))
4569                 (path (locate-library file)))
4570            (setq msg
4571                  (format "[autoload] %s %s (%s)"
4572                          (if (not (eq autoload sym))
4573                              (concat "defalias->" name)
4574                            "")
4575                          (if path
4576                              (file-name-nondirectory path)
4577                            file)
4578                          (if 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))
4585             (setq msg
4586                   (format "%s (%s)"
4587                           (file-name-nondirectory path)
4588                           (file-name-directory path)))
4589           (setq msg "<no path found>")))
4590        ;; ...................................................... other ...
4591        (t
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)" "")
4599                ad-info
4600                (if (and alias
4601                         (not (eq alias sym)))
4602                    (format "[%s alias --> %s]"
4603                            (symbol-name sym)
4604                            (symbol-name alias))
4605                  (symbol-name sym))
4606                msg))))
4607
4608 ;;}}}
4609 ;;{{{ code help: misc
4610
4611 ;;; ----------------------------------------------------------------------
4612 ;;;
4613 (defun tinylisp-autoload-generate-library (library)
4614   "Read all defuns and construct autoloads from LIBRARY on `load-path'."
4615   (interactive
4616    (list (tinylisp-library-read-name)))
4617   (let* ((path (if (file-name-absolute-p library)
4618                    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
4622     (cond
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"))))
4627
4628     (ti::package-autoload-create-on-file
4629      path (get-buffer-create tinylisp-:buffer-autoload))))
4630
4631 ;;; ----------------------------------------------------------------------
4632 ;;;
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
4636 syntax is:
4637
4638    (autoload 'function \"file\" ..)
4639                         |
4640                         This is mandatory
4641
4642   ARG   Ask lisp library name and locate it in `load-path' and generate
4643         autoloads."
4644   (interactive "P")
4645   (cond
4646    (arg
4647     (tinylisp-autoload-generate-library
4648      (tinylisp-library-read-name)))
4649    ((buffer-file-name)
4650     (ti::package-autoload-create-on-file
4651      (buffer-file-name) (get-buffer-create tinylisp-:buffer-autoload)))
4652    (t
4653     (message "TinyLisp: Autoloads can only be generated from file."))))
4654
4655 ;;; ----------------------------------------------------------------------
4656 ;;;
4657 (defun tinylisp-autoload-generate-file
4658   (file &optional regexp no-desc buffer verb)
4659   "Generate autoload from FILE matching REGEXP.
4660 Input:
4661
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
4675     (or buffer
4676         (setq buffer (get-buffer-create tinylisp-:buffer-autoload)))
4677     (ti::verb)
4678     (dolist (file files)
4679       (ti::package-autoload-create-on-file
4680        file
4681        buffer
4682        (null verb)
4683        no-desc))
4684     buffer))
4685
4686 ;;; ----------------------------------------------------------------------
4687 ;;;
4688 (defun tinylisp-forward-def (&optional back verb)
4689   "Go to next `def' forrward or `BACK'. VERB."
4690   (interactive "P")
4691   (let* ((opoint (point))
4692          ret)
4693     (ti::verb)
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
4697     ;;
4698     ;;      (defun  ...
4699     ;;      (negative-indent
4700     ;;         ...other function code
4701     ;;         *point here
4702     ;;
4703     ;;  And the defu macro would go to `negative' indent position and not
4704     ;;  to the `defun'. That's why regexp text.
4705     (cond
4706      (back
4707       (beginning-of-defun)
4708       (cond
4709        ((looking-at "^(def")
4710         (setq ret (point)))
4711        ((re-search-backward "^(def" nil t)
4712         (setq ret (match-beginning 0)))))
4713      (t
4714       (end-of-defun)
4715       (if (re-search-forward "^(def" nil t)
4716           (setq ret (match-beginning 0)))))
4717     (if ret
4718         (goto-char ret)
4719       (goto-char opoint)
4720       (if verb "No more `def' matches"))
4721     ret))
4722
4723 ;;; ----------------------------------------------------------------------
4724 ;;;
4725 (defun tinylisp-indent-around-point (&optional verb )
4726   "Indent current statement around the point. typically a function.
4727 VERB."
4728   (interactive)
4729   (let* (msg
4730          beg
4731          end)
4732     (ti::verb)
4733     (and (save-excursion
4734            (and (setq beg (tinylisp-forward-def 'back))
4735                 (setq msg (ti::string-left (ti::read-current-line) 60)))
4736            beg)
4737          (save-excursion
4738            (goto-char beg) (end-of-defun)
4739            (setq end (point))))
4740
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)))))
4746
4747 ;;; ----------------------------------------------------------------------
4748 ;;;
4749 (defun tinylisp-defmacro-surround-word ()
4750   "Surround current word with (, )  defmacro statement."
4751   (interactive)
4752   (unless (ti::char-in-list-case (preceding-char) '(?\ ?\t ?\n))
4753     (backward-word 1))
4754   (insert "(, ")
4755   (forward-word 1)
4756   (insert ")"))
4757
4758 ;;; ----------------------------------------------------------------------
4759 ;;;
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 [*].
4764
4765   (macro-function-call arg1 * arg2 arg3)
4766
4767 references:
4768   `tinylisp-:buffer-macro'
4769   `tinylisp-:macroexpand-function-list'"
4770
4771   (interactive
4772    (list
4773     (intern-soft
4774      (completing-read
4775       "Expand with function: "
4776       (ti::list-to-assoc-menu tinylisp-:macroexpand-function-list)
4777       nil
4778       nil
4779       (car tinylisp-:macroexpand-function-list)))))
4780   (let* ((mac-re tinylisp-:regexp-macro-definition)
4781          (opoint (point))
4782          point
4783          symbol
4784          sym
4785          to-buffer)
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)))
4792      (cond
4793       ((and (stringp symbol)
4794             ;; These are macros
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)))
4799        (message
4800         "TinyLisp: grabbed %s, but it is not a macro's call statement"
4801         symbol))
4802       ((and (stringp symbol)
4803             sym
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)
4809        (ti::pmin)
4810        (emacs-lisp-mode)
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)
4816        (ti::pmin))
4817       ((and (stringp symbol)
4818             (fboundp sym))
4819        (message "TinyLisp: macroexpand, sexp was function: %s" symbol))
4820       (t
4821        (message "TinyLisp: macroexpand, skipped: %s"
4822                 (or str "<can't read>")))))))
4823
4824 ;;}}}
4825 ;;{{{ properties display
4826
4827 ;;; ----------------------------------------------------------------------
4828 ;;;
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."
4832   (let* ((list '(
4833                  ("lisp" . eldoc-mode)
4834                  ("."    . paren-message-offscreen)))
4835          sym
4836          re)
4837     (dolist (elt list)
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))))))
4843
4844 ;;; ----------------------------------------------------------------------
4845 ;;;
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)))))
4850
4851 ;;; ----------------------------------------------------------------------
4852 ;;;
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)))))
4859
4860 ;;; ----------------------------------------------------------------------
4861 ;;;
4862 (defun tinylisp-syntax-show-mode (&optional arg verb)
4863   "Constantly show character syntax info, ARG behaves like mode arg. VERB."
4864   (interactive "p")
4865   (ti::verb)
4866   (cond
4867    (tinylisp-:property-show-mode
4868     (error "Turn off property show mode first."))
4869    (t
4870     (ti::bool-toggle tinylisp-:syntax-show-mode arg)
4871     (cond
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))
4876      (t
4877       (remove-hook    'post-command-hook 'tinylisp-syntax-post-command)
4878       (tinylisp-post-command-config 'restore)))))
4879   (if verb
4880       (message
4881        "TinyLisp: syntax show mode is %s"
4882        (if tinylisp-:syntax-show-mode
4883            "on"
4884          "off"))))
4885
4886 ;;; ----------------------------------------------------------------------
4887 ;;;
4888 (defun tinylisp-property-info (&optional arg)
4889   "See `tinylisp-property-show' and ARG. Return string 'face-info ov-info'."
4890   (let ((count      0)
4891         (face-str   "")
4892         (ov-str     "")
4893         prefix-ok
4894         ovl)
4895     (if (member arg '(1 (16) (64)))
4896         (setq face-str
4897               (format
4898                "%s"
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)
4905           (setq prefix-ok t))
4906       (dolist (elt ovl)
4907         (incf  count)
4908         (setq ov-str
4909               (format
4910                "%sov%s%s "
4911                ov-str
4912                (if prefix-ok
4913                    (int-to-string count)
4914                  "")
4915                (prin1-to-string (ti::compat-overlay-properties elt))))))
4916     (concat face-str " " ov-str)))
4917
4918 ;;; ----------------------------------------------------------------------
4919 ;;;
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)))
4926            str)
4927       (setq str
4928             (format
4929              "%s:%s"
4930              (point)
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))))
4934
4935 ;;; ----------------------------------------------------------------------
4936 ;;;
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'.
4940
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.
4944
4945    [r]POINT:FACE-PROPERTIES[ovN:OVERLAY-PROPERTIES]
4946    12:(face highlight)ov1(face region)ov2(owner my)
4947
4948 Input ARG:
4949    nil                  toggle between 0 and '(16)
4950    0                    off
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'.
4956 VERB                    verbose flag"
4957   (interactive "P")
4958   (ti::verb)
4959   (if tinylisp-:syntax-show-mode
4960       (error "Please turn off Syntax show mode first.")
4961     (cond
4962      ((null arg)
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)))
4968     (cond
4969      (tinylisp-:property-show-mode
4970       (tinylisp-post-command-config)
4971       (when verb
4972         (message
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))
4977      (t
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"))))))
4981
4982 ;;}}}
4983 ;;{{{ Snooping
4984
4985 ;;; ----------------------------------------------------------------------
4986 ;;;
4987 (defun tinylisp-snoop-variables-i-args ()
4988   "Ask arguments to `tinylisp-snoop-variables'."
4989   (list
4990    current-prefix-arg
4991    (nth
4992     1
4993     (assoc
4994      (completing-read
4995       "Name of variable snoop list: "
4996       (ti::list-to-assoc-menu
4997        (mapcar 'car tinylisp-:table-snoop-variables))
4998       nil
4999       'match-it)
5000      tinylisp-:table-snoop-variables))))
5001
5002 ;;; ----------------------------------------------------------------------
5003 ;;;
5004 (defun tinylisp-find-buffer-local-variables (&optional buffer)
5005   "Print buffer local variables to BUFFER."
5006   (interactive)
5007   (flet ((my-sort2
5008           (list)
5009           (sort list
5010                 (function
5011                  (lambda (a b)
5012                    (string< (symbol-name (car a))
5013                             (symbol-name (car b)))))))
5014          (my-sort1
5015           (list)
5016           (sort list
5017                 (function
5018                  (lambda (a b)
5019                    (string< (symbol-name a)
5020                             (symbol-name b)))))))
5021     (let* (var
5022            val)
5023       (or buffer
5024           (setq buffer (current-buffer)))
5025       (pop-to-buffer (get-buffer-create tinylisp-:buffer-variables))
5026       (ti::pmax)
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"
5034                           (symbol-name var)
5035                           (pp (cdr elt))))))
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))
5040                         (pp (cdr 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
5046                             coding-system-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
5051                               "\n"
5052                             "")
5053                           (symbol-name elt)
5054                           (pp val))))))))
5055
5056 ;;; ----------------------------------------------------------------------
5057 ;;;
5058 (defun tinylisp-find-autoload-functions (&optional buffer)
5059   "Display all autoload functions."
5060   (interactive)
5061   (let* ((list (ti::system-autoload-function-list))
5062          doc)
5063     (if (null list)
5064         (message "TinyLisp: No autoload functions found in Emacs.")
5065       (or buffer
5066           (setq buffer
5067                 (get-buffer-create tinylisp-:buffer-autoload)))
5068       (pop-to-buffer buffer)
5069       (erase-buffer)
5070       (insert "\n[TinyLisp] Autoload functions currently in Emacs:\n\n")
5071       (dolist (func list)
5072         (setq doc (documentation func))
5073         (cond
5074          ((eq doc nil)
5075           (setq doc "<no documentation>"))
5076          ((ti::nil-p doc)
5077           (setq doc "<empty documentation string>")))
5078         (insert (format "%s: %s\n%s\n\n"
5079                         (symbol-name func)
5080                         (or (ti::function-autoload-file func)
5081                             "<autoload file unknown>")
5082                         doc))))))
5083
5084 ;;; ----------------------------------------------------------------------
5085 ;;;
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)
5091    (ti::pmax))
5092   (pop-to-buffer (ti::system-match-in-hooks regexp tinylisp-:buffer-data))
5093   (sort-lines nil (point-min) (point-max)))
5094
5095 ;;; ----------------------------------------------------------------------
5096 ;;;
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)
5101   (ti::pmax)
5102   (insert "\n")
5103   (mapatoms
5104    (function
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)))))))
5112
5113 ;;; ----------------------------------------------------------------------
5114 ;;;
5115 (defun tinylisp-snoop-variables (&optional arg list)
5116   "Display contents of hooks. See `tinylisp-:table-snoop-variables'.
5117
5118 ARG can be
5119    1           With prefix arg, variables values are recorded to
5120                to buffer `tinylisp-:buffer-record' and
5121
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
5126
5127    C -u        allows editing the variables.
5128
5129 LIST           list of variables.
5130
5131 Flags when viewing, editing echo-area:
5132
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)))
5137          (read      (eq arg nil))
5138          (record    (eq arg 1))
5139          (save      (eq arg 0))
5140          (restore   (eq arg 9))
5141          (kill      (eq arg 8))
5142          (reset     (eq arg 5))
5143          (msg       (format
5144                      "(%s) %s"
5145                      (length list)
5146                      (mapconcat 'symbol-name list " ")))
5147          (prop      'tinylisp-original)
5148          str
5149          val
5150          ok)
5151     (dolist (elt list)
5152       (setq ok  (boundp elt))
5153       (cond
5154        ((or read write record)
5155         (if ok
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
5162                    (format "%s%s%s: "
5163                            (if write "+w " "")
5164                            (if (get elt prop)
5165                                "! "
5166                              "")
5167                            (symbol-name elt))
5168                    val))
5169         (if write                       ;replace content?
5170             (set elt (read str))))
5171        (save
5172         (put elt prop (symbol-value elt)))
5173        (kill
5174         (remprop elt prop))
5175        (restore
5176         (set elt (get elt prop)))
5177        (reset
5178         (set elt nil))
5179        (t
5180         (message "TinyLisp: Unknown arg %s" (prin1-to-string arg)))))
5181     (cond
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)))))
5186
5187 ;;}}}
5188 ;;{{{ Occur
5189
5190 ;;; ----------------------------------------------------------------------
5191 ;;;
5192 (defun tinylisp-occur-i-args ()
5193   "Ask arg1 to `tinylisp-occur'."
5194   (read-from-minibuffer
5195    "TinyLisp occur: "
5196    (nth 1 (tinylisp-read-symbol-at-point))
5197    nil
5198    nil
5199    'tinylisp-:occur-history))
5200
5201 ;;; ----------------------------------------------------------------------
5202 ;;;
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)
5210       (ti::pmin)
5211       (unless arg
5212         ;;  Remove comments.
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))
5217                                 (point-max)))))))
5218     ;;  Keep cursor in original buffer
5219     (pop-to-buffer obuffer)))
5220
5221 ;;; ----------------------------------------------------------------------
5222 ;;;
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)))
5229
5230 ;;; ----------------------------------------------------------------------
5231 ;;;
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."
5235   (interactive "P")
5236   (let* ((buffer (get-buffer tinylisp-:occur-buffer-name))
5237          line
5238          file
5239          str
5240          go-buffer)
5241     (if (null buffer)
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))
5250                                       (if back
5251                                           (forward-line -1)
5252                                         (forward-line 1)))
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.* \\(.*\\).$"
5261                                                                            1 nil 'matched)))
5262                                           (message
5263                                            "TinyLisp: Can't find file name from occur buffer."))))
5264       (if (and file
5265                (null (setq go-buffer (get-buffer file))))
5266           (message "TinyLisp: buffer not exist %s" file)
5267         (pop-to-buffer go-buffer)
5268         (goto-line line)
5269         (message str)))))
5270
5271 ;;}}}
5272 ;;{{{ debugger: std Emacs
5273
5274 ;;; ----------------------------------------------------------------------
5275 ;;;
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))
5280
5281 ;;; ----------------------------------------------------------------------
5282 ;;;
5283 (defun tinylisp-debugger-record-value (exp)
5284   "Read EXP and record it's value to `tinylisp-:buffer-record' buffer."
5285   (interactive
5286    (list (read-from-minibuffer
5287           "Eval: "
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.
5294     (save-excursion
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))
5300       (terpri))
5301     (tinylisp-with-current-buffer buffer
5302                                   (save-excursion
5303                                     (backward-line 1)
5304                                     (message (ti::read-current-line))))))
5305
5306 ;;}}}
5307 ;;{{{ Additional support functions
5308
5309 ;;; ----------------------------------------------------------------------
5310 ;;;
5311 (defun tinylisp-emergency (&optional verb)
5312   "Restore any dangerously advised functions.
5313 See `tinylisp-eval-at-point'. VERB."
5314   (interactive)
5315   (ti::verb)
5316   (ad-disable-advice 'defconst 'around 'tinylisp)
5317   (ad-activate 'defconst)
5318   (if verb
5319       (message
5320        "TinyLisp: Function states restored; you can continue as usual.")))
5321
5322 ;;; ----------------------------------------------------------------------
5323 ;;;
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)))
5329
5330 ;;; ----------------------------------------------------------------------
5331 ;;;
5332 (defun tinylisp-elint-buffer ()
5333   "Elint the buffer."
5334   (interactive)
5335   (tinylisp-elint-init)
5336   (tinylisp-safety-belt 'elint-current-buffer "See elint.el"))
5337
5338 ;;; ----------------------------------------------------------------------
5339 ;;;
5340 (defun tinylisp-elint-defun ()
5341   "Elint the buffer."
5342   (interactive)
5343   (tinylisp-elint-init)
5344   (tinylisp-safety-belt 'elint-defun "See elint.el"))
5345
5346 ;;; ----------------------------------------------------------------------
5347 ;;;
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
5352    (when sym
5353      (cond
5354       ((ad-get-arg 0)
5355        (message "TinyLisp: instrumented and cached %s (Edebug advice)" name)
5356        (pushnew
5357         (list
5358          sym
5359          (current-buffer)
5360          (buffer-file-name))
5361         tinylisp-:edebug-instrument-table
5362         :test 'equal))
5363       (t
5364        (tinylisp-edebug-table-remove-entry sym)))))
5365   ;; activate again
5366   (ti::advice-control 'eval-defun "^tinylisp"))
5367
5368 ;;; ----------------------------------------------------------------------
5369 ;;;
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'"
5373   (save-excursion
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))))))
5378
5379 ;;; ----------------------------------------------------------------------
5380 ;;;
5381 (defun tinylisp-edebug-table-remove-entry (function)
5382   "Remove FUNCTION from `tinylisp-:edebug-instrument-table'."
5383   (interactive)
5384   (let* ((elt (assq function tinylisp-:edebug-instrument-table)))
5385     (setq tinylisp-:edebug-instrument-table
5386           (delete elt tinylisp-:edebug-instrument-table))))
5387
5388 ;;; ----------------------------------------------------------------------
5389 ;;;
5390 (defun tinylisp-edebug-uninstrument-buffer ()
5391   "This is same as `eval-buffer', which cancels all edebug information."
5392   (tinylisp-eval-current-buffer))
5393
5394 ;;; ----------------------------------------------------------------------
5395 ;;;
5396 (defun tinylisp-edebug-instrument-buffer ()
5397   "Read whole buffer and instrument every found left flushed `defun'."
5398   (interactive)
5399   (let* (edebug-all-defs)
5400     (save-excursion
5401       (ti::pmin)
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)))))
5406
5407 ;;; ----------------------------------------------------------------------
5408 ;;;
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
5412
5413   FUNCTION-NAME  BUFFER-OF-EVAL  LIVE-BUFFER FILE-NAME-FOR-BUFFER"
5414   (interactive)
5415   (let* ((buffer (ti::temp-buffer tinylisp-:buffer-record))
5416          function
5417          name
5418          live-buffer
5419          live-name
5420          file)
5421     (display-buffer buffer)
5422     (tinylisp-with-current-buffer buffer
5423                                   (ti::pmax)
5424                                   (dolist (elt tinylisp-:edebug-instrument-table)
5425                                     (setq function    (nth 0 elt)
5426                                           name        (symbol-name function)
5427                                           buffer      (nth 1 elt)
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)
5431                                           file        (nth 2 elt))
5432                                     (insert (format "\n%-20s %-15s %-15s %s"
5433                                                     name buffer live-name file))))))
5434
5435 ;;; ----------------------------------------------------------------------
5436 ;;;
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.
5443
5444 This function looks up `tinylisp-:edebug-instrument-table' and with raw
5445 force reloads every package again thus wiping out Edebug instrumentation."
5446   (interactive)
5447   (let* (file-list
5448          buffer-list
5449          function
5450          name
5451          buffer
5452          live-buffer
5453          live-name
5454          file
5455          key
5456          tmp)
5457     (dolist (elt tinylisp-:edebug-instrument-table)
5458       (setq function    (nth 0 elt)
5459             name        (symbol-name function)
5460             buffer      (nth 1 elt)
5461             live-buffer (if (buffer-live-p buffer) (get-buffer buffer))
5462             live-name   (if live-buffer            (buffer-name live-buffer))
5463             file        (nth 2 elt)
5464             key         (or live-buffer file))
5465       (cond
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"
5469                  name
5470                  (or file
5471                      live-name
5472                      "")))
5473        (live-buffer
5474         (with-current-buffer live-buffer
5475           (tinylisp-eval-current-buffer))
5476         (message "TinyLisp: (edebug) wiped %s by re-evaluating buffer %s"
5477                  name live-name)
5478         (push buffer buffer-list))
5479        ((stringp file)
5480         (load-file file)
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)))
5485
5486 ;;; ----------------------------------------------------------------------
5487 ;;;
5488 (defun tinylisp-edebug-uninstrument  (&optional verb)
5489   "Uninstrument function whose _name_ is at current point. VERB.
5490 See `tinylisp-edebug-instrument'."
5491   (interactive)
5492   (tinylisp-edebug-instrument 'restore (ti::verb)))
5493
5494 ;;; ----------------------------------------------------------------------
5495 ;;;
5496 (defun tinylisp-edebug-instrument  (&optional uninstrument verb)
5497   "Instrument or UNINSTRUMENT function _name_ at current point. VERB.
5498
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.
5503
5504 If there is no function call at point, behave like standard
5505 `edebug-eval-defun' accessed via \\[edebug-eval-defun].
5506
5507 Example
5508
5509     ;; If point is over the word 'my-function2', that function is
5510     ;; instrumented
5511
5512     (defun my-function ()
5513       (interactive)
5514       (let ((buffer (buffer-name))
5515             (case-fold-search t))
5516          ;;   -!-
5517          (my-function2 buffer)
5518           ....
5519
5520 References:
5521
5522   `tinylisp-:edebug-instrument-table'"
5523   (interactive "P")
5524   (ti::verb)
5525   (save-excursion
5526     (save-window-excursion
5527       (cond
5528        ((ignore-errors
5529           (tinylisp-jump-to-definition
5530            nil
5531            (tinylisp-read-word)
5532            (not 'verb)
5533            (not 'nodisplay))
5534           (if uninstrument
5535               (eval-defun nil)
5536             (edebug-eval-defun 'instrument))
5537           t))
5538        (t
5539         ;;  No function at point.
5540         (edebug-eval-defun 'debug))))))
5541
5542 ;;; ----------------------------------------------------------------------
5543 ;;;
5544 (defun tinylisp-checkdoc ()
5545   "Interactively check document from current point forward.
5546 See `checkdoc-interactive'."
5547   (interactive)
5548   (tinylisp-safety-belt 'checkdoc-interactive "See checkdoc.el" (point)))
5549
5550 ;;; ----------------------------------------------------------------------
5551 ;;;
5552 (defun tinylisp-checkdoc-notes (&optional start)
5553   "Take notes from current point forward or START from beginning of buffer."
5554   (interactive "P")
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)
5562     (save-excursion
5563       (if start
5564           (ti::pmin))
5565       (with-current-buffer (get-buffer-create buffer)
5566         (ti::pmax)
5567         (insert (format "\n\nCheckdoc: %s *** Style check %s"
5568                         (symbol-value 'checkdoc-version)
5569                         (ti::date-standard-date 'minutes))))
5570       (tinylisp-safety-belt
5571        'checkdoc-continue
5572        "See checkdoc.el"
5573        'take-notes))
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))
5581             point)
5582         (with-current-buffer buffer
5583           ;; Go to start of the message
5584           (ti::pmax)
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.")))
5589
5590 ;;; ----------------------------------------------------------------------
5591 ;;;
5592 (defun tinylisp-checkdoc-comment-notes ()
5593   "See `checkdoc'."
5594   (interactive)
5595   (tinylisp-safety-belt 'checkdoc-comments "See checkdoc.el" t))
5596
5597 ;;; ----------------------------------------------------------------------
5598 ;;;
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:
5605
5606     ;; XXX.el -- proper first line
5607
5608     ;; Author
5609     ;; Maintainer
5610     ;; Created:
5611     ;; Keywords:
5612
5613     ;;; Commentary:
5614     ;;; Change Log:
5615     ;;; Code:
5616
5617     ;;; XXX.el ends here
5618
5619 See unix what(1) and GNU RCS indent(1) why you should adopt a style where
5620 you use @(#) and $Keywords$."
5621   (interactive)
5622   (require 'lisp-mnt)
5623   (if (not (string= (symbol-value 'lm-history-header)
5624                     "Change Log\\|History"))
5625       (message "\
5626 TinyLisp: your lisp-mnt.el is too old to have improved checking. Get newer.")
5627     (call-interactively 'lm-verify)))
5628
5629 ;;}}}
5630 ;;{{{ lisp-mnt.el
5631
5632 ;;#todo: Sent patch to FSF to include these in lisp-mnt.el
5633
5634 ;;; ----------------------------------------------------------------------
5635 ;;;
5636 (defun tinylisp-lisp-mnt-tag-check-and-fix (tag &optional on-error)
5637   "Correct misplaced lisp-mnt.el tag. Stop ON-ERROR.
5638 Return:
5639  'missing
5640  'fixed
5641  nil         Means ok."
5642   (ti::pmin)
5643   (let* ((regexp (concat "^;+[ \t]*" tag ":[ \t]*$"))
5644          (reference (format ";;; %s:" tag))
5645          status
5646          case-fold-search)
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))
5652       (forward-line -1)
5653       (if (looking-at "^[ \t]*$")
5654           (forward-line 1)
5655         (forward-line 1)
5656         (insert "\n")
5657         (setq status 'fixed))
5658       (forward-line 1)
5659       (unless (looking-at "^[ \t]*$")
5660         (insert "\n")
5661         (setq status 'fixed)))
5662     (when (and on-error
5663                (eq status 'missing))
5664       (pop-to-buffer (current-buffer))
5665       (error "Lisp-mnt: missing tags `;;; %s:'" tag))
5666     status))
5667
5668 ;;; ----------------------------------------------------------------------
5669 ;;;
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))."
5673   (interactive "P")
5674   (let* (missing
5675          fixed
5676          stat)
5677     (if (and (featurep 'folding)
5678              folding-mode)
5679         (folding-open-buffer))
5680     (dolist (tag '("Commentary" "Change Log" "Code"))
5681       (setq stat (tinylisp-lisp-mnt-tag-check-and-fix tag on-error))
5682       (cond
5683        ((eq stat 'missing)
5684         (push tag missing))
5685        ((eq stat 'fixed)
5686         (push tag fixed))))
5687     (if (or missing fixed)
5688         (list missing fixed))))
5689
5690 ;;; ----------------------------------------------------------------------
5691 ;;;
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)))
5697          find-file-hooks)
5698     (unless buffer
5699       (setq buffer (find-file-noselect file)))
5700     (with-current-buffer buffer
5701       (tinylisp-lisp-mnt-tag-check-and-fix-buffer on-error))))
5702
5703 ;;; ----------------------------------------------------------------------
5704 ;;;
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.
5707 Return.
5708  '((file ((missing-tags) (fixed-tags))) ..)."
5709   (interactive "DDir: \nP")
5710   (let* (stat
5711          list)
5712     (dolist (file (directory-files dir 'abs "\\.el$"))
5713       (setq stat (tinylisp-lisp-mnt-tag-check-and-fix-file file on-error))
5714       (if stat
5715           (push (list file stat) list)))
5716     list))
5717
5718 ;; (tinylisp-lisp-mnt-tag-check-and-fix-dir "~/elisp/tiny/lisp" 'err)
5719
5720 ;;}}}
5721
5722 (provide   'tinylisp)
5723
5724 ;;  These must be set, otherwise the mode setup will not activate
5725 ;;  correctly when user calls M-x tinylisp-mode.
5726
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)
5731
5732 (tinylisp-install-menu)
5733 (run-hooks 'tinylisp-:load-hook)
5734
5735 ;;; tinylisp.el ends here