]> git.donarmstrong.com Git - lib.git/blob - emacs_el/tiny-tools/tiny/tinypath.el
add tiny-tools
[lib.git] / emacs_el / tiny-tools / tiny / tinypath.el
1 ;;; tinypath.el --- Manage Emacs startup dynamically
2
3 ;; This file is not part of Emacs
4
5 ;;{{{ Id
6
7 ;; Copyright (C)    1999-2007 Jari Aalto
8 ;; Keywords:        extensions
9 ;; Author:          Jari Aalto
10 ;; Maintainer:      Jari Aalto
11 ;;
12 ;; To get information on this program, call M-x tinypath-version.
13 ;; Look at the code with folding.el.
14
15 ;; COPYRIGHT NOTICE
16 ;;
17 ;; This program is free software; you can redistribute it and/or modify it
18 ;; under the terms of the GNU General Public License as published by the Free
19 ;; Software Foundation; either version 2 of the License, or (at your option)
20 ;; any later version.
21 ;;
22 ;; This program is distributed in the hope that it will be useful, but
23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
24 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
25 ;; for more details.
26 ;;
27 ;; You should have received a copy of the GNU General Public License
28 ;; along with program; see the file COPYING. If not, write to the
29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
30 ;; Boston, MA 02110-1301, USA.
31 ;;
32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
33
34 ;;}}}
35 ;;{{{ Install
36
37 ;; ....................................................... &t-install ...
38 ;;
39 ;;  The very fast start
40 ;;
41 ;;      If you want to do the reading later, follow these steps. No
42 ;;      guarantees that this will work. If it did't, have a coffee near you
43 ;;      and read the whole documentation.
44 ;;
45 ;;      o   Include perl script *emacs-util.pl* in your `PATH'. If you
46 ;;          do not have perl, get it for Unix at http://www.perl.com/ or
47 ;;          install http://www.cygwin.com/ to your Win32 operating system.
48 ;;      o   If you use XEmacs, see `tinypath-:core-emacs-load-path-list'
49 ;;      o   Make sure all your personal Emacs Lisp files are under any of these
50 ;;          directories: $HOME/elisp, `~/.emacs.d' (newer Emacs), ~/.xemacs.
51 ;;      o   Create directory `$HOME/elisp/config' where cache will be saved.
52 ;;      o   Include these lines at the top of startup file: `$HOME/.emacs'
53 ;;
54 ;;          ;; $HOME/.emacs
55 ;;          (require 'cl)
56 ;;
57 ;;          ;;  PLEASE COPY VERBATIM. THERE ARE OPTIMIZATIONS
58 ;;          ;;  THAT ACTIVATE IF YOU use absolute path
59 ;;          (pushnew "~/elisp/tiny-tools-NNNN.NNNN/lisp/tiny"
60 ;;                   load-path :test 'string=)
61 ;;
62 ;;          ;; - If you use new XEmacs, that may ship the lisp
63 ;;          ;;   files in separate kit, tell where the directories are
64 ;;          ;;   => Was used in Win32 native XEmacs 2003.
65 ;;          ;; - See http://www.xemacs.org/Develop/cvsaccess.html
66 ;;          ;;   for cvs access and easy update (2003-05-20).
67 ;;
68 ;;          (when (featurep 'xemacs)
69 ;;            (setq  tinypath-:core-emacs-load-path-list
70 ;;                 '("/usr/local/share/xemacs/xemacs-packages"
71 ;;                   "/usr/local/share/xemacs/site-packages"
72 ;;                   "/usr/local/share/xemacs/mule-packages")))
73 ;;
74 ;;          (load "tinypath.el")
75 ;;
76 ;;          ;; <the rest of your Emacs setup below this>
77 ;;
78 ;;          ;; End $HOME/.emacs
79 ;;
80 ;;      o   After Emacs has been started, call `M-x'
81 ;;          `tinypath-cache-problem-report'. In the generated buffer see
82 ;;          `C-h' 'm' mode help for available commands.
83 ;;
84 ;;  First user note
85 ;;
86 ;;      You may see message "TinyPath: EXT Process running ...
87 ;;      [may take a while]" and Emacs hangs for a while when you use this
88 ;;      package for the first time. Please wait and read the documentation
89 ;;      about "Faster Emacs configuration" later in this file.
90 ;;
91 ;;      ********************************************************************
92 ;;      It is preferred that you use the EXT method, because the TRAD(itional)
93 ;;      lisp method has a drawback. It does not support rearranging
94 ;;      paths to order: 1) $HOME 2) site-lisp-files 3) core-emacs-lisp-files
95 ;;      ********************************************************************
96 ;;
97 ;;      The perl method guarantees, that anything you put into your
98 ;;      private ~/elisp will override and precede any other package
99 ;;      found elswhere in `load-path' hierarchy.
100 ;;
101 ;;      At any time you can read the manual with `M-x' `tinypath-version'
102 ;;
103 ;;  Cache file location
104 ;;
105 ;;      Create a directory where the cache information is saved. The location
106 ;;      can be set by changing `tinypath-:cache-file-prefix' which should be
107 ;;      pathname + file-prefix. The cache size depends on your
108 ;;      installed files, with 600 directories and 8000 lisp files, the
109 ;;      cache size is around 500k and if you use compression, it takes
110 ;;      somewhere 200k.
111 ;;
112 ;;          mkdir -p ~/elisp/config     (in new Emacs: ~/.emacs.d/config)
113 ;;
114 ;;  Transparent compression
115 ;;
116 ;;      If space is tight, this package supports transparent
117 ;;      compression. The files can be kept in compressed format
118 ;;      without touching code in startup files. Calls like below are
119 ;;      interpreted as if there were a `.el.gz' or `.el.bz2'
120 ;;      extensions attached to the files. See
121 ;;      `tinypath-:compressed-file-extensions' for more.
122 ;;
123 ;;          (load "some-file")
124 ;;          (require 'somefile)
125 ;;
126 ;;      This transparent support however comes with a prolonged search
127 ;;      time, because more attempts must be made in order to find the file.
128 ;;      If all the files are in non-compressed format and you do not plan
129 ;;      to use the compression support, a much better performancs can be
130 ;;      achieved by turning the support off (it's the default). To turn it
131 ;;      on, use:
132 ;;
133 ;;          (setq tinypath-:compression-support 'default)
134 ;;
135 ;;  Contact and support
136 ;;
137 ;;      Call `tinypath-debug-test-run' if you think there is something
138 ;;      odd going on. All the messages will appear in *Messages*
139 ;;      buffer (Emacs); under XEmacs, examine " *Message-Log*"
140 ;;      buffer. If you have any questions, contact maintainer and
141 ;;      don't forget to send contents of the *Messages* buffer.
142 ;;
143 ;;      ********************************************************************
144 ;;
145 ;;      IT IS HIGHLY RECOMMENDED THAT YOU VALIDATE YOUR SETUP
146 ;;      AFTER YOU HAVE LOADED THIS PACKAGE
147 ;;
148 ;;      Start Emacs and call report function to investigate any problems,
149 ;;      like duplicate packages that shadow each other. See documentation
150 ;;      below for more. The general rule is that you should delete
151 ;;      any offending packages (use `C-d' to delete file in the buffer
152 ;;      that displays the problem report)
153 ;;
154 ;;          C-u M-x tinypath-cache-problem-report   (or without C-u argument)
155 ;;
156 ;;      *******************************************************************
157
158 ;;}}}
159 ;;{{{ Documentation
160
161 ;; ..................................................... &t-commentary ...
162
163 ;;; Commentary:
164 ;;
165 ;;  Preface Feb 1999 - How it all begun
166 ;;
167 ;;      When you have set up your Emacs installation to your liking, a day
168 ;;      comes when you decide that it's time to seriously reconsider the
169 ;;      directory structure of your installed lisp packages. At start, it
170 ;;      is customary to use simple file hierarchy where all private
171 ;;      packages are installed under:
172 ;;
173 ;;          ~/elisp    (in new Emacs: ~/.emacs.d)
174 ;;
175 ;;      Complete kits are usually installed directly under the root:
176 ;;
177 ;;          ~/elisp/packages/bbdb-2.00.06/
178 ;;          ~/elisp/packages/psgml-1.0.3/
179 ;;          ~/elisp/packages/pcl-cvs-2.9.2/
180 ;;
181 ;;      A more sophisticated way is to use symlinks to the latest
182 ;;      versions, so that you don't have to change `load-path' every
183 ;;      time you install a new version. It is only matter of updating
184 ;;      the symlink:
185 ;;
186 ;;          ~/elisp/packages/pcl-cvs/  --> ~/elisp/packages/pcl-cvs-2.9.2/
187 ;;          |
188 ;;          This path is in the `load-path'
189 ;;
190 ;;      In network, where Windows is coupled with Unix workstations via SAMBA,
191 ;;      you may have mapped the _H:_ disk to you Unix _$HOME_:
192 ;;
193 ;;          H:  --> Unix $HOME  \\SERVER\DIRECTORY\YOUR-LOGIN-DIR
194 ;;
195 ;;      Now, there is a catch when Unix symlinks are used in `$HOME/elisp'
196 ;;      and the directories are accessed from Windows. Having set PC's
197 ;;      HOME environment variable to point to H:, Emacs can start reading
198 ;;      Unix `$HOME/.emacs' startup file, but there appeared messages
199 ;;      like "Can't load library xxx", which was soon followed by
200 ;;      bigger concerns: "autoloading xxx failed". The problem was the
201 ;;      mounted H: disk. You see, PC's network mount can't distinguish
202 ;;      symlinked directories from real directories, so all symlinked Unix
203 ;;      directories in `load-path' were dead. And that's why most of the
204 ;;      files couldn't be found any more.
205 ;;
206 ;;     The conclusions
207 ;;
208 ;;      For cross platform solution it is best not to rely on symlinks,
209 ;;      because they don't work well over a Windows mount. Secondly,
210 ;;      updating `load-path' should not be needed by hand after a new
211 ;;      package installation, after a directory name change, after
212 ;;      directory structure change, etc. A dream package would solve this
213 ;;      all and do the hard work: "There, that is the root(s) of all Emacs
214 ;;      lisp, go and search all the directories and update `load-path'"
215 ;;
216 ;;      That was what this package originally was all about. Nowadays
217 ;;      it does a little more than that. The `load-path' is updated
218 ;;      automatically without any manual work. Only the start ROOT
219 ;;      path(s) of installed lisp hierarchies need to be known. This
220 ;;      package is highly effective: scanning thousands of files in a
221 ;;      matter of seconds and once the cache has been created, it
222 ;;      takes only a snap to load it in next sessions. All `require'
223 ;;      and `load' commands also execute faster than previously,
224 ;;      because the information about existing files is immediately
225 ;;      available. The speedup is helped through advised functions.
226 ;;
227 ;;  Overview of features
228 ;;
229 ;;     Automatic load-path configuration
230 ;;
231 ;;      o   Define list of `root' directories of your Emacs lisp and this
232 ;;          package will recursively add directories which contain .el or
233 ;;          .elc files to `load-path'
234 ;;      o   A cache is utilized to remember previous scan and
235 ;;          expired periodically. Using cache speeds up loading files
236 ;;          considerably if you have many directories. The number of lisp
237 ;;          directories doesn't affect the load performance.
238 ;;          This is accomplished by using extra advice code in functions:
239 ;;          `load', `load-library', `require', `locate-library' and
240 ;;          `autoload'.
241 ;;      o   When Emacs becomes idle (some 15 minutes of idle time) the
242 ;;          cache and `load-path' is validated for erroneous entries and
243 ;;          rebuilt as needed. This feature should auto-detect changes in
244 ;;          directory structure and help semi auto-installing
245 ;;          new directories (packages) for you.
246 ;;      o   The `load-path' is optimized so, that users' files automatically
247 ;;          take precedence first (~/elisp), next any other files found,
248 ;;          and last the core Emacs files in the distribution.
249 ;;
250 ;;     Automatic Info-default-directory-list configuration
251 ;;
252 ;;      o   If you download packages that include Emacs info files,
253 ;;          the `Info-default-directory-list' is updated at the same time
254 ;;          as the `load-path', when root directories are examined.
255 ;;      o   No more manual updating of info files. The missing
256 ;;          `dir' entry is created or updated as needed.
257 ;;      o   You can update all _new_ info files in your system by calling
258 ;;          M-x `tinypath-info-scan-Info-default-directory-list'
259 ;;
260 ;;      If new info filesare added by hand, call function
261 ;;      `tinypath-info-handler' to update your Emacs and update the
262 ;;      `dir' entry. After that reset old information with `M-x'
263 ;;      `tinypath-info-initialize'.
264 ;;
265 ;;      This feature was designed to be used under Windows where
266 ;;      Cygwin installation provided many manual pages, which would
267 ;;      have been handy to read under Win32 Native Emacs. The catch
268 ;;      was how to mix Cygwin + Native Emacs for manual page and info
269 ;;      page reading. Under *nix this feature is of limited usability,
270 ;;      because info pages are installed in orderly manner by the system
271 ;;      installation scripts.
272 ;;
273 ;;     Win32 automatic manpath configuration
274 ;;
275 ;;      o   In Unix systems the MANPATH enavironment variable contains
276 ;;          directories where to find manual pages, but in Win32,
277 ;;          there is no default MANPATH and `M-x' `man' does not work.
278 ;;      o   If package *woman.el* (Included in latest Emacs
279 ;;          versions) is along `load-path', it is automatically
280 ;;          configured to support to read manual pages. It replaces
281 ;;          the `M-x' `man' command.
282 ;;
283 ;;     Win32 Cygwin environment support
284 ;;
285 ;;      o   If *cygwin1.dll* (<http://www.cygwin.com/>) is in `exec-path',
286 ;;          automatic detection tries to find the Cygwin root and scan
287 ;;          manual pages and info pages for use with *woman.el*
288 ;;          _Note:_ This feature is for native Win32 Emacs. Nowadays,
289 ;;          there is also native Cygwin Emacs, which behaves just like
290 ;;          the big brother *nix Emacs.
291 ;;
292 ;;     Compressed lisp file support
293 ;;
294 ;;      o   Overloads commands load, load-library, load-file, require
295 ;;          and autoload to accept `jka-compr' compressed lisp .el files.
296 ;;      o   Primarily meant to be used in low quota accounts.
297 ;;      o   Compress or decompress lisp files. You don't have to change
298 ;;          a thing in your Emacs startup file, all will work as usual.
299 ;;      o   Handle aliased commands that turn out to be
300 ;;          in `autoload' state.
301 ;;
302 ;;  How to set up your load path
303 ;;
304 ;;      The `tinypath-:load-hook' should contain function
305 ;;      `tinypath-setup' which starts examining all directories under
306 ;;      `load-path' and `tinypath-:load-path-root' which is set to
307 ;;      reasonable defaults of site wide and personal installations.
308 ;;      If you keep all your lisp files under *$HOME/elisp*, then you
309 ;;      do not need to configure anything for this package to work.
310 ;;      Your `load-path' will be updated after this code at the
311 ;;      beginning of your *$HOME/.emacs*
312 ;;
313 ;;          (load "~/elisp/tiny/tinypath") ;; Or anywhere you have it installed
314 ;;
315 ;;      If there are _many_ separate Emacs lisp root directories, like
316 ;;      one for *site-lisp* and one for *site-packages* and one for
317 ;;      *personal* *lisp* files, then those directories should be
318 ;;      added to variable `tinypath-:load-path-root'. Below there is
319 ;;      an example for PC users, where the E: partition replicates
320 ;;      identical Unix tree structure. We suppose for a moment that
321 ;;      Cygwin is installed there. The following actually works for
322 ;;      shared Unix Emacs setup file too, because non-existing
323 ;;      directories will get ignored:
324 ;;
325 ;;          (setq tinypath-:load-path-root
326 ;;            '("~/elisp"  "E:/usr/share/emacs/site-lisp/common"))
327 ;;          (load "~/elisp/tiny/tinypath")
328 ;;
329 ;;  Peiodic load path syncronization watchdog
330 ;;
331 ;;      If new lisp packages are installe dand tried reularly when new
332 ;;      development versions are tracked, then the manual need to call
333 ;;      `M-x' `tinypath-cache-regenerate' may become tiresome. There
334 ;;      is a built in idle timer watchdog included in the package, but
335 ;;      it is not activated by default. It's job is to examine load path
336 ;;      every now and them when Emacs is idle to see if the `load-path'
337 ;;      has gone out of synch i.e. new paths have appeared, old ones removed
338 ;;      or new packages has been added. This feature is experimental and
339 ;;      the scanning may be quite resource intensive because disk I/O
340 ;;      is neede to determine the status of the paths and files. To anable
341 ;;      it, you must define the load hook before anything else:
342 ;;
343 ;;          (setq tinypath-:load-hook
344 ;;             '(tinypath-install tinypath-install-timer))
345 ;;          ... and now the call to 'load' tinypath comes after it ...
346 ;;
347 ;;  XEmacs and Emacs specific directories
348 ;;
349 ;;      In spite of great effort from developers to make packages
350 ;;      compatible for both Emacs platforms, there is always some packages
351 ;;      that only work with Emacs or XEmacs. It is assumed that the site
352 ;;      admin has created directories like these to keep the *site-lisp*
353 ;;      installation clean:
354 ;;
355 ;;          ;;   This might be also under /opt/share/site-lisp
356 ;;          ;;   Refer to file hierarchy standard at
357 ;;          ;;   http://www.pathname.com/fhs/
358 ;;
359 ;;          /usr/share/emacs/site-lisp/common/   .. XEmacs and Emacs
360 ;;          /usr/share/emacs/site-lisp/emacs/    .. only for Emacs
361 ;;          /usr/share/emacs/site-lisp/xemacs/   .. only for XEmacs
362 ;;
363 ;;      To take care of the Emacs specific `load-path' setting, use code
364 ;;      similar to this snippet. If you load the setup multiple times, the
365 ;;      `pushnew' ensures that the directories are not added multiple
366 ;;      times.
367 ;;
368 ;;          (require 'cl)
369 ;;          (dolist (path ("~/elisp"
370 ;;                         ;;  For both Emacs and XEmacs
371 ;;                         "/usr/share/emacs/site-lisp/common"
372 ;;                         ;;  Select Emacs or XEmacs specific installations
373 ;;                         (if (boundp 'xemacs-logo)
374 ;;                             "/usr/share/xemacs/site-lisp"
375 ;;                           "/usr/share/emacs/site-lisp/emacs")))
376 ;;            (when (stringp path)
377 ;;              (pushnew path tinypath-:load-path-root :test 'string=)))
378 ;;
379 ;;          ;; PLEASE COPY VERBATIM. THERE ARE OPTIMIZATIONS
380 ;;          ;; THAT ACTIVATE IF YOU ADD THE PATH
381 ;;          (pushnew "~/elisp/tiny/lisp" load-path :test 'string=)
382 ;;          (load "tinypath.el")
383 ;;
384 ;;      The package will check current emacs version and make sure
385 ;;      that only correct directories are included to the
386 ;;      `load-path'. If you simply instructed to search the whole
387 ;;      site-lisp root `/usr/share/site-lisp', and current emacs
388 ;;      binary is "emacs", then all directories that contain path
389 ;;      portion `/xemacs' are automatically ignored.
390 ;;
391 ;;     Building part of site-lisp from Internet
392 ;;
393 ;;      If we continue talking a bit more about site-lisp, there is utility
394 ;;      *mywebget.pl* at <http://perl-webget.sourceforge.net/>. It
395 ;;      includes a *mywebget-emacs.conf* which contains
396 ;;      knowledge where the various lisp developers' home pages are and how
397 ;;      to download all known lisp tools that do not come with Emacs. If
398 ;;      you have lot of disk space and you're interested in getting more
399 ;;      tools to go with your Emacs, follow the instruction laid out
400 ;;      in the above project's page.
401 ;;
402 ;;      If you are further interested in Emacs packages, see Cvs
403 ;;      version control program available for Unix at
404 ;;      <http://www.cvshome.com/> and for Win32 `cvs' will ship with
405 ;;      the <http://cygwin.com> installation. With Cvs you can track
406 ;;      development of many Emacs projects including Gnus, BBDB,
407 ;;      Mailcrypt etc. Cvs is minimizing network traffic by
408 ;;      transferring only changes.  Here is one suggestion where you
409 ;;      could put all your Emacs Lisp Version control downloads:
410 ;;
411 ;;           /usr/share/emacs/site-lisp/net/cvs-packages
412 ;;
413 ;;      Now, the overall structure of whole site-lisp might look
414 ;;      something like this:
415 ;;
416 ;;                   ROOT/  ( /usr/share/emacs or equivalent )
417 ;;                   |
418 ;;                   +--site-lisp/
419 ;;                      |
420 ;;                      +--emacs/
421 ;;                      |  |  ...Emacs only files
422 ;;                      |  +--packages/
423 ;;                      |  |  +--pcl-cvs-2.9.9/
424 ;;                      |  |  +-... and so on
425 ;;                      |  +--win32/
426 ;;                      |     +--gnuserv/
427 ;;                      |     +-... and so on
428 ;;                      +--net/
429 ;;                      |  +--users/
430 ;;                      |     +-LispDeveloperA
431 ;;                      |     +-LispDeveloperB
432 ;;                      |     +-... and so on
433 ;;                      |  +--cvs-packages/
434 ;;                      |     +--liece/
435 ;;                      |     +--lookup/
436 ;;                      |     +--ILISP/
437 ;;                      |     +--jess-mode/
438 ;;                      |     +--devel/
439 ;;                      |     +--emacro/
440 ;;                      |     +--tnt/
441 ;;                      |     +--cc-mode/
442 ;;                      |     +--mailcrypt/
443 ;;                      |     +--bbdb/
444 ;;                      |     +--gnus/
445 ;;                      |     +-... and so on
446 ;;                      +--common/
447 ;;                      |     ...COMMON for both Emacs and XEmacs
448 ;;                      |     =======================================
449 ;;                      |     ...Packages that you find posted to the
450 ;;                      |     ...gnu.emacs.sources and whose author's
451 ;;                      |     ...do not have a homepage
452 ;;
453 ;;      For XEmacs, you would add:
454 ;;
455 ;;                   ROOT/  ( /usr/share/xemacs or equivalent )
456 ;;                   |
457 ;;                   +--site-lisp/
458 ;;                      |
459 ;;                      +--xemacs/
460 ;;                         |  ...XEamcs only files
461 ;;                         +--cvs-packages/
462 ;;                            +--xemacs-packages/
463 ;;
464 ;;     XEmacs 21.2+ core packages
465 ;;
466 ;;      Some (Win32) XEmacs versions come with only the very basic
467 ;;      installation. Lisp packages may be distributed in separate
468 ;;      archive *xemacs-packages* (nick named SUMO due to its huge
469 ;;      size). There is also *mule-packages* and *site-packages*
470 ;;      archives. A built-in heuristics tries to guess the location of
471 ;;      these by looking under and near your XEmacs installation. Here
472 ;;      is example from Win32:
473 ;;
474 ;;          .../XEmacs/XEmacs-NN.N/xemacs-packages
475 ;;          .../XEmacs/xemacs-packages
476 ;;
477 ;;      If the archives have been installed elsewhere, you have to tell the
478 ;;      location by defining following variable prior loading TinyPath. You
479 ;;      can't put these to `tinypath-:load-path-root' because this is
480 ;;      special information that needs to present during the very initial
481 ;;      boot-up to find crucial packages like *jka-compr.el*.
482 ;;
483 ;;          (setq tinypath-:core-emacs-load-path-list
484 ;;                '("/usr/share/site-lisp/xemacs/xemacs-packages"
485 ;;                  "/usr/share/site-lisp/xemacs/mule-packages"
486 ;;                  "/usr/share/site-lisp/xemacs/site-packages"))
487 ;;
488 ;;  Finding load-path directories
489 ;;
490 ;;      Supposing only default *$HOME/elisp* is used directory for files, the
491 ;;      `tinypath-:load-path-function' starts recursively searching all
492 ;;      the directories under the root(s) `tinypath-:load-path-root'. Not all
493 ;;      directories are counted in when the search descends below the root(s).
494 ;;      Variable `tinypath-:load-path-ignore-regexp' decides if the directory
495 ;;      should be ignored. By default:
496 ;;
497 ;;      o   Package's additional subdirectories like texinfo, tex, doc, etc,
498 ;;          misc, RCS, CVS, .svn (Subversion), MT (monotone version control),
499 ;;          zip are ignored.
500 ;;      o   Any temporary directories named .../t/ .../T/ .../tmp* .../temp*
501 ;;          are ignored.
502 ;;      o   Directories that do not contain any files ending to .el or .elc are
503 ;;          ignored. (it's fatser to do the above checks first).
504 ;;
505 ;;  Gnus and other 3rd party packages
506 ;;
507 ;;      _Note:_ In latest version of this utility *Gnus* is treated
508 ;;      specially. All Gnus versions are detected along load-path and
509 ;;      the very latest Gnus version is installed to your
510 ;;      `load-path'. This is based on the knowledge in the
511 ;;      `gnus-version' variable and the heuristics will pick the
512 ;;      newest for you. You actually do not have to do anything else,
513 ;;      but to drop latest Gnus somewhere, to be able to use it
514 ;;      immediately.
515 ;;
516 ;;       Under the hood (old documentation)
517 ;;
518 ;;      It is important to understand how this package works: It caches
519 ;;      every possible lisp directory it can find. Now, if you have
520 ;;      installed private copy of Gnus, say in `~/elisp/cvs-packages/gnus',
521 ;;      there is a problem, because Emacs distribution also includes Gnus.
522 ;;      There is NO WAY TO TELL OR CHANGE path order when the cache is in
523 ;;      use. This is a design decision and cannot be changed. The old trick,
524 ;;      where a new directory was added in front of `load-path', will not
525 ;;      work because everything goes through cache. What you need to do
526 ;;      instead, is to tell that the "other" Gnus should be ignored during
527 ;;      cache creation, so that it is completely unknown.
528 ;;
529 ;;     Solution: ignoring directories
530 ;;
531 ;;      There is very simple way. Put your regular expression to
532 ;;      `tinypath-:ignore-file-regexp-extra' and it will tell which
533 ;;      directories to ignore.  Naturally you must put the lisp code
534 ;;      _before_ you load package.
535 ;;
536 ;;          (setq tinypath-:load-path-ignore-regexp-extra
537 ;;                "\\|[/\\]x?emacs[/\\0-9.]+[/\\]lisp[/\\]gnus")
538 ;;          ;; PLEASE COPY VERBATIM. THERE ARE OPTIMIZATIONS
539 ;;          ;; THAT ACTIVATE If YOU ADD THE PATH
540 ;;          (require 'cl)
541 ;;          (pushnew "~/elisp/tiny/lisp" load-path :test 'string=)
542 ;;          (load "tinypath.el")
543 ;;
544 ;;      [For advanced Lisp programmers] You can add ignored gnus directory
545 ;;      to `tinypath-:load-path-ignore-regexp' via
546 ;;      `tinypath-:load-path-ignore-regexp-hook'. When the hook is run, the
547 ;;      default value for `tinypath-:load-path-ignore-regexp' is already
548 ;;      available. In hook, append regular expression that excludes the
549 ;;      Gnus directory. Here is an example; make sure that you don't add
550 ;;      the regexp multiple times. The multiple invocations is protected by
551 ;;      setting a plist property and checking it. The ugly [\\/] makes the
552 ;;      regexp compatible with both Unix and win32 paths. System
553 ;;      directories in Unix are typically /emacs/NN.NN/ and in win32
554 ;;      /emacs-NN.NN/, that's why added "-".
555 ;;
556 ;;          (add-hook 'tinypath-:load-path-ignore-regexp-hook
557 ;;                    'my-tinypath-:load-path-ignore-regexp-hook)
558 ;;
559 ;;          (defun my-tinypath-:load-path-ignore-regexp-hook ()
560 ;;            ;;  Do this only once
561 ;;            (unless (get 'my-tinypath-:load-path-ignore-regexp-hook 'set)
562 ;;              ;; mark as done.
563 ;;              (put 'my-tinypath-:load-path-ignore-regexp-hook 'set t)
564 ;;              (setq tinypath-:load-path-ignore-regexp
565 ;;                    (concat
566 ;;                     tinypath-:load-path-ignore-regexp
567 ;;                     "[/\\]x?emacs[/\\0-9.]+[/\\]lisp[/\\]gnus"))))
568 ;;
569 ;;      #todo: What about XEmacs public/private Gnus installations?
570 ;;
571 ;;  Updating new lisp packages
572 ;;
573 ;;      Suppose you have installed a new version of a package:
574 ;;
575 ;;          ~/elisp/gnus/pgnus-0.74/
576 ;;          ~/elisp/gnus/pgnus-0.95/    ;; NEW
577 ;;
578 ;;      Both these directories end up being added to the `load-path',
579 ;;      but that is not preferable. It is the latest version that
580 ;;      should be in the `load-path'. The solution is to move the old
581 ;;      versions under some name that will be ignored by default. It
582 ;;      is recommended that a backup of previous packages are renamed
583 ;;      to start with a word "tmp-". All directories that start with
584 ;;      prefix *tmp* are ignored.
585 ;;
586 ;;          % mv ~/elisp/gnus/pgnus-0.74/ ~/elisp/gnus/tmp-pgnus-0.74/
587 ;;                                                     ====
588 ;;
589 ;;      However if you update package in a site-lisp directory, there
590 ;;      may be a distant problem that somebody needs older version of
591 ;;      the package. If you made the backup like above, that user
592 ;;      cannot load the old package any more, because it doesn't show
593 ;;      up in `load-path'
594 ;;
595 ;;      There is no easy answer to keep old packages. Admin could
596 ;;      announce that: "new version has been installed in DIR, the old
597 ;;      one is in TMP-OLD-DIR" and have users manually arrange their
598 ;;      `load-path' if needed. Following lisp command would solve
599 ;;      their setup. The statement below adds the old directory to the
600 ;;      *beginning* of `load-path' and thus load commands would find the
601 ;;      old version of the package first.
602 ;;
603 ;;          (load "~/elisp/tiny/tinypath")
604 ;;          ;;  Add more directories.
605 ;;          (pushnew "TMP-OLD-OLD-DIR" load-path :test 'string=)
606 ;;          (tinypath-cache-regenerate)
607 ;;
608 ;;      Remember to mention to users that they need to update cache with
609 ;;      `tinypath-cache-regenerate' (called with prefix argument) to see
610 ;;      the changes.
611 ;;
612 ;;  Duplicate files in path
613 ;;
614 ;;      If you have accustomed to putting your path to specific order,
615 ;;      you have to rethink the strategy. The philosophy behind this
616 ;;      utility was that there SHOULD BE NOT NEED TO DO MANUAL WORK TO
617 ;;      UPDATE PATHS. This means that the order of the paths must not
618 ;;      be significant. Now, you may face a situation where library or
619 ;;      package contains a file, which has already been installed.
620 ;;      Take for example, *smtpmail.el*:
621 ;;
622 ;;          /usr/bin/emacs-20.4/lisp/mail/smtpmail.el
623 ;;          /usr/share/site-lisp/common/packages/semi/flim-1.12.1/smtpmail.el
624 ;;
625 ;;      There is a problem if FLIM's *smtpmail.el* is not compatible with
626 ;;      the one in Emacs. If it is, then there is no problem. Either one can be
627 ;;      loaded, and the `load-path' order does not matter. But you don't
628 ;;      know that before you get error "function smtpmail-xxxx not defined"
629 ;;      and you start investigating with (locate-library "smtpmail") which
630 ;;      package is actually active.
631 ;;
632 ;;      Please investigate your path with [C-u] `M-x'
633 ;;      `tinypath-cache-problem-report' and see if you find duplicate
634 ;;      entries. Check each one and possibly move the file to another
635 ;;      name or remove older ones. E.g. in the above situation, the
636 ;;      cure might be moving FLIM's *smtpmail.el* under name
637 ;;      *flim-smtpmail.el* so that it doesn't get loaded with (require
638 ;;      'smtpmail). The BEST IS TO CONTACT THE MAINTAINER(S) and tell
639 ;;      them about conflicts. Here is a sample of one generated
640 ;;      problem report:
641 ;;
642 ;;          imenu.el
643 ;;            323 34073 1998-05-07 16:28:08 /usr/share/site-lisp/common/other/
644 ;;            910 37169 1999-12-04 02:47:58 /usr/share/site-lisp/common/programming/java/jde/jde-2.1.6beta13/lisp/
645 ;;            1350 38663 1999-11-28 01:14:38 /usr/bin/emacs/gnu-emacs/emacs-20.4.1/lisp/
646 ;;          base64.el
647 ;;            515  9943 1999-12-11 19:15:20 /usr/share/site-lisp/common/packages/gnus-5.8.2/lisp/
648 ;;            807  9892 1999-11-15 00:00:12 /usr/share/site-lisp/common/packages/w3-4.0pre.46/lisp/
649 ;;
650 ;;      _Explanation:_ Previously *imenu* was installed as a separate
651 ;;      package. Now latest Emacs ships with one, so it is best to delete
652 ;;      the previous one `other/imenu.el.' Keep on eye on the numbers
653 ;;      here: The lower, the more close it is to the beginning of
654 ;;      cache when the directories were searched. The package with
655 ;;      lowest score will get loaded. Another package, *base64.el*
656 ;;      seems to be problematic too. But because Gnus path has lowest
657 ;;      score, it will get loaded before w3's base64.el. This is good,
658 ;;      because Gnus contains the latest version of *base64.el*. In
659 ;;      the buffer `tinypath-report-mode' is turned on to manipulate
660 ;;      reported lines.  Unnecessary files can be deleted with
661 ;;      `Control-shift-mouse-1' or `C-c' `C-d'.
662 ;;
663 ;;  Symlinked directories are ignored
664 ;;
665 ;;      TODO: Later version might support symlinks. Rethinking this over.
666 ;;
667 ;;      It has been the tradition to use symlinks a lot in Unix to
668 ;;      arrange easy access to versioned packages. Like how to
669 ;;      ~/elisp/gnus/ no matter what version is currently installed.
670 ;;
671 ;;          ln -s ~/elisp/packages/gnus-N.NN  ~/elisp/packages/gnus
672 ;;
673 ;;      This package however *skips* those symlinks and records the
674 ;;      absolute path name to the `load-path'. There are couple of
675 ;;      points: a) it is more instructive to peek the `load-path' to
676 ;;      actually see what versions have been installed to the Emacs b)
677 ;;      The symlinks are error prone since there may be several
678 ;;      symlinks that lead to same directory and c) symlinks may not
679 ;;      work well in heterogenous environments where Win32 and Linux
680 ;;      and Unix hosts are networked together. To migrate to this
681 ;;      package you need to examine your symlinks and remove them.
682 ;;
683 ;;      If you have drawn a symlink to the the current directory from
684 ;;      *SEPARATE* directory, then that directory will never be seen:
685 ;;
686 ;;          ln -s ~/some-disk/elisp/artist-1.1/ ~/elisp/packages/artist-1.1
687 ;;
688 ;;      To solve this, instead either _a)_ move the package physically
689 ;;      under the ~/elisp/ from the *~/some-disk/elisp/* so that the
690 ;;      recursive search will record it or _b)_ add the separate
691 ;;      directory *~/some-disk/elisp* to the variable
692 ;;      `tinypath-:load-path-root'.
693 ;;
694 ;;  Using cache
695 ;;
696 ;;      Now when you're freed from update burden of the directories in your
697 ;;      disk, you can concentrate organizing the files under sensible
698 ;;      directories. Here is an example how the organizing could go:
699 ;;
700 ;;          ~/elisp/users/kevinr/       Kevin Rodger's files
701 ;;          ~/elisp/users/ilya/         Ilya Zakharevich's files
702 ;;          ..
703 ;;          ~/elisp/packages/bbdb-2.00.06/  Version-ed packages
704 ;;          ~/elisp/packages/psgml-1.0.3/
705 ;;          ~/elisp/packages/pcl-cvs-2.9.2/
706 ;;          ~/elisp/packages/tiny-19990215/
707 ;;          ...
708 ;;          ~/elisp/other/              All single add-on packages
709 ;;
710 ;;      All these paths in `load-path' and you can imagine how slow a
711 ;;      standard Emacs would become: it takes even more time to find some
712 ;;      package xxx, when Emacs sees a call (require 'xxx), because Emacs
713 ;;      must start looking into every single directory under `load-path'
714 ;;      until it can determine if it can or cannot load the asked package.
715 ;;      This utility will store all lisp files in cache, and it is
716 ;;      activated by default. The variable `tinypath-:cache-expiry-days'
717 ;;      controls the interval when it is concluded that a new tree
718 ;;      recursion is needed. If you install new packages during those
719 ;;      non-expiry days, it is best to call `C-u' `M-x'
720 ;;      `tinypath-cache-regenerate' to build up to date image of your files
721 ;;      and `load-path' directories.
722 ;;
723 ;;        If you want one short advice: always call `tinypath-cache-regenerate'
724 ;;        after any lisp file or directory update.
725 ;;
726 ;;  Cache file and different Emacs versions
727 ;;
728 ;;      It is important that each Emacs loads correct cache file. The cache
729 ;;      file's name is derived from the emacs version and emacs type, which
730 ;;      can be "xemacs", "win32-xemacs", "emacs" or "win32-emacs".
731 ;;
732 ;;            tinypath-:cache-file-prefix
733 ;;          + EMACS-TYPE
734 ;;          + HOST
735 ;;          + EMACS-VERSION
736 ;;          + tinypath-:cache-file-postfix
737 ;;
738 ;;          ~/elisp/config/emacs-config-tinypath-cache-win32-HOST-emacs-20.4.1.el.gz
739 ;;          ==========================================                        ======
740 ;;          prefix                                                           postfix
741 ;;
742 ;;     Unix hosts and NFS mounts
743 ;;
744 ;;      In Unix environment, it is also common that several hosts are
745 ;;      NFS mounted so that the home disk is available from every
746 ;;      server. The programs could also be NFS mounted, but many times
747 ;;      programs are stored locally on each server's own disks. Now,
748 ;;      there would be a problem if you logged to host *A* and started
749 ;;      tinypath.el which had made cache in host *B*, because *A* does
750 ;;      not have the same directories as *B* did (site-lisp). This has
751 ;;      been taken care of by including _hostname_ part in the cache
752 ;;      file name. For each host, a separate cache file is
753 ;;      created. Now, suppose all the Unix hosts are same brand, say
754 ;;      Sun OS, Linux, or HP-UX and a good administrator has separated
755 ;;      the programs and the data in their own directory
756 ;;      structures. Furthermore, these directories are NFS mounted and
757 ;;      thus visible to the remote machines. In this scenario, it
758 ;;      would not really matter to which host you log into, because
759 ;;      you would always see the same programs and site-lisp
760 ;;      directories and there would not be need for host specific
761 ;;      cache files. In that case, it is possible to disable the
762 ;;      *HOST* word by setting with:
763 ;;
764 ;;          (setq tinypath-:cache-file-hostname-function nil)
765 ;;
766 ;;  Info file support
767 ;;
768 ;;      In addition to updating the `load-path', the recursive function
769 ;;      has a chance to search for installed info files as well. When you
770 ;;      keep all your site lisp under one directory, it is not uncommon
771 ;;      that the bigger packages include documentation files in info format
772 ;;      as well. Like:
773 ;;
774 ;;          /usr/share/site-lisp/emacs/pcl-cvs-2.9.9/
775 ;;          /usr/share/site-lisp/common/packages/psgml-1.2.1/
776 ;;
777 ;;      One possibility is that after you download and uncompress a
778 ;;      package, you copy the info file to some central directory
779 ;;      where you keep all you info files. This is lot of manual work.
780 ;;      (Never mind that in Unix you might use Makefile to install
781 ;;      everything, in Win32 it's all manual work). This package does the
782 ;;      same job by looking for directories that either have info files or
783 ;;      a central info repository called `dir'. If the `dir' file
784 ;;      has all the info files up to date, nothing is done. In other cases:
785 ;;
786 ;;      o   If the central `dir' in the directory does not exits,
787 ;;          it is created.
788 ;;      o   If `dir' does not contain entry for info file, it is added.
789 ;;          The entry name is derived from the filename.
790 ;;
791 ;;      The `Info-default-directory-list' is updated to include any new
792 ;;      directory locations and they are saved to same cache file. When you
793 ;;      call `C-h' `i' you will see the new info entries. Easy and
794 ;;      maintenance friendly. No need to worry about supplied info files any
795 ;;      more, they are automatically integrated to your Emacs. If you have
796 ;;      installed any new packages to your system, Emacs packages or Unix
797 ;;      packages that installed something with "install -c", it is best to
798 ;;      update your info files with `M-x'
799 ;;      `tinypath-info-scan-Info-default-directory-list'. This is also
800 ;;      called if you call: `C-u' `M-x' `tinypath-cache-regenerate'
801 ;;
802 ;;  Cygwin support (Win32 and woman.el)
803 ;;
804 ;;      It is common that Emacs in Win32 environment is coupled with
805 ;;      <http://www.cygwin.com> toolkit which contains all the manual pages
806 ;;      for the unix commands and possibly new info pages. This package
807 ;;      will locate `cygwin1.dll' file along PATH and recurse whole cygwin
808 ;;      installation root to find new entries that can be used inside
809 ;;      Emacs. In theory this all should happen automatically and the only
810 ;;      thing you have to do is to ensure that you have proper PATH
811 ;;      settings at your OS level before this package is started. If Cygwin
812 ;;      /bin directory in in PATH, `tinypath-:extra-path-root' will get set
813 ;;      to a correct value at boot time.
814 ;;
815 ;;      If you have more places where you keep Unix tools which contain
816 ;;      more manual or info pages, like Reed Kotler (old Unix-like env)
817 ;;      http://www.reedkotler.com/ you _must_ manually set variable
818 ;;      `tinypath-:extra-path-root' to the list of search root directories.
819 ;;      If you set this yourself, you _must_ also include the cygwin
820 ;;      installation root directory
821 ;;
822 ;;          (setq tinypath-:extra-path-root
823 ;;                '("e:/unix-root/cygwin"
824 ;;                  "e:/unix-root/reed-kotler"
825 ;;                  ...))
826 ;;
827 ;;      Package *woman.el* will be configured automatically if it is along
828 ;;      `load-path' to handle manual page viewing with command `M-x'
829 ;;      `man'. Please make sure that you do not destroy the pre-defined
830 ;;      `woman-manpath' in your Emacs startup files with lisp commands or
831 ;;      the efforts to find out new manual pages are thrown off the window.
832 ;;      Search you startup files for anything that looks like `setq',
833 ;;      `defvar', `defconst': (setq woman-manpath ... and change the code
834 ;;      to _add_ to the variable instead:
835 ;;
836 ;;          (require 'cl)
837 ;;          (dolist (path '("one" "two" "three"))
838 ;;            (pushnew (expand-file-name path) woman-manpath :test 'string))
839 ;;
840 ;;  Faster Emacs configuration (Perl emacs-util.pl)
841 ;;
842 ;;      Indication of this feature at startup is a message, where
843 ;;      EXT refers to externally launched process. It must be waited
844 ;;      until further processing is done; i.e. Emacs is hung for a while.
845 ;;
846 ;;          TinyPath: EXT Process running ... [may take a while]
847 ;;
848 ;;      As this package evolved and more support was added to various
849 ;;      environments, like Cygwin, which required traversing hundred of
850 ;;      directories to find out if they contained info or manual pages,
851 ;;      it came evident that Emacs Lisp method was too slow. An alternative
852 ;;      method was developed using Perl language and written in *emacs-util.pl*
853 ;;      which can traverse directory hierarchies to find relevant
854 ;;      directories for the setup. This interface is automatically used
855 ;;      if two conditions are met in current environment:
856 ;;
857 ;;      o   Binary *perl* must be along PATH. (according  `executable-find')
858 ;;      o   perl script *emacs-util.pl* must be along PATH. Either copy
859 ;;          the file to suitable place or include Tiny Tool's `/bin'
860 ;;          directory to your PATH.
861 ;;
862 ;;      If all goes well, a `call-process' to the utility script will
863 ;;      return the file hierarchies much faster than the Emacs Lisp ever
864 ;;      could. The difference is that you don't see the traversing progress
865 ;;      as you would if Emacs Lisp did the same thing. The command line
866 ;;      arguments passed to the utility scripts can be found from the
867 ;;      *Message* buffer and you can run the program yourself if you think
868 ;;      that it returns incorrect listing. Print the script help with
869 ;;      following command:
870 ;;
871 ;;          % perl emacs-util.pl --help
872 ;;
873 ;;      Here are some performance statistics of the perl script in action.
874 ;;      (Use --verbose argument to see the statistics)
875 ;;
876 ;;      o   Intel 400MHz, IBM GXP 80G IDE/ATA 100 disk, whole Cygwin
877 ;;          installation scan: 3 min 46 sec, dirs: 2373, files: 35 271
878 ;;      o   Same PC, but this time site-lisp directory, subset of Cygwin
879 ;;          hierarchy at /usr/share/site-lisp took:
880 ;;          0 min 13 sec, dirs: 648, files: 8750
881 ;;
882 ;;      Let's consider one scenario that you may encounter if you intend to
883 ;;      use Cygwin similarly as the big brother Linux. Let's suppose that
884 ;;      you have dedicated a disk portion where you intend to duplicate
885 ;;      whole Linux-like directory hierarchy. You have ROOT under which you
886 ;;      keep all the files, including anything that is Cygwin-related.
887 ;;
888 ;;          E:/usr/share/site-lisp Emacs lisp as outlined earlier
889 ;;          E:/usr/share/site-perl Perl packages and scripts
890 ;;          E:/usr/share/site-php  PHP code
891 ;;          E:/usr/share/site-cvs  Various other external CVS C-packages
892 ;;
893 ;;      The default heuristics `tinypath-ti::win32-cygwin-p' should find
894 ;;      *cygwin1.dll* installed and report that Cygwin root is *E:/*
895 ;;      This means that `tinypath-:extra-path-root' will get set for
896 ;;      you when package loads. Suppose further that you have set
897 ;;      variable `tinypath-:load-path-root' to point out suitable
898 ;;      locations in *E:/usr/share/site-lisp*. It would seem
899 ;;      that this combination means that the hierarchies would be
900 ;;      traversed multiple times, since the Cygwin root already
901 ;;      includes all the rest:
902 ;;
903 ;;          E:/                             Cygwin root
904 ;;          E:/usr/share/site-lisp/emacs    For this emacs...
905 ;;          E:/usr/share/site-lisp/common   Emacs and XEmacs compatible tree
906 ;;
907 ;;      Don't worry. The Perl utility is smart enough to reduce this
908 ;;      to search only *E:/* and discard other roots as redundant. Hm,
909 ;;      what if other lisp files are found _outside_ of the
910 ;;      *E:/usr/share/site-lisp/*, because it searches every dir
911 ;;      starting from *E:/* Say:
912 ;;
913 ;;          E:/tmp/try/some-file.el
914 ;;
915 ;;      Will the directory *E:/tmp/try/* reported as lisp `load-path'
916 ;;      candidate and added to search list? Yes and no. Yes, it will be
917 ;;      reported, but no, it will not be added to the `load-path' because it
918 ;;      doesn't match the initial user's idea where to look for lisp files. If
919 ;;      you pump up the `tinypath-:verbose' to level 5, you can see PATH-NOK
920 ;;      messages labeled "candidate" to indicate those rejections. Only files
921 ;;      that reside under `tinypath-:load-path-root' directories are counted
922 ;;      in.
923 ;;
924 ;;  Updating running Emacs
925 ;;
926 ;;      Suppose you have downloaded the latest versions of packages X, Y and Z
927 ;;      and you want your current emacs's paths updated, call this function:
928 ;;
929 ;;          M-x tinypath-cache-regenerate
930 ;;
931 ;;      Take a bit of skepticism: It is a fortunate event if it all
932 ;;      worked that easily. You see, you already have several packages
933 ;;      loaded in your Emacs and they are using the "old" code. Now
934 ;;      you wiped the old directories away and told Emacs to look for
935 ;;      only "new" directories.  After a while you may run into
936 ;;      bizarre dependency problems. I recommend that after any major
937 ;;      package update, which contains _several_ of files (like Gnus),
938 ;;      you:
939 ;;
940 ;;      o    Install package and regenerate cache in current Emacs session
941 ;;           with `M-x' `tinypach-cache-regenerate'.
942 ;;      o    Save your current Emacs buffers (see *desktop.el*, *tinydesk.el*)
943 ;;      o    Quit, restart Emacs and restore your working desktop.
944 ;;
945 ;;  Compressed lisp file support
946 ;;
947 ;;      In order to use the full compression support for autoload
948 ;;      functions as well, set variable
949 ;;      `tinypath-:compression-support' to symbol `all'. The normal
950 ;;      value for compression is 'default which support handling
951 ;;      `require' and `load' commands. The variable must be set before
952 ;;      package is loaded.
953 ;;
954 ;;     About Jka-compr package
955 ;;
956 ;;      jka-compr.el has native support to un/compress any file that
957 ;;      have specific extensions. The handling is done via
958 ;;      `file-name-handler-alist' and commands like these will load
959 ;;      properly including any autoloads.
960 ;;
961 ;;          (load "my-el.gz")
962 ;;
963 ;;      The problem is that the load statements have to be manually
964 ;;      changed so that they end in .gz so that jka-compr takes care
965 ;;      of loading. What if the file is later uncompressed? Again all
966 ;;      the load commands must be updated. This isn't very nice, since
967 ;;      it should be able to un/compress elisp files and still have
968 ;;      permanent load statements. Basically this is what the
969 ;;      compression support here is all about; there is no need to
970 ;;      worry if the file is compressed or not when advised functions
971 ;;      are in effect. The following statement will work for both file
972 ;;      types:
973 ;;
974 ;;          (load "my-el")
975 ;;
976 ;;     How the compressed loading works
977 ;;
978 ;;      o   When user request `load' FILE, try to find some compressed file
979 ;;          that JKA knows about by adding extensions ".gz" and ".Z" and
980 ;;          whatever user has configured JKA to handle. _LIMITATION:_
981 ;;          only .gz .bz2 and the like that compress one file at a time
982 ;;          is currently supported. Don't try using .zip or similar.
983 ;;      o   If the FILE is absolute path, then look from that
984 ;;          directory only.
985 ;;      o   If no directory is given, find the file along the `load-path'.
986 ;;      o   If there was somewhere a compressed file, just load it (because JKA
987 ;;          will transparently uncompress it), eval it, and kill the buffer.
988 ;;      o   If NO COMPRESSED file was found, just follow normal
989 ;;          emacs rules.
990 ;;
991 ;;     Note: Why you should not prefer compressed .elc files
992 ;;
993 ;;      The purpose of compression support is to make it possible to
994 ;;      have more useful lisp files in an account that has a limited
995 ;;      disk space (quota). Many Unicersity student accounts have this
996 ;;      limitation. Keeping lisp files in compressed format
997 ;;      saves quite a much disk space.
998 ;;
999 ;;      o   Plain text, lisp `.el', files compress better.
1000 ;;      o   The documentation in comments is important, e.g all the
1001 ;;          instruction to use the file are there. Byte compiling
1002 ;;          strips away documentation.
1003 ;;      o   In order to debug or send bug reports you need .el files.
1004 ;;          The errors from .elc files are useless.
1005 ;;      o   The performance ratio that the .elc files offer may not
1006 ;;          be a crucial factor (many times you couldn't tell).
1007 ;;
1008 ;;     Note: advised emacs commands
1009 ;;
1010 ;;      The adviced functions can be further adviced, but
1011 ;;      if the redefined function uses `interactive-p' test, it will
1012 ;;      not indicate user call (like M-x load-library). The reason why
1013 ;;      the advised functions detect it, is that advice.el's
1014 ;;      `ad-do-it' macro cannot pass the interactive flag information
1015 ;;      to the original functions.
1016 ;;
1017 ;;  Trouble shooting
1018 ;;
1019 ;;      There is no denying it, this package is potentionally
1020 ;;      dangerous. When something goes wrong, it really goes wrong and
1021 ;;      your Emacs may be messed up completely. So, here are some
1022 ;;      trouble shooting tips, that you might want to try to rescue
1023 ;;      the situation or understand what is going on. The most usual
1024 ;;      blame is the *cache* content which does not contain the
1025 ;;      correct or up to date information.
1026 ;;
1027 ;;     Package is not found or loaded?
1028 ;;
1029 ;;      Please confirm that the file location is known and is in right
1030 ;;      directory by calling `M-x' `locate-library'. If the result is
1031 ;;      not correct, please check `tinypath-:load-path-root' and
1032 ;;      `tinypath-:extra-path-root'. Try to remedy the situation,
1033 ;;      regenerate cache with `C-u' `M-x' `tinypath-cache-regenerate'.
1034 ;;
1035 ;;     You don't know what particular package is causing troubles
1036 ;;
1037 ;;      Go to the *Message* buffer and clear it (`C-x' `h' followed by
1038 ;;      `C-w'). Run the path generation engine with debug `M-x'
1039 ;;      `tinypath-debug-external-helper' and study the output. It may
1040 ;;      be ignoring some files that you think should be included. Please
1041 ;;      check content of `tinypath-:load-path-ignore-regexp' and
1042 ;;      `tinypath-:load-path-ignore-regexp-extra'.
1043 ;;
1044 ;;     You need to see the internals
1045 ;;
1046 ;;      Call function `tinypath-cache-file-find-file' to display the current
1047 ;;      cache and use `C-s' and `C-r' to search entries in the file. Remember
1048 ;;      that you must not modify this file, because any changes you do, will
1049 ;;      get overwritten next time the cache is regenerated. The problem is
1050 ;;      somewhere else if you can see incorrect items in the cache file.
1051 ;;
1052 ;;  Code note: General
1053 ;;
1054 ;;      Because this package is among the first that is loaded from Emacs
1055 ;;      startup file, It contains copies of some functions from TinyLib
1056 ;;      libraries, to make the package independent until the point where
1057 ;;      the `load-path' has been set up and other libraries are available.
1058 ;;      In the code you may find marks "#copy:" which indicate code that
1059 ;;      has been copied/simplified to be used here. Autoload statements in
1060 ;;      this package defer loading functions until the end is reached and
1061 ;;      `load-path' is determined and the rest of the functions can be
1062 ;;      loaded from the libraries.
1063 ;;
1064 ;;  Code note: Where is that emacs package
1065 ;;
1066 ;;      If you ever need to know the location of a package that Emacs
1067 ;;      would load or has loaded, while this utility is in effect,
1068 ;;      use this call:
1069 ;;
1070 ;;          (insert (tinypath-cache-p "gnus.el"))
1071 ;;
1072 ;;      In fact the regular call yields same result, because
1073 ;;      `locate-library' is adviced:
1074 ;;
1075 ;;          (insert (locate-library "gnus.el"))
1076 ;;
1077 ;;      More easily, with *tinylisp.el*, which takes advantage of
1078 ;;      tinypath.el cache, you can load any emacs package for editing
1079 ;;      with command:
1080 ;;
1081 ;;          M-x load-library RET tinylisp RET
1082 ;;          M-x tinylisp-library-find-file
1083 ;;          (tinypath cache)Lisp Library: gnus.el RET
1084 ;;
1085 ;;      Alternatively there is mode hot-keys $ l f  and  $ l p :
1086 ;;
1087 ;;          M-x load-library RET tinylisp RET
1088 ;;          M-x tinylisp-install
1089 ;;          M-x tinylisp-mode  (in *scratch* buffer, see "E" in modeline)
1090 ;;          $ l f
1091 ;;          (tinypath cache)Lisp Library: gnus.el RET
1092 ;;
1093 ;;  Code note: Internal optimizations
1094 ;;
1095 ;;      In the installation section it is instructed that the location of the
1096 ;;      package is pushed into the `load-path' before the package is loaded:
1097 ;;
1098 ;;          (require 'cl)
1099 ;;          (pushnew "~/elisp/tiny/lisp/tiny" load-path :test 'string=)
1100 ;;          (load "tinypath.el")
1101 ;;
1102 ;;      Please follow this instruction. The reason is that program
1103 ;;      tries to use most efficient code to boot everything up and the
1104 ;;      first thing it does is to check the location where it has been
1105 ;;      saved. This package will use this information to assume that
1106 ;;      the Perl program is available somewhere near that that path
1107 ;;      (../../bin). If that fails, the Perl program is searched along
1108 ;;      `exec-path'. This is usually desirable, situation because
1109 ;;      every new installation includes newer version of Perl program
1110 ;;      and the one at `exec-path' may not be up to date. The perl
1111 ;;      code will speed up booting compared to pure Emacs Lisp
1112 ;;      implementation. In addition the Perl code section in this file
1113 ;;      (often referred as "external") has extra features included.
1114 ;;
1115 ;;  Code note: *Messages*
1116 ;;
1117 ;;      This package will print loads of messages to Emacs "*Message*" or
1118 ;;      XEmacs " *Message-Log*" buffer. This is a design decisions so that
1119 ;;      execution can be easily traced during Emacs load time. It also help
1120 ;;      reporting errors. The default `tinypath-:verbose' 3 will log the most
1121 ;;      important messages.  Even if you set the level to 0 or nil, still
1122 ;;      some messages are displayed. Have a look at Message buffer if you have
1123 ;;      not much used it before. You may find interesting information to
1124 ;;      debug some of your own mis-configurations, like stale directories
1125 ;;      in `exec-path'.
1126 ;;
1127 ;;  Code note: Custom
1128 ;;
1129 ;;      If you have very old Emacs that does not contain *custom.elc*
1130 ;;      (Yes, it must be in compiled format, be sure to check), you
1131 ;;      can download Noah Friedman's excellent custom emulation
1132 ;;      package *cust-stub.el* at
1133 ;;      http://www.splode.com/~friedman/software/emacs-lisp/ You have
1134 ;;      to load it from absolute location before loading this packages
1135 ;;      like this:
1136 ;;
1137 ;;          (load "~/elisp/noah/cust-stub")
1138 ;;          (load "tinypath")
1139 ;;
1140 ;;  Code note: Insinuating packages
1141 ;;
1142 ;;      Some packages can be auto-configured when the perl script
1143 ;;      reads the contents of the directories. Like package *woman.el*
1144 ;;      which needs to know the location of man path directories. For
1145 ;;      other packages there are different "installations". Gnus is
1146 ;;      one interesting example: Every Emacs and XEmacs release comes
1147 ;;      with Gnus version, which is usually outdated and many install
1148 ;;      Gnus privately. Multiple Gnus versions in the load paths is a
1149 ;;      problem and the wished situation is that there would be only
1150 ;;      the latest. Program's logic tries to find out which of the
1151 ;;      Gnus packages along `load-path' is the latest and hopefully
1152 ;;      after making the right decision (according to gnus-version-*
1153 ;;      variable) the other Gnus locations are hidden by modifying
1154 ;;      `load-path' and `tinypath-:load-path-ignore-regexp'. This is a
1155 ;;      complimentary method to that suggested in this manual section's
1156 ;;      topic "3rd party packages".
1157 ;;
1158 ;;  Code note: Elp profiling results
1159 ;;
1160 ;;      The profiling results were run using method below. It must be note,
1161 ;;      that the `tinypath-external-*' is the time when the external perl
1162 ;;      program examines all the directories, so EXT time is not significant
1163 ;;      because it varies from system to system. The
1164 ;;      `tinypath-external-setup-parse-data' is the actual time spent in
1165 ;;      parsing the returned data. The functions that are called most of the
1166 ;;      time are the ones that must be kept on eye on and they seem to
1167 ;;      perform very well. Immediate below are the most important functions
1168 ;;      that perform the Parsing after the perl has returned results (these
1169 ;;      are not from the total listing, but after tweaking). The listing
1170 ;;      below represents timing results somewhere around 2001:
1171 ;;
1172 ;;          tinypath-external-output-parse                   1    4.89  4.89
1173 ;;            tinypath-external-output-parse-1               5    1.09  0.21
1174 ;;            tinypath-external-output-parse-1-cache         1    3.79  3.79
1175 ;;
1176 ;;
1177 ;;          tinypath-external-setup-parse-data               1    5.77  5.77
1178 ;;            tinypath-external-setup-1-load-path            249  0.70  0.002
1179 ;;            tinypath-external-setup-1-man-path             44   0.0   0.0
1180 ;;            tinypath-exec-path-append                      73   0.92  0.012
1181 ;;            tinypath-info-handler                          31   8.46  0.27
1182 ;;            tinypath-external-setup-cache                  1    0.0   0.0
1183 ;;
1184 ;;      These timing results was taken 2003-05-18 running Cygwin
1185 ;;      XEmacs 21.4.10, Pentium 400 Mhz. These profiling results are
1186 ;;      from the initial boot phase, before cache is loaded. It's
1187 ;;      pretty fast.
1188 ;;
1189 ;;          (setq tinypath-:install-flag nil)
1190 ;;          (load "elp"
1191 ;;          (load "tinypath")
1192 ;;          (elp-instrument-package "tinypath-")
1193 ;;
1194 ;;          ;; Now run the boot phase ONLY
1195 ;;          (tinypath-load-path-initial-value
1196 ;;            tinypath-:core-emacs-load-path-list)
1197 ;;
1198 ;;          Function Name                                   Count Elap   Ave
1199 ;;          =============================================== ===== =====  ===
1200 ;;          tinypath-load-path-initial-value                1     0.477  0.47
1201 ;;          tinypath-load-path-add-subdirs                  1     0.463  0.46
1202 ;;          tinypath-directory-subdirs                      1     0.451  0.45
1203 ;;          tinypath-emacs-root-directory                   1     0.008  0.00
1204 ;;          tinypath-emacs-root-by-load-path                1     0.008  0.00
1205 ;;          tinypath-emacs-core-path-p                      119   0.004  3.36
1206 ;;          tinypath-expand-file-name                       5     0.001  0.00
1207 ;;          tinypath-load-path-initial-value-xemacs         1     0.001  0.00
1208 ;;          tinypath-load-path-string-match                 1     0.001  0.00
1209 ;;          tinypath-win32-p                                5     0.0    0.0
1210 ;;          tinypath-emacs-versions                         1     0.0    0.0
1211 ;;
1212 ;;      Theses timing results was taken 2003-05-18 running Cygwin
1213 ;;      XEmacs 21.4.10, Pentium 400 Mhz. The cache with 4500
1214 ;;      directories was loaded from configuration file. In this case
1215 ;;      `tinypath-:cache-file-postfix' value was '.el'. The timing
1216 ;;      information was tested and generated with:
1217 ;;
1218 ;;      o   `C-x' `C-f' tinypath.el RET  -- toad read tinypath.el to Emacs
1219 ;;      o   `M-x' `load-library' RET tinylisp.el RET
1220 ;;      o   `M-x' `turn-on-tinylisp-mode' RET
1221 ;;      o   $ -    to eval current buffer
1222 ;;      o   $ e I  to instrument everything (Wtih empty value, scan buffer)
1223 ;;      o   `M-x' `tinypath-cache-regenerate' RET
1224 ;;      o   $ e s  to show results
1225 ;;
1226 ;;
1227 ;;          Function Name                                   Count Elap   Ave
1228 ;;          =============================================== ===== =====  ===
1229 ;;          tinypath-install                                1     6.812  6.81
1230 ;;          tinypath-cache-setup-main                       1     5.76   5.76
1231 ;;          tinypath-setup                                  1     5.76   5.76
1232 ;;          tinypath-directory-list-clean                   7     3.756  0.53
1233 ;;          tinypath-cache-file-load                        1     2.552  2.55
1234 ;;          tinypath-load-path-clean                        1     2.272  2.27
1235 ;;          tinypath-cache-file-need-sync-p                 1     1.932  1.93
1236 ;;          tinypath-load-path-not-in-synch-p               1     1.932  1.93
1237 ;;          tinypath-exec-path-clean                        2     0.679  0.34
1238 ;;          tinypath-exec-path-check-verbose                2     0.597  0.298
1239 ;;          tinypath-exec-path-check                        2     0.594  0.297
1240 ;;          tinypath-load-path-merge                        1     0.364  0.364
1241 ;;          tinypath-Info-default-directory-list-clean      1     0.218  0.218
1242 ;;          tinypath-file-remove-trailing-slash             825   0.121  0.000
1243 ;;          tinypath-cache-mode                             1     0.082  0.082
1244 ;;          turn-on-tinypath-cache-mode                     1     0.082  0.082
1245 ;;          turn-on-tinypath-cache-mode-maybe               1     0.082  0.082
1246 ;;          tinypath-ti::advice-control                     1     0.081  0.081
1247 ;;          tinypath-install-timer                          1     0.007  0.007
1248 ;;          tinypath-cache-file-name                        2     0.006  0.003
1249 ;;          tinypath-exec-path-from-path                    2     0.006  0.003
1250 ;;          tinypath-ti::compat-timer-cancel-function       1     0.005  0.005
1251 ;;          tinypath-ti::compat-timer-elt                   2     0.004  0.002
1252 ;;          tinypath-cache-warn-if-not-exist                1     0.004  0.004
1253 ;;          tinypath-cache-file-old-p                       1     0.004  0.004
1254 ;;          tinypath-days-old                               1     0.002  0.002
1255 ;;          tinypath-cache-status-string                    2     0.002  0.001
1256 ;;          tinypath-cache-status-message                   1     0.002  0.002
1257 ;;          tinypath-advice-instantiate                     1     0.002  0.002
1258 ;;          tinypath-expand-file-name                       3     0.001  0.000
1259 ;;          tinypath-ti::compat-timer-cancel                1     0.001  0.001
1260 ;;          tinypath-use-compression-maybe                  2     0.001  0.0005
1261 ;;          tinypath-exec-path-append                       1     0.001  0.001
1262 ;;          tinypath-win32-p                                6     0.0    0.0
1263 ;;          tinypath-emacs-versions                         2     0.0    0.0
1264 ;;          tinypath-ti::date-time-difference               1     0.0    0.0
1265 ;;          tinypath-eval-after-load                        1     0.0    0.0
1266 ;;          tinypath-time-string                            2     0.0    0.0
1267 ;;          tinypath-file-compressed-p                      2     0.0    0.0
1268 ;;          tinypath-emacs-lisp-file-list-cache-clear       1     0.0    0.0
1269 ;;          tinypath-autoload-file-name                     1     0.0    0.0
1270 ;;          tinypath-autoload-require                       1     0.0    0.0
1271 ;;          tinypath-cache-p                                1     0.0    0.0
1272 ;;          tinypath-cache-file-hostname                    2     0.0    0.0
1273 ;;          tinypath-load-path-root-changed-p               1     0.0    0.0
1274 ;;
1275 ;;      Same timing test as above, but now using compiled cache file at
1276 ;;      Emacs startup. In this case `tinypath-:cache-file-postfix' value was
1277 ;;      '.elc'. The speedup is 50%, reducing the load time to mere 3-4
1278 ;;      seconds. Notice the dramatic change in `tinypath-cache-file-load':
1279 ;;      0.5 seconds vs. 2.5 seconds non-compiled.
1280 ;;
1281 ;;          Function Name                                   Count Elap   Ave
1282 ;;          =============================================== ===== =====  ===
1283 ;;          tinypath-install                                1     3.305  3.30
1284 ;;          tinypath-cache-setup-main                       1     2.017  2.01
1285 ;;          tinypath-setup                                  1     2.017  2.01
1286 ;;          tinypath-directory-list-clean                   7     1.608  0.22
1287 ;;          tinypath-load-path-clean                        1     0.904  0.90
1288 ;;          tinypath-advice-instantiate                     1     0.784  0.78
1289 ;;          tinypath-cache-file-load                        1     0.549  0.54
1290 ;;          tinypath-exec-path-check                        2     0.506  0.25
1291 ;;          tinypath-exec-path-check-verbose                2     0.506  0.25
1292 ;;          tinypath-load-path-not-in-synch-p               1     0.368  0.36
1293 ;;          tinypath-cache-file-need-sync-p                 1     0.368  0.36
1294 ;;          tinypath-exec-path-clean                        2     0.326  0.16
1295 ;;          tinypath-exec-path-from-path                    2     0.154  0.07
1296 ;;
1297 ;;  Thoughts
1298 ;;
1299 ;;      o   In theory it is possible to load remote files with ange-ftp/EFS in
1300 ;;          manner of `load-library' RET /user@host:/path/to/file but that
1301 ;;          has never been tested.
1302 ;;      o   It theory it would be possible to add /user@host:/path/to/dir/
1303 ;;          to `load-path', but that has never been tested.
1304
1305 ;;}}}
1306
1307 ;;; Change Log:
1308
1309 ;;; Code:
1310
1311 ;;{{{ Require (a)
1312
1313 ;;; ......................................................... &require ...
1314
1315 ;;  While loading this package XEmacs garbage collects like mad.
1316 ;;  Ease it up for a while. These values are restored at the end.
1317
1318 (unless (get 'gc-cons-threshold 'tinypath-initial)
1319   (put 'gc-cons-threshold 'tinypath-initial gc-cons-threshold))
1320
1321 (put 'gc-cons-threshold 'tinypath gc-cons-threshold)
1322 (setq gc-cons-threshold (* 1024 1024 10))
1323
1324 ;;  Why the provide is at the start of file?
1325 ;;  Because XEmacs does not record `load-history' entry unless it sees
1326 ;;  `provide' statement. There is a check for SELF LOCATION by looking at
1327 ;;  the `load-history' in this package
1328
1329 (provide   'tinypath)
1330
1331 (eval-and-compile
1332
1333   (require 'cl)
1334
1335   (when (string-match "21.3" (emacs-version))
1336     ;; `dolist' is broken in Emacs 21.3 subr.el. Force loading
1337     ;;  it first, then wipe it with cl-macs.el. This way there
1338     ;;  is no chance that subr.el would be loaded ever again
1339     ;;  by some package
1340     (load "cl-macs"))
1341
1342   ;;  These variables must be here in order to Byte compiler to see them
1343   ;;  before they are used.
1344
1345   (defcustom tinypath-:verbose-info-messages nil
1346     "*If non-nil, notify missing environment variables like USER.
1347 This variable is meant for Win32 environment, where Unix style
1348 USER and LOGNAME variables are not defined by default.")
1349
1350   (defvar tinypath-:boot-ignore-directory-regexp
1351     ;; #todo: /usr/share/emacs/21.3/lisp/obsolete
1352     "\\(CVS\\|RCS\\|info\\|texi\\|\\.svn\\|/MT\\)/?$"
1353     "While searching lisp boot subdirs, ignore those that match this regexp.
1354 Popular version control directories are excluded by default.")
1355
1356   ;;  #todo: Mysterious byte compile bug:
1357   ;;  Remove all cache files, compile tinypath, launch emacs.
1358   ;;  => Dies with a message of: "function member* not found".
1359
1360   (unless (fboundp 'member*)
1361     (autoload 'member* "cl-seq"))
1362
1363   (defconst tinypath-:xemacs-p
1364     (or (boundp 'xemacs-logo)
1365         (featurep 'xemacs)
1366         (string-match "XEmacs" (emacs-version)))
1367     "Non-nil if running XEmacs.")
1368
1369   ;;  Mostly for Win32 environment checks
1370   (defvar tinypath-:startup-no-messages t
1371     "*If non-nil, do not display error message buffer at startup.
1372 You should set this to `nil' if you begin to use this package first
1373 time to see messages that may need attention. Alternatively, check
1374 message buffer.")
1375
1376   (defvar font-lock-mode) ;; Byte compiler silencers
1377   (defvar lazy-lock-mode)
1378   (defvar dired-directory)
1379
1380   (autoload 'ti::macrof-version-bug-report  "tinylib" "" nil 'macro)
1381
1382   (autoload 'pp                             "pp")
1383   (autoload 'assq                           "assoc")
1384   (autoload 'aput                           "assoc")
1385   (autoload 'executable-find                "executable")
1386
1387   ;; Quiet byte compiler. These are checked with `boundp' in the code
1388
1389   (defvar Info-default-directory-list)
1390   (defvar Info-dir-file-attributes)
1391   (defvar woman-manpath)
1392   (defvar Info-directory-list)
1393
1394   ;; See find-file.el
1395   (defvar ff-search-directories)
1396
1397   ;;  This is just forward declaration for byte compiler
1398   ;;  It it not sensible to lift `defcustom' definition apart from
1399   ;;  to the beginning of file due to macros and all which refer to it.
1400   ;;  => This is a user variable and defcustom should stay in user section.
1401   (defvar tinypath-:verbose 3
1402     "*Verbosity level"))
1403
1404 (eval-when-compile
1405   (require 'advice))
1406
1407 ;;}}}
1408 ;;{{{ Environment
1409
1410 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1411 ;;
1412 ;;      Basic Environment check and definitions
1413 ;;
1414 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1415
1416 (defvar tinypath-:win32-p
1417   (cond
1418    ((memq system-type '(ms-dos windows-nt)))  ;; Emacs
1419    ((fboundp 'console-type)                   ;; XEmacs
1420     ;; Quiet Emacs byte compiler
1421     (memq (funcall (symbol-function 'console-type))
1422           '(win32 w32 mswindows)))
1423    ((boundp 'window-system)
1424     (memq (symbol-value 'window-system) '(win32 w32 mswindows)))
1425    (t
1426     (message "TinyPath: Internal win32-p check alert, contact maintainer.")
1427     nil))
1428   "The value is non-nil under Win32 operating system.")
1429
1430 (defvar tinypath-:win32-cygwin-p
1431   (and tinypath-:win32-p
1432        (let ((case-fold-search t))
1433          (string-match "cygwin" (emacs-version))))
1434   "The value is non-nil if running under Win32 Cygwin Emacs.")
1435
1436 ;;; ----------------------------------------------------------------------
1437 ;;;
1438 (defun tinypath-tmp-message (msg)
1439   "Print messages to user."
1440   (let ((buffer (get-buffer-create "*tinypath.el ERROR*")))
1441     (with-current-buffer buffer
1442       (goto-char (point-min))
1443       (insert msg) ;; Insert message first
1444       ;; Make a record to *Messages* buffer as well.
1445       (message msg)
1446       (unless tinypath-:startup-no-messages
1447         (pop-to-buffer buffer)))))
1448
1449 ;;; ----------------------------------------------------------------------
1450 ;;; #copy from tinyliba.el
1451 (defun tinypath-win32-p ()
1452   "Check if running under Win32 system."
1453   (cond
1454    ((memq system-type '(ms-dos windows-nt)))  ;; Emacs
1455    ((fboundp 'console-type)                   ;; XEmacs
1456     ;; Quiet Emacs byte compiler
1457     (memq (funcall (symbol-function 'console-type))
1458           '(win32 w32 mswindows)))
1459    ((boundp 'window-system)
1460     (memq (symbol-value 'window-system) '(win32 w32 mswindows)))
1461    ((error "TinyPath: Internal win32-p check alert, contact maintainer."))))
1462
1463 ;;; ----------------------------------------------------------------------
1464 ;;;
1465 (defun tinypath-install-environment-home ()
1466   "Check environment: HOME."
1467   (when (or (not (getenv "HOME"))
1468             (not (file-directory-p (getenv "HOME"))))
1469     (tinypath-tmp-message
1470      (concat
1471       "\
1472 ** TinyPath.el: [ERROR] HOME variable error set.
1473
1474    The variable is either a) not set or b) it points to invalid directory.
1475
1476    An environment variable named HOME must be set so that Emacs knows where to
1477    read initialization file like $HOME/.emacs. The HOME variable is crucial
1478    to Emacs functioning and lot of packages depend on its existence.
1479
1480 "
1481       (cond
1482        (tinypath-:win32-p
1483         "")
1484        (t
1485         "\
1486    Hm. This error should not happen under Unix/Linux system.
1487    Please recheck your environment and contact your sysadm
1488    to determine cause of this.")
1489        (t
1490         "\
1491    In Windows Win95/98/NT: Add this statement to your c:\\AUTOEXEC.BAT file
1492    and reboot the computer.
1493
1494       set HOME=C:\yourname
1495
1496    The `yourname' is a directory which you must create and it should not
1497    contain spaces in the directory name.
1498
1499    In Windows ME/2000/etc You have to use Start=> Control-Panel=> System
1500    icon, select `advanced' tab and button `environment' to alter the
1501    values. Click `apply' and `ok' to make new settings effective.\n\n")))))
1502   ;;  Return value from function
1503   (getenv "HOME"))
1504
1505 ;;; ----------------------------------------------------------------------
1506 ;;;
1507 (defun tinypath-install-environment-user ()
1508   "Check environment: USER, USERNAME, LOGNAME."
1509   (let* ((user  (getenv "USER"))
1510          (uname (getenv "USERNAME")) ;; W2k variable
1511          (log   (getenv "LOGNAME"))
1512          unix-fix
1513          win32-fix)
1514     ;;  In Unix, require that both LOGNAME and USER is correct
1515     ;;  Different shells and Unix/Linux systems do not define always
1516     ;;  both.
1517     (cond
1518      ((and user
1519            (null log))
1520       ;; After this, all is ok.
1521       (setq unix-fix "LOGNAME")
1522       (setenv "LOGNAME" user))
1523      ((and log
1524            (null user))
1525       (setq unix-fix "USER")
1526       (setenv "USER" user)))
1527     (when (and uname
1528                (null user))
1529       (setq win32-fix "USER")
1530       (setenv "USER" user))
1531     ;;  Read variables again; the above may have updated something
1532     (setq user  (getenv "USER")
1533           uname (getenv "USERNAME")
1534           log   (getenv "LOGNAME"))
1535
1536     (when (and unix-fix
1537                tinypath-:verbose-info-messages
1538                (not tinypath-:win32-p))
1539       (tinypath-tmp-message
1540        (format
1541         (concat
1542          "\
1543 ** TinyPath.el: [INFO] environment variable %s was `%s'
1544
1545    Hm. This error should not normally happen in Unix environment, but this
1546    may be a bash(1) problem, which does not define USER by default.
1547    Please check you environment by logging in from a fresh terminal. You
1548    can correct it in your shell's startup file or inform System
1549    Administrator of your site. Here is an example:
1550
1551        $HOME/.bashrc:   export USER=$LOGNAME    # If you have $LOGNAME
1552        $HOME/.tcshrc:   setenv USER foo")
1553         unix-fix (getenv unix-fix))))
1554     (when (and win32-fix
1555                tinypath-:verbose-info-messages)
1556       (tinypath-tmp-message
1557        (format
1558         (concat
1559          "\
1560 ** TinyPath.el: [INFO] environment variable %s set to `%s'
1561
1562    In this Windows ME/NT/2000 there was variable USERNAME which was copied
1563    to USER. Note however, that this only sets Emacs environment, and does
1564    not affect outside environment, so you're adviced to define these
1565    variables permanetly through Start=> Control-Panel=>
1566    SystemIcon/Environment tab/
1567
1568    If you want to set this locally to your Emacs, add following code
1569    to your startup file at $HOME/.emacs
1570
1571       ;; \"username\" must contain no spaces. Max 8 characters
1572       (setenv \"USER\"  \"username\")
1573
1574    In Windows Win95/98/NT: Add this statement to your c:\\AUTOEXEC.BAT file
1575    and reboot the computer.
1576
1577       set USER=johndoe
1578       set LOGNAME=johndoe
1579
1580    The `johndoe' is a short, usually maximum of 8 characters, which must
1581    not contain spaces. The value usually is the same as the HOME path's
1582    last directory name.
1583
1584    In Windows ME/2000/etc use Start => Control-Panel => System and
1585    select `advanced' tab and `environment' button to alter the values.
1586    Fill in the values and click `ok' to activate new environment.\n\n")
1587         win32-fix (getenv win32-fix))))))
1588
1589 ;;; ----------------------------------------------------------------------
1590 ;;;
1591 (defun tinypath-install-environment ()
1592   "Check environment variables."
1593   (tinypath-install-environment-home)
1594   (tinypath-install-environment-user))
1595
1596 ;;}}}
1597
1598 ;;{{{ Load time functions and macros
1599
1600 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1601 ;;
1602 ;;      This section must be before variable definitions.
1603 ;;      The functions must be available during the variable
1604 ;;      initializations, that's why `eval-and-compile' wrapping.
1605 ;;
1606 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1607
1608 ;;; --++-- --++-- --++-- --++-- --++-- --++-- --++--  eval-and-compile --
1609
1610 (eval-and-compile
1611
1612 ;;; ----------------------------------------------------------------------
1613 ;;;
1614   (defun tinypath-byte-compile-running-p ()
1615     "Return non-nil if byte compiling file."
1616     (string= (buffer-name) " *Compiler Input*"))
1617
1618 ;;; ----------------------------------------------------------------------
1619 ;;; Only some values are recorded as messages to the *Messages* buffer
1620 ;;; Showing the values possibly makes user think if he needs
1621 ;;; to change the defaults.
1622 ;;;
1623   (put 'tinypath-set-default-value-macro 'lisp-indent-function 1)
1624   (put 'tinypath-set-default-value-macro 'edebug-form-spec '(body))
1625   (defmacro tinypath-set-default-value-macro (var &rest body)
1626     "Print verbose messages when activating VAR and run BODY."
1627     (`
1628      (let* (val)
1629        ;;  This may call several functions.
1630        (setq val (,@ body))
1631        (unless (tinypath-byte-compile-running-p)
1632          (message "TinyPath: Default value for `%s' ... %s"
1633                   (, var)
1634                   (prin1-to-string val)))
1635        val)))
1636
1637 ;;; ----------------------------------------------------------------------
1638 ;;;
1639   (put 'tinypath-verbose-macro 'lisp-indent-function 1)
1640   (defmacro tinypath-verbose-macro (level &rest body)
1641     "When LEVEL is =< `tinypath-:verbose' run BODY."
1642     (`
1643      (when (and (numberp tinypath-:verbose)
1644                 (or (= (, level) tinypath-:verbose)
1645                     (< (, level) tinypath-:verbose)))
1646        (,@ body)
1647        (when (> tinypath-:verbose 19)
1648          (tinypath-log-write)))))
1649
1650 ;;; ----------------------------------------------------------------------
1651 ;;;
1652   (put 'tinypath-directory-sep-char-macro 'lisp-indent-function 0)
1653   (defmacro tinypath-directory-sep-char-macro (&rest body)
1654     "Emacs and XEmacs compatibility.
1655 In let, set `directory-sep-char' to / and run BODY."
1656     (`
1657      (let ((directory-sep-char ?/))
1658        (if (null directory-sep-char) ;; Byte compiler silencer
1659            (setq directory-sep-char nil))
1660        (,@ body))))
1661
1662 ;;; ----------------------------------------------------------------------
1663 ;;;
1664   (defsubst tinypath-expand-file-name (path)
1665     "Expand filenames and always use forward slashes."
1666     (cond
1667      ((and (not tinypath-:win32-p)
1668            ;; Nothing to do
1669            (string-match "^/" path)
1670            (not (string-match "\.\." path))))
1671      (t
1672       (tinypath-directory-sep-char-macro
1673        (setq path (expand-file-name path)))))
1674     (if tinypath-:win32-p
1675         (setq path (downcase path)))
1676     path)
1677
1678 ;;; ----------------------------------------------------------------------
1679 ;;;
1680   (put 'tinypath-expand-file-name-variable-macro  'lisp-indent-function 0)
1681   (defmacro tinypath-expand-file-name-variable-macro (var)
1682     "Expand list of paths stored in VAR symbol."
1683     (`
1684      (let (list)
1685        (dolist (path (, var))
1686 ;;;        (push (tinypath-expand-file-name path) list))
1687          (setq list (cons path list)))
1688        (setq (, var) (nreverse list)))))
1689
1690 ;;; ----------------------------------------------------------------------
1691 ;;;
1692   (defun tinypath-message-bug (bug &optional die)
1693     "Tell how to report BUG (string) and optionally DIE."
1694     (let* ((msg
1695             (substitute-command-keys
1696              (concat
1697               (format
1698                "TinyPath: [ERROR] report bug with name [%s]"
1699                bug)
1700               "See also \\[tinypath-version]"))))
1701       (if die
1702           (error msg)
1703         (message msg)
1704         (sit-for 5))))
1705
1706 ;;; ----------------------------------------------------------------------
1707 ;;;
1708   (defun tinypath-directory-up (dir)
1709     "Return precious DIR."
1710     (setq dir (file-name-as-directory dir)) ;; Ensure trailing slash
1711     (when (stringp dir)
1712       (file-name-directory
1713        ;; Delete trailing slash
1714        (substring dir
1715                   0
1716                   (1- (length dir))))))
1717
1718 ;;; ----------------------------------------------------------------------
1719 ;;;
1720   (defun tinypath-directory-subdirs (dir)
1721     "Return directories under DIR."
1722     (let* (list)
1723       (when (file-directory-p dir)
1724         (dolist (elt (directory-files dir 'full))
1725           (if (file-directory-p elt)
1726 ;;;            (push elt list)
1727               (setq list (cons elt list)))))
1728       list))
1729
1730 ;;; ----------------------------------------------------------------------
1731 ;;; #copy: tinyliba.el
1732 ;;;
1733   (defun tinypath-ti::win32-cygwin-p (&optional use-cache)
1734     "Return root if path to cygwin1.dll is found from `exec-path'.
1735 If USE-CACHE is non-nil, retrieve cached value."
1736     (let (ret)
1737       (cond
1738        ((and use-cache
1739              (get 'tinypath-ti::win32-cygwin-p 'cache-set))
1740         (setq ret (get 'tinypath-ti::win32-cygwin-p 'cache-value)))
1741        (t
1742         (put 'tinypath-ti::win32-cygwin-p 'cache-set t)
1743         (dolist (path exec-path)
1744           (when (and (stringp path)
1745                      (file-exists-p
1746                       (concat
1747                        (file-name-as-directory path) "cygwin1.dll"))
1748                      (file-exists-p
1749                       (concat
1750                        (file-name-as-directory path) "cygpath.exe")))
1751             ;;  The root directory is one DIR up from bin/cygwin1.dll
1752             ;;
1753             ;;  1) Drop the trailing slash  ../bin
1754             ;;  2) Give one directory up    ..
1755             ;;
1756             ;;  We have to leave trailing slash, because the resulting
1757             ;;  directory may be in the worst case C:/
1758             ;;  (which is NOT recommended place for cygwin install)
1759             ;;
1760             (when (string-match "^\\(.*\\)[/\\]" path)
1761               (setq path
1762                     (match-string 1 path))
1763               (setq ret path)
1764               ;;  This is native Cygwin Emacs, not a Win32 version
1765               ;;  if path is empty: /bin => one up => ''
1766               (when (string= ret "")
1767                 (setq ret "/"))
1768               (put 'tinypath-ti::win32-cygwin-p 'cache-value ret)
1769               (return))))))
1770       ret))
1771
1772 ;;; ----------------------------------------------------------------------
1773 ;;; Earlier XEmacs and Emacs `executable-find' functions are buggy
1774 ;;; and do not find binaries correctly, so we use our own implemantation.
1775 ;;;
1776   (defun tinypath-executable-find (file)
1777     "Find FILE along path. FILE must be absolute name with possible .exe
1778 Emacs `executable-find' tries various suffixes in Win32, but this
1779 function just looks if FILE exists along load path."
1780     (let* (ret name)
1781       (dolist (path exec-path)
1782         (setq name (concat (file-name-as-directory path) file))
1783         (when (and (not (file-directory-p name))
1784                    (file-exists-p name))
1785           (setq ret (tinypath-expand-file-name name))
1786           (return)))
1787       ret))
1788
1789 ;;; ----------------------------------------------------------------------
1790 ;;;
1791   (defun tinypath-executable-find-binary (file)
1792     "Try finding binary: FILE or FILE.exe in win32."
1793     (if tinypath-:win32-p
1794         (tinypath-executable-find (concat file ".exe"))
1795       (tinypath-executable-find file)))
1796
1797 ;;; ----------------------------------------------------------------------
1798 ;;;
1799   (defun tinypath-emacs-versions (&optional noerr cache)
1800     "Return possible version numbers for current Emacs. NOERR.
1801 If CACHE is set, use cached value."
1802     (interactive)
1803     (if (and cache
1804              (get 'tinypath-emacs-versions 'version))
1805         (get 'tinypath-emacs-versions 'version)
1806       (let* ((str (emacs-version))
1807              ;;   XEmacs beta has spaces in this variable. Just take
1808              ;;   the first word from it. There must be no spaces
1809              ;;   in filename returned from this function
1810              ;;
1811              ;;   emacs-version: "21.2  (beta19) \"Shinjuku\" XEmacs Lucid"
1812              (patch          (progn
1813                                (cond
1814                                 ((string-match "patch \\([0-9]+\\)" str)
1815                                  (match-string 1 str))
1816                                 ;;  XEmacs 21.1  (beta23)
1817                                 ((string-match "(beta\\([0-9]+\\))" str)
1818                                  (match-string 1 str)))))
1819              (major-version-x-x  (progn
1820                                    (string-match "[0-9]+\\.[.0-9]" str)
1821                                    (match-string 0 str)))
1822              (major-version  (progn
1823                                (string-match "[0-9]+\\.[.0-9]+" str)
1824                                (match-string 0 str)))
1825              (version        (concat major-version ;; 20.6.1
1826                                      (if patch
1827                                          (concat "." patch)
1828                                        "")))
1829              ret)
1830         (dolist (ver (list  version  major-version major-version-x-x))
1831           (when ver
1832             (pushnew ver ret :test 'string=)))
1833         (when ret
1834           (put 'tinypath-emacs-versions 'version ret))
1835         (or ret
1836             (and (null noerr)
1837                  (tinypath-message-bug "Can't parse `emacs-version'."))))))
1838
1839 ;;; ----------------------------------------------------------------------
1840 ;;;
1841   (defun tinypath-emacs-root-by-other-methods ()
1842     "Return ROOT of emacs installation directory."
1843     (let* ((sym  'invocation-directory)
1844            ;;  Use `symbol-value' to compile cleanly in all
1845            ;;  Emacs and XEmacs versions. It just hides the variable form
1846            ;;  Byte compiler
1847            (val  (if (and (boundp sym)
1848                           (stringp (symbol-value sym)))
1849                      (symbol-value sym)))
1850            (dir  (and val
1851                       (file-directory-p val)
1852                       (file-name-as-directory val))))
1853       (when dir
1854         (tinypath-directory-up dir))))
1855
1856 ;;; ----------------------------------------------------------------------
1857 ;;;
1858   (defun tinypath-emacs-core-path-p (path &optional version)
1859     "Test if PATH is core Emacs path. VERSION number can be found from path."
1860     ;;  PATH name must contain version for this emacs and subdirectory "lisp"
1861     (and (if version
1862              (string-match (regexp-quote version) path)
1863            t)
1864          ;; /usr/local/share/emacs/20.7/site-lisp
1865          (string-match "[/\\]lisp" path)
1866          (string-match (concat
1867                         ;;  Win32 installs emacs-20.4
1868                         "^.*emacs-[0-9]+\\.+[0-9.-]+"
1869                         ;;  Unix installs emacs/20.4
1870                         "\\|^.*emacs[/\\][0-9]+\\.+[0-9.-]+")
1871                        path)))
1872
1873 ;;; ----------------------------------------------------------------------
1874 ;;;
1875   (defun tinypath-emacs-root-by-load-path ()
1876     "Return ROOT of emacs installation directory by reading `load-path'.
1877 Return:
1878
1879    '(matched-part original-path)."
1880     (let* ((ver (car-safe (tinypath-emacs-versions 'noerr 'cache)))
1881            ret)
1882       (if (null ver)
1883           (tinypath-message-bug "root-by-load-path")
1884         (dolist (path load-path)
1885           (when (and (stringp path)
1886                      (tinypath-emacs-core-path-p path ver))
1887             (return
1888              (setq ret (list
1889                         (match-string 0 path)
1890                         path))))))
1891       (unless ret
1892         ;; User has wiped the load-path information by accident,
1893         ;; Try doing something about it.
1894         ;;
1895         ;; #todo: Should we restore part of the path from $EMACSLOADPATH ?
1896         ;; --> I'm afraid not many set the variable at all
1897         (let ((path (tinypath-emacs-root-by-other-methods)))
1898           (if path
1899               (setq ret (list path path)))))
1900       (tinypath-verbose-macro 7
1901                               (message "TinyPath: EMACS ROOT %s" (or (car-safe ret) "<nil>")))
1902       ret))
1903
1904 ;;; ----------------------------------------------------------------------
1905 ;;;
1906   (defun  tinypath-emacs-root-directory ()
1907     "Return Emacs installation root directory."
1908     (cond
1909      ((and invocation-directory
1910            ;;  In Unix this is /usr/local/bin  which is NOT the
1911            ;;  Emacs installatio place.
1912            ;;
1913            ;;  In Win32 this is c:/.....emacs-21.3/bin/ which
1914            ;;  can be used
1915            (file-directory-p (concat invocation-directory "../lisp")))
1916       (tinypath-expand-file-name
1917        (concat invocation-directory "../lisp")))
1918      (t
1919       (car-safe (tinypath-emacs-root-by-load-path)))))
1920
1921 ;;; ----------------------------------------------------------------------
1922 ;;;
1923   (defun tinypath-load-path-string-match (regexp)
1924     "Check if REGEXP is found form load path. Return first match."
1925     (dolist (path load-path)
1926       (when (and (stringp path)
1927                  (string-match regexp path))
1928         (return path))))
1929
1930 ;;; ----------------------------------------------------------------------
1931 ;;;
1932   (defun tinypath-load-path-add-subdirs (root &optional verbose)
1933     "Add all subdirectories of ROOT to `load-path' with VERBOSE message level.
1934 ROOT can be a single directory or list of directories."
1935     (cond
1936      ((stringp root)
1937       (setq root (list root)))
1938      ((listp root)
1939       nil)
1940      (t
1941       (error "Incorrect ROOT parameter value: %s" root)))
1942     (dolist (dir root)
1943       (dolist (subdir (tinypath-directory-subdirs dir))
1944         ;;  Convert forward and backward slashes.
1945         (setq subdir
1946               (tinypath-expand-file-name subdir))
1947         (unless (string-match tinypath-:boot-ignore-directory-regexp subdir)
1948           (tinypath-verbose-macro (or verbose 8)
1949                                   (message "TinyPath: add subdir %s" subdir))
1950           (pushnew subdir load-path :test 'string=)))))
1951
1952 ;;; ----------------------------------------------------------------------
1953 ;;;
1954   (defun tinypath-default-load-path-root-user ()
1955     "Return user's Emacs Lisp path by guessing various directories."
1956     (flet ((msg (m)
1957                 (message m)
1958                 (unless tinypath-:startup-no-messages
1959                   (sit-for 2))
1960                 nil))
1961       (if (null (getenv "HOME"))
1962           (msg "TinyPath: [ERROR] Environment variable HOME is not set.")
1963         (let* (ret)
1964           (dolist (dir (list
1965                         (if tinypath-:xemacs-p
1966                             "~/.xemacs.d")
1967                         (if tinypath-:xemacs-p
1968                             "~/.xemacs")
1969                         "~/.emacs.d" ;; New Emacs
1970                         "~/elisp"
1971                         "~/lisp"
1972                         "~/.elisp"
1973                         "~/.lisp"
1974                         "~/.emacs"))
1975             (when (and (stringp dir)
1976                        (file-directory-p dir))
1977               (setq ret dir)))
1978           (unless ret
1979             ;;  Try to scan all of home for lisp. Hm, Ugh.
1980             ;;  Perhaps a user who starts Emacs for the first time, or
1981             ;;  a Windows, where HOME is not set.
1982             (tinypath-verbose-macro 3
1983                                     (msg (format
1984                                           (concat "TinyPath: [WARN] Can't determine personal "
1985                                                   "lisp package directory. $HOME/elisp was expected. "
1986                                                   "This is probably harmless; "
1987                                                   "see variable tinypath-:load-path-root for more."
1988                                                   "Environment variable HOME is [%]")
1989                                           (or (getenv "HOME")
1990                                               "<not set>")))))
1991           ret))))
1992
1993 ;;; ----------------------------------------------------------------------
1994 ;;;
1995   (defun tinypath-default-load-path-root-dirs ()
1996     "Find default directories for `tinypath-:load-path-root'."
1997     (let (list)
1998       (dolist (dir
1999                (list
2000                 (tinypath-default-load-path-root-user)
2001
2002                 ;;  site wide configuration
2003                 ;;  #todo: where is XEmacs installed by default?
2004                 (if (not tinypath-:xemacs-p)
2005                     (concat
2006                      "/usr/local/share/emacs/"
2007                      (if (string-match "[0-9]+\\.[0-9]+" emacs-version)
2008                          (match-string 0 emacs-version)
2009                        "")
2010                      "/lisp"))
2011                 ;; Cygwin
2012                 "/var/share/site-lisp"
2013                 ;; Debian
2014                 "/usr/local/lib/emacs/site-lisp"
2015                 "/usr/local/share/emacs/site-lisp"
2016                 "/usr/local/share/site-lisp"
2017                 "/opt/share/site-lisp"
2018                 "/opt/local/share/site-lisp"
2019                 "/opt/local/share/emacs/site-lisp"))
2020         (when (stringp dir)
2021           (message "TinyPath: default tinypath-:load-path-root => %s %s"
2022                    dir
2023                    (if (file-directory-p dir)
2024                        "OK"
2025                      "NOT EXIST"))
2026           (if (file-directory-p dir)
2027               (push dir list))))
2028       list))
2029
2030 ;;; ----------------------------------------------------------------------
2031 ;;;
2032   (defun  tinypath-directory-search (dir list &optional verb bug)
2033     "Search DIR in the hierarchy of directories upward.
2034
2035 Input:
2036
2037   DIR       Directory to search. This can be nil.
2038
2039   LIST      List of possible search directories.
2040             -- A simple string means absolute location/DIR
2041             -- Directory enclosed in (dir count) means that the directory is
2042                also searched `count' levels upward.
2043             -- Directory enclosed in (dir 'abs) means absolute location
2044                without using parameter DIR.
2045
2046             For example with value:
2047
2048             '(/dir1 (/some/more/of/dir2 2) (/this/location abs)  /dir3 ...)
2049
2050             The choices searched are:
2051
2052             /dir1/DIR
2053             /some/more/of/dir2/DIR
2054             /some/more/of/DIR
2055             /this/location
2056             /dir3/DIR
2057
2058   VERB     Verbose messages.
2059   BUG      If set, and DIR not found, call `tinypath-message-bug'."
2060     (let* (found)
2061       (flet ((check-dir
2062               (try dir)
2063               (setq try (tinypath-expand-file-name
2064                          (concat (file-name-as-directory try)
2065                                  dir)))
2066               (if verb
2067                   (message "TinyPath: directory search ... %s" try))
2068               (when (file-directory-p try)
2069                 (if verb
2070                     (message "TinyPath: directory search ... found %s" try))
2071                 try)))
2072         (or dir
2073             (setq dir ""))
2074         (dolist (try list)
2075           (cond
2076            ((stringp try)
2077             (if (setq found (check-dir try dir))
2078                 (return)))
2079            ((listp try)
2080             (multiple-value-bind (path count) try
2081               (cond
2082                ((and (stringp path)
2083                      (eq count 'abs))
2084                 (if (setq found (check-dir path dir))
2085                     (return)))
2086                ((and (stringp path)
2087                      (integerp count))
2088                 (while (and (stringp path)
2089                             (not (zerop count))
2090                             (> count 0))
2091                   (if (setq found (check-dir path dir))
2092                       (return))
2093                   (decf count)
2094                   (setq path
2095                         (tinypath-directory-up path)))))))))
2096
2097         (cond
2098          (found ;;#todo: anything to do here?
2099           t)
2100          (t
2101           ;;  Hope people that have it in non-standard locations
2102           ;;  will tell it to maintainer.
2103           (when (and verb bug)
2104             (message "TinyPath: [WARNING] %s not found." dir)
2105             (tinypath-message-bug
2106              (format "Directory lookup fail %s" dir)))))
2107         found)))
2108
2109 ;;; ----------------------------------------------------------------------
2110 ;;;
2111   (defun tinypath-load-path-initial-value-xemacs (root &optional force)
2112     "Add XEmacs installation lisp directories to `load-path'.
2113
2114 Input:
2115
2116   ROOT      XEmacs installation root directory.
2117             See function `tinypath-emacs-root-directory'.
2118
2119   FORCE     Try to locate xemacs-packages even if that directory is
2120             found from `load-path'. The force option unconditionally
2121             adds all found directories to `load-path'. No duplicates
2122             are added though. This option is able to fix broken
2123             `load-path'."
2124     ;;  Latest XEmacs does not include all of its packages in the
2125     ;;  standard installation, but in a huge archive called "SUMO", which
2126     ;;  contains subdirectory "xemacs-packages".
2127     ;;
2128     ;;  We have no way of knowing where that directory has been unpacked, but
2129     ;;  try few guesses anyway.
2130     (when (and tinypath-:xemacs-p
2131                (boundp 'emacs-major-version)
2132                ;;  The `symbol-value' is just a byte compiler silencer
2133                ;;  after the above `boundp' test.
2134                (> (symbol-value 'emacs-major-version) 20)
2135                (or force
2136                    (null (tinypath-load-path-string-match
2137                           "xemacs-packages"))))
2138       (message "TinyPath: load-path auto-boot [XEmacs] ...")
2139       (let* (found
2140              xemacs-packages)
2141         ;;  Search under standard location
2142         ;;  <XEmacs-root>/xemacs-packages  or
2143         ;;  XEmacs/XEmacs-21.2/xemacs-packages
2144         (dolist (lisp '("xemacs-packages"
2145                         "mule-packages"
2146                         "site-packages"))
2147           (setq lisp (concat lisp "/lisp"))
2148           (when (setq found
2149                       (tinypath-directory-search
2150                        lisp
2151                        (list (list root 3))
2152                        'verb
2153                        'bug))
2154             (if (string= lisp "xemacs-packages/lisp")
2155                 (setq xemacs-packages found))
2156             (tinypath-load-path-add-subdirs found)))
2157         ;; Still not found? Try few more alternatives. This time
2158         ;; we only try to find the "xemacs-packages"
2159         (unless xemacs-packages
2160           (when (setq found
2161                       (tinypath-directory-search
2162                        "xemacs-packages/lisp"
2163                        (list
2164                         ;;  The first is historical location
2165                         ;;  of a vanilla-configured XEmacs
2166                         '("/usr/local/lib/xemacs" abs)
2167                         ;;  Try more guesses
2168                         '("/usr/share/lib/xemacs" abs)
2169                         '("/usr/lib/xemacs" abs)
2170                         '("~/.xemacs-packages/lisp" abs)
2171                         '("~/.xemacs")
2172                         '("~" abs)
2173                         '("~/site-lisp" abs)
2174                         '("~/lisp")
2175                         '("~/elisp"))
2176                        'verb
2177                        'bug))
2178             (tinypath-load-path-add-subdirs found)))
2179         (message "TinyPath: load-path auto-boot [XEmacs]... done."))))
2180
2181 ;;; ----------------------------------------------------------------------
2182 ;;;
2183   (defun tinypath-load-path-initial-value (&optional dir-list)
2184     "Add Emacs installation lisp directories to `load-path'.
2185 This is solely used for booting up tinypath.el package, so that
2186 `require' commands can be satisfied. Without the core packages available
2187 in `load-path' it is not possible to use Emacs.
2188
2189 The DIR-LIST is location of additional directories to consider as
2190 Emacs core-lisp installation directories."
2191     (let* ((root-base (tinypath-emacs-root-directory))
2192            (dir-p     (and root-base
2193                            (file-directory-p root-base)))
2194            root)
2195       (message "TinyPath: load-path auto-boot (Emacs install dir)... %s"
2196                (if root-base
2197                    root-base
2198                  "[can't find Emacs install root]")
2199                (if dir-p
2200                    "(dir nok)"
2201                  "(dir ok)"))
2202       (when (and root-base
2203                  dir-p)
2204         ;;  Why this booting is even needed? Isn't `load-path' already
2205         ;;  set, when Emacs starts? Not quite. Emacs does not include term/
2206         ;;  directory in `load-path', because it has peculiar way of
2207         ;;  requiring (load "term/vt100"). This boot section will ensure
2208         ;;  that all paths are included in `load-path'.
2209         ;;
2210         (message "TinyPath: load-path auto-boot [running]")
2211         (setq root-base (file-name-as-directory root-base))
2212         ;;
2213         ;;  Make ROOT/lisp directory. This is the same for all
2214         ;;  Emacs versions. Win32 conversion to lowercase
2215         ;;
2216         (setq root (tinypath-expand-file-name (concat root-base "lisp")))
2217         ;;
2218         ;; This is just ultimate safeguard. We did find the
2219         ;; root, but that doesn't mean it is included in the `load-path'
2220         ;; E.g. there may be directories /ROOT/lisp/something
2221         ;;
2222         ;; It is still possible that member fails, because
2223         ;;
2224         ;; - Win32 can have mixed case paths, C:/ and c:/ are
2225         ;;   different to pushnew
2226         ;; - Win32 slashes c:\ c:/ confuse pushnew.
2227         ;;
2228         ;; These will be handled in the final install phase,
2229         ;; see function `tinypath-load-path-clean'
2230         ;;
2231         (unless (or (member root load-path)
2232                     (member (file-name-as-directory root) load-path))
2233           (pushnew root load-path :test 'string=)
2234           (message "TinyPath: load-path auto-boot [%s added]." root))
2235         ;;
2236         ;;  We might have included this line inside the above `unless',
2237         ;;  after `pushnew' but we do not do that. It's not a guarantee
2238         ;;  that subdirectories are there if ROOT was there.
2239         ;;
2240         (message "TinyPath: booting standard Emacs lisp paths.")
2241         (tinypath-load-path-add-subdirs root 2)
2242         (tinypath-load-path-initial-value-xemacs root-base)
2243         ;;  Add user supplied additional paths.
2244         (when dir-list
2245           (message "TinyPath: booting user supplied lisp paths.")
2246           (tinypath-load-path-add-subdirs dir-list))
2247         (message "TinyPath: load-path auto-boot... done"))))
2248
2249 ;;; ----------------------------------------------------------------------
2250 ;;;
2251   (defun tinypath-tmp-find-root-home ()
2252     "Return suitable root user HOME directory. /home/root etc."
2253     (let (ret)
2254       (dolist (path (list
2255                      (if (and (not tinypath-:win32-p)
2256                               (eq (user-uid) 0))
2257                          (getenv "HOME"))
2258                      "/home/root"
2259                      "/users/root"
2260                      "/root"
2261                      "/"))
2262         (when (and (stringp path)
2263                    (file-directory-p path))
2264           (message "TinyPath: tinypath-tmp-find-root-home [%s]" path)
2265           (setq ret path)
2266           (return)))
2267       ret))
2268
2269 ;;; ----------------------------------------------------------------------
2270 ;;;
2271   (defun tinypath-tmp-find-writable-dir (&optional file)
2272     "Find writable directory and append FILE to it. Only used at startup.
2273 This function sets initial values for variable
2274 `tinypath-:cache-file-prefix'.
2275
2276 User should `setq' this variable before calling tinypath.el
2277
2278 References:
2279
2280   `tinypath-:cache-file-prefix'
2281   `tinypath-:load-path-dump-file'"
2282     (let ((root-home   (tinypath-tmp-find-root-home))
2283           (root-user-p (and (not tinypath-:win32-p)
2284                             (eq (user-uid) 0)))
2285           (user        (or (getenv "USER")
2286                            (getenv "LOGNAME")
2287                            (if (boundp 'user-login-name) ;; Not in XEmacs 21.4
2288                                user-login-name)
2289                            (let ((home (expand-file-name "~")))
2290                              (if (string-match "\\([^/\\]+\\)$" home)
2291                                  (match-string 1 home)))
2292                            ""))
2293           ret)
2294       (when (and (not (file-directory-p "~/tmp"))
2295                  (not (file-directory-p "c:/"))) ;; Non-Win32 system
2296         (message "TinyPath: [WARNING] Cannot find $HOME/tmp directory."))
2297       (dolist (dir '("~/.emacs.d/config/"
2298                      "~/elisp/config/"
2299                      "~/elisp/conf/"
2300                      "~/lisp/config/"
2301                      "~/lisp/conf/"
2302                      "~/.xemacs/config/"
2303                      "~/tmp/"
2304                      "~"
2305                      "/tmp/"
2306                      "/var/tmp/"
2307                      "c:/temp/"
2308                      "c:/tmp/"
2309                      "c:/"))
2310         ;; The ROOT user is special case. (expand-file-name "~")
2311         ;; may return plain "/".
2312         ;; check if SysAdm has created
2313         ;; /home/root, /users/root etc. directory.
2314         (cond
2315          ((and root-user-p
2316                (string-match "~" dir))
2317           (setq dir
2318                 (if (string= root-home "/")
2319                     ;; ~  =>  ""
2320                     (replace-match "" nil nil dir)
2321                   ;; ~/tmp =>  /home/root/tmp
2322                   (replace-match root-home nil nil dir))))
2323          (t
2324           (setq dir (file-name-as-directory
2325                      (expand-file-name dir)))))
2326         (when (and (file-directory-p dir)
2327                    (file-writable-p
2328                     (concat dir
2329                             (or file "###tinypath.el-test###"))))
2330           ;; In multi-user environment, we must say /tmp/-USER-file
2331           (when (string= dir "/tmp/")
2332             (setq dir (concat dir "-" user "-" )))
2333           (setq ret (concat dir (or file "")))
2334           (return)))
2335       ;;  Last thing to do. If User has set his HOME to point to
2336       ;;  C:/, that is not a good idea. Move cache file under C:/TEMP
2337       (when (and (string-match "^[Cc]:[/\\]?$" ret)
2338                  (file-directory-p "C:/temp"))
2339         (message
2340          "TinyPath: [WARNING] find-writable-dir Using c:/temp instead of c:/")
2341         (setq ret "c:/temp"))
2342       (if ret
2343           ret
2344         (error "TinyPath: Can't find writable directory for %s" file))))
2345
2346   ) ;; --++-- --++-- --++-- --++-- --++-- --++-- --++-- eval-and-compile +--
2347
2348 ;;}}}
2349 ;;{{{ variables
2350
2351 ;;; ......................................................... &v-hooks ...
2352
2353 (defcustom tinypath-:load-hook '(tinypath-install)
2354   "*Hook run when package is loaded.
2355 Please make sure that this hook contains function `tinypath-install'
2356 or nothing will be set up to Emacs when you load tinypath.el.
2357
2358 Other suggested function could be put to this hook:
2359   `tinypath-exec-path-check-verbose-fix'
2360   `tinypath-install-timer'."
2361   :type  'hook
2362   :group 'TinyPath)
2363
2364 (defcustom tinypath-:load-path-function 'tinypath-load-path-setup
2365   "*Function define all additional paths to the `load-path'."
2366   :type  'function
2367   :group 'TinyPath)
2368
2369 (defcustom tinypath-:report-mode-define-keys-hook
2370   '(tinypath-report-mode-default-bindings)
2371   "*List of functions to run which define keys to `tinydesk-mode-map'."
2372   :type  'hook
2373   :group 'TinyPath)
2374
2375 (defcustom tinypath-:report-mode-hook nil
2376   "*Hook run after the `tinypath-report-mode' is turned on."
2377   :type  'hook
2378   :group 'TinyPath)
2379
2380 (defcustom tinypath-:cache-duplicate-report-hook nil
2381   "*Hook run after the `tinypath-cache-duplicate-report' function.
2382 The point is at the beginning of `tinypath-:report-buffer' when
2383 the hook is run."
2384   :type  'hook
2385   :group 'TinyPath)
2386
2387 (defcustom tinypath-:load-path-ignore-regexp-hook  nil
2388   "*Hook run after the `tinypath-:load-path-ignore-regexp' is defined.
2389 You can use this to add more ignore regexps to the default value.
2390 See Manual for the details M-x tinypath-version and \"Gnus\"."
2391   :type  'hook
2392   :group 'TinyPath)
2393
2394 ;;; ........................................................ &v-public ...
2395 ;;; User configurable
2396
2397 (defcustom tinypath-:load-path-accept-criteria t
2398   "*Control which incarnation of the installed package is respected.
2399 When Emacs is installed, it contains many packages that may be
2400 maintained out of Emacs core. (e.g. in CVS)
2401 You may find or install more up to date version from developer's site.
2402
2403 Example: cperl-mode.el
2404
2405   Take for example cperl-mode.el which is avalable at
2406   http://cpan.perl.org/modules/by-authors/Ilya_Zakharevich/cperl-mode/
2407
2408   The package is installed in Emacs kit at location:
2409
2410       <root>/emacs-20.7/lisp/progmodes/cperl-mode.el
2411
2412   For ystem wide installation, more up to date package could
2413   be found at:
2414
2415       /usr/local/share/site-lisp/net/users/zakharevich-ilya/cperl-mode.el
2416
2417   and private user may keep the package in
2418
2419      ~/elisp/cperl-mode.el
2420
2421 Which package loads?
2422
2423   nil           First one that is in `load-path', when the cache was built.
2424                 See `tinypah-cache-problem-report'.
2425
2426   t             Choose package under $HOME, or one at site wide or
2427                 one in the default installation.
2428
2429   function      If this is a callable function, pass LIST of paths
2430                 to it to choose the correct package. Function must
2431                 return string PATH or nil.")
2432
2433 (defcustom tinypath-:compression-support nil
2434   "*Type of compression support: 'default, 'all or 'none.
2435
2436 'default
2437
2438     Files ending to .gz and .bz2 files are counted in when
2439     a load command is issued.
2440
2441 'all
2442
2443     In addition to 'default, also autoloaded functions can be found from
2444     compressed files. This means that statements like these will work:
2445
2446     (autoload 'jka-compr \"jka-compr\")
2447
2448     The recommendation is that you set this value to 'all if you keep your lisp
2449     files in compressed format to save space.
2450
2451 nil
2452
2453     Do not use compression support. Seach only .el and .elc files.
2454     This is the recommended setting in case there is no need for
2455     compressed files. It will speed searching considerably.
2456
2457     Variable `tinypath-:compressed-file-extensions' is not used.
2458
2459 'none
2460
2461     Do not use cache at all. Use this if the cache is broken. In Total
2462     emergency, call M-x -1 `tinypath-cache-mode' to disable all advises.
2463
2464 This value must be set once, before package is loaded. Changing it afterwards
2465 has no effect."
2466   :type '(choice (const default)
2467                  (const all)
2468                  (const none))
2469   :group 'TinyPath)
2470
2471 (when (and (boundp 'command-line-args)
2472            (member "-debug-init" (symbol-value 'command-line-args)))
2473   (put 'tinypath-:verbose 'debug-init tinypath-:verbose)
2474   (message "tinypath: VERBOSE 10; Emacs option was -debug-init")
2475   (setq tinypath-:verbose 10))
2476
2477 (defcustom tinypath-:cache-expiry-days
2478   (tinypath-set-default-value-macro
2479    "tinypath-:cache-expiry-days"
2480    14)
2481   "*How many days until expiring `load-path' cache and rescan paths.
2482 If set to nil; do not use cache feature, but scan directories at startup."
2483   :type 'integer
2484   :group 'TinyPath)
2485
2486 (defcustom tinypath-:report-mode-name "TinyPathReport"
2487   "*The name of the `tinypath-report-mode'."
2488   :type  'string
2489   :group 'TinyPath)
2490
2491 (defcustom tinypath-:verbose
2492   (tinypath-set-default-value-macro
2493    "tinypath-:verbose"
2494    3)
2495   "*If number, bigger than zero, let user know what's happening.
2496 In error situations you can look old messages from *Messages* buffer.
2497 If you want all messages, set value to 10.
2498
2499 If you want killer-logging, select 20. All this will also save
2500 everything to `tinypath-:log-file'."
2501   :type  '(integer :tag "Verbose level 0 ... 10")
2502   :group 'TinyPath)
2503
2504 (defcustom tinypath-:verbose-timing
2505   (tinypath-set-default-value-macro
2506    "tinypath-:verbose-timing"
2507    nil)
2508   "*If non-nil, dispaly laod time of each `load' `load-library' `require' call.
2509 This variable is obsolete and not used.")
2510
2511 (eval-and-compile
2512
2513   (defun tinypath-cygwin-p ()
2514     "Return Cygwin installation root if Cygwin is along PATH."
2515     (let ((cygwin-p
2516            (cond
2517             ((locate-library "executable-find")
2518              (autoload 'executable-find "executable-find")
2519              ;;  Should be in /bin/cygrunsrv.exe
2520              ;;  The funcall just hides this from idiot byte compiler
2521              ;;  Which doesn't see autoload definition.
2522              (funcall (symbol-function 'executable-find) "cygrunsrv"))
2523             ((let (file)
2524                (dolist (dir exec-path)
2525                  (setq file
2526                        (concat (file-name-as-directory dir)
2527                                "cygrunsrv.exe"))
2528                  (if (file-exists-p file)
2529                      (return file))))))))
2530       (when cygwin-p
2531         ;;  X:/SOME/PREFIX/bin/cygrunsrv.exe => X:/SOME/PREFIX/
2532         (when (string-match "^\\(.*\\)/[^/]+/" cygwin-p)
2533           (match-string 1 cygwin-p)))))
2534
2535   (defun tinypath-info-default-path-list ()
2536     "Return default Info path candidate list."
2537     (let ((cygwin-p (tinypath-cygwin-p))
2538           (list
2539            '("/usr/info"
2540              "/usr/local/info"
2541              "/usr/info/"
2542              "/doc/info"
2543              "/usr/share/info"
2544              "/usr/local/share/info"
2545              "/opt/info"
2546              "/opt/share/info"))
2547           ret)
2548       ;;  Add more default info paths to search
2549       (when cygwin-p
2550         (dolist (elt '("usr/info"  "usr/local/info"))
2551           (push (concat (file-name-as-directory cygwin-p)  elt) list)))
2552       ;;  Drop non-existing directories
2553       (dolist (elt list)
2554         (when (file-directory-p elt)
2555           (push elt ret)))
2556       ret))
2557
2558   (defcustom tinypath-:Info-default-directory-list
2559     (tinypath-info-default-path-list)
2560     "*Additional INFO directories to check for inclusion.
2561 Any new entries in these directories are checked and
2562 fixed and added to `Info-default-directory-list'."
2563     :type '(list directory)
2564     :group 'TinyPath)) ;; eval-and-compile end
2565
2566 (message "TinyPath: [VAR] tinypath-:Info-default-directory-list %s"
2567          (prin1-to-string tinypath-:Info-default-directory-list))
2568
2569 ;;  We can't use `ti::package-config-file-prefix' NOW, because the tinylibm.el
2570 ;;  is not yet loaded - `load-path' is not yet know for sure.
2571 ;;
2572 ;;  #todo: this is hard coded location. If Emacs ever defines similar function
2573 ;;  #todo: then we can start using it to put config files to common place.
2574
2575 (defcustom tinypath-:compressed-file-extensions
2576   (delq
2577    nil
2578    (cond
2579     (tinypath-:win32-cygwin-p
2580      ;;  We know that Cygwin contains programs for these
2581      '(".gz" ".bz2"))
2582     (t
2583      (list
2584       ;;  The order is important. Put most likely first
2585       (if (tinypath-executable-find-binary "bzip2")    ".bz2")
2586       (if (tinypath-executable-find-binary "gzip")     ".gz")))))
2587   ;;  2003-05-18 commented out. the "Z" compression is way too obsolete
2588   ;;  it is also faster to check only 2 extensions
2589   ;; (if (tinypath-executable-find-binary "compress") ".Z")))
2590   "*List of supported compressed file extensions.
2591 The default list is built dynamically by checking the binary in `exec-path'.
2592 The default list is:
2593
2594 \(setq tinypath-:compressed-file-extensions '( \".gz\" \".bz2\"))
2595
2596 References:
2597   `tinypath-:compression-support'."
2598   :type  '(list  string)
2599   :group 'TinyPath)
2600
2601 (message "TinyPath: [VAR] tinypath-:compressed-file-extensions %s"
2602          (prin1-to-string tinypath-:compressed-file-extensions))
2603
2604 (defcustom tinypath-:cache-file-prefix
2605   ;;
2606   ;; Can't use `ti::package-config-file-prefix', because the library
2607   ;; is not loaded yet. USER MUST SETQ THIS VARIABLE
2608   ;;
2609   (tinypath-set-default-value-macro
2610    "tinypath-:cache-file-prefix"
2611    (tinypath-tmp-find-writable-dir "emacs-config-tinypath-cache"))
2612   "*File where to store `tinypath-:cache'. See `tinypath-:cache-file-postfix'.
2613 This is only a prefix for filename. The whole filename is returned by
2614 function `tinypath-cache-file-name' which appends emacs version id after
2615 this prefix string.
2616
2617 An example:  /home/some/elisp/config/tinypah-cache-"
2618   :type  'string
2619   :group 'TinyPath)
2620
2621 (message "TinyPath: [VAR] tinypath-:cache-file-prefix %s"
2622          (prin1-to-string tinypath-:cache-file-prefix))
2623
2624 (defcustom tinypath-:cache-file-hostname-function
2625   'tinypath-cache-file-hostname
2626   "*Function to return HOST for the cache file name.
2627
2628 You're interested on this variable only if you're running several networked
2629 machines and 1) you always have same, ONE mounted $HOME directory 2) and
2630 each machine has its own run-files, like site-lisp.
2631
2632 Use value nil to disable using hostname in cache file name:
2633
2634   (setq tinypath-:cache-file-hostname-function nil)
2635
2636 To activate the hostname portion in cache name, set variable to like this:
2637 This makes each HOST have its own cache.
2638
2639   (setq tinypath-:cache-file-hostname-function 'tinypath-cache-file-hostname)
2640
2641 See manual \\[tinypath-version] for more information."
2642   :type  'function
2643   :group 'TinyPath)
2644
2645 (message "TinyPath: [VAR] tinypath-:cache-file-hostname-function %s"
2646          (prin1-to-string tinypath-:cache-file-hostname-function))
2647
2648 ;;  We select the compressed file to save space if we can detect gzip
2649 ;;  in this environment.
2650
2651 (defcustom tinypath-:cache-file-postfix
2652   (if t
2653       ".elc"
2654     ;; 2000-01 Disabled for now
2655     (if (tinypath-executable-find-binary "gzip")
2656         ".el.gz"
2657       ".el"))
2658   "*Extension for `tinypath-:cache'. See also `tinypath-:cache-file-prefix'.
2659 The xtension may be compiled version \".elc\" or non-compiled \".el\".
2660 Even with compiled version, the .el file is also retained, because it's
2661 the only readable file and in emergencies you can fix it and load it by hand.
2662
2663 You could also set this to \".el.gz\" if space is crucial, but that makes
2664 startup lot slower. This is be\81´cause package must arrange loading jka-compr.el
2665 before anything else and the load time will increase with compression.
2666
2667 Do not st this to \".elc.gz\", it's not supported."
2668   :type  'string
2669   :group 'TinyPath)
2670
2671 (message "TinyPath: [VAR] tinypath-:cache-file-postfix %s"
2672          (prin1-to-string tinypath-:cache-file-postfix))
2673
2674 (defcustom tinypath-:load-path-dump-file
2675   ;;
2676   ;; Can't use `ti::package-config-file-prefix', because the library
2677   ;; is not loaded yet. USER MUST SETQ THIS VARIABLE
2678   ;;
2679   (tinypath-tmp-find-writable-dir "emacs-config-tinypath-dump.el")
2680   "*Where to store dumped load path. See `tinypath-load-path-dump'."
2681   :type  'file
2682   :group 'TinyPath)
2683
2684 (defcustom tinypath-:cache-duplicate-report-ignore-functions
2685   '(tinypath-cache-duplicate-report-ignore-function)
2686   "*Functions called with FILE. Return t to ignore FILE in duplicate report.
2687 Called from function `tinypath-cache-duplicate-report'."
2688   :type  'function
2689   :group 'TinyPath)
2690
2691 (message
2692  "TinyPath: [VAR] tinypath-:cache-duplicate-report-ignore-functions %s"
2693  (prin1-to-string
2694   tinypath-:cache-duplicate-report-ignore-functions))
2695
2696 (defcustom tinypath-:ignore-file-regexp nil
2697   "*Prohibit loading lisp file if regexp matches absolute path.
2698 If \"\\\\.elc\" ignore all compiled files and load only source files.
2699
2700 This regexp is matched against absolute filename being loaded and
2701 if it matches, the file is ignore. An error is signaled
2702 if there is no single choice available after exclude.
2703
2704 There may be reasons why you would always load only the non-compiled
2705 version and ignore compiled versions:
2706
2707 --  You are developing packages or debugging packages and you
2708     want your Emacs to load only non-compiled versions. The *Backtrace*
2709     buffer output is more sensible with non-compiled functions.
2710
2711     ==> Setting value to \".\" will ignore all compiled files.
2712
2713 --  You have share some site-lisp files with Emacs and XEmacs, but
2714     you primarily use GNU Emacs and the compiled files are for it.
2715     XEmacs must not load the compiled versions.
2716
2717     ==> Set this regexp in your $HOME/.emacs when XEmacs is loaded, to
2718     match the directory part of file which is located in shared lisp
2719     directory for Emacs and Xemacs."
2720   :type  'regexp
2721   :group 'TinyPath)
2722
2723 (defcustom tinypath-:manpath-ignore-regexp
2724   "terminfo"
2725   "*Regexp to exclude directories for MANPATH additions.
2726 It really isn't very serious if MANPATH contains few faulty directories,
2727 do don't worry. You can see the final results in `tinypath-:extra-manpath'."
2728   :type  'regexp
2729   :group 'TinyPath)
2730
2731 (defcustom tinypath-:exec-path-ignore-regexp nil
2732   "*Regexp to exclude directories for `exec-path' additions.
2733 The automatic Perl utility will find every directory under
2734 `tinypath-:extra-path-root' which contain executable files and them to
2735 `exec-path. Set this variable to ignore certain directories."
2736   :type  'regexp
2737   :group 'TinyPath)
2738
2739 (defcustom tinypath-:load-path-ignore-regexp
2740   (concat
2741    "[/\\]"     ;; windows or unix dir separator start
2742    "\\("       ;; START grouping
2743    ;;   Skip Distributed help files
2744    "tex\\(i\\|info\\)$"
2745    "\\|doc[/\\]"
2746    ;;   Skip Other directories
2747    "\\|RCS[/\\]\\|CVS[/\\]\\|zip\\|\\.svn\\|/MT/"
2748    ;;   Skip Perl or other build directories
2749    "\\|\\.\\(cpan\\|build\\|s?inst\\)"
2750    ;;   Skip temporary directories /T/ /t/ /tmp* /temp*
2751    "\\|[Tt][/\\]\\|te?mp"
2752    ;;   Skip build directories
2753    "\\|\\.\\(build\\|s?inst\\)"
2754    (if (and (not tinypath-:xemacs-p)
2755             (not (string< emacs-version "21"))) ;; > 21
2756        "\\|psgml"
2757      "")
2758    (if (and (not tinypath-:xemacs-p)
2759             (not (string< emacs-version "21"))) ;; > 21
2760        "\\|pcl-cvs"                   ;Emacs 21.2 - under name pcvs.el
2761      "")
2762    (if (and (not tinypath-:xemacs-p)
2763             (not (string< emacs-version "21")))
2764        "\\|artist-[0-9.]+"              ;artist is in Emacs 21.2
2765      "")
2766    (if tinypath-:xemacs-p               ;EFS doesn't work in Emacs
2767        ""
2768      "\\|efs")
2769    ;;  20.x has custom lib, so we don't want to install private
2770    ;;  custom.el copy that we used for 19.x Emacs
2771    ;; (if (> emacs-major-version 19) "\\|custom" "")
2772    ;;  Do not use TM in latest Emacs. Gnus and VM has MIME handling.
2773    ;;  SEMI might be ok.
2774    ;; (if (> emacs-major-version 19) "\\|tm/\\|tm-[^/]+" "")
2775    "\\)")
2776   "*Regexp to match directories which to ignore. Case sensitive.
2777 If `tinypath-:load-path-ignore-regexp-extra' is string, it is appended ONCE
2778 to this default regexp.
2779
2780 This variable is case sensitive."
2781   :type  '(string :tag "Regexp")
2782   :group 'TinyPath)
2783
2784 (eval-and-compile
2785   (defvar tinypath-:install-flag t
2786     "If non-nil, install package.
2787 Should only be used in cases of maintenance and debug.
2788 To start debugging the package, set this variable nil before loading. Nothing
2789 is done until function `tinypath-install-main' is called.
2790
2791     (defun my-tinypath-debug-prepare ()
2792       (require 'elp)
2793       (require 'edebug)
2794       (setq debug-on-error t)
2795       (setq debug-ignored-errors nil)
2796       (setq tinypath-:install-flag nil)
2797       (setq tinypath-:cache-file-postfix \".elc\")
2798       (setq tinypath-:load-hook nil)
2799       (setq tinypath-:verbose 5)
2800       (setq tinypath-:load-path-root)))
2801           '(
2802             ;; \"~/elisp\"   ;; Commented out while debugging
2803                ;;  Run statements one by one with C-x C-e
2804     (my-tinypath-debug-prepare)
2805     (load \"/path/t/tinypath\")
2806     ;;  <at this point, you could instrument tinypath functions using elp>
2807     (tinypath-load-path-initial-value
2808      tinypath-:core-emacs-load-path-list)
2809     (tinypath-install-main)
2810     ;;  Do something and then call this:
2811     (tinypath-install)
2812
2813 The above is just an example how to prepare to debug package."))
2814
2815 (defvar tinypath-:load-path-ignore-regexp-extra nil
2816   "*String to add to `tinypath-:load-path-ignore-regexp'.
2817 Remember to start the regexp with OR-statement \\\\| because the regexp
2818 is added to existing value.
2819
2820 Value of this regexp is added every time the file is loaded.
2821 See Manual for explanation: M-x tinypath-version and \"Gnus\".")
2822
2823 ;; Append to default value. This is the easiest this way.
2824
2825 (when (and (stringp tinypath-:load-path-ignore-regexp)
2826            (stringp tinypath-:load-path-ignore-regexp-extra))
2827   (setq tinypath-:load-path-ignore-regexp
2828         (concat tinypath-:load-path-ignore-regexp
2829                 tinypath-:load-path-ignore-regexp-extra)))
2830
2831 ;;  Experienced users have a chance to add more regexps to the variable
2832
2833 (run-hooks 'tinypath-:load-path-ignore-regexp-hook)
2834
2835 (message "TinyPath: [VAR] tinypath-:ignore-file-regexp %s"
2836          (prin1-to-string tinypath-:ignore-file-regexp))
2837
2838 (eval-and-compile ;;  Needed at boot-time.
2839   (defcustom tinypath-:core-emacs-load-path-list nil
2840     "*List of core Emacs lisp directories.
2841
2842 Setting this variable is mandatory if the initial `load-path'
2843 in Emacs startup does not contain core lisp packages.
2844
2845 Emacs:
2846
2847     In Emacs, this would be directory where core lisp files
2848     reside, typically /usr/share/emacs/NN.N/lisp.
2849
2850 XEmacs:
2851
2852     In XEmacs, you would add the location of
2853     xemacs-packages, mule-packages and site-packages or in older versions
2854     /usr/lib/xemacs-NN.N/lisp/
2855
2856    You do not need to set this variable for XEmacs, because the automatic boot
2857    up will find the core packages provided that packages have been
2858    installed at the same level as the XEmacs itself:
2859
2860        XEmacs/xemacs-NN.N/
2861        XEmacs/site-packages/
2862        XEmacs/mule-packages/
2863        ..."
2864     :type  'directory
2865     :group 'TinyPath))
2866
2867 (message "TinyPath: [VAR] tinypath-:core-emacs-load-path-list %s"
2868          (prin1-to-string tinypath-:core-emacs-load-path-list))
2869
2870 (defcustom tinypath-:load-path-root
2871   (tinypath-set-default-value-macro
2872    "tinypath-:load-path-root"
2873    (tinypath-default-load-path-root-dirs))
2874   "*List of root directories of Emacs lisp packages.
2875 Put list all lisp package installation roots here, like
2876
2877  (setq tinypath-:load-path-root
2878    (list
2879     (if (not tinypath-:xemacs-p)
2880        ;; This is for Emacs only
2881         \"/usr/local/share/emacs/site-lisp\")
2882      \"/usr/local/share/site-lisp\"
2883      \"/opt/share/site-lisp\"
2884      ;; or ~/lisp
2885      \"~/elisp\")
2886
2887 Non-existing directories do no harm, because every
2888 element that is not a string and a valid directory is ignored."
2889   :type  '(list directory)
2890   :group 'TinyPath)
2891
2892 (defcustom tinypath-:extra-path-root
2893   (tinypath-set-default-value-macro
2894    "tinypath-:extra-path-root"
2895    (let ((path (tinypath-ti::win32-cygwin-p 'use-cache)))
2896      (when path
2897        (message
2898         (concat "TinyPath: Cygwin root is %s."
2899                 " Consider adding all Cygwin INFO directories"
2900                 " to variable `Info-directory-list'.")
2901         path))
2902      nil))
2903   "*Win32 Cygwin installation root or other search directories.
2904 This variable contains list of directories.
2905
2906 In many times people working with Emacs also install http://www.cygwin.com/
2907 Unix environment, which contains manual pages and info files for the
2908 utilities.
2909
2910 Set this variable to LIST of additional search root directories
2911 for manual pages and info files."
2912   :type  '(list directory)
2913   :group 'TinyPath)
2914
2915 (message "TinyPath: [VAR] tinypath-:extra-path-root %s"
2916          (prin1-to-string tinypath-:extra-path-root))
2917
2918 ;;; ....................................................... &v-private ...
2919
2920 (defvar tinypath-:original-load-path load-path
2921   "Original load-path value before loading this package.
2922 It is used later in \\[tinypath-cache-regenerate]. DO NOT TOUCH.")
2923
2924 (defvar tinypath-:original-load-path-after-load nil
2925   "The `load-path' value after this package has been loaded.
2926 If `load-path' changes during Emacs sesssion, then
2927 cache is not used. This happens e.g. while value locally
2928 bound:
2929
2930     (let ((load-path  ...))
2931       ;; The value is no longer the global value
2932       ....
2933
2934 DO NOT TOUCH. Only function that regenerate cache are allowed
2935 to change this.")
2936
2937 (defvar tinypath-:log-file
2938   (tinypath-tmp-find-writable-dir "emacs-tinypath.el.log")
2939   "With `tinypath-:verbose' set to 20, the message buffer
2940 is constantly written to disk. Prepare, everything will take oodles
2941 of time...")
2942
2943 (defvar tinypath-:external-data-structure nil
2944   "Whole data structure from external tool. See `tinypath-external-setup'.
2945 Do not touch. This is highly important for debugging purposes.")
2946
2947 (defvar tinypath-:extra-manpath nil
2948   "Additional paths found. See `tinypath-:extra-path-root'.")
2949
2950 (defvar tinypath-:extra-ff-search-directories nil
2951   "Additional C/C++ include paths found. See `tinypath-:extra-path-root'")
2952
2953 (defvar tinypath-report-mode-map nil
2954   "Keymap for buffer generated by `tinypath-cache-duplicate-report'.")
2955
2956 (defvar tinypath-:cache nil
2957   "List of all lisp files along `load-path'.
2958 \((\"file\" (POS . PATH)) .. ).")
2959
2960 (defvar tinypath-:time-data nil
2961   "When each package is loaded, its load time is recoded here.
2962 See `tinypath-time-display'. The data structure is ((package . time-sec)).")
2963
2964 (defvar tinypath-:time-buffer "*tinypath-time-results*"
2965   "Buffer to put results of `tinypath-time-display'.")
2966
2967 (defvar tinypath-:cache-level-two nil
2968   "Cache of tinypath-:cache. It keeps the files already resolved by
2969 consulting the cache. Its aim is to speed up the search.
2970 \((\"file\" . \"absolute-path\") ...).")
2971
2972 (defvar tinypath-dumped-load-path nil
2973   "Load path with Disk Drive letters. See `tinypath-load-path-dump'.")
2974
2975 (defvar tinypath-:cache-mode nil
2976   "State of `tinypath-cache-mode'. DO NOT CHANGE THIS VARIABLE DIRECTLY.
2977 There is more than just changing this variable's state.
2978 Use function `tinypath-cache-mode' which modifies everything needed.")
2979
2980 (defvar tinypath-:report-buffer "*tinypath-report*"
2981   "*Buffer where to report e.g. after `tinypath-cache-duplicate-report'.")
2982
2983 (defvar tinypath-:timer-elt nil
2984   "Timer process.")
2985
2986 (defconst tinypath-:report-mode-font-lock-keywords
2987   (list
2988    ;; File size
2989    (list
2990     (concat
2991      "[0-9][0-9]:[0-9][0-9]:[0-9][0-9][ \t]+"
2992      "\\(.*\\)")
2993     1 'font-lock-reference-face)
2994    ;; Filename
2995    (list
2996     (concat
2997      "^[ \t]+[0-9]+[ \t]+"
2998      "\\([0-9]+\\)")
2999     1 'font-lock-variable-name-face)
3000    ;;  Emacs core installation
3001    (list
3002     "x?emacs[-\\/][0-9]+[0-9.]+"
3003     0 'font-lock-keyword-face t)
3004    (list
3005     "ERROR:"
3006     0 'font-lock-constant-face)
3007    ;; filename heading at the start of the line
3008    (list
3009     "^[^ \t\r\n]+"
3010     0 'font-lock-string-face)
3011    (list ;; mark deleted files
3012     "^[*].*"
3013     0 'font-lock-comment-face t))
3014   "*Font lock keywords for the `tinypath-:report-buffer' buffer.")
3015
3016 (defvar tinypath-:external-util-bin "emacs-util.pl"
3017   "*External utility to help finding Emacs boot up information.
3018 DO NOR CHANGE THE NAME OF THE BINARY unless you rename the utility.
3019 See M-x tinypath-version (the manual) for more information.")
3020
3021 ;;}}}
3022 ;;{{{ Macros
3023
3024 ;;; ----------------------------------------------------------------------
3025 ;;; Only some values are recorded as messages to the *Messages* buffer
3026 ;;; Showing the values possibly makes user think if he needs
3027 ;;; to change the defaults.
3028 ;;;
3029 (put 'tinypath-with-temp-buffer 'lisp-indent-function 0)
3030 (put 'tinypath-with-temp-buffer 'edebug-form-spec '(body))
3031 (defmacro tinypath-with-temp-buffer (&rest body)
3032   "Clear all hooks while running `with-temp-buffer'"
3033   (` (let (temp-buffer-setup-hook
3034            font-lock-mode
3035            lazy-lock-mode)
3036        ;;  This is no-op, just quiets Byte Compiler (non used variable).
3037        (if temp-buffer-setup-hook
3038            (setq temp-buffer-setup-hook nil))
3039        (if font-lock-mode
3040            (setq font-lock-mode nil))
3041        (if temp-buffer-setup-hook
3042            (setq temp-buffer-setup-hook nil))
3043        (if lazy-lock-mode
3044            (setq lazy-lock-mode nil))
3045        (with-temp-buffer
3046          (,@ body)))))
3047
3048 ;;; ----------------------------------------------------------------------
3049 ;;;
3050 (defmacro tinypath-Info-default-directory-list ()
3051   "Emacs and XEmacs compatibility."
3052   ;; Latest XEmacs does not use `Info-default-directory-list'
3053   (if tinypath-:xemacs-p
3054       (intern "Info-directory-list")
3055     (intern "Info-default-directory-list")))
3056
3057 ;;; ----------------------------------------------------------------------
3058 ;;;
3059 (defmacro tinypath-Info-default-directory-list-sym ()
3060   "Emacs and XEmacs compatibility."
3061   (`
3062    (if tinypath-:xemacs-p
3063        (intern "Info-directory-list")
3064      (intern "Info-default-directory-list"))))
3065
3066 ;;; ----------------------------------------------------------------------
3067 ;;;
3068 (defmacro tinypath-message-log-max-sym ()
3069   "Emacs and XEmacs compatibility."
3070   (`
3071    (cond
3072     ((boundp 'log-message-max-size) ;; XEmacs
3073      (intern "log-message-max-size"))
3074     ((boundp 'message-log-max)
3075      (intern "message-log-max"))
3076     (t
3077      (error "tinypath-message-log-max-sym")))))
3078
3079 ;;; ----------------------------------------------------------------------
3080 ;;;
3081 (defmacro tinypath-message-log-max-sym-value ()
3082   "Emacs and XEmacs compatibility."
3083   (`
3084    (symbol-value (tinypath-message-log-max-sym))))
3085
3086 ;;; ----------------------------------------------------------------------
3087 ;;;
3088 (defmacro tinypath-message-log-max-sym-set (value)
3089   "Emacs and XEmacs compatibility."
3090   (`
3091    (set (tinypath-message-log-max-sym) (, value))))
3092
3093 ;;; ----------------------------------------------------------------------
3094 ;;; #copy: from tinyliba.el
3095 (defmacro tinypath-ti::bool-toggle (var &optional arg)
3096   "Toggle VAR according to ARG like mode would do.
3097 Useful for for functions that use arg 0/-1 = off, 1 = on, nil = toggle.
3098 Minor modes behave this way.
3099
3100 VAR is set to following values when ARG is:
3101
3102   arg 0/-1  VAR -> nil
3103   arg nbr   VAR -> t
3104   arg nil   VAR -> not(var)     toggles variable"
3105   (` (setq (, var)
3106            (cond
3107             ((and (integerp (, arg))
3108                   (< (, arg) 1))        ;Any negative value or 0
3109              nil)
3110             ((null (, arg))
3111              (not (, var)))
3112             (t
3113              t)))))
3114
3115 ;;}}}
3116 ;;{{{ Duplicated functions
3117
3118 ;;; ----------------------------------------------------------------------
3119 ;;; #copy: tinylib.el
3120 (defsubst tinypath-ti::date-time-difference (a b)
3121   "Calculate difference between times A and B.
3122 The input must be in form of '(current-time)'
3123 The returned value is difference in seconds.
3124 E.g., if you want to calculate days; you'd do
3125
3126 \(/ (tinypath-ti::date-time-difference a b) 86400)  ;; 60sec * 60min * 24h"
3127   (let ((hi (- (car a) (car b)))
3128         (lo (- (car (cdr a)) (car (cdr b)))))
3129     (+ (lsh hi 16) lo)))
3130
3131 ;;; ----------------------------------------------------------------------
3132 ;;; #copy: tinylib.el
3133 (defun tinypath-ti::dired-buffer (dir)
3134   "Return dired buffer runninr DIR."
3135   (setq dir (file-name-as-directory dir)) ;; Dired uses trailing slash
3136   (dolist (buffer (buffer-list))
3137     (with-current-buffer buffer
3138       (when (and (eq major-mode 'dired-mode)
3139                  (string= dired-directory dir))
3140         (return buffer)))))
3141
3142 ;;; ----------------------------------------------------------------------
3143 ;;;
3144 (defun tinypath-ti::window-single-p ()
3145   "Check if there is only one window in current frame."
3146   ;;  No need to run `length' when `nth' suffices.
3147   (let* ((win      (selected-window))
3148          (next     (next-window)))
3149     ;;  Same window?
3150     (eq win next)))
3151
3152 ;;; ----------------------------------------------------------------------
3153 ;;; #copy: tinylibm.el
3154 (defmacro tinypath-ti::funcall (func-sym &rest args)
3155   "Call FUNC-SYM with ARGS.
3156 Like funcall, but secretly call function if it exists.
3157
3158 The full story:
3159
3160   Byte Compiler isn't very smart when it comes to knowing if
3161   symbol exist or not. If you have following statement in your function,
3162   it still complaints that the function \"is not known\"
3163
3164   (if (fboundp 'some-non-existing-func)
3165       (some-non-existing-func arg1 arg2 ...))
3166
3167   instead use:
3168
3169   (if (fboundp 'some-non-existing-func)
3170       (tinypath-ti::funcall 'some-non-existing-func arg1 arg2 ...)
3171
3172   to get rid of the unnecessary warning.
3173
3174 Warning:
3175
3176   You _cannot_ use ti::funcall if the function is in autoload state, because
3177   `symbol-function' doesn't return a function to call. Rearrange
3178   code so that you do (require 'package) test."
3179   (`
3180    (let* ((func (, func-sym)))
3181      (when (fboundp (, func-sym))
3182        ;; Old
3183        ;;   (apply (symbol-function (, func-sym)) (,@ args) nil)
3184        (apply func (,@ args) nil)))))
3185
3186 ;;; ----------------------------------------------------------------------
3187 ;;; #copy: from tinylib.el
3188 (defun tinypath-days-old (file)
3189   "How old FILE is in days. An approximation."
3190   (let* ((a  (current-time))
3191          (b  (nth 5 (file-attributes file)))
3192          (hi (- (car a) (car b)))
3193          (lo (- (car (cdr a)) (car (cdr b)))))
3194     (/ (+ (lsh hi 16) lo) 86400)))
3195
3196 ;;; ----------------------------------------------------------------------
3197 ;;; #copy from tinylibm.el
3198 (defun tinypath-ti::replace-match (level &optional replace string)
3199   "Kill match from buffer at sub-match LEVEL or replace with REPLACE.
3200 Point sits after the replaced or killed area.
3201
3202 Optionally you can give STRING. If level didn't match, do nothing.
3203
3204 Call:
3205
3206   (level &optional replace string)
3207
3208 Return:
3209
3210   t     Action taken
3211   nil   If match at LEVEL doesn't exist.
3212   str   If string was given."
3213   (if (null string)
3214       (cond
3215        ((match-end level)
3216         (delete-region (match-beginning level) (match-end level))
3217
3218         ;;  I think emacs has bug, because cursor does not sit at
3219         ;;  match-beginning if I delete that region, instead it is off +1
3220         ;;  --> force it to right place
3221
3222         (and replace
3223              (goto-char (match-beginning level))
3224              (insert replace))))
3225     (when (match-end level)             ;Handle string case
3226       (concat
3227        (substring string 0 (match-beginning level))
3228        (if replace replace "")
3229        (substring string (match-end level))))))
3230
3231 ;;; ----------------------------------------------------------------------
3232 ;;; #copy: from tinylibb.el
3233 (defun tinypath-replace-regexp-in-string
3234   (regexp rep string &optional fixedcase literal subexp start)
3235   (let* ((i  0))
3236     (or subexp
3237         (setq subexp 0))
3238
3239     (while (string-match regexp string)
3240       (if (> (incf i) 5000)
3241           (error "Substituted string causes circular match. Loop never ends.")
3242         (setq string (inline (tinypath-ti::replace-match subexp rep string)))))
3243     string))
3244
3245 ;;; ----------------------------------------------------------------------
3246 ;;; #copy: from tinylibm.el
3247 (defun tinypath-ti::pp-variable-list (list &optional buffer def-token)
3248   "Print LIST of variables to BUFFER. DEF-TOKEN defaults to `defconst'."
3249   (let* (val)
3250     (or buffer
3251         (setq buffer (current-buffer)))
3252     (or def-token
3253         (setq def-token "defconst"))
3254     (dolist (sym list)
3255       (unless (symbolp sym)
3256         (error "List member is not symbol %s" sym))
3257       (setq val (symbol-value sym))
3258       (insert (format "\n\n(%s %s\n" def-token (symbol-name sym)))
3259       (cond
3260        ((numberp val)
3261         (insert val))
3262        ((stringp val)
3263         (insert (format "\"%s\"" val)))
3264        ((memq val '(t nil))
3265         (insert (symbol-name val)))
3266        ((and (symbolp val)
3267              (fboundp val))
3268         (insert "(function " (symbol-name val) ")"))
3269        ((symbolp val)
3270         (insert "'" (symbol-name val)))
3271        ((listp
3272          (insert "'" (pp val))))
3273        (t
3274         (error "unknown content of stream" sym val)))
3275       (insert ")"))))
3276
3277 ;;; ----------------------------------------------------------------------
3278 ;;; #copy from tinylibm.el
3279 (defun tinypath-ti::write-file-variable-state
3280   (file desc list &optional fast-save bup)
3281   "Save package state to FILE.
3282
3283 Input:
3284
3285   FILE      filename
3286   DESC      One line description string for the file.
3287   LIST      List of variable symbols whose content to save to FILE.
3288
3289   FAST-SAVE The default `pp' function used to stream out the contents
3290             of the listp variables is extremely slow if your variables
3291             contain lot of data. This flag instructs to use alternative,
3292             much faster, but not pretty on output, method.
3293
3294   BUP       If non-nil, allow making backup. The default is no backup."
3295   (tinypath-with-temp-buffer
3296    (let ((backup-inhibited (if bup nil t))
3297          ;;  prohibit Crypt++ from asking confirmation
3298          (crypt-auto-write-buffer  t))
3299      (unless crypt-auto-write-buffer    ;Bytecomp silencer
3300        (setq crypt-auto-write-buffer nil))
3301      (insert ";; " file " -- " desc "\n"
3302              ";; Date: "
3303              (tinypath-time-string)
3304              "\n\n")
3305      (if (not fast-save)
3306          (tinypath-ti::pp-variable-list list)
3307        (dolist (var list)
3308          (insert (format "\n\n(defconst %s\n" (symbol-name var)))
3309          ;;  While `pp' would have nicely formatted the value, It's
3310          ;;  unbearable SLOW for 3000 file cache list.
3311          ;;  `prin1-to-string' is 10 times faster.
3312          (insert "'" (prin1-to-string (symbol-value var)) ")\n")))
3313      (insert (format "\n\n;; end of %s\n" file))
3314      (write-region (point-min) (point-max) file))))
3315
3316 ;;; ----------------------------------------------------------------------
3317 ;;; #copy from tinylib.el
3318 (defun tinypath-ti::advice-control
3319   (list regexp &optional disable verb msg)
3320   "Enables/disable SINGLE-OR-LIST of advised functions that match REGEXP.
3321 Signals no errors, even if function in LIST is not advised.
3322 All advice classes ['any] are ena/disabled for REGEXP.
3323
3324 Input:
3325
3326   LIST                  list of functions.
3327   REGEXP                advice name regexp. Should normally have ^ anchor
3328   DISABLE               flag, of non-nil then disable
3329   VERB                  enable verbose messages
3330   MSG                   display this message + on/off indication"
3331   (dolist (func list)
3332     (ignore-errors
3333       (if disable
3334           (ad-disable-advice  func 'any regexp)
3335         (ad-enable-advice     func 'any regexp))
3336       (ad-activate func))) ;;change state
3337   (if verb
3338       (message
3339        (concat
3340         (or msg "advice(s): ")
3341         (if disable
3342             "off"
3343           "on")))))
3344
3345 ;;; ----------------------------------------------------------------------
3346 ;;; #copy
3347 (defun tinypath-ti::string-remove-whitespace (string)
3348   "Squeezes empty spaces around beginning and end of STRING.
3349 If STRING is not stringp, then returns STRING as is."
3350   (when (stringp string)
3351     (if (string-match "^[ \t]+\\(.*\\)" string)
3352         (setq string (match-string 1 string)))
3353
3354     (if (string-match "[ \t]+\\'" string)
3355         (setq string
3356               (substring string 0  (match-beginning 0)))))
3357   string)
3358
3359 ;;; ----------------------------------------------------------------------
3360 ;;; #copy: from tinylib.el
3361 (defun tinypath-ti::vc-version-lessp (a b &optional zero-treat)
3362   "Return t if A is later version than B.
3363 This function can only check only three levels, up till: NN.NN.NN.
3364
3365 Input
3366
3367   A             Version string one
3368   B             Version string two
3369   ZERO-TREAT    If non-nil, consider version numbers starting with 0.NN
3370                 never than 2.1. In this case it is assumed
3371                 that zero based versions are latest development releases."
3372   (flet ((version (str regexp)
3373                   (if (string-match regexp str)
3374                       (string-to-number (match-string 1 str))
3375                     0)))
3376     (let* ((a1 (version a "^\\([0-9]+\\)"))
3377            (a2 (version a "^[0-9]+\\.\\([0-9]+\\)"))
3378            (a3 (version a "^[0-9]+\\.[0-9]+\\.\\([0-9]+\\)"))
3379            (b1 (version b "^\\([0-9]+\\)"))
3380            (b2 (version b "^[0-9]+\\.\\([0-9]+\\)"))
3381            (b3 (version b "^[0-9]+\\.[0-9]+\\.\\([0-9]+\\)")))
3382       (or (and zero-treat
3383                (and (= a1 0)
3384                     (> b1 0)))
3385           (> a1 b1)
3386           (and (= a1 b1)
3387                (> a2 b2))
3388           (and (= a1 b1)
3389                (= a2 b2)
3390                (> a3 b3))))))
3391
3392 ;;; ----------------------------------------------------------------------
3393 ;;;
3394 (defun tinypath-message-get-buffer ()
3395   "Return *Message* buffer pointer."
3396   (or (get-buffer "*Messages*")
3397       (get-buffer " *Message-Log*"))) ;; XEmacs
3398
3399 ;;; ----------------------------------------------------------------------
3400 ;;;
3401 (defun tinypath-log-write ()
3402   "*Write log to `tinypath-:log-file'."
3403   (let* ((buffer (tinypath-message-get-buffer))
3404          (file   tinypath-:log-file))
3405     (ignore-errors
3406       (with-current-buffer buffer
3407         (write-region (point-min) (point-max) file)))))
3408
3409 ;;; ----------------------------------------------------------------------
3410 ;;;
3411 (defun tinypath-ti::compat-timer-elt  (function)
3412   "Search FUNCTION and return timer elt.
3413 You can use this function to check if some function is currently
3414 in timer list. (i.e. active)
3415
3416 The timer lists are searched in following order:
3417
3418   `itimer-list'
3419   `timer-list'
3420   'timer-idle-list'
3421
3422 Return:
3423
3424   '(timer-elt timer-variable)"
3425   (let* (pos
3426          list
3427          item
3428          ret)
3429     (flet ((get-elt (elt place)
3430                     (if (vectorp elt)
3431                         (aref elt place)
3432                       (nth place elt))))
3433       (dolist (timer '(
3434                        ;; (("Mon Dec  9 10:01:47 1996-0" 10
3435                        ;;     process nil))
3436                        (timer-idle-list . 5)
3437                        (timer-alist . 2)
3438                        (timer-list  . 2) ;; 19.34+
3439                        (itimer-list . 3)))
3440         (when (boundp (car timer))
3441           (setq list (symbol-value (car timer))
3442                 pos  (cdr timer))
3443           ;;  NOTE: this is different in Xemacs. It is not a vector
3444           ;; timer-[idle-]list Emacs 19.34
3445           ;;  NOTE: this is different in Xemacs. It is not a vector
3446
3447           ;; ([nil 12971 57604 0 60 display-time-event-handler nil nil])
3448           ;; [nil 13971 14627 646194 60
3449           ;;      (lambda (f) (run-at-time ...))
3450           ;;      (irchat-Command-keepalive) nil]
3451           (if (and (not tinypath-:xemacs-p)
3452                    (vectorp (car list)))
3453               (setq pos 5))
3454           (dolist (elt list)
3455             (setq item (get-elt elt pos))
3456 ;;;     (d!! (functionp item) (get-elt elt (1+ pos)))
3457             (when (or (and (symbolp item)
3458                            (eq item function))
3459                       ;;  It may be lambda expression
3460                       (and (functionp item)
3461                            (string-match (regexp-quote (symbol-name function))
3462                                          (prin1-to-string
3463                                           (get-elt elt (1+ pos))))))
3464               (setq ret (list elt (car timer)))
3465               (return))))))
3466     ret))
3467
3468 ;;; ----------------------------------------------------------------------
3469 ;;;
3470 (defun tinypath-ti::compat-timer-cancel  (key &optional cancel-function)
3471   "Delete timer KEY entry, where KEY is full element in (i)`timer-alist'."
3472   (let (var)
3473     (when key
3474       (when (and (null var)
3475                  (boundp 'timer-alist)) ;Emacs
3476         (setq var 'timer-alist)
3477         (tinypath-ti::funcall 'cancel-timer key)
3478         (set var (delete key (symbol-value 'timer-alist))))
3479       (when (and (null var)
3480                  (boundp 'timer-list))  ;Emacs 19.34
3481         (setq var 'timer-list)
3482         ;;  Must use this command
3483         (tinypath-ti::funcall 'cancel-timer key))
3484       (when (and (null var)
3485                  (boundp 'timer-idle-list)) ;Emacs 19.34
3486         (setq var 'timer-idle-list)
3487         ;;  Must use this command
3488         (tinypath-ti::funcall 'cancel-timer key))
3489       (when (and (null var)
3490                  (boundp 'itimer-list)) ;XEmacs
3491         (setq var 'itimer-list)
3492         (tinypath-ti::funcall 'cancel-itimer key)
3493         (set var (delete key (symbol-value 'itimer-list))))
3494       var)))
3495
3496 ;;; ----------------------------------------------------------------------
3497 ;;; #copy: tinylib.el
3498 (defun tinypath-ti::compat-timer-cancel-function (function)
3499   "Delete all timer entries for FUNCTION."
3500   (let (key)
3501     (while (setq key (car-safe (tinypath-ti::compat-timer-elt function)))
3502       (tinypath-ti::compat-timer-cancel key))
3503     key))
3504
3505 ;;; ----------------------------------------------------------------------
3506 ;;; #copy: tinylib.el
3507 (defun tinypath-ti::directory-recursive-do (root function)
3508   "Start at ROOT and call FUNCTION recursively from each ascended directory."
3509   (let* ((list (tinypath-subdirectory-list root)))
3510     (if (null list)
3511         (funcall function root)
3512       (dolist (path list)
3513         (tinypath-ti::directory-recursive-do path function)))))
3514
3515 ;;}}}
3516 ;;{{{ Modes
3517
3518 ;;; ----------------------------------------------------------------------
3519 ;;;
3520 (defun tinypath-report-mode-default-bindings ()
3521   "Define default key bindings to `tinypath-report-mode-map'."
3522   (unless (keymapp tinypath-report-mode-map)
3523     (setq tinypath-report-mode-map (make-sparse-keymap))
3524     (cond
3525      (tinypath-:xemacs-p
3526       (define-key tinypath-report-mode-map [(control shift button1)]
3527         'tinypath-report-mode-delete-file))
3528      (t
3529       (define-key tinypath-report-mode-map [C-S-mouse-1]
3530         'tinypath-report-mode-delete-file)))
3531     ;; ............................................. users with no mouse ...
3532     (define-key tinypath-report-mode-map "\C-d"
3533       'tinypath-report-mode-delete-file)
3534     (define-key tinypath-report-mode-map "\C-c\C-d"
3535       'tinypath-report-mode-delete-file-noconfirm)
3536     (define-key tinypath-report-mode-map "\C-cd"
3537       'tinypath-report-mode-dired)
3538     (define-key tinypath-report-mode-map "\C-p"
3539       'tinypath-report-mode-previous)
3540     (define-key tinypath-report-mode-map [(control up)]
3541       'tinypath-report-mode-previous)
3542     (define-key tinypath-report-mode-map "\C-n"
3543       'tinypath-report-mode-next)
3544     (define-key tinypath-report-mode-map [(control down)]
3545       'tinypath-report-mode-next)
3546     (define-key tinypath-report-mode-map "\C-cr"
3547       'tinypath-cache-duplicate-report)
3548     (define-key tinypath-report-mode-map "\C-cg"
3549       'tinypath-cache-regenerate)
3550     (define-key tinypath-report-mode-map [(return)]
3551       'tinypath-report-mode-find-file)
3552     (define-key tinypath-report-mode-map "\C-cf"
3553       'tinypath-report-mode-find-file)))
3554
3555 ;;}}}
3556 ;;{{{ Debug
3557
3558 ;;; ----------------------------------------------------------------------
3559 ;;;
3560 (put 'tinypath-debug-wrapper-macro 'lisp-indent-function 0)
3561 (put 'tinypath-debug-wrapper-macro 'edebug-form-spec '(body))
3562 (defmacro tinypath-debug-wrapper-macro (&rest body)
3563   "Increase `tinypath-:verbose' and `message-log-size'."
3564   (`
3565    (let* ((tinypath-:verbose 12))
3566      ;;  Value t is unlimited in Emacs, but don't know about XEmacs
3567      ;;  Setting a high value works always.
3568      (set (tinypath-message-log-max-sym) 900000)
3569      (with-current-buffer (tinypath-message-get-buffer)
3570        (,@ body)
3571        (pop-to-buffer (current-buffer))))))
3572
3573 ;;; ----------------------------------------------------------------------
3574 ;;;
3575 (defun tinypath-debug-test-run (&optional clear)
3576   "Developer function. Test everything with full debug and CLEAR buffer."
3577   (interactive "P")
3578   (tinypath-debug-wrapper-macro
3579    (if clear
3580        (erase-buffer))
3581    (tinypath-cache-regenerate)))
3582
3583 ;;; ----------------------------------------------------------------------
3584 ;;;
3585 (defun tinypath-debug-external-helper ()
3586   "Developer function. Test external helper program."
3587   (interactive)
3588   (tinypath-debug-wrapper-macro
3589    (tinypath-external-helper-call
3590     (current-buffer)
3591     (tinypath-external-setup-1-main)
3592     'debug)))
3593
3594 ;;}}}
3595 ;;{{{ Misc
3596
3597 ;;; ----------------------------------------------------------------------
3598 ;;;
3599 (defsubst tinypath-load-copy-get (&optional property)
3600   "Return value of `tinypath-:original-load-path-after-load'.
3601 Optionally from PROPERTY."
3602   (if property
3603       (get 'tinypath-:original-load-path-after-load property)
3604     tinypath-:original-load-path-after-load load-path))
3605
3606 ;;; ----------------------------------------------------------------------
3607 ;;;
3608 (defsubst tinypath-load-copy-now (&optional property)
3609   "Save `load-path' to `tinypath-:original-load-path-after-load'.
3610 Optionally save the value to PROPERTY."
3611   (if property
3612       (put 'tinypath-:original-load-path-after-load
3613            property
3614            load-path)
3615     (setq tinypath-:original-load-path-after-load load-path)))
3616
3617 ;;; ----------------------------------------------------------------------
3618 ;;;
3619 (defsubst tinypath-load-copy-equal-p ()
3620   "Return non-nil if saved `load-path' copy has not changed."
3621   (equal tinypath-:original-load-path-after-load load-path))
3622
3623 ;;; ----------------------------------------------------------------------
3624 ;;; (tinypath-eval-after-load "woman" 'tinypath-insinuate-woman)
3625 ;;;
3626 (defun tinypath-eval-after-load (file function)
3627   "Simulate `eval-after-load'. load FILE and run FUNCTION."
3628   (cond
3629    ((not (fboundp 'eval-after-load)) ;; Older Emacs versions do not have this.
3630     (and (load file 'noerr)
3631          (funcall function)))
3632    (t
3633     ;; See after-load-alist
3634     ;; ... If FILE is already loaded, evaluate FORM right now.
3635     (eval-after-load file
3636       (` (progn (funcall (quote (, function)))))))))
3637
3638 ;;; ----------------------------------------------------------------------
3639 ;;;
3640 (defun tinypath-time-string (&optional time)
3641   "Return TIME in ISO 8601 format YYYY-MM-DD HH:MM:SS"
3642   (format-time-string "%Y-%m-%d %H:%M:%S" (or time (current-time))))
3643
3644 ;;; ----------------------------------------------------------------------
3645 ;;;
3646 (defun tinypath-list-display (msg list &optional insert)
3647   "Display MSG and LIST to *Messages* or INSERT.
3648 The MSG should contain %s format string to write each element."
3649   (let* ((i 0)
3650          (size 80000)) ;; 60k
3651     ;;  Without increasing the display size, all of the cached
3652     ;;  paths would not be seen. This could also be checked dynamically
3653     ;;  by computing <`length' of cache> x <approx. 120 characters display>
3654     (when (and (null insert)
3655                (< (tinypath-message-log-max-sym-value) size))
3656       (tinypath-message-log-max-sym-set size))
3657     (dolist (elt list)
3658       (incf i)
3659       (setq elt (if (stringp elt)
3660                     elt
3661                   (prin1-to-string elt)))
3662       (setq elt (format (concat "%3d " msg) i elt))
3663       (if insert
3664           (insert elt "\n")
3665         (message elt))))
3666   (unless insert
3667     (let* ((buffer (tinypath-message-get-buffer)))
3668       (when buffer
3669         (display-buffer buffer)))))
3670
3671 ;;; ----------------------------------------------------------------------
3672 ;;;
3673 (defsubst tinypath-suffixes (file)
3674   "Return list of try suffixes for FILE. '(\".el\" \".elc\")."
3675   (cond
3676    ((string-match "\\.elc?$" file)
3677     '(""))
3678    (t
3679     '(".el" ".elc"))))
3680
3681 ;;; ----------------------------------------------------------------------
3682 ;;; We need this because we use advised `locate-library'
3683 ;;;
3684 (defun tinypath-locate-library (file)
3685   "Like `locate-library' FILE, but return list of paths."
3686   (let (path-list
3687         (suffix (tinypath-suffixes file))
3688         path)
3689     (dolist (dir load-path)
3690       (setq dir (file-name-as-directory dir))
3691       (dolist (postfix suffix)
3692         (setq path (concat dir file postfix))
3693         (when (file-exists-p path)
3694           (pushnew path path-list :test 'string=))))
3695     path-list))
3696
3697 ;;; ----------------------------------------------------------------------
3698 ;;;
3699 (defun tinypath-byte-compile-file (file)
3700   "Byte compile FILE is file name end to \".elc\"."
3701   (when (and (stringp file)
3702              (string-match "\\.el$" file))
3703     (unless (byte-compile-file file)
3704       (message "TinyPath: {ERROR] Byte compile failed for %s" file)
3705       (delete-file (concat file "c")))))
3706
3707 ;;; ----------------------------------------------------------------------
3708 ;;;
3709 (defun tinypath-cache-duplicate-report-ignore-function (file)
3710   "Ignore from output in XEmacs _pkg.el and the like."
3711   ;; In XEmacs there are lot of these pkg files.
3712   (string-match
3713    "\\(auto-autoloads\\|_pkg\\|custom-load\\|load-path\\)\\.el"
3714    file))
3715
3716 ;;; ----------------------------------------------------------------------
3717 ;;;
3718 (defun tinypath-maybe-warn-message-log-max ()
3719   "Print message if Message-Log size is too small.
3720 Too small value would prevent debugging tinypath.el."
3721   (let* ((size 20000)
3722          now)
3723     (setq now
3724           (symbol-value (tinypath-message-log-max-sym)))
3725     (when (and (> tinypath-:verbose 9)
3726                ;;  Value `t' is for unlimited size.
3727                (or (not (eq t now))
3728                    (and (integerp now)
3729                         (and (< now size)))))
3730       (message
3731        (concat "TinyPath: Possibly can't display all logs. Increase "
3732                (symbol-name
3733                 (tinypath-message-log-max-sym))))
3734       (sit-for 2))))
3735
3736 ;;; ----------------------------------------------------------------------
3737 ;;;
3738 (defsubst tinypath-file-compressed-p (file)
3739   "Check if FILE includes a comression extension."
3740   (string-match "\\.\\(gz\\|[Zz]\\|bz2\\)$" file))
3741
3742 ;;; ----------------------------------------------------------------------
3743 ;;;
3744 (defun tinypath-use-compression ()
3745   "Load jka-compr.el safely."
3746   (or (featurep 'jka-compr)
3747       (let ((file (or (tinypath-cache-p "jka-compr")
3748                       (locate-library "jka-compr")
3749                       (error "\
3750 TinyPath: [PANIC] Can't find Emacs core library jka-cmpr.el."))))
3751         (if (fboundp 'ad-Orig-load)
3752             (tinypath-ti::funcall 'ad-Orig-load file)
3753           (load file))
3754         ;; New X/Emacs releases need this
3755         (cond
3756          ((fboundp 'auto-compression-mode) ;; New Emacs: jka-compr.el
3757           ;; symbol-function suppresses Byte compiler messages
3758           (funcall (symbol-function 'auto-compression-mode) 1))
3759          ((fboundp 'jka-compr-install)
3760           (tinypath-ti::funcall 'jka-compr-install))))))
3761
3762 ;;; ----------------------------------------------------------------------
3763 ;;;
3764 (defsubst tinypath-use-compression-maybe (file)
3765   "Use compression if FILE includes a compressed file extension."
3766   (or (featurep 'jka-compr)
3767       (when (tinypath-file-compressed-p file)
3768         (tinypath-use-compression))))
3769
3770 ;;; ----------------------------------------------------------------------
3771 ;;;
3772 (defun tinypath-cache-warn-if-not-exist (file)
3773   "Print message if FILE does not exist."
3774   (when (stringp file)
3775     (tinypath-use-compression-maybe file))
3776   (when (null (let (ret)
3777                 (dolist (ext '("" ".el" ".elc"))
3778                   (when (file-exists-p (concat file ext))
3779                     (setq ret t)
3780                     (return)))
3781                 ret))
3782     (message
3783      (substitute-command-keys
3784       (format
3785        "TinyPath: CACHE invalid. The cached file does not exist %s \
3786 Please run \\[tinypath-cache-regenerate]"
3787        file)))
3788     (sleep-for 1)
3789     t))
3790
3791 ;;; ----------------------------------------------------------------------
3792 ;;;
3793 (defun tinypath-file-extension-compressed (&optional list)
3794   "Append `tinypath-:compressed-file-extensions' to each element in LIST.
3795 If `tinypath-:compression-support' is nil, then do nothing and return nil."
3796   (let* (ret)
3797     (dolist (elt (or list '("")))
3798       (when (stringp elt)
3799         ;;  `nreverse' is due to `push' which would change the order
3800         (dolist (ext (reverse tinypath-:compressed-file-extensions))
3801           (when (stringp ext)
3802             (push (concat elt ext) ret)))))
3803     (nreverse ret)))
3804
3805 ;;; ----------------------------------------------------------------------
3806 ;;;
3807 (defun tinypath-file-extension-list (package)
3808   "Return possible extensions to search for PACKAGE. This function is used
3809 only once to return the search extension list to the cache function. The
3810 list is reused internally and chhanging
3811 `tinypath-:compressed-file-extensions' afterward in running Emacs has no
3812 effect."
3813   ;; See `tinypath-suffixes'
3814   (cond
3815    ((string-match "\\.elc$" package)
3816     (append '(".elc")
3817             (tinypath-file-extension-compressed '(".elc"))))
3818    ((string-match "\\.el$" package)
3819     (append '(".el")
3820             (tinypath-file-extension-compressed '(".el"))))
3821    ((string-match "\\(z\\|bz2\\)$" package)
3822     nil)
3823    (t
3824     (let* (ret)
3825       ;;  The correct order is ELCs first then EL.
3826       ;;  The list is built in reverse order here.
3827       (setq ret (tinypath-file-extension-compressed '(".el")))
3828       (push ".el" ret)
3829       (dolist (elt (tinypath-file-extension-compressed '(".elc")))
3830         (push elt ret))
3831       (push ".elc" ret)
3832       ret))))
3833
3834 ;;; ----------------------------------------------------------------------
3835 ;;;
3836 (defun tinypath-file-extension-list-choices ()
3837   "Return list of choices to search.
3838  '((el . (list)) (elc . (list)) (nil . (list)))."
3839   (let* (
3840          ;; As a fall back, should we search .el choices if .elc
3841          ;; choices fail
3842          (elc (append (tinypath-file-extension-list "package.elc")
3843                       (tinypath-file-extension-list "package.el")))
3844          (el  (tinypath-file-extension-list "package.el"))
3845          (all (tinypath-file-extension-list "package")))
3846     (list
3847      elc
3848      el
3849      (cons nil all))))
3850
3851 ;;; ----------------------------------------------------------------------
3852 ;;;
3853 (defun tinypath-file-remove-trailing-slash (path)
3854   "Remove trailing slashes, unless it is a Win32 root dir f:/"
3855   (unless (string-match "^[a-z]:[\\/]$" path)
3856     (if (string-match "^\\(.*\\)[\\/]$" path)
3857         (setq path (match-string 1 path))))
3858   path)
3859
3860 ;;; ----------------------------------------------------------------------
3861 ;;;
3862 (defun tinypath-emacs-lisp-file-list (&optional from-cache)
3863   "Return only lisp file alist (file . path) from `tinypath-:cache'.
3864 With optional parameter FROM-CACHE, use the latest cached value.
3865 Be warned, this may not be the absolute latest."
3866   (let* ((id "tinypath-emacs-lisp-file-list")
3867          list
3868          save)
3869     (when from-cache
3870       (setq list (get 'tinypath-emacs-lisp-file-list 'cache)))
3871
3872     (unless tinypath-:cache
3873       (message "%s: [ERROR] `tinypath-:cache' is nil." id))
3874
3875     (unless list
3876       (setq save t)
3877       (dolist (elt tinypath-:cache)
3878         (when (string-match "\\.el.?$" (car elt))
3879           (push (cons (car elt) (cdr (nth 1 elt)))
3880                 list))))
3881
3882     (if save
3883         (put 'tinypath-emacs-lisp-file-list 'cache list))
3884
3885     list))
3886
3887 ;;; ----------------------------------------------------------------------
3888 ;;;
3889 (defun tinypath-emacs-lisp-file-list-cache-clear ()
3890   "Clear cache kept by `tinypath-emacs-lisp-file-list'."
3891   (put 'tinypath-emacs-lisp-file-list 'cache nil))
3892
3893 ;;; ----------------------------------------------------------------------
3894 ;;;
3895 (defun tinypath-directory-list-clean (list &optional list-name)
3896   "Clean LIST for anything suspicious: non-directories, non-strings.
3897 If you have moved directories from one place to another or some program has
3898 added entries to it, it is possible that LIST is \"fragmented\".
3899
3900 - Remove non-strings, possibly (nil t) values.
3901 - Expand all directories. In Win32, `downcase' every path.
3902 - Convert to use only forward slashes.
3903 - Remove trailing slashes.
3904 - Remove duplicate paths.
3905 - Remove non existing paths
3906
3907 Input:
3908
3909   LIST         List, List of directories
3910   LIST-NAME    String, The name of variable for debug."
3911   (let* (new-path)
3912     (or list-name
3913         (setq list-name ""))
3914     (dolist (path list)
3915       (cond
3916        ((not (stringp path))
3917         (tinypath-verbose-macro 5
3918                                 (message "TinyPath: %s cleaned, NON-STRING ENTRY %s"
3919                                          list-name
3920                                          (prin1-to-string path))))
3921        ((not (file-directory-p path))
3922         (tinypath-verbose-macro 5
3923                                 (message "TinyPath: [WARN] %s cleaned, directory does not exist %s"
3924                                          list-name path)))
3925        (t
3926         ;;  This will also convert all paths to forward slashes
3927         ;;  and downcase them in win32
3928         (setq path (tinypath-expand-file-name path))
3929         ;;  Remove trailing slashes, unless it is a Win32 root dir like C:/
3930         (setq path (tinypath-file-remove-trailing-slash path))
3931         (tinypath-verbose-macro 7
3932                                 (message "TinyPath: %s added %s" list-name path))
3933         (pushnew path new-path :test 'string=))))
3934     (nreverse new-path)))
3935
3936 ;;; ----------------------------------------------------------------------
3937 ;;;
3938 (defun tinypath-find-dir  (file dir-list)
3939   "Search DIR-LIST and return directory when FILE is found.
3940 If FILE is nil, then return first existing directory in DIR-LIST.
3941
3942 Note: directory list passed can contain non-string entries. They are ignored."
3943   (let* (ret)
3944     (dolist (dir dir-list)
3945       (when (stringp dir)
3946         (when (string-match "[/\\]$" dir) ;Remove trailing slash
3947           (setq dir (substring dir 0 (1- (length dir))  )))
3948         (when (file-exists-p
3949                (concat (file-name-as-directory dir)
3950                        (or file "")))
3951           (setq ret (tinypath-expand-file-name dir))
3952           (return))))
3953     ret))
3954
3955 ;;; ----------------------------------------------------------------------
3956 ;;;
3957 (defsubst tinypath-path-ok-this-emacs-p (path)
3958   "Check that /emacs path is for Emacs and /xemacs path is for XEmacs.
3959 Return t if path is ok for current Emacs."
3960   (let* ((no-emacs-regexp (if (inline tinypath-:xemacs-p)
3961                               ".*[/\\]emacs"
3962                             ".*[/\\]xemacs"))
3963          (this-emacs-regexp (if (inline tinypath-:xemacs-p)
3964                                 ".*[/\\]xemacs"
3965                               ".*[/\\]emacs"))
3966          (correct-emacs   t)
3967          len1
3968          len2)
3969     (when (string-match no-emacs-regexp path)
3970       (setq len1 (length (match-string 0 path)))
3971       ;;  If path contains both the word Emacs and XEmacs, then it
3972       ;;  is hard to know if this is invalid or not
3973       ;;
3974       ;;   /usr/local/share/bin/emacs/xemacs/xemacs-21.2
3975       ;;   /usr/local/share/bin/emacs/emacs/emacs-20.3
3976       ;;
3977       (when (string-match this-emacs-regexp path)
3978         (setq len2 (length (match-string 0 path)))
3979         (tinypath-verbose-macro 7
3980                                 (message "TinyPath: PATH-NOK both emacs versions in path?? %s" path)))
3981       (when (or (null len2)
3982                 (< len2 len1)) ;; the correct Emacs name must be LAST
3983         (setq correct-emacs nil)
3984         (tinypath-verbose-macro 7
3985                                 (message "TinyPath: PATH-NOK WRONG EMACS %s" path))))
3986     correct-emacs))
3987
3988 ;;; ----------------------------------------------------------------------
3989 ;;;
3990 (defsubst tinypath-path-ok-p (path)
3991   "Check if path is accepted with `tinypath-:load-path-ignore-regexp'."
3992   (when (and (stringp path)
3993              (tinypath-path-ok-this-emacs-p path))
3994     (cond
3995      ;; .................................................... directory ...
3996 ;;; Checked already in `tinypath-directory-list-clean'.
3997 ;;;     ((not (file-directory-p path))
3998 ;;;     (tinypath-verbose-macro 5
3999 ;;;       (message "TinyPath: PATH-NOK dir does not exist: %s"
4000 ;;;                path))
4001 ;;;      nil)
4002 ;;;     ;; ................................................ ignore regexp ...
4003      ((and (stringp tinypath-:load-path-ignore-regexp)
4004            (string-match "[ \t\r\n]" tinypath-:load-path-ignore-regexp)
4005            (let (case-fold-search)
4006              (string-match tinypath-:load-path-ignore-regexp path)))
4007       (tinypath-verbose-macro 3
4008                               (message
4009                                (concat "TinyPath: PATH-NOK tinypath-:load-path-ignore-regexp "
4010                                        "matches [%s] (ignored) %s")
4011                                (match-string 0 path) path))
4012       nil)
4013      ;; ...................................................... symlink ...
4014      ((file-symlink-p path)
4015       (tinypath-verbose-macro 5
4016                               (message "TinyPath: PATH-NOK symlink (ignored) %s" path))
4017       nil)
4018      ;; ................................................ non-core path ...
4019      ((let (ver)
4020         (and (setq ver (car-safe (tinypath-emacs-versions 'noerr 'cache)))
4021              ;;  It looks like core path ....
4022              (tinypath-emacs-core-path-p path)
4023              ;;  But it's not for this emacs VERSION
4024              (not (tinypath-emacs-core-path-p path ver))))
4025       (tinypath-verbose-macro 5
4026                               (message "TinyPath: PATH-NOK non-core path (ignored) %s" path))
4027       nil)
4028      ;; ........................................................... ok ...
4029      (t
4030       t))))
4031
4032 ;;; ----------------------------------------------------------------------
4033 ;;;
4034 (defun tinypath-directory-lisp-p (path)
4035   "Check if directory has any files matching regexp `\\.elc?'."
4036   (cond
4037    ((not (stringp path))
4038     (tinypath-verbose-macro 5
4039                             (message "TinyPath: [error] directory entry %s" (prin1-to-string path))))
4040    ((not (file-directory-p path))
4041     (tinypath-verbose-macro 5
4042                             (message "TinyPath: [error] directory not found %s" path)))
4043    (t
4044     (dolist (elt (directory-files path))
4045       (when (string-match "\\.elc?" elt)
4046         (return t))))))
4047
4048 ;;; ----------------------------------------------------------------------
4049 ;;;
4050 (defun tinypath-subdirectory-list (path)
4051   "Return all subdirectories under PATH."
4052   (let* (list)
4053     (dolist (elt (directory-files path 'absolute) )
4054       (when (and (not (string-match "\\.\\.?$" elt)) ;; skip . and ..
4055                  (file-directory-p elt)) ;; take only directories
4056         (push elt list)))
4057     list))
4058
4059 ;;}}}
4060 ;;{{{ autoload and other system help functions
4061
4062 ;;; ----------------------------------------------------------------------
4063 ;;;
4064 (defun tinypath-self-location-load-history ()
4065   "Return `load-history' entry"
4066   (let* (file)
4067     (dolist (elt load-history)
4068       (setq file (car elt))
4069       (when (and (stringp file)
4070                  (setq file (tinypath-expand-file-name file))
4071                  (string-match "^\\(.+\\)[\\/]tinypath\\." file))
4072         (return (match-string 1 file))))))
4073
4074 ;;; ----------------------------------------------------------------------
4075 ;;;
4076 (defun tinypath-self-location ()
4077   "If package was loaded with absolute path, return path.
4078 Uses `load-history' and `load-path' information."
4079   (let* ((ret (tinypath-self-location-load-history)))
4080     (unless ret ;; No luck with load-history, try load-path
4081       (dolist (path load-path)
4082         (setq path (file-name-as-directory (expand-file-name path)))
4083         (when (or (and (file-exists-p (concat path "tinypath.el"))
4084                        path)
4085                   (and (file-exists-p (concat path "tinypath.elc"))
4086                        path)
4087                   (and (file-exists-p (concat path "tinypath.el.gz"))
4088                        path))
4089           (return (setq ret path)))))
4090     (unless ret
4091       (message
4092        (concat
4093         "TinyPath: SELF NOTE tinypath.el was not loaded"
4094         "\tusing absolute path."
4095         "\t(load \"~/some/absolute/path/tinypath.el\")"))
4096       (message "TinyPath: SELF %s" (or ret "<no load-history>" )))
4097     ;;  tinypath-* function is XEmacs and Emacs compatible version
4098     ;;  and ensures that forward slashes are used.
4099     (and ret
4100          (setq ret (tinypath-expand-file-name ret)))
4101     ret))
4102
4103 ;;; ----------------------------------------------------------------------
4104 ;;;
4105 (defun tinypath-autoload-file-name (function)
4106   "Load package if FUNCTION is in autoload state."
4107   (let* ((str (prin1-to-string (symbol-function function))))
4108     (when (string-match "^(autoload[ \t]+\"\\([^\"]+\\)" str)
4109       (setq str (match-string 1 str))
4110       ;;  there is one problem. prin1-to-string doubles every backslash
4111       ;;  c:\\\\dir\\\\ ... (XEmacs problem)
4112       (if (string-match "/" str)
4113           str
4114         (let* ((final ""))
4115           ;; It's easier and faster to do this in buffer, than
4116           ;; parsing STRING
4117           (tinypath-with-temp-buffer
4118            (insert str)
4119            (goto-char (point-min))
4120            (while (re-search-forward "\\([^\\]+\\)" nil t)
4121              (setq final (concat
4122                           final
4123                           (match-string 1)
4124                           "/"))))
4125           ;; remove trailing "/"
4126           (substring final 0 (1- (length final))))))))
4127
4128 ;;; ----------------------------------------------------------------------
4129 ;;;
4130 (defun tinypath-autoload-require (function &optional noerr nomsg)
4131   "Load package if FUNCTION is in autoload state.
4132 NOERR NOMSG are parameters to `load'."
4133   (let* ((file (tinypath-autoload-file-name function)))
4134     (when file
4135       (load file noerr nomsg))))
4136
4137 ;;; ----------------------------------------------------------------------
4138 ;;;
4139 (defun tinypath-admin-remove-matching (path)
4140   "Remove PATH from `load-path' and add to `tinypath-:load-path-ignore-regexp'."
4141   (let ((fid  "tinypath-admin-remove-matching"))
4142     ;; Initially the idea was that the entries were purged fom cache too, but
4143     ;; looping and reconstructing it takes too much time.
4144     ;;
4145     ;; It's more efficient to disable packages by using regexps in
4146     ;; tinypath-:load-path-ignore-regexp, although this is not as transparent.
4147     ;;
4148     ;; --> #todo: Add better functionality to perl code.
4149
4150     ;;  Kill second level cache which "remembers" paths.
4151     (setq tinypath-:cache-level-two nil)
4152
4153     (setq path (regexp-quote (tinypath-expand-file-name path)))
4154     (tinypath-load-path-remove path)
4155     (tinypath-load-path-remove-cache path)
4156
4157     (message "TinyPath: %s adding to tinypath-:load-path-ignore-regexp [%s]"
4158              fid path)
4159
4160     (cond
4161      ((not (stringp tinypath-:load-path-ignore-regexp))
4162       (setq tinypath-:load-path-ignore-regexp path))
4163      ((not (string-match path tinypath-:load-path-ignore-regexp))
4164       (setq tinypath-:load-path-ignore-regexp
4165             (concat tinypath-:load-path-ignore-regexp
4166                     "\\|" path))))))
4167
4168 ;;}}}
4169 ;;{{{ External: emacs-util.pl
4170
4171 ;;; ----------------------------------------------------------------------
4172 ;;;
4173 (defun tinypath-external-output-parse-1-cache ()
4174   "Parse files in format `tinypath-:cache'."
4175   (let* ((i 0)
4176          (personal-count 0) ;; User files 0 .. 2000
4177          (other-count 2000)
4178          (emacs-count 5000)
4179          (font-lock-mode nil)
4180          (lazy-lock-mode nil)
4181          (regexp (concat "^LISP-FILE[ \t]+"
4182                          "\\("
4183                          "\\([^ \t\r\n]+[\\/]\\)"
4184                          "\\([^ \t\r\n]+\\)"
4185                          "\\)"))
4186          path
4187          dir
4188          file
4189          emacs
4190          other
4191          personal
4192          elt)
4193     (goto-char (point-min))
4194     (while (re-search-forward regexp nil t)
4195       (setq path (match-string 1)
4196             dir  (match-string 2)
4197             file (match-string 3))
4198       ;; was: (tinypath-path-ok-p dir) , but now perl does
4199       ;; the checking
4200       (when t
4201         ;; (set-text-properties 0 (length dir) nil dir)
4202         ;; (set-text-properties 0 (length file) nil file)
4203         (incf i)
4204         (when (zerop (% i 10))
4205           (tinypath-verbose-macro 2
4206                                   (message "TinyPath: EXT Caching files... %d %s" i path)))
4207         ;; data structure is ("file.el" (1 . "/home/foo/elisp/"))
4208         ;;
4209         ;;  The reason why we put paths to separate lists is that
4210         ;;  OTHER directories must override the Core Emacs paths,
4211         ;;  so that newest files are found. Usually you can download
4212         ;;  newer versions than what Emacs has.
4213         (cond
4214          ((tinypath-load-path-emacs-distribution-p path)
4215           (incf emacs-count)
4216           (setq elt (list file (cons emacs-count dir)))
4217           (push elt emacs))
4218          ((tinypath-load-path-personal-p path)
4219           (incf personal-count)
4220           (setq elt (list file (cons personal-count dir)))
4221           (push elt personal))
4222          (t
4223           (incf other-count)
4224           (setq elt (list file (cons other-count dir)))
4225           (push elt other)))))
4226     (append (nreverse personal) (append other emacs))))
4227
4228 ;;; ----------------------------------------------------------------------
4229 ;;;
4230 (defun tinypath-external-output-parse-1 (id)
4231   "Parse ID from current buffer. See `tinypath-external-helper'."
4232   (let* ((case-fold-search t)
4233          (regexp (concat "^" id "[ \t]+\\([^ \t\r\n]+\\)"))
4234          string
4235          list)
4236     (goto-char (point-min))
4237     (while (re-search-forward regexp nil t)
4238       (setq string (match-string 1))
4239       ;; (set-text-properties 0 (length string) nil string)
4240       (push string list))
4241     (unless list
4242       (tinypath-verbose-macro 1
4243                               (message  "TinyPath: EXT PARSE FATAL (id %s)\n" id)))
4244     list))
4245
4246 ;;; ----------------------------------------------------------------------
4247 ;;;
4248 (defun tinypath-external-output-parse-main ()
4249   "Parse current buffer. See'`tinypath-external-helper'."
4250   (let* (list
4251          data
4252          name)
4253     ;;  Speedier processing
4254     (buffer-disable-undo)
4255     ;;  Clear text properties so that the data structures are clean
4256     ;;  and possibly faster to use
4257     (set-text-properties (point-min) (point-max) nil)
4258     (tinypath-verbose-macro 5
4259                             (message  "TinyPath: EXT OUTPUT \n%s\n" (buffer-string)))
4260     ;;  This list of symbols is same as the prefix string from
4261     ;;  the perl script:
4262     ;;
4263     ;;  LISP-FILE filename-here
4264     ;;  LISP-DIR filename-here
4265     ;;  ...
4266     (dolist (id '(info
4267                   bin
4268                   man
4269                   lisp-dir
4270                   c-src-dir))
4271       (setq name (symbol-name id)
4272             data  (tinypath-external-output-parse-1 name))
4273       (if (null data)
4274           (tinypath-verbose-macro 3
4275                                   (message "TinyPath: EXT PARSE ERROR [%s]" name))
4276         (push (cons id data) list)))
4277     ;;  'cache (lisp-files) handling is different. Do it now
4278     (let ((data (tinypath-external-output-parse-1-cache)))
4279       (if data
4280           (push (cons 'cache data) list)))
4281     list))
4282
4283 ;;; ----------------------------------------------------------------------
4284 ;;;
4285 (defun tinypath-external-bin-location (file)
4286   "Return location of BINARY. Look from the installation dir.
4287 Look up `exec-path' and the kit installation directory. See
4288 Manual \\[tinypath-version] for more."
4289   (let* ((path  (tinypath-executable-find file))
4290          (ret   path)
4291          self)
4292     (when (and (null path)
4293                (setq self (tinypath-self-location)))
4294       ;;  PATH/to/.../lisp/tiny/<tinypath.el>
4295       ;;            |
4296       ;;            |
4297       ;;            /bin/emacs-util.pl
4298       (setq self (tinypath-expand-file-name self))
4299       (setq self
4300             (concat
4301              (file-name-as-directory self)
4302              ;;  PATH/to/lisp/files/<tinypath.el>
4303              "../../bin/"
4304              file))
4305       (if (file-exists-p self)
4306           (setq ret self)))
4307     (tinypath-verbose-macro 3
4308                             (message "TinyPath: EXT bin location %s" ret))
4309     (when (and ret
4310                (not (file-exists-p ret)))
4311       (message "TinyPath: EXT FATAL, bin location is wrong %s" ret)
4312       (setq ret nil))
4313     ret))
4314
4315 ;;; ----------------------------------------------------------------------
4316 ;;;
4317 (defun tinypath-external-helper-call (buffer path-list &optional debug)
4318   "Use external helper Perl script if available.
4319 First, Environment must contain perl executable and second
4320 `tinypath-:external-util-bin' must be along path.
4321
4322 Input:
4323
4324   BUFFER     Where to output.
4325   PATH-LIST  list of root directories to search.
4326   DEBUG      Request debug.
4327
4328 Return:
4329
4330   t          If external utility was found and called."
4331   (let* ((file  tinypath-:external-util-bin)
4332          (perl  (tinypath-executable-find-binary "perl"))
4333          (bin   (tinypath-external-bin-location
4334                  tinypath-:external-util-bin))
4335          (opt   (or path-list
4336                     (error "TinyPath: path-list is empty.")))
4337          (ignore tinypath-:load-path-ignore-regexp))
4338     (tinypath-verbose-macro 3
4339                             (message "TinyPath: EXT perl location %s" (or perl "<not found>")))
4340     (tinypath-verbose-macro 3
4341                             (message "TinyPath: EXT exec-path %s %s" file (or bin "<not found>")))
4342     (when debug
4343       (push "3" opt)
4344       (push "--debug" opt))
4345     (when (and tinypath-:win32-p
4346                (not tinypath-:win32-cygwin-p))
4347       (push "no-symlinks" opt)
4348       (push "--scan-type" opt))
4349     (setq ignore
4350           (concat
4351            (or ignore "")
4352            (if (stringp ignore)
4353                "\\|" "")
4354            (if tinypath-:xemacs-p
4355                "[/\\]emacs"
4356              "[/\\]xemacs")))
4357     (dolist (switch (list
4358                      "--Info"
4359                      "--Man"
4360                      "--Bin"
4361                      "--Lang-lisp-file"
4362                      "--Lang-lisp-dir"
4363                      "--Lang-c-src-dir"
4364                      ignore
4365                      "--ignore-emacs-regexp"))
4366       ;;  These will go to the beginning, which is ok.
4367       (push switch opt))
4368     (push bin opt)
4369     (when debug
4370       ;;  If Emacs hangs, at least we know how the external command was called.
4371       (find-file "~/emacs-debug-tinypath.log")
4372       (erase-buffer)
4373       (insert (pp opt))
4374       (save-buffer))
4375     (if (null (and perl bin))
4376         (tinypath-verbose-macro 5
4377                                 "TinyPath: EXT ERROR Can't call external utility")
4378       (message "TinyPath: EXT Process running... [please wait] %s"
4379                (mapconcat 'identity opt " "))
4380       (with-current-buffer buffer
4381         (apply 'call-process
4382                perl
4383                nil
4384                (current-buffer)
4385                nil
4386                opt)
4387         (tinypath-verbose-macro 9
4388                                 (message
4389                                  (concat "\nTinyPath: EXT OUTPUT END\n")))
4390         (message "TinyPath: EXT done %s" bin)
4391         t))))
4392
4393 ;;; ----------------------------------------------------------------------
4394 ;;;
4395 (defun tinypath-external-helper-main (path-list)
4396   "Call external helper with PATH-LIST and parse output.
4397
4398 Return:
4399
4400   '((info . (path path ..))
4401     (man  . (path path ..))
4402     (bin  . (path path ..))
4403     (lisp . (path path ..))
4404     (cache . <FORMAT EQUALS TO TINYPATH-:CACHE>))."
4405   (tinypath-with-temp-buffer
4406    (when (tinypath-external-helper-call (current-buffer) path-list)
4407      (tinypath-external-output-parse-main))))
4408
4409 ;;; ----------------------------------------------------------------------
4410 ;;;
4411 (defun tinypath-external-setup-1-main ()
4412   "Return paths to pass to external program."
4413   (let (list)
4414     (dolist (elt (list
4415                   ;; load-path must not be there, because it may be already
4416                   ;; populated from the cache file: the one that we are
4417                   ;; trying to build from fresh.
4418                   ;;
4419                   ;; -> do not add `load-path' to returned list
4420                   ;;
4421                   ;; But we can add the original load path which were
4422                   ;; saved at startup.
4423                   tinypath-:extra-path-root
4424                   tinypath-:original-load-path
4425                   tinypath-:load-path-root
4426                   (tinypath-Info-default-directory-list)))
4427       (dolist (path elt)
4428         (when (and (stringp path)
4429                    (not (string-match "^[ \t]+$" path))
4430                    (file-directory-p path))
4431           (push (tinypath-expand-file-name path) list))))
4432     list))
4433
4434 ;;; ----------------------------------------------------------------------
4435 ;;;
4436 (defun tinypath-external-setup-cache (data)
4437   "Set `tinypath-:cache from DATA '((cache (DATA) ..)."
4438   (let* ((list (assq 'cache data)))
4439     (when list
4440       (setq list (cdr list))
4441       (setq tinypath-:cache list))))
4442
4443 ;;; ----------------------------------------------------------------------
4444 ;;;
4445 (defsubst tinypath-external-setup-1-load-path (path regexp)
4446   "Add PATH to `load-path'. Use REGEXP to check validity."
4447   ;; The perl program recursed ALL directories, but we only
4448   ;; want to find out lisp dirs that USER requested in
4449   ;; `load-path' and `tinypath-:load-path-root'
4450   ;;
4451   ;; lisp-roots is a lookup string "PATH\\|PATH\\|PATH .."
4452   ;; which we can use to check if path is accepted
4453   ;;
4454   (cond
4455    ((not (string-match regexp path))
4456     (tinypath-verbose-macro 5
4457                             (message "TinyPath: PATH-NOK not candidate %s" path)))
4458    ((tinypath-path-ok-p path)
4459     (pushnew path load-path :test 'string=))))
4460
4461 ;;; ----------------------------------------------------------------------
4462 ;;;
4463 (defsubst tinypath-external-setup-1-man-path (path)
4464   "Add PATH to `tinypath-:extra-manpath'."
4465   (when (or (not (stringp
4466                   tinypath-:manpath-ignore-regexp))
4467             (not (string-match
4468                   tinypath-:manpath-ignore-regexp
4469                   path)))
4470     (pushnew path tinypath-:extra-manpath :test 'string=)))
4471
4472 ;;; ----------------------------------------------------------------------
4473 ;;;
4474 (defun tinypath-external-load-path-lookup-regexp ()
4475   "Return candidate `load-path' lookup regexp.
4476 This is combination of `load-path' and `tinypath-:load-path-root'."
4477   (let* ((lisp-roots (append load-path
4478                              tinypath-:load-path-root)))
4479     ;; Make lookup regexp
4480     (mapconcat
4481      (function
4482       (lambda (x)
4483         (regexp-quote
4484          (tinypath-expand-file-name x))))
4485      lisp-roots
4486      "\\|")))
4487
4488 ;;; ----------------------------------------------------------------------
4489 ;;;
4490 (defun tinypath-external-setup-parse-data (data)
4491   "Parse external tool's DATA structure."
4492   (let* ((lisp-lookup (tinypath-external-load-path-lookup-regexp))
4493          correct-emacs
4494          type)
4495     (when data
4496       (dolist (elt data)
4497         (setq type (car elt))
4498         (dolist (path (cdr elt))
4499           ;; 'cache element is not a string.
4500           (when (stringp path)
4501             (setq correct-emacs
4502                   (tinypath-path-ok-this-emacs-p path)))
4503           (cond
4504            ((equal type 'cache)
4505             (return)) ;; Not handled in this loop
4506            ((and (equal type 'lisp-dir)
4507                  correct-emacs)
4508             (tinypath-external-setup-1-load-path path lisp-lookup))
4509            ((equal type 'man)
4510             (tinypath-external-setup-1-man-path path))
4511            ((equal type 'c-src-dir)
4512             (pushnew path
4513                      tinypath-:extra-ff-search-directories
4514                      :test
4515                      'string=))
4516            ((and (equal type 'bin)
4517                  correct-emacs)
4518             (tinypath-exec-path-append path))
4519            ((and (equal type 'info)
4520                  correct-emacs)
4521             (tinypath-info-handler path)
4522             (pushnew path
4523                      (tinypath-Info-default-directory-list)
4524                      :test
4525                      'string=)))))
4526       (tinypath-external-setup-cache data)) ;; When
4527     (tinypath-verbose-macro 3
4528                             (message "TinyPath: EXT END tinypath-external-setup %s"
4529                                      (if data
4530                                          "[DATA OK]"
4531                                        "[DATA NOK]")))
4532     data))
4533
4534 ;;; ----------------------------------------------------------------------
4535 ;;;
4536 (defun tinypath-external-setup ()
4537   "Use external tool to help setup emacs.
4538 See `tinypath-external-helper-main'."
4539   (and
4540    (setq tinypath-:external-data-structure
4541          (tinypath-external-helper-main
4542           (tinypath-external-setup-1-main)))
4543    (tinypath-external-setup-parse-data
4544     tinypath-:external-data-structure)))
4545
4546 ;;}}}
4547 ;;{{{ Cache
4548
4549 ;;; ----------------------------------------------------------------------
4550 ;;;
4551 (defsubst tinypath-cache-elt-fullpath (elt)
4552   "Return full path t package from cache ELT."
4553   ;; ("sgml-mode.el" (5359 . "d:/emacs-21.3/lisp/textmodes/")
4554   (concat (cdr (nth 1 elt))
4555           (car-safe elt)))
4556
4557 ;;; ----------------------------------------------------------------------
4558 ;;;
4559 (defsubst tinypath-cache-elt-package (elt)
4560   "Return package name from cache ELT."
4561   (car-safe elt))
4562
4563 ;;; ----------------------------------------------------------------------
4564 ;;;
4565 (defun tinypath-cache-p-1-initialize ()
4566   "Set internal extension cache."
4567   (put 'tinypath-cache-p-1
4568        'extension-cache
4569        (tinypath-file-extension-list-choices)))
4570
4571 ;;; ----------------------------------------------------------------------
4572 ;;;
4573 (defun tinypath-cache-p-1-extensions (package)
4574   "Return list of extensions for PACKAGE."
4575   (unless (get 'tinypath-cache-p-1 'extension-cache)
4576     (tinypath-cache-p-1-initialize))
4577   (if (string-match "\\.elc?$" package)
4578       (assoc (match-string 0 package)
4579              (get 'tinypath-cache-p-1
4580                   'extension-cache))
4581     (cdr (assq nil
4582                (get 'tinypath-cache-p-1
4583                     'extension-cache)))))
4584
4585 ;;; ----------------------------------------------------------------------
4586 ;;;
4587 (defun tinypath-cache-p-1-new-cache-lookup
4588   (package choices &optional regexp)
4589   "Search PACKAGE and CHOICES from `tinypath-:cache'.
4590 Input:
4591
4592   PACKAGE   vt100
4593   CHOICES   '(\"vt100\" \".el.gz\" \".el\" ...)
4594   REGEXP    If string, ignore files matching this regexp. E.g. '\.elc'."
4595   (let* ((fid  "tinypath-cache-p-1-new-cache-lookup")
4596          (file package)
4597          try
4598          ret)
4599     ;; Remove extension
4600     (when (string-match "^\\(.*\\)\\(\\.elc?\\)$" package)
4601       (setq file (match-string 1 package))
4602       (tinypath-verbose-macro 10
4603                               (message "%s REMOVE EXTENSION %s" fid package)))
4604
4605     (dolist (elt choices)
4606       (tinypath-verbose-macro 10
4607                               (message "%s trying... %s"  fid (concat file elt)))
4608       (setq try (concat file elt))
4609       (when (and (or (null regexp)
4610                      (not (string-match regexp try)))
4611                  (setq elt (assoc try tinypath-:cache)))
4612         (tinypath-verbose-macro 10
4613                                 (message "%s ASSOC %s" fid (prin1-to-string elt)))
4614         (setq ret elt)
4615         (return)))
4616     ret))
4617
4618 ;;; ----------------------------------------------------------------------
4619 ;;; There used to be function `tinypath-cache-p-1-old' which
4620 ;;; was first implementation and the new function was developed while
4621 ;;; the "old" was trusted version.
4622 ;;;
4623 (defun tinypath-cache-p-1-new-cache (package &optional no-special)
4624   "Check if PACKAGE is in tinypath-:cache. Return PATH or nil.
4625 If package contains absolute directory part, return PACKAGE.
4626
4627 The search order for unidentified package is:
4628 '(\".elc\" \".elc.bz2\" \".elc.gz\" \".el\" \".el.bz2\" \".el.gz\")
4629
4630 Input:
4631
4632   PACKAGE       file to find from cache.
4633   NO-SPECIAL    There is special handling for jka-compr which is never
4634                 checked for compressed file. Non-nil bypasses special
4635                 case handling.
4636
4637 Return:
4638
4639   '(PATH  CACHE-ELEMENT)"
4640   (when tinypath-:cache
4641     (let* ((fid  "TinyPath: tinypath-cache-p-1-new-cache ")
4642            (regexp1  tinypath-:ignore-file-regexp)
4643            ;;  These files are banned, although they were put to
4644            ;;  load-path or cache. Gnus version is one good example:
4645            ;;  The original Gnus from Emacs installation is not used
4646            ;;  if there is newer Gnus found.
4647            (regexp2  tinypath-:load-path-ignore-regexp)
4648            ;; (dir      (file-name-directory package))
4649            (choices  (tinypath-cache-p-1-extensions package))
4650            elt
4651            ret)
4652       (tinypath-verbose-macro 10
4653                               (message (concat fid
4654                                                " CHOICES "
4655                                                (prin1-to-string choices))))
4656       (setq
4657        ret
4658        (catch 'done
4659          (flet (                 ;; First function
4660                 (path-name (ELT) ;; ELT = '("FILE.EL" (POS . "PATH"))
4661                            (when ELT
4662                              (concat (cdr (nth 1 ELT)) (car ELT)  )))
4663                 ;; Second function
4664                 (throw-ignore
4665                  (ELT)
4666                  (cond
4667                   ((and ELT
4668                         (or (and (stringp regexp1)
4669                                  (string-match regexp1
4670                                                (car ELT)))
4671                             (and (stringp regexp2)
4672                                  (let (case-fold-search)
4673                                    (string-match regexp2
4674                                                  (cdr (nth 1 ELT)))))))
4675                    (tinypath-verbose-macro 10
4676                                            (message "%s`ignore-file-regexp' %s"
4677                                                     fid
4678                                                     (car ELT)))
4679                    nil)
4680                   (ELT
4681                    (throw 'done (path-name ELT))))))
4682            (tinypath-verbose-macro 10
4683                                    (message (concat fid " ENTRY %s %s")
4684                                             package
4685                                             (prin1-to-string choices)))
4686            (when (setq elt (assoc package tinypath-:cache))
4687              (tinypath-verbose-macro 10
4688                                      (message (concat fid "DIRECT HIT %s") package))
4689              (throw-ignore elt))
4690            ;; .................................................. search ...
4691            (cond
4692             ((and (null no-special)
4693                   (string-match "jka-compr" package))
4694              ;; XEmacs 20.4  installs files under
4695              ;; /usr/lib/xemacs-20.4/lisp and all the lisp file sources
4696              ;; are in compressed format. This means, that we cannot load
4697              ;; jka-compr.el.gz initially.
4698              ;;
4699              ;; This situation is evident if user has disabled the .elc
4700              ;;  loading with tinypath-:ignore-file-regexp
4701              (setq regexp1 nil)
4702              (tinypath-verbose-macro 10
4703                                      (message (concat fid "SPECIAL CASE %s") package))
4704              (setq elt
4705                    (or (and (not (string-match "\\.el$" package))
4706                             (assoc "jka-compr.elc" tinypath-:cache))
4707                        (assoc "jka-compr.el" tinypath-:cache)
4708                        (let ((cache
4709                               (tinypath-load-path-locate-library
4710                                "jka-compr.el")))
4711                          (when cache ;;  Make it look like CACHE entry
4712                            (list "jka-compr.el"
4713                                  (cons 1 (file-name-directory
4714                                           cache)))))))
4715              (unless elt
4716                (error "TinyPath: (cache-p-1) FATAL, can't find %s"
4717                       package))
4718              (throw 'done (path-name elt)))
4719             ;; .......................................... regular files ...
4720             ((not (string-match "\\.\\(g?z\\|bz2\\)$" package))
4721              (throw-ignore (setq elt (tinypath-cache-p-1-new-cache-lookup
4722                                       package choices regexp1))))))))
4723       (tinypath-verbose-macro 9
4724                               (message "TinyPath: cache hit: %s [%s] %s"
4725                                        package
4726                                        (or ret "")
4727                                        (prin1-to-string elt)))
4728       (list ret elt))))
4729
4730 ;;; ----------------------------------------------------------------------
4731 ;;;
4732 (defun tinypath-cache-p-1-new (package &optional no-special)
4733   "Check if PACKAGE is in tinypath-:cache. Return PATH or nil.
4734 See `tinypath-cache-p-1-new-cache'.
4735
4736 Paths with directory component are changed to plain PACKAGE
4737 searches. Like if searching:
4738
4739    term/vt100
4740
4741 This is converted into search:
4742
4743    vt100"
4744   ;; Do not search absolute paths
4745   (let* ((fid "tinypath-cache-p-1-new "))
4746     (tinypath-verbose-macro 10
4747                             (message "%s Searching for... %s" fid package))
4748     (cond
4749      ((not (stringp package))
4750       (list nil nil))
4751      ((string-match "^[/\\~]\\|^[A-Za-z]:" package)
4752       (list package nil))
4753      (t
4754       (when (file-name-directory package)
4755         (tinypath-verbose-macro 10
4756                                 (message "%s %stry Searching plain PACKAGE.el" fid package))
4757         (setq package (file-name-nondirectory package)))
4758       (tinypath-cache-p-1-new-cache package no-special)))))
4759
4760 ;;; ----------------------------------------------------------------------
4761 ;;;
4762 (defsubst tinypath-cache-p-1 (package)
4763   "Call correct cache implementation."
4764   (tinypath-cache-p-1-new package))
4765
4766 ;;; ----------------------------------------------------------------------
4767 ;;;
4768 (defun tinypath-cache-p-2 (package)
4769   "Check if PACKAGE is in `tinypath-:cache'. Return PATH or nil.
4770 If PACKAGE contains a path name, return PACKAGE."
4771   (let  (list
4772          level2
4773          elt
4774          elt2
4775          ret)
4776     (cond
4777      ;;  Nothing to do, Linux or Win32 absolute path name
4778      ((string-match "^[/\\~]\\|^[A-Za-z]:" package)
4779       (setq ret package))
4780      ((file-name-directory package)
4781       ;;  look up "package" first, because it is most
4782       ;;  likely known to cache, only then "dir/package"
4783       (setq list
4784             (list (file-name-nondirectory package)))
4785       ;; 2003-15-18 disabled looking term/vt100
4786       ;; because, it should be found from cache with
4787       ;; simple name "vt100".
4788       ;; package
4789       nil)
4790      (t
4791       (setq list (list package))))
4792     (dolist (file list)
4793       (setq elt    nil
4794             elt2   nil
4795             level2 nil)
4796       (cond
4797        ;; If level two cache exists, then check that the entry has not
4798        ;; been resolved before.
4799        ((and tinypath-:cache-level-two
4800              (setq elt2 (assoc file tinypath-:cache-level-two))
4801              (setq ret  (cdr elt)))
4802         (setq level2 t))
4803        (t
4804         (and (setq elt (tinypath-cache-p-1 file))
4805              (setq ret (car elt)))))
4806       ;;  Did cache hold the information?
4807       (cond
4808        ((null ret))
4809        ((and (stringp ret)
4810              (file-exists-p ret))
4811         (unless level2
4812           ;; This was not in level 2, put it these
4813           (push (cons package ret) tinypath-:cache-level-two))
4814         (return))
4815        (ret
4816         ;;  Invalid cache entry, file does not exist any more.
4817         (tinypath-verbose-macro 3
4818                                 (tinypath-cache-warn-if-not-exist ret))
4819         ;;  Remove from both caches
4820         (when elt
4821           (setq tinypath-:cache (delq (cadr elt) tinypath-:cache)))
4822         (when elt2
4823           (setq tinypath-:cache-level-two
4824                 (delq elt2 tinypath-:cache-level-two))))))
4825     (when (null ret)
4826       ;;  Do full scan.
4827       (setq ret (tinypath-load-path-locate-library package))
4828       (when (and ret
4829                  (file-exists-p ret))
4830         ;;  Mark tesese entries with "zero" position: They have
4831         ;;  been found later on while Emacs is running.
4832         (push (cons package ret) tinypath-:cache-level-two)
4833         (push (list (file-name-nondirectory ret)
4834                     (cons 0  (file-name-directory ret)))
4835               tinypath-:cache)))
4836
4837     ret))
4838
4839 ;;; ----------------------------------------------------------------------
4840 ;;;
4841 (defun tinypath-cache-p (package)
4842   "Check if PACKAGE is in tinypath-:cache. Return PATH or nil.
4843 If package contains absolute directory part, return PACKAGE."
4844   (if (string-match "^[~/\\]" package)
4845       ;; Any absolute load paths are ignored by CACHE and returned
4846       ;;  as is, so ignore references like ~/.emacs
4847       package
4848     (tinypath-cache-p-2 package)))
4849
4850 ;;; ----------------------------------------------------------------------
4851 ;;;
4852 (defsubst tinypath-cache-p-for-advice (file)
4853   "If load-path and cache are the same, return cache lookup for FILE.
4854 This code is used in adviced function."
4855   (if (tinypath-load-copy-equal-p)
4856       (tinypath-cache-p file)))
4857
4858 ;;; ----------------------------------------------------------------------
4859 ;;;
4860 (defun tinypath-cache-match-package (regexp &optional flag)
4861   "Return cache elements whose package names match REGEXP.
4862 If FLAG is non-nil, return package names, not cache elements."
4863   (let (list
4864         name)
4865     (dolist (elt tinypath-:cache)
4866       (setq name (tinypath-cache-elt-package elt))
4867       (cond
4868        ((not (stringp name))
4869         (message "TinyPath: [ERROR] invalid cache entry: %s"
4870                  (prin1-to-string elt)))
4871        ((string-match regexp name)
4872         (push (if flag
4873                   name
4874                 elt)
4875               list))))
4876     (nreverse list)))
4877
4878 ;;; ----------------------------------------------------------------------
4879 ;;;
4880 (defun tinypath-cache-match-fullpath (regexp &optional flag)
4881   "Return cache elements whose full path match REGEXP.
4882 If FLAG is non-nil, return package names, not cache elements."
4883   (let (list
4884         name)
4885     (dolist (elt tinypath-:cache)
4886       (setq name (tinypath-cache-elt-fullpath elt))
4887       (cond
4888        ((not (stringp name))
4889         (message "TinyPath: [ERROR] invalid cache entry: %s"
4890                  (prin1-to-string elt)))
4891        ((string-match regexp name)
4892         (push (if flag
4893                   name
4894                 elt)
4895               list))))
4896     (nreverse list)))
4897
4898 ;;; ----------------------------------------------------------------------
4899 ;;;
4900 (defun tinypath-cache-file-hostname ()
4901   "Return `system-name'."
4902   (downcase
4903    (or (or (getenv "HOST")              ;Unix
4904            (getenv "COMPUTERNAME"))     ;Win32
4905        "unknownhost")))
4906
4907 ;;; ----------------------------------------------------------------------
4908 ;;;
4909 (defun tinypath-cache-file-name ()
4910   "Return Emacs version specific cache file.
4911
4912 References:
4913
4914   `tinypath-:cache-file-prefix'.
4915   `tinypath-:cache-file-postfix'"
4916   (let* (host
4917          (type (if tinypath-:xemacs-p
4918                    "xemacs"
4919                  "emacs"))
4920          (list (tinypath-emacs-versions))
4921          (ver  (or (nth 1 list)
4922                    (nth 0 list)))
4923          (win32  (if tinypath-:win32-p
4924                      "win32-"
4925                    ""))
4926          (cygwin (if tinypath-:win32-cygwin-p
4927                      "cygwin-"
4928                    ""))
4929          (host-func tinypath-:cache-file-hostname-function)
4930          ret)
4931     (when (and host-func
4932                (functionp host-func))
4933       (let (ret)
4934         (setq ret (funcall host-func))
4935         (tinypath-verbose-macro 3
4936                                 (message "TinyPath: CACHE file host function returned %s"
4937                                          (or ret "nil")))
4938         (if (stringp ret)
4939             (setq host ret))))
4940     (setq ret
4941           (concat tinypath-:cache-file-prefix
4942                   "-"
4943                   win32
4944                   cygwin
4945                   (if (stringp host)
4946                       (concat host "-")
4947                     "")
4948                   type
4949                   "-"
4950                   ver
4951                   tinypath-:cache-file-postfix))
4952     ret))
4953
4954 ;;; ----------------------------------------------------------------------
4955 ;;;
4956 (defun tinypath-cache-file-name-compiled-p (file)
4957   "Check if FILE matches \"\\\\.elc$\". Return non-compiled FILE."
4958   (when (string-match "\\(^.+\\.el\\)c$" file)
4959     (match-string 1 file)))
4960
4961 ;;; ----------------------------------------------------------------------
4962 ;;;
4963 (defun tinypath-cache-file-name-all ()
4964   "Return list of cache files.
4965 If `tinypath-:cache-file-postfix' is `\.elc', then return both
4966 compiled and non-compiled files."
4967   (let* ((file      (tinypath-cache-file-name))
4968          (el        (tinypath-cache-file-name-compiled-p file)))
4969     (if el
4970         (list file el)
4971       (list file))))
4972
4973 ;;; ----------------------------------------------------------------------
4974 ;;;
4975 (defun tinypath-cache-file-delete ()
4976   "Delete cache file(s) from disk, if they exist."
4977   (dolist (file (tinypath-cache-file-name-all))
4978     (when (file-exists-p file)
4979       (delete-file file)
4980       (tinypath-verbose-macro 5
4981                               (message "TinyPath: Cache deleted: %s" file)))))
4982
4983 ;;; ----------------------------------------------------------------------
4984 ;;;
4985 (defun tinypath-cache-file-old-p (file)
4986   "Return non-nil if FILE exists and is too old.
4987 References:
4988   `tinypath-:cache-expiry-days'."
4989   (when (and (file-exists-p file)
4990              (integerp tinypath-:cache-expiry-days))
4991     (let* ((days  (tinypath-days-old file)))
4992       (when (> days tinypath-:cache-expiry-days)
4993         (tinypath-verbose-macro 2
4994                                 (message "TinyPath: Cache is too old: %s days" days))
4995         t))))
4996
4997 ;;; ----------------------------------------------------------------------
4998 ;;;
4999 (defun tinypath-cache-file-write (file)
5000   "Write state information to FILE."
5001 ;;;   (interactive "FFile to save cache: ")
5002   (let* ((bytecomp  (tinypath-cache-file-name-compiled-p file))
5003          (write     (or bytecomp file)))
5004     (tinypath-verbose-macro 2
5005                             (message "TinyPath: Saving cache to %s" write))
5006     (tinypath-ti::write-file-variable-state
5007      write
5008      (concat "Emacs load-path settings.\n"
5009              ";; This file is automatically generated. Do not touch.\n"
5010              ";; See tinypath.el and M-x tinypath-cache-regenerate.\n")
5011      (list
5012       'load-path
5013       'exec-path
5014       'tinypath-:extra-manpath
5015       'tinypath-:extra-path-root
5016       'tinypath-:extra-ff-search-directories
5017       (if (boundp 'Info-directory-list) ;; XEmacs
5018           'Info-directory-list
5019         'Info-default-directory-list)
5020       'tinypath-:cache)
5021      'no-pp-print 'no-backup)
5022     ;;  Only if name ends to "\.elc"
5023     (if bytecomp
5024         (tinypath-byte-compile-file bytecomp))))
5025
5026 ;;; ----------------------------------------------------------------------
5027 ;;;
5028 (defun tinypath-cache-file-save ()
5029   "Save cache file."
5030   (tinypath-cache-file-write (tinypath-cache-file-name)))
5031
5032 ;;; ----------------------------------------------------------------------
5033 ;;;
5034 (defun tinypath-cache-file-load ()
5035   "Load cache."
5036   (let* (stat)
5037     (dolist (file (tinypath-cache-file-name-all))
5038       (setq stat (file-exists-p file))
5039       (tinypath-verbose-macro 2
5040                               (message "TinyPath: %sLoading cache file %s"
5041                                        (if stat
5042                                            ""
5043                                          "[ERROR] ")
5044                                        file))
5045       (when stat
5046         (load file)
5047         (return)))))
5048
5049 ;;; ----------------------------------------------------------------------
5050 ;;;
5051 (defun tinypath-cache-file-find-file ()
5052   "Display cache by calling `find-file'."
5053   (interactive)
5054   (let* ((file (tinypath-cache-file-name)))
5055     (tinypath-verbose-macro 2
5056                             (message "TinyPath: find-file cache %s" file))
5057     (find-file file)))
5058
5059 ;;; ----------------------------------------------------------------------
5060 ;;;
5061 (defun tinypath-cache-file-need-sync-p ()
5062   "Load cache. If cache needs synchronization, return non-nil."
5063   (let* (ret
5064          found)
5065     ;;  Using a simple variable is faster than
5066     ;;  checking (if load-path   , because load-path may be very big
5067     ;;
5068     (if load-path
5069         (setq found t))
5070     (unless found
5071       (setq ret 'cache-file-content-error)
5072       (message "TinyPath: [ERROR] CACHE; empty load-path"))
5073     (unless tinypath-:cache
5074       (setq ret 'cache-file-content-error)
5075       (message "TinyPath: [ERROR] CACHE; empty tinypath-:cache in"))
5076     ;;  Make sure that read cache is in synch with
5077     ;;  the `load-path'. If not, force rescanning.
5078     (when (and found
5079                (tinypath-load-path-not-in-synch-p 'fast-check))
5080       (setq ret 'need-sync))
5081     ret))
5082
5083 ;;; ----------------------------------------------------------------------
5084 ;;;
5085 (defun tinypath-cache-display (&optional insert)
5086   "Display `tinypath:-cache' and `tinypath-:cache-level-two'.
5087 Optionally INSERT."
5088   (interactive "P")
5089   (if tinypath-:cache-level-two
5090       (tinypath-list-display "tinypath-:cache-level-two %s"
5091                              tinypath-:cache-level-two insert)
5092     (message "tinypath-:cache-level-two is empty, nothing to display."))
5093   (tinypath-list-display "tinypath-:cache %s"
5094                          tinypath-:cache insert))
5095
5096 ;;}}}
5097 ;;{{{ Info files
5098
5099 (defconst tinypath-:info-file-basic-contents
5100   (concat
5101    "This is the file .../info/dir, which contains the\n"
5102    "topmost node of the Info hierarchy, called (dir)Top.\n"
5103    "The first time you invoke Info you start off looking at this node.\n"
5104    "\1f\n"
5105    "File: dir  Node: Top\tThis is the top of the INFO tree\n"
5106    "\n"
5107    "  This (the Directory node) gives a menu of major topics.\n"
5108    "  Typing \"q\" exits, \"?\" lists all Info commands, \"d\" returns here,\n"
5109    "  \"h\" gives a primer for first-timers,\n"
5110    "  \"mEmacs<Return>\" visits the Emacs manual, etc.\n"
5111    "\n"
5112    "  In Emacs, you can click mouse button 2 on a menu item or cross reference\n"
5113    "  to select it.\n"
5114    "\n"
5115    "* Menu:\n\n")
5116   "*This variable includes a basic `dir' file for Emacs info.
5117 Do not change.")
5118
5119 ;;; ----------------------------------------------------------------------
5120 ;;;
5121 (defun tinypath-info-display (&optional insert)
5122   "Display info path contents. Optionally INSERT.
5123 This would be `Info-directory-list' in XEmacs and
5124 `Info-default-directory-list' in Emacs."
5125   (interactive "P")
5126   (tinypath-list-display
5127    (concat (if tinypath-:xemacs-p
5128                "Info-directory-list"
5129              "Info-default-directory-list")
5130            " %s")
5131    (tinypath-Info-default-directory-list)
5132    insert))
5133
5134 ;;; ----------------------------------------------------------------------
5135 ;;;
5136 (defun tinypath-Info-default-directory-list-clean ()
5137   "Clean `Info-default-directory-list'.
5138 Remove any suspicious elements: non-directories, non-strings."
5139   (set (tinypath-Info-default-directory-list-sym)
5140        (tinypath-directory-list-clean
5141         (tinypath-Info-default-directory-list)
5142         "Info-directory-list")))
5143
5144 ;;; ----------------------------------------------------------------------
5145 ;;;
5146 (defun tinypath-write-region (beg end file)
5147   "Write region BEG END to FILE and ignore errors, but print message."
5148   (condition-case err
5149       (write-region (point-min) (point-max) file)
5150     (error
5151      (tinypath-verbose-macro 3
5152                              (message "TinyPath: [INFO] No permission to write %s %s"
5153                                       (or file "<nil>")  (prin1-to-string err))))))
5154
5155 ;;; ----------------------------------------------------------------------
5156 ;;;
5157 (defun tinypath-info-files-in-directory (dir)
5158   "Return all info files in DIR.
5159 The list is composed of capitalized names of the found files:
5160
5161     tar.info       --> Tar
5162     fileutils.info --> Fileutils
5163
5164 Returned list in the above case is '(\"Tar\" \"Fileutils\")."
5165   ;;  Cache this value only once and reuse as needed.
5166   (unless (get 'tinypath-info-files-in-directory
5167                'compress-extensions)
5168     (put 'tinypath-info-files-in-directory
5169          'compress-extensions
5170          (tinypath-file-extension-compressed)))
5171   (let* ((files      (directory-files dir))
5172          (extensions (cons "" (get 'tinypath-info-files-in-directory
5173                                    'compress-extensions)))
5174          ret)
5175     (dolist (file files)
5176       (when (catch 'exit
5177               (dolist (ext extensions)
5178                 ;;  NOTE:  Can't use \\| in here, because posix match engine
5179                 ;;  tries all possibilities and we want to stop after first
5180                 ;;  matched regexp.
5181                 ;;
5182                 ;;  File Examples:
5183                 ;;
5184                 ;;    cc-mode-1
5185                 ;;    eshell.info
5186                 ;;
5187                 (dolist (re '("^\\(.*\\)\\.info-1"
5188                               "^\\(.*\\)\\.info"
5189                               "^\\(.*\\)-1"))
5190                   (setq re (concat re ext "$"))
5191                   (when (string-match re file)
5192                     (throw 'exit file)))))
5193         (pushnew (capitalize (downcase (match-string 1 file)))
5194                  ret
5195                  :test 'string=)))
5196     (sort ret 'string-lessp)))
5197
5198 ;;; ----------------------------------------------------------------------
5199 ;;;
5200 (defun tinypath-info-directory-entry-p (entry)
5201   "Search for info ENTRY."
5202   (let* ((point (point)) ;; Faster than using save-excursion.
5203          ret)
5204     (goto-char (point-min))
5205     ;;  This check relies on using the same ENTRY for filename
5206     ;;
5207     ;;      * Oview: (Overview).
5208     ;;
5209     ;;  But what if user manually edit's the file and makes it read:
5210                                         ;:
5211     ;;      * Exim Oview: (Overview).
5212     ;;
5213     ;;  Ok, handle that too, but require thet "Oview" is still there.
5214     (when (and (goto-char (point-min))
5215                (re-search-forward
5216                 (format "^[*]\\([ \t]+[^ \t\r\n]+\\)?[ \t]+%s:[ \t]+"
5217                         entry)
5218                 nil t)
5219                (setq ret (point))))
5220     (goto-char point) ;; Restore point
5221     ret))
5222
5223 ;;; ----------------------------------------------------------------------
5224 ;;;
5225 (defun tinypath-info-directory-contents-update
5226   (file &optional verb interactive info-files)
5227   "Update the central `dir' with all new info files in directory.
5228 Give the absolute path to the `dir' and the directory is scanned
5229 for new entries which are updated to file `dir'.
5230
5231 Input:
5232
5233   FILE         The `dir' file location
5234   VERB         Allow printing verbose messages
5235   INTERACTIVE  Leave the buffer in Emacs for editing.
5236   INFO-FILES   Info files in directory, like \"Eieio\"
5237
5238 Return:
5239
5240   t   if any changes made."
5241
5242   ;;  (interactive "FInfo file named `dir', location: ")
5243
5244   (when (file-directory-p file)
5245     (error "You must give a filename"))
5246   (let ((buffer (find-file-noselect file))
5247         done
5248         buffer-file)
5249     (with-current-buffer buffer
5250       ;;  If we read /usr/local/info and we're not root, then
5251       ;;  this buffer will be read only. Make it writable. The
5252       ;;  save error is handled elsewhere.
5253       ;;
5254       (setq buffer-read-only nil)
5255       (tinypath-verbose-macro 1
5256                               (message "TinyPath: [INFO] found %s" file))
5257       (let* ((entries (or info-files
5258                           (tinypath-info-files-in-directory
5259                            (file-name-directory file)))))
5260         (dolist (entry entries)
5261           (unless (tinypath-info-directory-entry-p entry)
5262             (goto-char (point-max))
5263             (unless (looking-at "^[\n\t ]*$")
5264               (insert "\n"))
5265             (insert (format "* %s: (%s).\n" entry entry))
5266             (tinypath-verbose-macro 2
5267                                     (message "TinyPath: [INFO] added entry `%s' to file %s"
5268                                              entry file))
5269             (setq done t)
5270             (set-buffer-modified-p nil) ;; do not ask user  when killing buffer
5271             (setq buffer-file (buffer-file-name))))) ;; let*
5272       (if (interactive-p)
5273           (when done
5274             (message "TinyPath: [INFO] Edit and verify changes at %s" file))
5275         (when (and done buffer-file)
5276           (tinypath-write-region (point-min) (point-max) buffer-file))
5277         (when (buffer-live-p buffer)
5278           (kill-buffer buffer)))) ;; With-current
5279     done))
5280
5281 ;;; ----------------------------------------------------------------------
5282 ;;;
5283 (defun tinypath-info-file-DIR (path)
5284   "Make `dir' file name using PATH."
5285   (concat (file-name-as-directory path) "dir"))
5286
5287 ;;; ----------------------------------------------------------------------
5288 ;;;
5289 (defun tinypath-info-handler-DIR (dir)
5290   "Handle creating/updating central info file DIR `dir' to current directory."
5291   (let* ((dir-file (tinypath-info-file-DIR dir)))
5292     (unless (file-exists-p dir-file)  ;No central dir, generate one...
5293       (tinypath-verbose-macro 3
5294                               (message "TinyPath: [INFO] missing central `dir' generating %s"
5295                                        dir-file))
5296       (tinypath-with-temp-buffer
5297        (insert tinypath-:info-file-basic-contents)
5298        (insert " "
5299                (tinypath-expand-file-name dir)
5300                "\n")
5301        ;;  maybe we don't have permission to write to this directory?
5302        (tinypath-write-region (point-min) (point-max) dir-file)
5303        t))))
5304
5305 ;;; ----------------------------------------------------------------------
5306 ;;;
5307 (defun tinypath-info-handler (dir)
5308   "Check if DIR contains info files and a special `dir' file.
5309 This function will create `dir' file if it does not exist,
5310 update `Info-default-directory-list' and add any new INFO entries in
5311 DIR to central `dir' file in that directory.
5312
5313 Please suggest to the lisp package maintainer that he
5314 should ship with default `dir' in next release so that it
5315 could be automatically used.
5316
5317 Return
5318
5319   t   if any changes made."
5320   (interactive "fGive directory with info files: ")
5321   ;;  If user calls us, make sure new files are also noticed.
5322   ;;
5323   (if (interactive-p)
5324       (tinypath-info-initialize))
5325   (let* ((list     (tinypath-info-files-in-directory dir))
5326          (dir-file (concat (file-name-as-directory dir) "dir"))
5327          cleanup
5328          done)
5329     (when (and (null list)
5330                (interactive-p))
5331       (message "Tinypath: No info file candidates in %s" dir))
5332     (when list                          ;info files in this directory?
5333       (setq done (tinypath-info-handler-DIR dir))
5334       (tinypath-info-directory-contents-update
5335        dir-file
5336        (interactive-p)
5337        (interactive-p)
5338        list)
5339       (tinypath-verbose-macro 2
5340                               (message "TinyPath: [INFO] PUSH maybe => %s"
5341                                        dir))
5342       (tinypath-verbose-macro 5
5343                               (message
5344                                "TinyPath: [INFO] PUSH (before) Info-default-directory-list: %s"
5345                                (prin1-to-string (tinypath-Info-default-directory-list))))
5346       ;;  Always add found directories to the list.
5347       ;;  Notice, that directory may contain trailing slash, that's why
5348       ;;  two `member' tests
5349       ;;
5350       ;;   ../info
5351       ;;   ../info/
5352       ;;
5353       (let* ((dir1 (file-name-as-directory dir))         ;; with slash
5354              (dir2 (substring dir 0 (1- (length dir1)))) ;; without
5355              (list (tinypath-Info-default-directory-list)))
5356         (unless (or (member dir1 list)
5357                     (member dir2 list))
5358           (tinypath-verbose-macro 2
5359                                   (message
5360                                    "TinyPath: [INFO] PUSH Info-default-directory-list => %s" dir2))
5361           (setq cleanup t)
5362           ;;  This is efectively "(push dir2 <info-list>)"
5363           (set (tinypath-Info-default-directory-list-sym)
5364                (cons dir2 (tinypath-Info-default-directory-list)))
5365           (tinypath-verbose-macro 5
5366                                   (message
5367                                    "TinyPath: [INFO] PUSH (after) Info-default-directory-list: %s"
5368                                    (prin1-to-string (tinypath-Info-default-directory-list))))))
5369       ;;  Kill all previous info files from Emacs, so that next info
5370       ;;  C-h i will force Emacs to regenerate found new entries.
5371       (when (or cleanup                 ;Added new directory
5372                 (interactive-p))
5373         (tinypath-info-initialize)))
5374     done))
5375
5376 ;;; ----------------------------------------------------------------------
5377 ;;;
5378 (defun tinypath-info-kill-buffers ()
5379   "Kill all *info* buffers."
5380   ;;  - There may be hidden buffers that Emacs uses to gather
5381   ;;    all 'dir' files.
5382   ;;  - Kill also centeal buffer *info*
5383   (dolist (buffer (buffer-list))
5384     (when (string-match "^ info\\|^\\*info" (buffer-name buffer))
5385       (kill-buffer buffer))))
5386
5387 ;;; ----------------------------------------------------------------------
5388 ;;;
5389 (defun tinypath-info-initialize ()
5390   "Initialize info to pristine state.
5391 After this function, the central `dir' creates all its parts from scratch
5392 and not from cached directories."
5393   (interactive)
5394   (tinypath-Info-default-directory-list-clean)
5395   ;;  - This must be set to nil, because otherwise Info would not
5396   ;;    rescan new entries.
5397   (setq Info-dir-file-attributes nil)
5398   (tinypath-info-kill-buffers))
5399
5400 ;;; ----------------------------------------------------------------------
5401 ;;;
5402 (defun tinypath-info-scan-Info-default-directory-list (&optional list)
5403   "Examine and possibly fix LIST of dirs to `Info-default-directory-list'.
5404 Without any arguments, checks `Info-default-directory-list'
5405 and `tinypath-:Info-default-directory-list'.
5406
5407 If there were any new entries or possibly new directory without
5408 and root INFO file `dir', Emacs info cache cache is deleted and
5409 existing *info* buffer if killed. You should run \\[info] to
5410 regenerate all the info parts again.
5411
5412 Return
5413
5414   t   if any changes made."
5415   (interactive)
5416   (let* (seen
5417          done)
5418     (or list
5419         (setq list (append (tinypath-Info-default-directory-list)
5420                            tinypath-:Info-default-directory-list)))
5421     (dolist (path list)
5422       (unless (member path seen)
5423         (push path seen)
5424         (when (file-directory-p path)
5425           (when (tinypath-info-handler path)
5426             (setq done t)))))
5427     (when (and done
5428                (interactive-p))
5429       (tinypath-cache-file-save))
5430     (when done
5431       (tinypath-info-initialize))
5432     done))
5433
5434 ;;}}}
5435 ;;{{{ Timing support
5436
5437 ;;; ----------------------------------------------------------------------
5438 ;;;
5439 (defun tinypath-time-difference (a b)
5440   "Calculate difference between times A and B.
5441 The input must be in form of '(current-time)'
5442 The returned value is difference in seconds.
5443 E.g., if you want to calculate days; you'd do
5444
5445 \(/ (tinypath-time-difference a b) 86400)  ;; 60sec * 60min * 24h"
5446   (let ((hi  (- (car a) (car b)))
5447         (lo  (- (car (cdr a)) (car (cdr b))))
5448         (mic (- (car (cddr a)) (car (cddr b)))))
5449     (+
5450      (+ (lsh hi 16) lo)
5451      (/ mic 1000000))))
5452
5453 ;;; ----------------------------------------------------------------------
5454 ;;;
5455 (defun tinypath-time-results (buffer)
5456   "Write load time results to BUFFER. Return buffer pointer."
5457   (let* (time
5458          min
5459          sec)
5460     (with-current-buffer (get-buffer-create buffer)
5461       (erase-buffer)
5462       (dolist (elt tinypath-:time-data)
5463         (setq time (cdr elt)
5464               min  (/ time 60)
5465               sec  (- time (* min 60)))
5466         (insert
5467          (format "%-20s %d  %dmin %dsec\n"
5468                  (car elt)
5469                  time
5470                  min
5471                  sec)))
5472       (current-buffer))))
5473
5474 ;;; ----------------------------------------------------------------------
5475 ;;;
5476 (defun tinypath-time-display ()
5477   "Display timing information of each package loaded."
5478   (interactive)
5479   (display-buffer (tinypath-time-results tinypath-:time-buffer)))
5480
5481 ;;; ----------------------------------------------------------------------
5482 ;;;
5483 (defun tinypath-time-record (package start-time)
5484   "Record load time of PACKAGE, when START-TIME is known."
5485   (when  (stringp package)
5486     (let* ((stop-time (current-time))
5487            (file (file-name-nondirectory package))
5488            (name (if (string-match "^.*\\(.*\\)\\.elc$" file)
5489                      (match-string 1 file)
5490                    file))
5491            (diff (tinypath-time-difference stop-time start-time)))
5492       (if tinypath-:verbose-timing
5493           (message "TinyPath: load time %s %dsec" name diff)
5494         (tinypath-verbose-macro 9
5495                                 (message "TinyPath: load time %s %dsec" name diff)))
5496       (aput 'tinypath-:time-data name diff))))
5497
5498 ;;; ----------------------------------------------------------------------
5499 ;;;
5500 (put 'tinypath-time-macro 'lisp-indent-function 1)
5501 (put 'tinypath-time-macro 'edebug-form-spec '(body))
5502 (defmacro tinypath-time-macro (package &rest body)
5503   "Record PACKAGE timing to `tinypath-:time-data' and run BODY."
5504   (`
5505    (let* ((start-time (current-time)))
5506      (prog1
5507          (progn (,@ body))
5508        (tinypath-time-record (, package) start-time)))))
5509
5510 ;;}}}
5511 ;;{{{ exec-path
5512
5513 ;;; ----------------------------------------------------------------------
5514 ;;;
5515 (defun tinypath-exec-path-from-path ()
5516   "Parse environment variable PATH."
5517   (let ((path   (getenv "PATH"))
5518         (regexp (concat "[^" path-separator "]+"))
5519         list)
5520     (when path
5521       (tinypath-with-temp-buffer
5522        (insert path)
5523        (goto-char (point-min))
5524        (while (re-search-forward regexp nil t)
5525          (push (match-string 0) list))))
5526     (nreverse list)))
5527
5528 ;;; ----------------------------------------------------------------------
5529 ;;;
5530 (defun tinypath-exec-path-append (path)
5531   "Add PATH to `exec-path'.
5532 Add new PATH to the end, so that user's paths take precedence.
5533 Ignore path if it matches `tinypath-:exec-path-ignore-regexp'."
5534   ;;  expand - Otherwise `member' would not do much good (duplicates)
5535   (setq path (tinypath-expand-file-name path))
5536   (unless (member path exec-path)
5537     (if (and (stringp tinypath-:exec-path-ignore-regexp)
5538              (string-match
5539               tinypath-:exec-path-ignore-regexp
5540               path))
5541         (tinypath-verbose-macro 3
5542                                 (message "\
5543 TinyPath: PATH ignored by tinypath-:exec-path-ignore-regexp %s" path))
5544       (setq exec-path (append exec-path (list path))))))
5545
5546 ;;; ----------------------------------------------------------------------
5547 ;;;
5548 (defun tinypath-exec-path-check ()
5549   "Check if `exec-path' lack any directory as in PATH.
5550 Return missing paths."
5551   (let* ( ;; (tinypath-directory-list-clean exec-path "exec-path"))
5552          (exec  exec-path)
5553          (PATH  (tinypath-directory-list-clean
5554                  (tinypath-exec-path-from-path)
5555                  "PATH"))
5556          missing)
5557     (dolist (path PATH)
5558       (unless (or (member path exec)
5559                   ;;  With trailing slash
5560                   (member (file-name-as-directory path) exec))
5561         (push path missing)))
5562     (nreverse missing)))
5563
5564 ;;; ----------------------------------------------------------------------
5565 ;;;
5566 (defun tinypath-exec-path-check-verbose (&optional fix)
5567   "Print messages if `exec-path' lacks any directory found in PATH.
5568 Optionally FIX by adding missing directories to the end."
5569   (interactive)
5570   (let ((missing (tinypath-exec-path-check)))
5571     (when missing
5572       (dolist (path missing)
5573         (message "TinyPath: PATH check. `exec-path' does not include %s%s"
5574                  path
5575                  (if fix
5576                      " [fixed]"
5577                    ""))
5578         (when fix
5579           (tinypath-exec-path-append path))))))
5580
5581 ;;; ----------------------------------------------------------------------
5582 ;;;
5583 (defun tinypath-exec-path-check-verbose-fix ()
5584   "Call `tinypath-exec-path-check-verbose' with argument 'fix."
5585   (tinypath-exec-path-check-verbose 'fix))
5586
5587 ;;; ----------------------------------------------------------------------
5588 ;;;
5589 (defun tinypath-exec-path-clean ()
5590   "Clean `exec-path' for anything suspicious: non-directories, non-strings."
5591   (tinypath-verbose-macro 5
5592                           (message "TinyPath: tinypath-exec-path-clean."))
5593   (setq exec-path (tinypath-directory-list-clean exec-path "exec-path")))
5594
5595 ;;; ----------------------------------------------------------------------
5596 ;;;
5597 (defun tinypath-exec-path-display (&optional insert)
5598   "Display `exec-path' by messaging' it. Optionally INSERT."
5599   (interactive "P")
5600   (tinypath-list-display "exec-path %s" exec-path insert))
5601
5602 ;;}}}
5603 ;;{{{ load-path
5604
5605 ;;; ----------------------------------------------------------------------
5606 ;;;
5607 (defun tinypath-load-path-emacs-distribution-p (path)
5608   "Return non-nil if PATH is from Emacs distribution."
5609   (string-match
5610    (concat
5611     "[/\\]x?emacs[/\\][0-9]+[0-9.]+[/\\]" ;; Unix  emacs/20.7/
5612     "\\|[/\\]x?emacs-[0-9]+[0-9.]+[/\\]") ;; win32 emacs-20.7/
5613    path))
5614
5615 ;;; ----------------------------------------------------------------------
5616 ;;;
5617 (defun tinypath-load-path-personal-p (path)
5618   "Return non-nil if PATH is under $HOME"
5619   (string-match
5620    (regexp-quote (expand-file-name "~"))
5621    (expand-file-name path)))
5622
5623 ;;; ----------------------------------------------------------------------
5624 ;;; (tinypath-load-path-search "gnus.el")
5625 ;;;
5626 (defun tinypath-load-path-search (package &optional all include-all)
5627   "Search `load-path' for PACKAGE and optioanlly ALL occurrances.
5628 This is the last resort if cache fails.
5629
5630 INCLUDE-ALL says that tinypath-:load-path-ignore-regexp'
5631 is not used.
5632
5633 Return
5634
5635   path          Absolute path location
5636   '(path ..)    If option ALL was set."
5637   (unless (get 'tinypath-cache-p-1 'extension-cache)
5638     (tinypath-cache-p-1-initialize))
5639   (let* (case-fold-search ;; Case sensitive match.
5640          file
5641          ret)
5642     (tinypath-verbose-macro 5
5643                             (message
5644                              (concat
5645                               "TinyPath: [WARNING] Performance problem; `%s' caused "
5646                               "full load-path scan.")
5647                              package))
5648     (dolist (dir load-path)
5649       (when (and (stringp dir)
5650                  (file-directory-p dir)
5651                  (or include-all
5652                      (null tinypath-:load-path-ignore-regexp)
5653                      (not (string-match
5654                            tinypath-:load-path-ignore-regexp
5655                            dir))))
5656         (let* ((try     (if  (string-match "\\.elc?$" package)
5657                             (file-name-sans-extension package)
5658                           package))
5659                (choices (tinypath-cache-p-1-extensions package))
5660                (files   (directory-files
5661                          dir
5662                          nil
5663                          (concat "^"
5664                                  (regexp-quote try)
5665                                  "\\("
5666                                  (mapconcat
5667                                   ;;  "\\.el\\|\\.el\\.gz\\|..."  etc.
5668                                   (function
5669                                    (lambda (x)
5670                                      (regexp-quote x)))
5671                                   choices
5672                                   "\\|")
5673                                  "\\)$"))))
5674           (cond
5675            ((eq 1 (length files))
5676             (setq file (concat
5677                         (file-name-as-directory
5678                          (expand-file-name dir))
5679                         (car files)))
5680             (if all
5681                 (push file ret)
5682               (return (setq ret file))))
5683            (t
5684             ;;  Multiple matches. Hm #todo.
5685             nil)))))
5686     ;;  Retain order how files were encountered.
5687     (if (listp ret)
5688         (nreverse ret)
5689       ret)))
5690
5691 ;;; ----------------------------------------------------------------------
5692 ;;; (tinypath-load-path-locate-library "cperl-mode")
5693 ;;;
5694 (defun tinypath-load-path-locate-library (package)
5695   "Locate PACKAGE along `load-path'.
5696
5697 References:
5698
5699   `tinypath-:load-path-accept-criteria'."
5700   (let* ((criteria      tinypath-:load-path-accept-criteria)
5701          (list          (tinypath-load-path-search
5702                          package criteria))
5703
5704          ;;  LIST can be '(path path ...) if ALL-MATCHES is activated.
5705          ;;  otherwise the returned value is absolute path name.
5706          (ret  (if (listp list)
5707                    (car-safe list)
5708                  list)))
5709     (cond
5710      ((or (null ret)                    ;Not found. Do nothing
5711           (stringp list)               ;Did not search all directories
5712           (eq (length ret) 1)))       ;Only one match, RET already set
5713      ((functionp criteria)
5714       (setq ret (funcall criteria list)))
5715      (criteria
5716       ;;  Third party package overrides Emacs installation
5717       (let* ((ver  (car-safe (tinypath-emacs-versions 'noerr)))
5718              (home (ignore-errors (expand-file-name "~")))
5719              home-list
5720              emacs-list
5721              other-list)
5722         (dolist (path list)
5723           (cond
5724            ((tinypath-emacs-core-path-p path ver)
5725             (push path emacs-list))
5726            ((and home
5727                  (string-match home path))
5728             (push path home-list))
5729            (t
5730             (push path other-list))))
5731         ;;  Now sort out the correct package
5732         ;;  1) User comes first
5733         ;;  2) non-Emacs installation
5734         ;;  3) Emacs installation
5735         (setq ret (or (and home-list
5736                            (car (nreverse home-list)))
5737                       (and other-list
5738                            (car (nreverse other-list)))
5739                       (and emacs-list
5740                            (car (nreverse emacs-list))))))))
5741     ret))
5742
5743 ;;; ----------------------------------------------------------------------
5744 ;;;
5745 (defun tinypath-load-path-display (&optional insert)
5746   "Display `load-path' by messaging' it. Optionally INSERT."
5747   (interactive "P")
5748   (tinypath-list-display "load-path %s" load-path insert))
5749
5750 ;;; ----------------------------------------------------------------------
5751 ;;;
5752 (defun tinypath-load-path-not-in-synch-p (&optional fast)
5753   "Check that load-path directories exists.
5754
5755 Input:
5756
5757   FAST   If non-nil, stop at first non-existing directory.
5758
5759 Return:
5760
5761   List of directories that do not exist."
5762   (let (list)
5763     (dolist (path load-path)
5764       (when (and (stringp path)
5765                  (not (file-directory-p path)))
5766         (push path list)
5767         (if fast
5768             (return))))
5769     (tinypath-verbose-macro 3
5770                             (message "TinyPath: CACHE SYNC error status is => [%s]"
5771                                      (prin1-to-string list)))
5772     list))
5773
5774 ;;; ----------------------------------------------------------------------
5775 ;;;
5776 (defun tinypath-load-path-clean (&optional extensive-test)
5777   "Clean `load-path' for anything suspicious: non-directories, non-strings.
5778
5779 If EXTENSIVE-TEST flag is non-nil, remove any paths that do not contain
5780 lisp code. With it, the check will spend much more time."
5781   (tinypath-verbose-macro 3
5782                           (message "TinyPath: CLEAN load-path"))
5783   (setq load-path (tinypath-directory-list-clean load-path "load-path"))
5784   (let (list)
5785     (when extensive-test
5786       (dolist (path load-path)
5787         (when (and (tinypath-path-ok-p path)
5788                    (tinypath-directory-lisp-p path)))
5789         (push path list))
5790       (setq load-path (nreverse list))))
5791   load-path)
5792
5793 ;;; ----------------------------------------------------------------------
5794 ;;;
5795 (defun tinypath-load-path-reorder ()
5796   "Move Emacs paths to predefined order.
5797 - User paths at the beginning (HOME dir paths)
5798 - Next anything in any order (site-lisp)
5799 - Last core Emacs paths."
5800   (let* (personal
5801          emacs
5802          other)
5803     (dolist (path load-path)
5804       (cond
5805        ((tinypath-load-path-emacs-distribution-p path)
5806         (push path emacs))
5807        ((tinypath-load-path-personal-p path)
5808         (push path personal))
5809        (t
5810         (push path other))))
5811     (setq load-path
5812           (append
5813            (nreverse personal)
5814            (append
5815             (nreverse other)
5816             (nreverse emacs))))))
5817
5818 ;;; ----------------------------------------------------------------------
5819 ;;;
5820 (defun tinypath-add-directory-one (path)
5821   "Add one PATH to the `load-path'. Old entry is removed."
5822   ;;  remove previous entry
5823   (if (null (tinypath-directory-lisp-p path))
5824       (tinypath-verbose-macro 3
5825                               (message "TinyPath: Add ignored. No LISP files in %s" path))
5826     (if (member path load-path)
5827         (setq load-path (delete path load-path)))
5828     (pushnew
5829      (if tinypath-:win32-p
5830          (downcase path)
5831        path)
5832      load-path
5833      :test 'string=)))
5834
5835 ;;; ----------------------------------------------------------------------
5836 ;;;
5837 (defun tinypath-add-directory-many (list)
5838   "Add to `load-path' each directory in LIST.
5839 LIST can contains single elements or lists:
5840  '(single single (elt elt) single (elt elt)))"
5841   (dolist (elt list)
5842     (when elt
5843       (if (not (listp elt))
5844           (setq elt (list elt)))
5845       (dolist (path elt)
5846         (tinypath-add-directory-one path)))))
5847
5848 ;;; ----------------------------------------------------------------------
5849 ;;; This function is recursive
5850 ;;;
5851 (defun tinypath-add-directory-many-below-root-dir (root)
5852   "Add all directories below ROOT to `load-path'."
5853   (if (not (stringp root))
5854       (tinypath-verbose-macro 5
5855                               (message "TinPath: Cannot add below root. Not a string: %s"
5856                                        (prin1-to-string root)))
5857     (if (not (and (file-exists-p root)
5858                   (file-directory-p root)
5859                   (not (file-symlink-p root))))
5860         (tinypath-verbose-macro 3
5861                                 (message "TinyPath: root does NOT exist: %s" root))
5862       (setq root (tinypath-expand-file-name root))
5863
5864       (tinypath-verbose-macro 3
5865                               (message "TinyPath: root %s" root))
5866
5867       (let* ((list (tinypath-subdirectory-list root)))
5868         (when (tinypath-path-ok-p root)
5869           (tinypath-verbose-macro 5
5870                                   (message "TinyPath: adding        %s" root))
5871           (tinypath-info-handler root)
5872           (tinypath-add-directory-one root))
5873         (dolist (path list)
5874           (tinypath-verbose-macro 3
5875                                   (message "TinyPath: recursing => %s" path))
5876           (tinypath-add-directory-many-below-root-dir path)))  )))
5877
5878 ;;; ----------------------------------------------------------------------
5879 ;;;
5880 (defun tinypath-load-path-remove-old (regexp)
5881   "Remove all paths matching REGEXP from `load-path'"
5882   (setq load-path
5883         (remove-if
5884          (function
5885           (lambda (x)
5886             (string-match regexp x)))
5887          load-path)))
5888
5889 ;;; ----------------------------------------------------------------------
5890 ;;;
5891 (defun tinypath-load-path-remove (regexp)
5892   "Remove any matching REGEXP from `load-path'.
5893 Return t if removed something."
5894   (let* ((spare load-path)
5895          list
5896          status)
5897     (dolist (elt load-path)
5898       (if (string-match regexp elt)
5899           (setq status t)
5900         (push elt list)))
5901     (cond
5902      ((null list)
5903       (setq load-path spare)
5904       (tinypath-verbose-macro 3
5905                               (message "TinyPath: FATAL regexp %s cleaned whole load-path."
5906                                        regexp)))
5907      (t
5908       (setq load-path list)))
5909     status))
5910
5911 ;;; ----------------------------------------------------------------------
5912 ;;;
5913 (defun tinypath-load-path-remove-cache (regexp)
5914   "Remove any matching REGEXP from `tinypath-:cache'.
5915 Return t if removed something."
5916   (let* ((spare tinypath-:cache)
5917          status)
5918     (dolist (elt tinypath-:cache)
5919       (when (string-match regexp
5920                           ;;  ELT = '("file.el" (POS . "path"))
5921                           (cdr (nth 1 elt)))
5922         (setq status t)
5923         (setq tinypath-:cache (delete elt tinypath-:cache))))
5924     (unless tinypath-:cache
5925       (setq tinypath-:cache spare)
5926       (tinypath-verbose-macro 3
5927                               (message "TinyPath: FATAL regexp %s cleaned whole tinypath-:cache."
5928                                        regexp)))
5929     status))
5930
5931 ;;; ----------------------------------------------------------------------
5932 ;;;
5933 (defun tinypath-load-path-setup ()
5934   "This is default function to add paths to `load-path'.
5935 Add all paths below `tinypath-:load-path-root'. See this variable.
5936
5937 References:
5938
5939   `tinypath-:load-path-function'"
5940   (let ((list tinypath-:load-path-root))
5941     (if (stringp list) ;; make one string into LIST
5942         (setq list (list list)))
5943     ;;  This message is a little premature, but it cleaner here,
5944     ;;  than after the dolist loop
5945     (message
5946      "TinyPath: SETUP `tinypath-:load-path-root' was checked and cleaned.")
5947     (dolist (elt list)
5948       (if (not (stringp elt))
5949           (message "TinyPath: `tinypath-:load-path-root' ELT `%s' \
5950 is not a string. `tinypath-:load-path-root': %s "
5951                    (prin1-to-string elt)
5952                    (prin1-to-string tinypath-:load-path-root)))
5953       (tinypath-verbose-macro 2
5954                               (message "TinyPath: => load path root %s " elt))
5955       (tinypath-add-directory-many-below-root-dir elt))))
5956
5957 ;;;}}}
5958 ;;;{{{ Cache
5959
5960 ;;; ----------------------------------------------------------------------
5961 ;;;
5962 (defun tinypath-load-path-directory-files (path-list)
5963   "Return all files along PATH-LIST."
5964   (let ((count        0)
5965         list)
5966     (dolist (dir path-list)
5967       (when (and (stringp dir)
5968                  (file-directory-p dir))
5969         ;;   make sure directory has a slash at the end
5970         (setq dir (file-name-as-directory dir))
5971         ;;  TRAD means "traditional Emacs Lisp way", because
5972         ;;  there is new method EXT for "External tool" to do similar
5973         ;;  caching. In fact if you see these messages, something
5974         ;;  went wrong with the EXT method.
5975         (tinypath-verbose-macro 1
5976                                 (message "TinyPath: TRAD Caching files... %d %s"
5977                                          (length list)
5978                                          dir))
5979         (dolist (file (directory-files dir nil "\\.elc?$"))
5980           (unless (file-directory-p (concat dir file))
5981             (incf count)
5982             (when (or t ) ;; (string-match "other" dir))
5983               (tinypath-verbose-macro 9
5984                                       (message "TinyPath: TRAD Cached %s"
5985                                                (concat dir file))))
5986             (push (list file (cons count
5987                                    (tinypath-expand-file-name dir)))
5988                   list)))))
5989     ;; Preserve find order.
5990     ;; (nreverse list)
5991     list))
5992
5993 ;;; ----------------------------------------------------------------------
5994 ;;;
5995 (defun tinypath-load-path-merge (list)
5996   "Merge LIST to `load-path'."
5997   ;;  Merge original path to loaded path
5998   (dolist (path list)
5999     (pushnew path load-path :test 'string=)))
6000
6001 ;;; ----------------------------------------------------------------------
6002 ;;;
6003 (defun tinypath-cache-setup-clear ()
6004   "Clear cache variables.
6005 You should call `tinypath-cache-setup-scan' after this function."
6006   (setq tinypath-:cache nil)
6007   (setq tinypath-:cache-level-two nil)
6008   (tinypath-load-path-clean))
6009
6010 ;;; ----------------------------------------------------------------------
6011 ;;;
6012 (defun tinypath-cache-setup-scan (&optional traditional)
6013   "Build the cache either by using external program or Emacs Lisp."
6014   (let* ((external (not traditional))
6015          ;;  While loading this package Cygwin XEmacs garbage collects like mad.
6016          ;;  Ease it up for a while. This is 30Meg
6017          (gc-cons-threshold (* 1024 1024 30)))
6018     (or (and external
6019              (tinypath-external-setup))
6020         (progn
6021           (tinypath-verbose-macro 3
6022                                   (message
6023                                    (concat
6024                                     "TinyPath: "
6025                                     "TRAD lisp method used for scanning.")))
6026           (tinypath-maybe-warn-message-log-max)
6027           (tinypath-info-scan-Info-default-directory-list)
6028           (funcall tinypath-:load-path-function)
6029           (setq tinypath-:cache (tinypath-load-path-directory-files
6030                                  load-path))))
6031     ;;  many push and pushnew were called.
6032     (when (fboundp 'garbage-collect)
6033       (message "TinyPath: cache-setup-scan requested `garbage-collect'")
6034       (garbage-collect))))
6035
6036 ;;; ----------------------------------------------------------------------
6037 ;;;
6038 (defun tinypath-cache-status-string ()
6039   "Return cache statistics."
6040   (format "TinyPath: packages %d, load-path %d, exec-path %d, info %d"
6041           (length tinypath-:cache)
6042           (length load-path)
6043           (length exec-path)
6044           (length (tinypath-Info-default-directory-list))))
6045
6046 ;;; ----------------------------------------------------------------------
6047 ;;;
6048 (defun tinypath-cache-status-message ()
6049   "Print cache statistics."
6050   (interactive)
6051   (message (tinypath-cache-status-string)))
6052
6053 ;;; ----------------------------------------------------------------------
6054 ;;;
6055 (defun tinypath-cache-setup-main (&optional force traditional)
6056   "Set `load-path' possibly using cache.
6057 If `tinypath-:cache-file' is recent enough load it, otherwise
6058 rescan directories if cache file is older than
6059 `tinypath-:cache-expiry-days'. After scan save cache.
6060
6061 Input:
6062
6063   FORCE       Rescan and save cache.
6064   TRADITIONAL Use traditional Emacs lisp cache scan."
6065   (interactive "P")
6066   (let* ((file       (tinypath-cache-file-name))
6067          (read-cache (and (null force)
6068                           (stringp file)
6069                           (file-exists-p file)
6070                           (null (tinypath-cache-file-old-p file))))
6071          no-save)
6072     ;; .............................................. compressed cache ...
6073     (tinypath-use-compression-maybe file)
6074     ;; .................................................... load cache ...
6075     (when read-cache
6076       (let ((orig load-path))
6077         (tinypath-cache-file-load)
6078         (setq force (tinypath-cache-file-need-sync-p))
6079         (tinypath-load-path-merge orig)))
6080     ;; .......................................................... scan ...
6081     ;;  Clean everything before scan. This has two purposes
6082     ;;
6083     ;;  - Remove invalid entries
6084     ;;  - Expand all paths to use absolute names and forward slashes.
6085     ;;    Expand is needed because all tests are done using absolute paths:
6086     ;;    `member', `pushnew' etc. Emacs and XEmacs Win32 differences are
6087     ;;    also solved with expand.
6088     (when (null read-cache)
6089       (tinypath-load-path-clean)
6090       ;; (tinypath-Info-default-directory-list-clean)
6091       (tinypath-directory-list-clean
6092        tinypath-:extra-path-root
6093        "tinypath-:extra-path-root"))
6094     ;; .............................................. regenerate cache ...
6095     (when (or force
6096               (null (file-exists-p file))
6097               (null tinypath-:cache))
6098       (setq force t) ;; Write cache too
6099       ;; Remove invalid entries so that they are not saved
6100       (tinypath-cache-setup-clear)
6101       ;; READ IT
6102       (tinypath-cache-setup-scan traditional)
6103       ;; Clean invalid entries
6104       (tinypath-directory-list-clean
6105        tinypath-:extra-path-root
6106        "tinypath-:extra-path-root")
6107       (tinypath-directory-list-clean
6108        tinypath-:extra-manpath
6109        "tinypath-:extra-manpath")
6110       (tinypath-load-path-clean)
6111       (tinypath-Info-default-directory-list-clean))
6112     (if (> (length exec-path) 100)
6113         (tinypath-verbose-macro 3
6114                                 (message
6115                                  "TinyPath: [WARNING] exec-path length looks suspicious: %d"
6116                                  (length exec-path))))
6117     (tinypath-exec-path-clean)
6118     (tinypath-exec-path-check-verbose-fix) ;; Missing items? (from PATH)
6119     (unless load-path
6120       (tinypath-message-bug "FATAL SCAN load-path nil")
6121       ;;  Try rescue as best as we can, so that User's Emacs is still usable
6122       (message "TinyPath: FATAL trying to boot to restore load-path.")
6123       (tinypath-load-path-initial-value)
6124       (unless load-path
6125         (tinypath-message-bug
6126          "[FATAL] SCAN2 load-path still nil, disable tinypath.el"))
6127       (setq no-save t))
6128     (when (or force
6129               (null read-cache))
6130       ;; Cache has changed. See where is latest gnus
6131       (tinypath-load-path-reorder))
6132     ;;  Do this always, because:
6133     ;;  1. At Boot phase standard emacs-NN.N/lisp/gnus path is
6134     ;;     added
6135     ;;  2. There may be newer Gnus, which we know only after the
6136     ;;     cache has been loaded.
6137     ;;  => Last thing to do is to check various Gnus versions along
6138     ;;     load-path.
6139     (tinypath-insinuate-gnus)
6140     ;; ................................................... write cache ...
6141     (tinypath-load-copy-now) ;; Save load-path.
6142     (when (and (null no-save)
6143                (or force
6144                    (and tinypath-:cache-expiry-days ;cache allowed
6145                         (null read-cache))))        ;but now expired
6146       (tinypath-cache-file-save))
6147     (tinypath-cache-status-message)
6148     ;; Make sure that this list is cleared. It must be
6149     ;; regenerated as well.
6150     (tinypath-emacs-lisp-file-list-cache-clear)))
6151
6152 ;;; ----------------------------------------------------------------------
6153 ;;;
6154 (defun tinypath-cache-setup-maybe ()
6155   "If `load-path' or `tinypath-:cache' is out of date, rebuild cache."
6156   (when (or (tinypath-cache-non-existing-directory-list)
6157             (tinypath-cache-non-existing-file-list))
6158     (tinypath-verbose-macro 2
6159                             (message "TinyPath: Cache validate: inconsistent state, rebuilding..."))
6160     (tinypath-cache-setup-main 'force)))
6161
6162 ;;; ----------------------------------------------------------------------
6163 ;;;
6164 (defun tinypath-report-mode-font-lock (&optional buffer)
6165   "Call `font-lock' with `tinypath-:report-mode-font-lock-keywords' in BUFFER."
6166   (with-current-buffer (or buffer (current-buffer))
6167     (font-lock-mode 1)
6168     (make-local-variable 'font-lock-keywords)
6169     (set 'font-lock-keywords tinypath-:report-mode-font-lock-keywords)
6170     (font-lock-fontify-buffer)))
6171
6172 ;;; ----------------------------------------------------------------------
6173 ;;;
6174 (defun tinypath-cache-duplicate-different-size-p (elt)
6175   "Called by `tinypath-cache-duplicate-report'.
6176 Check if ELT contains different files by size."
6177   (let (path
6178         file
6179         stat
6180         size
6181         size-old
6182         ret)
6183     (setq file (car elt)
6184           elt  (cdr elt))
6185     (dolist (item elt)
6186       (setq path  (concat (cdr item) file)
6187             stat  (file-attributes path)
6188             size  (nth 7 stat))
6189       (when (and size-old
6190                  (not (eq size-old size)))
6191         (setq ret t)
6192         (return))
6193       (setq size-old size))
6194     ret))
6195
6196 ;;; ----------------------------------------------------------------------
6197 ;;;
6198 (defun tinypath-cache-duplicate-report (&optional size-rank)
6199   "Report all identical lisp files in `tinypath-:cache' and rank by SIZE.
6200
6201 Input:
6202
6203   SIZE-RANK
6204
6205         if given, report duplicate file only if the size is
6206         different. If you just have copy of the same file in the
6207         `load-path' that is not critical, but if the file size differs
6208         then you have different versions of the file and you should
6209         remove the old one(s) from path.
6210
6211 Output:
6212
6213   alist.el
6214             35  2971 1999-02-27 12:51:12 /usr/local/share/site-lisp/common/mime/apel-9.13/
6215           1166  2971 1999-11-25 00:37:18 /home/foo/elisp/tiny/lisp/other/
6216              |  |    |                   |
6217              |  |    |                   location
6218              |  |    ISO 8601 modification time
6219              |  size
6220              the order number in cache
6221
6222 References:
6223
6224   `tinypath-:cache-duplicate-report-hook'
6225   `tinypath-cache-problem-report'."
6226   (interactive "P")
6227   (let* ((ignore-functions
6228           tinypath-:cache-duplicate-report-ignore-functions)
6229          (report-buffer tinypath-:report-buffer)
6230          accept
6231          list
6232          stat
6233          size
6234          date
6235          list-tmp
6236          list-dup
6237          file
6238          path
6239          ptr
6240          seen)
6241     ;; .................................................... build list ...
6242     ;;  result: ( (FILE . (PATH PATH PATH ..)) (FILE . (PATH ..)) )
6243     (dolist (elt tinypath-:cache)
6244       (setq file  (car elt)
6245             path  (nth 1 elt))
6246       (when (string-match "\\.el" file)
6247         (when tinypath-:win32-p
6248           (setq file (downcase file)))
6249         (setq accept
6250               (or (and
6251                    ignore-functions
6252                    (null
6253                     (let (ret)
6254                       (dolist (func ignore-functions)
6255                         (when (funcall func (concat (cdr path) file))
6256                           (setq ret t)
6257                           (return)))
6258                       ret)))
6259                   (null ignore-functions)))
6260         (when accept
6261           (if (not (setq ptr (assoc file list)))
6262               (push (cons file (list path)) list)
6263             (setq list-tmp (cdr ptr))
6264             (push path list-tmp)
6265             (setcdr ptr list-tmp)))))
6266     ;; .............................................. check duplicates ...
6267     (dolist (elt list)
6268       (when (> (length (cdr elt)) 1)
6269         (push elt list-dup)))
6270     ;; ................................................. print results ...
6271     (if (null list-dup)
6272         (message "TinyPath: No duplicates in `tinypath-:cache'")
6273       (let ((sorted (sort
6274                      list-dup
6275                      (function
6276                       (lambda (a b)
6277                         (setq a (car a)
6278                               b (car b))
6279                         (string< a b))))))
6280         (setq list-dup sorted))
6281       (display-buffer (get-buffer-create report-buffer))
6282       (with-current-buffer report-buffer
6283         (erase-buffer)
6284         (tinypath-report-mode 'verbose)
6285         (dolist (elt list-dup)
6286           (when (tinypath-cache-duplicate-different-size-p elt)
6287             (setq file (car elt))
6288             (insert file "\n")
6289             (dolist (elt (nreverse (cdr elt)))
6290               (setq path  (concat (cdr elt) file))
6291               (unless (member path seen)
6292                 (push path seen)
6293                 (if (not (file-exists-p path))
6294                     (insert "\t  ERROR: file does not exist " path "\n" )
6295                   (setq stat  (file-attributes path)
6296                         size  (nth 7 stat)
6297                         date  (nth 5 stat))
6298                   ;; ISO 8601 date
6299                   (setq date (tinypath-time-string date))
6300                   (insert (format "\t %5d %5d %s %s\n"
6301                                   (car elt)
6302                                   size
6303                                   date
6304                                   path))))))))) ;; dolist-dolist
6305     (with-current-buffer report-buffer
6306       (goto-char (point-min))
6307       (run-hooks 'tinypath-:cache-duplicate-report-hook))
6308     list-dup))
6309
6310 ;;; ----------------------------------------------------------------------
6311 ;;;
6312 (defun tinypath-report-timing-summary ()
6313   "Gather timing summary from *Message* buffer if `tinypath-:verbose-timing'."
6314   (interactive)
6315   (let* ((buffer (tinypath-message-get-buffer))
6316          string)
6317     (pop-to-buffer buffer)
6318     (goto-char (point-min))
6319     (while (re-search-forward "^TinyPath: load time.*" nil t)
6320       (setq string (concat (or string "") "=> " (match-string 0) "\n")))
6321     (message "Tinypath: [TIMING SUMMARY FROM ABOVE]" string)
6322     (goto-char (point-max))))
6323
6324 ;;; ----------------------------------------------------------------------
6325 ;;;
6326 (defsubst tinypath-report-mode-map-activate ()
6327   "Use local `tinypath-report-mode-map' in current buffer.
6328 \\{tinypath-report-mode-map}"
6329   (use-local-map tinypath-report-mode-map))
6330
6331 ;;; ----------------------------------------------------------------------
6332 ;;;
6333 (defun tinypath-report-mode-previous ()
6334   "Go to previous file."
6335   (interactive)
6336   (beginning-of-line)
6337   (if (re-search-backward "^[ \t]+[0-9].*/\\(.\\)" nil t)
6338       (goto-char (match-beginning 1))))
6339
6340 ;;; ----------------------------------------------------------------------
6341 ;;;
6342 (defun tinypath-report-mode-next ()
6343   "Go to next file."
6344   (interactive)
6345   (re-search-forward "^[ \t]+[0-9].*/" nil t))
6346
6347 ;;; ----------------------------------------------------------------------
6348 ;;;
6349 (defun tinypath-report-mode-find-file ()
6350   "Load file in current line to Emacs."
6351   (interactive)
6352   (let* ((file (tinypath-report-mode-file-name)))
6353     (cond
6354      ((null file)
6355       (message "TinyPath: No file in this line.")
6356       nil)
6357      (t
6358       (display-buffer (find-file-noselect file))))))
6359
6360 ;;; ----------------------------------------------------------------------
6361 ;;;
6362 (defun  tinypath-report-mode-file-name ()
6363   "Read filename under point."
6364   (save-excursion
6365     (beginning-of-line)
6366     (when (re-search-forward
6367            " ..:..:..[ \t]+\\(.*\\)"
6368            (save-excursion (end-of-line) (point))
6369            t)
6370       (tinypath-ti::string-remove-whitespace (match-string 1)))))
6371
6372 ;;; ----------------------------------------------------------------------
6373 ;;;
6374 (defun tinypath-report-mode-dired (dir)
6375   "Run dired on current line (reads filename)."
6376   (interactive
6377    (let* ((file (tinypath-report-mode-file-name))
6378           (dir   (and file
6379                       (file-name-directory file))))
6380      (list
6381       (read-file-name "Dired: " dir))))
6382   (unless dir
6383     (error "TinyPath: DIR missing: `%s'" dir))
6384   (let* ((dired (tinypath-ti::dired-buffer dir)))
6385     (cond
6386      (dired
6387       (pop-to-buffer dired))
6388      ((tinypath-ti::window-single-p)
6389       (split-window)
6390       (other-window 1)
6391       (dired dir))
6392      (t
6393       (other-window 1)
6394       (dired dir)))))
6395
6396 ;;; ----------------------------------------------------------------------
6397 ;;;
6398 (defun tinypath-report-mode-delete-file (&optional force)
6399   "Delete file in the current line. FORCE deleting.
6400 See also `tinypath-report-mode-delete-file-noconfirm'."
6401   (interactive "P")
6402   (let* ((file (tinypath-report-mode-file-name))
6403          (point (point)))
6404     (cond
6405      ((null file)
6406       (message "TinyPath: No file in this line."))
6407      ((not (file-exists-p file))
6408       (message "TinyPath: file not found %s" file))
6409      ((or force
6410           (y-or-n-p (format "Really delete %s " file)))
6411       (delete-file file)
6412       (message "TinyPath: deleted %s" file)
6413       (overwrite-mode 1)
6414       (beginning-of-line)
6415       (insert "*")
6416       (overwrite-mode -1)))
6417     (goto-char point)))
6418
6419 ;;; ----------------------------------------------------------------------
6420 ;;;
6421 (defun tinypath-report-mode-delete-file-noconfirm ()
6422   "Delete file in the current line without confirmation."
6423   (interactive)
6424   (tinypath-report-mode-delete-file 'force))
6425
6426 ;;; ----------------------------------------------------------------------
6427 ;;;
6428 ;;;###autoload
6429 (defun tinypath-report-mode (&optional verb)
6430   "Major mode to help working with `tinypath-cache-duplicate-report'.
6431 and `tinypath-cache-problem-report'. VERB.
6432
6433 \\{tinypath-report-mode-map}"
6434   (interactive "P")
6435   (tinypath-report-mode-map-activate)   ;turn on the map
6436   (setq  mode-name   tinypath-:report-mode-name)
6437   (setq  major-mode 'tinypath-report-mode) ;; for C-h m
6438   (when verb
6439     (message
6440      (substitute-command-keys
6441       (concat
6442        "TinyPath: delete file with \\[tinydesk-report-mode-delete-file]")))
6443     (sleep-for 1))
6444   (tinypath-report-mode-font-lock)
6445   (run-hooks 'tinypath-:report-mode-hook))
6446
6447 ;;; ----------------------------------------------------------------------
6448 ;;;
6449 (defun tinypath-cache-non-existing-file-list ()
6450   "Return list of non existing files in cache."
6451   (let (list
6452         path)
6453     (dolist (elt tinypath-:cache)
6454       ;; '(("file" (POS . PATH)) .. )
6455       (setq path (concat (cdr (nth 1 elt))
6456                          (car elt) ))
6457       (unless (file-exists-p path)
6458         (push path list)))
6459     list))
6460
6461 ;;; ----------------------------------------------------------------------
6462 ;;;
6463 (defun tinypath-cache-non-existing-directory-list ()
6464   "Return list of non existing directories in cache or `load-path'."
6465   (let (list
6466         path)
6467     (dolist (dir tinypath-:cache)
6468       ;; ( ("file" (POS . PATH)) .. )
6469       (setq dir (cdr (nth 1 dir)))
6470       (unless (file-exists-p dir)
6471         (pushnew path list :test 'string=)))
6472     (dolist (dir load-path)
6473       (unless (file-exists-p dir)
6474         (pushnew path list :test 'string=)))
6475     list))
6476
6477 ;;; ----------------------------------------------------------------------
6478 ;;;
6479 (defun tinypath-cache-non-exist-report ()
6480   "Report non-existing files in cache."
6481   (let ((list (tinypath-cache-non-existing-file-list)))
6482     (if (null list)
6483         (message "TinyPath: No non-existing files in `tinypath-:cache'")
6484       (display-buffer (get-buffer-create tinypath-:report-buffer))
6485       (with-current-buffer tinypath-:report-buffer
6486         (goto-char (point-max))
6487         (tinypath-report-mode-font-lock)
6488         (insert "\nNon Existing files:\n")
6489         (dolist (elt list)
6490           (insert "  %s\n" elt))))
6491     list))
6492
6493 ;;; ----------------------------------------------------------------------
6494 ;;;
6495 (defun tinypath-cache-problem-report (&optional size-rank)
6496   "Generate problem report: non-existing files and duplicates.
6497 See SIZE-RANK in `tinypath-cache-duplicate-report'."
6498   (interactive)
6499   (tinypath-cache-non-exist-report)
6500   (tinypath-cache-duplicate-report))
6501
6502 ;;; ----------------------------------------------------------------------
6503 ;;;
6504 (defun tinypath-cache-regenerate (&optional delete-cache)
6505   "Regenerate cache. `tinypath-cache-setup-main' is called with arg t.
6506 The DELETE-CACHE removes any previous stored cache from disk.
6507 Use it for completely clean any previous cache conflicts."
6508   (interactive "P")
6509   (when delete-cache
6510     (tinypath-cache-file-delete))
6511   ;;  If something wicked happened, at least there is a backup
6512   (unless load-path
6513     ;;  Silence byte compiler. The function is in this file, but it
6514     ;;  would complain: "`tinypath-original-values' might not be defined
6515     ;;  at runtime."
6516     (let ((func 'tinypath-original-values))
6517       (funcall func 'restore)))
6518   (tinypath-info-scan-Info-default-directory-list)
6519   (tinypath-cache-setup-main 'regenerate))
6520
6521 ;;; ----------------------------------------------------------------------
6522 ;;;
6523 (defun tinypath-cache-mode (mode)
6524   "Toggle fast package loading MODE by enabling or disabling advises.
6525
6526 Input:
6527
6528     If MODE is positive integer, enable defadvice code to to utilize
6529     package (possibly compressed) lookup from `tinypath-:cache'.
6530
6531     If MODE is negative integer, turn support off.
6532
6533 Description:
6534
6535     If you have many directories in your `load-path', turning this mode on
6536     makes packages load instantly without time consuming path lookup.
6537
6538 Warning:
6539
6540   Regenerate cache with \\[tinypath-cache-regenerate] if you have installed new
6541   packages or if you have added new Lisp files to your system. Keep also
6542   `tinypath-:cache-expiry-days' relatively small if you update often."
6543   (interactive "P")
6544   (let* ((list '( ;; autoload   => see below
6545                  locate-library
6546                  load
6547                  require)))
6548     ;; In Emacs (at least on 20.7), load-library is a wrapper for load. So,
6549     ;; it makes no sense advising it, because the cache is searched twice.
6550     ;; #todo: check this code .. and xemacs `load-library'
6551     (when t ;;  tinypath-:xemacs-p
6552       (push 'load-library list))
6553     ;;  Activate only if user requested 'all
6554     (when (eq tinypath-:compression-support 'all)
6555       (push 'autoload list))
6556     (tinypath-ti::bool-toggle tinypath-:cache-mode mode)
6557     (cond
6558      (tinypath-:cache-mode
6559       (tinypath-ti::advice-control list "tinypath")
6560       (if (interactive-p)
6561           (message "TinyPath: cache advice code ACTIVATED.")))
6562      (t
6563       (tinypath-ti::advice-control list "tinypath" 'disable)
6564       (if (interactive-p)
6565           (message "TinyPath: cache advice code DEACTIVATED."))))))
6566
6567 ;;; ----------------------------------------------------------------------
6568 ;;;
6569 (defun turn-on-tinypath-cache-mode ()
6570   "See `tinypath-cache-mode'."
6571   (interactive)
6572   (tinypath-cache-mode 1))
6573
6574 ;;; ----------------------------------------------------------------------
6575 ;;;
6576 (defun turn-off-tinypath-cache-mode ()
6577   "See `tinypath-cache-mode'."
6578   (interactive)
6579   (tinypath-cache-mode -1))
6580
6581 ;;; ----------------------------------------------------------------------
6582 ;;;
6583 (defun turn-on-tinypath-cache-mode-maybe ()
6584   "See `tinypath-cache-mode'.
6585 Turn mode on only if `tinypath-:cache-expiry-days' is non-nil,
6586 otherwise turn mode off."
6587   (interactive)
6588   (if (integerp tinypath-:cache-expiry-days)
6589       (turn-on-tinypath-cache-mode)
6590     (turn-off-tinypath-cache-mode)))
6591
6592 ;;;}}}
6593 ;;;{{{ Advice code
6594
6595 ;; ############################   BEGIN FUNCTION -- advice instantiate
6596
6597 (defun tinypath-advice-instantiate ()
6598   "Intantiate all advices."
6599   ;;  These are put into function to make them delayed and
6600   ;;  so that they can be called at apropriate time.
6601
6602   (require 'advice)
6603
6604   ;;  I don't know what EFS does, but it certainly must be loaded before we
6605   ;;  try to advice `require' or `load' functions. It somehow overwrites the
6606   ;;  the original definitions.
6607   ;;
6608   ;;  efs.el
6609   ;;
6610   ;;  (efs-overwrite-fn "efs" 'load)
6611   ;;  (efs-overwrite-fn "efs" 'require)
6612   ;;
6613   ;;  See also efs-ovwrt.el
6614
6615   (when tinypath-:xemacs-p
6616     (require 'efs))
6617
6618 ;;; ----------------------------------------------------------------------
6619 ;;; (turn-on-tinypath-cache-mode)
6620 ;;; (turn-off-tinypath-cache-mode)
6621 ;;;
6622   (defadvice autoload (around tinypath dis)
6623     "Use `tinypath-:cache' for fast lookup of files."
6624     (let* ((file        (ad-get-arg 1))
6625            (path        (tinypath-cache-p-for-advice file)))
6626       (when path
6627         (ad-set-arg 1 path))
6628       ad-do-it))
6629
6630 ;;; ----------------------------------------------------------------------
6631 ;;; (load FILE &optional NOERROR NOMESSAGE NOSUFFIX MUST-SUFFIX)
6632 ;;;
6633   (defadvice load (around tinypath dis)
6634     "Use `tinypath-:cache' for fast lookup of files."
6635     (let* ((file        (ad-get-arg 0))
6636            (nosuffix    (ad-get-arg 3))
6637            (must-suffix (ad-get-arg 4)))
6638       (unless (stringp file)
6639         (error "Parameter FILE is not a string %s"
6640                (prin1-to-string file)))
6641       (when (and (null nosuffix)
6642                  (null must-suffix))
6643         ;; #todo: this needs better handling. Now we just
6644         ;; ignore cache if suffix parameters are set.
6645         ;;
6646         ;; If optional fourth arg NOSUFFIX is non-nil, don't try adding
6647         ;; suffixes `.elc' or `.el' to the specified name FILE. If optional
6648         ;; fifth arg MUST-SUFFIX is non-nil, insist on the suffix `.elc' or
6649         ;; `.el'; don't accept just FILE unless it ends in one of those
6650         ;; suffixes or includes a directory name.
6651         (let ((path (tinypath-cache-p-for-advice file)))
6652           (when path
6653             (tinypath-verbose-macro 5
6654                                     (message "TinyPath: (advice load) Cache hit %s" file))
6655             (ad-set-arg 0 path))))
6656       ad-do-it))
6657
6658 ;;; ----------------------------------------------------------------------
6659 ;;;
6660   (defadvice load-library (around tinypath dis)
6661     "Use `tinypath-:cache' for fast lookup of files."
6662     (let* ((file  (ad-get-arg 0))
6663            (path  (tinypath-cache-p-for-advice file)))
6664       (when path
6665         (tinypath-verbose-macro 5
6666                                 (message "TinyPath: (advice load-library) Cache hit %s" file))
6667         (ad-set-arg 0 path))
6668       ad-do-it))
6669
6670 ;;; ----------------------------------------------------------------------
6671 ;;; In Win32 XEmacs 21.2 beta; the this function calls `locate-file' which
6672 ;;; for some reason breaks if given a absolute file name. The XEmacs
6673 ;;; docs also say that `locate-file' uses hash table to speed up processing.
6674 ;;; Hm.
6675 ;;;
6676 ;;; There is problem with functions that use (interactive-p) test, because
6677 ;;; advice can't pass the information to the underlying function, so any
6678 ;;; such test inside here won't work.
6679 ;;;
6680 ;;; 21.3.1:
6681 ;;; (locate-library LIBRARY &optional NOSUFFIX PATH INTERACTIVE-CALL)
6682 ;;;
6683   (defadvice locate-library (around tinypath act)
6684     "Use `tinypath-:cache' for fast lookup of files."
6685     (interactive
6686      (let ((cache (tinypath-emacs-lisp-file-list 'from-cache)))
6687        (list
6688         (completing-read
6689          (format "%slocate library: "
6690                  (if cache
6691                      "(TinyPath cache)"
6692                    ""))
6693          cache
6694          nil
6695          nil
6696          nil))))  ;;; Default word
6697     (let* ((file  (ad-get-arg 0))
6698            (ok    (tinypath-load-copy-equal-p))
6699            (path  (if (and ok
6700                            file)
6701                       (tinypath-cache-p file)))
6702            (error (and ok
6703                        path
6704                        (tinypath-cache-warn-if-not-exist path))))
6705       (unless (stringp file)
6706         (error "Parameter FILE is not a string %s"
6707                (prin1-to-string file)))
6708       (cond
6709        ((and path
6710              (null error))
6711         (tinypath-verbose-macro 5
6712                                 (message "TinyPath: (advice locate-library) Cache hit %s => %s"
6713                                          file path))
6714         (setq ad-return-value path))
6715        ((and ok
6716              (setq path (car-safe (tinypath-locate-library file))))
6717         ;;  (fboundp 'locate-file)  ;; Do not continue in XEmacs
6718         (setq ad-return-value path))
6719        (t
6720         ad-do-it))
6721       ;; We must simulate in the advice, this interactive behavior, because
6722       ;; underlying function does not know it any more, due to advice.
6723       (when (interactive-p)
6724         (if path
6725             (message path)
6726           (message "locate-library: %s not found."
6727                    (or file "<no filename>"))))))
6728
6729 ;;; ----------------------------------------------------------------------
6730 ;;;
6731   (defadvice require (around tinypath dis)
6732     "Use `tinypath-:cache' for fast lookup of files.
6733 Property (get 'require 'tinypath-load-list) contains list
6734 of required packages: '((feature . path)."
6735     (let* ((feature  (ad-get-arg 0))
6736            (opt      (ad-get-arg 1))    ;the optional "file" parameter
6737            (alist    (get 'require 'tinypath-load-list))
6738            lib
6739            path)
6740       (unless (symbolp feature)
6741         (error "Parameter FEATURE is not a symbol %s"
6742                (prin1-to-string feature)))
6743       (when (and (not (featurep feature))
6744                  ;;  Avoid recursive calls.
6745                  (not (assq feature alist)))
6746         (setq lib (cond
6747                    ((stringp opt)
6748                     (if (string-match "/" opt)
6749                         (tinypath-expand-file-name opt)  opt))
6750                    (t
6751                     (symbol-name feature))))
6752         (when (setq path (tinypath-cache-p-for-advice lib))
6753           (tinypath-verbose-macro 5
6754                                   (message "TinyPath: (advice require) Cache hit %s" lib))
6755           (tinypath-cache-warn-if-not-exist path)
6756           (push (cons feature path) alist)
6757           (put 'require 'tinypath-load-list alist)
6758           (ad-set-arg 1 path)))
6759       ad-do-it))
6760
6761   ) ;; ############################   END FUNCTION -- end advice instantiate
6762
6763 ;;;}}}
6764 ;;;{{{ win32: Unix $HOME directory mounted to PC, like to H: disk
6765
6766 ;;; ----------------------------------------------------------------------
6767 ;;;
6768 (defun tinypath-load-path-dump (mount-point &optional file)
6769   "Dump load path directories to disk.
6770
6771 If you have Mounted Unix disk (say H: ) which sees your Unix $HOME directory,
6772 then keep in mind that NT Emacs does not see symlinked directories.
6773
6774 Call this function from _Unix_ Emacs and it converts symbolic links to
6775 real directory names and writes output to FILE.
6776
6777 You can then load that file in your NT emacs and make it see all
6778 the same directories as your Unix Emacs does.
6779
6780 Repeat this every time you make symbolic path links in Unix.
6781
6782 References:
6783
6784   `tinypath-:load-path-dump-file'"
6785   (interactive "sUnix $HOME is equivalent to: \nf")
6786   (let* ((home      (file-truename (tinypath-expand-file-name "~")))
6787          (load-path load-path))
6788     (setq tinypath-dumped-load-path nil)
6789     (or file
6790         (setq file tinypath-:load-path-dump-file))
6791     (dolist (path load-path)
6792       (if (not (string-match "[a-z]" mount-point))
6793           (setq path (file-truename path))
6794         (setq path (tinypath-replace-regexp-in-string
6795                     (regexp-quote home)
6796                     mount-point
6797                     (file-truename path))))
6798       (push path tinypath-dumped-load-path))
6799
6800     (tinypath-ti::write-file-variable-state
6801      file "Absolute path dump for NTEmacs to access Unix Home disk"
6802      '(tinypath-dumped-load-path))))
6803
6804 ;;; ----------------------------------------------------------------------
6805 ;;;
6806 (defun tinypath-load-path-setup-win32 ()
6807   "Load `tinypath-:load-path-dump-file' in win32."
6808   (let* ((file tinypath-:load-path-dump-file))
6809     (when (and tinypath-:win32-p
6810                (load file 'noerr))
6811       ;; Merge these unix paths with the NT Emacs paths.
6812       ;; If these paths do not exist; they are not added
6813       (tinypath-verbose-macro 2
6814                               (message "TinyPath: load-path merge from %s" file))
6815       (tinypath-add-directory-many
6816        (symbol-value 'tinypath-dumped-load-path)))))
6817
6818 ;;}}}
6819 ;;{{{ Win32 support (cygwin)
6820
6821 ;;; ----------------------------------------------------------------------
6822 ;;;
6823 (defun tinypath-manpage-handler (path)
6824   "If PATH has manual pages, add to `tinypath-:extra-manpath'."
6825   (let* (ret)
6826     (unless (member path tinypath-:extra-manpath)
6827       (dolist (file (directory-files path))
6828         (when (string-match "\\.[0-9]$" file)
6829           (tinypath-verbose-macro 9
6830                                   (message "TinyPath: MAN %s [found %s] " path file))
6831           (pushnew path tinypath-:extra-manpath :test 'string=)
6832           (setq ret path)
6833           (return))))
6834     ret))
6835
6836 ;;; ----------------------------------------------------------------------
6837 ;;;
6838 (defun tinypath-extra-path-handler (path)
6839   "Check PATH for info files and manual pages."
6840   (tinypath-info-handler path)
6841   (tinypath-manpage-handler path))
6842
6843 ;;; ----------------------------------------------------------------------
6844 ;;;
6845 (defun tinypath-woman-setup ()
6846   "Install woman.el (if available) to read manual pages in Win32."
6847   (when tinypath-:win32-p
6848     (when (or (featurep 'woman)
6849               (fboundp 'woman)
6850               (when (locate-library "woman.el")
6851                 (autoload 'woman                  "woman" "" t)
6852                 (autoload 'woman-find-file        "woman" "" t)
6853                 (autoload 'woman-dired-find-file  "woman" "" t)
6854
6855                 (unless (getenv "MANPATH") ;; woman-path
6856                   (message
6857                    "TinyPath: MANPATH does not exist, set `woman-manpath'."))
6858                 t))
6859       (defalias 'man 'woman)
6860       t)))
6861
6862 ;;; ----------------------------------------------------------------------
6863 ;;;
6864 (defun tinypath-extra-path-setup (list)
6865   "Look for new info and manual pages under LIST of root directories."
6866   (dolist (path list)
6867     (if (or (not (stringp path))
6868             (not (file-directory-p path)))
6869         (tinypath-verbose-macro 5
6870                                 (message
6871                                  "TinyPath: invalid search ROOT %s"
6872                                  (prin1-to-string path)))
6873       (tinypath-ti::directory-recursive-do
6874        path 'tinypath-extra-path-handler))))
6875
6876 ;;; ----------------------------------------------------------------------
6877 ;;;
6878 (defun tinypath-cygwin-setup ()
6879   "If Cygwin is present add it to `tinypath-:extra-path-root'."
6880   (let* ((cygwin-path (tinypath-ti::win32-cygwin-p))) ;; has trailing slash
6881     (if (null cygwin-path)
6882         (tinypath-verbose-macro 2
6883                                 (message "TinyPath: [Cygwin] not found from PATH."))
6884       (pushnew cygwin-path
6885                tinypath-:extra-path-root
6886                :test 'string=)
6887       ;;  Be absolutely sure that the path is not added multiple
6888       ;;  times "f:/unix/cygwin" or "f:/unix/cygwin/" because
6889       ;;  this would cause reading the same directory twice
6890       ;;
6891       ;; (tinypath-directory-list-clean  ;; No trailing slashes after this
6892       ;;  tinypath-:extra-path-root
6893       ;;  "CYGWIN tinypath-:extra-path-root")
6894       ;;
6895       (tinypath-verbose-macro 2
6896                               (message "TinyPath: [Cygwin] found from PATH: %s" cygwin-path))
6897       ;; (tinypath-extra-path-setup list)
6898       tinypath-:extra-path-root)))
6899
6900 ;;}}}
6901 ;;{{{ Install functions
6902
6903 ;;; ----------------------------------------------------------------------
6904 ;;;
6905 (defun tinypath-install-timer (&optional uninstall)
6906   "Install or UNINSTALL timer to keep cache structure in synch with disk.
6907 Reference:
6908   `tinypath-cache-setup-maybe'  15min, idle timer calls this periodically."
6909   (interactive "P")
6910   (let* (timer
6911          status)
6912     (when (fboundp 'run-with-idle-timer)
6913       ;;
6914       ;;  I don't think this ever fails, but be bullet proof anyway
6915       ;;  We ,ust run `require' because `run-with-idle-timer'
6916       ;;  must not be in autoload state.
6917       ;;
6918       ;;  timers are different in Emacs implementations. Load correct
6919       ;;  package.
6920       ;;  XEmacs keeps this in xemacs-packages/lisp/fsf-compat/timer.el
6921       ;;
6922       (setq status
6923             (cond
6924              (tinypath-:xemacs-p
6925               (or (require 'itimer)
6926                   (require 'timer)))
6927              (t
6928               (require 'timer))))
6929       (if (null status)
6930           (tinypath-verbose-macro 1
6931                                   (message "TinyPath: TIMER ERROR Can't install timers to emacs."))
6932         (cond
6933          (uninstall
6934           (tinypath-ti::compat-timer-cancel-function
6935            'tinypath-cache-setup-maybe)
6936           (message
6937            "TinyPath: `load-path' synchronization watchdog UNINSTALLED."))
6938          (t
6939           (tinypath-ti::compat-timer-cancel-function
6940            'tinypath-cache-setup-maybe)
6941           ;;  At this point, we have wiped out the autoload definitions
6942           ;;  with explicit `require', because `symbol-function'
6943           ;;  won't work on autoloaded definitions.
6944           (tinypath-autoload-require 'run-with-idle-timer)
6945           (setq timer
6946                 (funcall
6947                  (symbol-function 'run-with-idle-timer)
6948                  (* 60 15)
6949                  'repeat
6950                  'tinypath-cache-setup-maybe))
6951           (message
6952            "TinyPath: `load-path' synchronization watchdog INSTALLED.")))))
6953     (setq tinypath-:timer-elt timer)))
6954
6955 ;;; ----------------------------------------------------------------------
6956 ;;;
6957 (defun tinypath-insinuate-woman ()
6958   "Add items in `tinypath-:extra-manpath' to `woman-manpath'."
6959   (when (boundp 'woman-manpath)
6960     (dolist (path tinypath-:extra-manpath)
6961       (when (stringp path)
6962         (tinypath-verbose-macro 7
6963                                 (message "TinyPath: Adding to `woman-manpath' %s" path))
6964         (pushnew path woman-manpath :test 'string=)))))
6965
6966 ;;; ----------------------------------------------------------------------
6967 ;;;
6968 (defun tinypath-insinuate-find-file ()
6969   "Add items in `tinypath-:extra-manpath' to `woman-manpath'."
6970   (when (boundp 'ff-search-directories)
6971     (dolist (path tinypath-:extra-ff-search-directories)
6972       (when (stringp path)
6973         (tinypath-verbose-macro 7
6974                                 (message "TinyPath: Adding to `ff-search-directories' %s" path))
6975         (pushnew path ff-search-directories :test 'string=)))))
6976
6977 ;;; ----------------------------------------------------------------------
6978 ;;;
6979 (defun tinypath-gnus-load-path-list ()
6980   "Return Gnus locations in `load-path' by searching regexp gnus/?$"
6981   (let* (list
6982          found
6983          previous)
6984     (dolist (path load-path)
6985       ;; cvs-packages/gnus/etc/gnus
6986       ;;
6987       ;; "../gnus/"    or at the end "../gnus"
6988       ;;
6989       (and (not (string-match "/etc/" path))
6990            (string-match "\\(.+[/\\]gnus\\)\\([/\\]\\|[/\\]?$\\)"  path)
6991            (setq found (match-string 1 path))
6992            ;;  It's faster to "remember" the previous match and test it with
6993            ;;  `equal' that all the time use `pushnew'. This reduces
6994            ;;  `pushnew' calls.
6995            (not (equal previous found))
6996            (setq previous found)
6997            (pushnew found list :test 'string=)))
6998     list))
6999
7000 ;;; ----------------------------------------------------------------------
7001 ;;;
7002 (defun tinypath-gnus-versions (&optional path-list)
7003   "Find out gnus version numbers along `load-path' or PATH-LIST.
7004 The PATH-LIST must conatins the root directoryies of Gnus installations.
7005 Return ((VER . PATH) ..)."
7006   (let* (file
7007          list)
7008     ;; There is no way we can say which Gnus version is the latest without
7009     ;; loading the gnus.el and looking inside the file
7010     (tinypath-with-temp-buffer
7011      (dolist (path path-list)
7012        ;;  XEmacs installation drop all gnus lisp files directly under:
7013        ;;
7014        ;;      xemacs-packages/lisp/gnus/
7015        ;;
7016        ;;  But the Gnus CVS tree contains directory structure
7017        ;;
7018        ;;      cvs-packages/gnus/lisp/
7019        ;;      cvs-packages/gnus/contrib
7020        ;;      cvs-packages/gnus/etc
7021        ;;
7022        (dolist (try '("gnus.el" "lisp/gnus.el"))
7023          (setq file (concat
7024                      (tinypath-expand-file-name
7025                       (file-name-as-directory path))
7026                      try))
7027          (when (file-exists-p file)
7028            (erase-buffer)
7029            ;;  About within 10%  of the file size the defconst can be found
7030            (insert-file-contents file nil 1 10000)
7031            (goto-char (point-min))
7032            (when (re-search-forward
7033                   "defconst.*gnus-version.*\"\\([0-9.]+\\)"
7034                   nil t)
7035              (push (cons (match-string 1) file)
7036                    list)))))
7037      (tinypath-verbose-macro 7
7038                              (message "TinyPath: found Gnus versions %s" (prin1-to-string list)))
7039      list)))
7040
7041 ;;; ----------------------------------------------------------------------
7042 ;;;
7043 (defun tinypath-gnus-latest-version (path-list)
7044   "Return latest gnus version from PATH-LIST.
7045 Return structure is ordered so, that the latest version is first:
7046 '((VERSION-STRING . PATH) ..).
7047
7048 Development versions starting with 0.N are condired newer that
7049 any N.N version."
7050   (let* ((ver    (tinypath-gnus-versions path-list))
7051          zero
7052          sorted)
7053     (when ver
7054       (setq sorted
7055             (sort
7056              ver
7057              (function
7058               (lambda (a b)
7059                 (if (or (string-match "^0" (car a))
7060                         (string-match "^0" (car b)))
7061                     (setq zero t))
7062                 (setq a (car a)
7063                       b (car b))
7064                 (tinypath-ti::vc-version-lessp a b)))))
7065       ;;  put ZERO numbers first.
7066       (if zero
7067           (setq sorted (reverse sorted))))
7068     sorted))
7069
7070 ;;; ----------------------------------------------------------------------
7071 ;;;
7072 (defun tinypath-insinuate-gnus ()
7073   "Examine `load-path' and leave the latest Gnus version."
7074   (let* ((list (tinypath-gnus-load-path-list)))
7075     (cond
7076      ((null list)
7077       (tinypath-verbose-macro 7
7078                               (message "TinyPath: No newer Gnus found along `load-path'.")))
7079      ((eq 1 (length list))
7080       ;;  Make sure no old gnus is used.
7081       (setq tinypath-:cache-level-two nil)
7082       (tinypath-verbose-macro 1
7083                               (message "TinyPath: One Gnus found along `load-path' %s"
7084                                        (car list)))
7085       (pushnew (car list) load-path :test 'string=)
7086       list)
7087      (t
7088       ;; Latest gnus version is first in the returned list, drop it out
7089       ;; and remove all other paths.
7090       ;;
7091       (dolist (path (cdr (tinypath-gnus-latest-version list)))
7092         (setq path
7093               (tinypath-file-remove-trailing-slash
7094                (file-name-directory (cdr path))))
7095         ;;  some/dir/gnus/lisp/  -->  some/dir/gnus/
7096         (tinypath-verbose-macro 1
7097                                 (message "TinyPath: Removing older Gnus from `load-path' %s"
7098                                          path))
7099         (tinypath-admin-remove-matching path)
7100         path)))))
7101
7102 ;;; ----------------------------------------------------------------------
7103 ;;;
7104 (defun tinypath-setup (&optional no-cache force)
7105   "Add additional directories to `load-path'.
7106 If `tinypath-:cache-expiry-days' is defined, use cached `load-path'
7107 If cache is too old, read directories under `tinypath-:load-path-root'.
7108
7109 Input:
7110
7111   NO-CACHE   If non-nil, do not use cache but read directories under
7112              `tinypath-:load-path-root'.
7113   FORCE      Regenerate cache.
7114
7115 References:
7116
7117   `tinypath-:load-path-function'"
7118   (interactive "P")
7119   (if (or no-cache
7120           (null tinypath-:cache-expiry-days)) ;Cache is not allowed
7121       (funcall tinypath-:load-path-function)
7122     (tinypath-cache-setup-main force)))
7123
7124 ;;; ----------------------------------------------------------------------
7125 ;;;
7126 (defun tinypath-load-path-root-changed-p ()
7127   "Check if `tinypath-:load-path-root' has changed since last run.
7128 The property value (get 'tinypath-:load-path-root 'tinypath-last-value)
7129 holds the last stored value."
7130   (let ((last (get 'tinypath-:load-path-root 'tinypath-last-value)))
7131     (and last
7132          (not (equal last tinypath-:load-path-root)))))
7133
7134 ;;; ----------------------------------------------------------------------
7135 ;;;
7136 (defun tinypath-install ()
7137   "Install package. There is no uninstall."
7138   (interactive)
7139   (let* ((fid     "tinypath-install")
7140          (time-a  (current-time))
7141          time-b
7142          diff)
7143     (message "TinyPath: %s BEGIN %s" fid (tinypath-time-string))
7144     (message "TinyPath: [INFO] (defmacro) Info-default-directory-list: %s"
7145              (prin1-to-string (tinypath-Info-default-directory-list)))
7146     (message "TinyPath: [INFO] Info-directory-list: %s"
7147              (if (boundp 'Info-directory-list)
7148                  (prin1-to-string Info-directory-list)
7149                "<empty>"))
7150     (message "TinyPath: [INFO] INFOPATH environment variable: %s"
7151              (or (getenv "INFOPATH")
7152                  "no variable"))
7153     ;;  Must be before the cygwin check, where cygwin1.dll is
7154     ;;  searched along `exec-path'
7155     ;;
7156     ;; (tinypath-exec-path-clean)
7157     ;; (tinypath-exec-path-check-verbose 'fix) ;; Missing items? (from PATH)
7158     ;;
7159     ;;  This is already set in default value for `tinypath-:extra-path-root'
7160     ;;  (when (tinypath-win32-p) (tinypath-cygwin-setup))
7161     ;; ................................................ examine system ...
7162     ;;
7163     ;;  Make sure all are absolute: use forward slash in all path names
7164     (tinypath-expand-file-name-variable-macro
7165      tinypath-:load-path-root)
7166     ;;  Suppose user has changed the value since the last time
7167     ;;  and does M-x load-library RET tinypath.el RET
7168     ;;  => check if we should regenerate cache or read from disk
7169     (if (not (tinypath-load-path-root-changed-p))
7170         (tinypath-setup)
7171       (message
7172        "TinyPath: INSTALL tinypath-:load-path-root changed, doing reboot.")
7173       ;; (tinypath-cache-regenerate)
7174       nil)
7175     ;; ........................................ cleanup and activation ...
7176     ;;
7177     ;; Delay defining advises until this point
7178     ;;
7179     (unless (eq tinypath-:compression-support 'none)
7180       (tinypath-advice-instantiate))
7181     ;;
7182     ;;  The autoload statements must be here, because `autoload' is
7183     ;;  an advised function. The `fboundp' is just an extra measure,
7184     ;;  so that it does not even call the advised-autoload function if
7185     ;;  this file is loaded multiple times
7186     ;;
7187     (unless (fboundp 'ti::macrof-version-bug-report)
7188       (autoload 'ti::macrof-version-bug-report "tinylib" "" nil 'macro))
7189     (unless (fboundp 'font-lock-mode)
7190       (autoload 'font-lock-mode "font-lock"  "" t))
7191     (unless (eq tinypath-:compression-support 'none)
7192       (turn-on-tinypath-cache-mode-maybe))
7193     ;; (tinypath-install-timer)       ;; Install watchdog to check load-path
7194     ;;  woman.el, man page viewer for Win32
7195     ;;  We do not load this, but define autoloads and then add the found
7196     ;;  paths after woman is active.
7197     ;;
7198     (when tinypath-:win32-p
7199       (if (tinypath-woman-setup)
7200           (tinypath-eval-after-load "woman" 'tinypath-insinuate-woman)
7201         (when tinypath-:extra-manpath
7202           (message "\
7203 TinyPath: ** Hm, manual pages found, but you do not have woman.el
7204              Visit http://centaur.maths.qmw.ac.uk/Emacs/
7205              and you will be able to use `M-x man' in Win32 system."))))
7206     (tinypath-eval-after-load "find-file" 'tinypath-insinuate-find-file)
7207     (setq time-b (current-time))
7208     (setq diff   (tinypath-ti::date-time-difference time-b time-a))
7209     (put 'tinypath-:load-path-root
7210          'tinypath-last-value
7211          tinypath-:load-path-root)
7212     (tinypath-Info-default-directory-list-clean)
7213     (tinypath-exec-path-clean)
7214     (message "TinyPath: [INFO] END (defmacro) Info-default-directory-list: %s"
7215              (prin1-to-string (tinypath-Info-default-directory-list)))
7216     (message "TinyPath: [INFO] END Info-directory-list: %s"
7217              (if (boundp 'Info-directory-list)
7218                  (prin1-to-string Info-directory-list)
7219                "<empty>"))
7220     (message "TinyPath: %s END %s" fid (tinypath-time-string))
7221     (message (concat (tinypath-cache-status-string)
7222                      (format " time %d sec" diff)))))
7223
7224 ;;}}}
7225 ;;{{{ Require (b)
7226
7227 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7228 ;;
7229 ;;  The require statements are unconventionally put here and not to the
7230 ;;  beginning of file, because sometimes Win32
7231 ;;  XEmacs development betas do not have correct `load-path' and
7232 ;;  require `advice' and `jka-compr' would fail.
7233 ;;
7234 ;;  At this point the load-path has been partially fixed (that is: booted)
7235 ;;  and we can run `require' commands.
7236 ;;
7237 ;;  The files can be in compressed format as well.
7238 ;;
7239 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7240
7241 (eval-and-compile
7242   (defun tinypath-original-values (mode)
7243     "MODE can be 'save 'restore original `load-path' and `exec-path'.
7244 The original value is saved under property `tinypath-saved-value'."
7245     (let ((savesym 'tinypath-saved-value))
7246       (dolist (sym '(load-path
7247                      exec-path))
7248         (cond
7249          ((eq mode 'save)
7250           ;;  Save can only be once.
7251           (or (get sym savesym)
7252               (put sym savesym (symbol-value sym))))
7253          ((eq mode 'restore)
7254           (set sym (get sym savesym)))))))
7255
7256   (tinypath-original-values 'save)
7257
7258   ;;  We MUST run this at compile time too, because in XEmacs
7259   ;;  it will make loading custom.elc possible. Without it, the
7260   ;;  defcustomed variables give errors
7261   (when tinypath-:install-flag
7262     (when (and (not (tinypath-byte-compile-running-p))
7263                ;;(and (tinypath-byte-compile-running-p)
7264                ;;     (boundp 'xemacs-logo))
7265                ;;
7266                ;; If there is cache and it is valid, do not run
7267                ;; BOOT.
7268                (let ((file (tinypath-cache-file-name)))
7269                  (tinypath-cache-file-old-p file)))
7270       (tinypath-load-path-initial-value
7271        tinypath-:core-emacs-load-path-list))))
7272
7273 (require 'info)
7274
7275 ;;}}}
7276 ;;{{{ Install load time
7277
7278 ;;; ----------------------------------------------------------------------
7279 ;;;
7280 ;;;####autoload (autoload 'tinypath-version "tinypath" "" t)
7281 (defun tinypath-version (&rest args)
7282   "Display version and manual. ARGS are ignored."
7283   (interactive)
7284   (let ((path (locate-library "tinypath.el")))
7285     (cond
7286      ((null path)
7287       (message "TinyPath: [ERROR] cannot find tinypath.el to read."))
7288      (t
7289       (let* ((name   "*tinypath-version*")
7290              (buffer (get-buffer name)))
7291         (if buffer
7292             (pop-to-buffer buffer)
7293           (pop-to-buffer (get-buffer-create name))
7294           (insert-file-contents path)
7295           (goto-char (point-min))
7296           (when (re-search-forward "Change Log")
7297             (forward-line 1)
7298             (delete-region (point) (point-max))
7299             (goto-char (point-min))
7300             (while (re-search-forward "^;[;{}]+ ?" nil t)
7301               (replace-match "" nil 'literal))
7302             (goto-char (point-min)))))))))
7303
7304 ;;; ----------------------------------------------------------------------
7305 ;;;
7306 (defun tinypath-install-reset-variables ()
7307   "Restore modified values, like GC parameters."
7308   ;; Restore value that was saved at the beginning of file
7309   (setq gc-cons-threshold
7310         (get 'gc-cons-threshold 'tinypath))
7311   ;;  Restore original value for rest of the Emacs session
7312   (let ((val (get 'tinypath-:verbose 'debug-init)))
7313     (when (integerp val)
7314       (setq tinypath-:verbose val))))
7315
7316 ;;; ----------------------------------------------------------------------
7317 ;;;
7318 (defun tinypath-install-pristine ()
7319   "Try to restore package to original Emacs settings.
7320 This means restoring `exec-path' and `load-path' as they
7321 were seen at Emacs startup. The cache is cimpletely rebuilt and
7322 then saved to disk."
7323   (interactive)
7324   (let ((load (tinypath-load-copy-get 'original))
7325         (exec (get 'exec-path 'tinypath)))
7326     (if (not (and load exec))
7327         (error "TinyPath: No original values found.")
7328       (setq load-path load)
7329       (setq exec-path exec)
7330       (tinypath-cache-regenerate))))
7331
7332 ;;; ----------------------------------------------------------------------
7333 ;;;
7334 (defun tinypath-install-main ()
7335   "The main loader. The very first setup for the package.
7336 This function is called when package is loaded.
7337
7338 Runs hooks:
7339
7340   `tinypath-:report-mode-define-keys-hook'
7341   `tinypath-:load-hook'."
7342   (run-hooks 'tinypath-:report-mode-define-keys-hook)
7343   (eval-and-compile
7344     (unless (tinypath-byte-compile-running-p)
7345       (tinypath-install-environment)
7346       (run-hooks 'tinypath-:load-hook)))
7347   ;;  This last message is here solely so that with log level 20
7348   ;;  the message is also saved the log file
7349   (tinypath-verbose-macro 3
7350                           (tinypath-cache-status-message)))
7351
7352 (tinypath-load-copy-now)
7353 (tinypath-load-copy-now 'original)
7354 (put 'exec-path 'tinypath exec-path) ;; Save original value
7355
7356 (if tinypath-:install-flag
7357     (tinypath-install-main))
7358
7359 (tinypath-install-reset-variables)
7360
7361 ;;}}}
7362
7363 ;;; tinypath.el ends here