emacs_el/tiny-tools/tiny/tinylibid.el

   1 ;;; tinylibid.el --- Library for (Id)entifying buffer, regardless of mode
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   6
   7 ;; Copyright (C) 1995-2007 Jari Aalto
   8 ;; Keywords:     extensions
   9 ;; Author:       Jari Aalto
  10 ;; Maintainer:   Jari Aalto
  11 ;;
  12 ;; To get information on this program, call M-x ti::id-version.
  13 ;; Look at the code with folding.el
  14
  15 ;; COPYRIGHT NOTICE
  16 ;;
  17 ;; This program is free software; you can redistribute it and/or modify it
  18 ;; under the terms of the GNU General Public License as published by the Free
  19 ;; Software Foundation; either version 2 of the License, or (at your option)
  20 ;; any later version.
  21 ;;
  22 ;; This program is distributed in the hope that it will be useful, but
  23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  24 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  25 ;; for more details.
  26 ;;
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with program; see the file COPYING. If not, write to the
  29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  30 ;; Boston, MA 02110-1301, USA.
  31 ;;
  32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  33
  34 ;;}}}
  35 ;;{{{ Install
  36
  37 ;;; Install:
  38
  39 ;; ........................................................ &t-install ...
  40 ;; Put this file on your Emacs-Lisp load path, add following into your
  41 ;; ~/.emacs startup file
  42 ;;
  43 ;;      (require 'tinylibid)
  44 ;;
  45 ;; Or use autoload. This is preferred method
  46 ;;
  47 ;;      (autolad 'ti::id-info "tinylibid" "Buffer info" t)
  48 ;;
  49 ;; Function to call to get buffer identity. You normally call this
  50 ;; from lisp code and not interactively.
  51 ;;
  52 ;;      M-x ti::id-info
  53 ;;
  54 ;; If you have any questions, always use function
  55 ;;
  56 ;;      M-x ti::id-submit-bug-report
  57 ;;
  58 ;; Request:
  59 ;;
  60 ;;      Please send any example file or mode that I'm not aware of,
  61 ;;      I'll try to support any programming mode
  62
  63 ;;}}}
  64 ;;{{{ Documentation
  65
  66 ;; .................................................... &t-commentary ...
  67
  68 ;;; Commentary:
  69
  70 ;; Preface, Feb 1995
  71 ;;
  72 ;;      Seems quite uninteresting package to you? I bet it does, unless
  73 ;;      you're a lisp programmer who has infite time to twiddle his
  74 ;;      c++-mode-hook + 20 others hooks and have all the time develop nice
  75 ;;      little funcs to make living in emacs easier.
  76 ;;
  77 ;;      While someone may think that all users stick to one mode e.g. when
  78 ;;      they are programming C++, that's not obvious. For example programmer
  79 ;;      may move between all kind of modes during programming and the
  80 ;;      trouble is, that while the buffer's logical content remains the same,
  81 ;;      the hooks know nothing about it. Hooks are just dummies that get
  82 ;;      called whenever you turn some mode on, try C++ mode over nroff code
  83 ;;      and you'll be surprised.
  84 ;;
  85 ;;      Now let's see one session example:
  86 ;;
  87 ;;      .   write Lisp               ;lisp-mode + folding-mode
  88 ;;      .   hmm, need center-command ;move to text-mode
  89 ;;      .   code again               ;lisp-mode
  90 ;;      .   adjust defconst var pos. ;turn on tiny tab minor mode
  91 ;;      .   code again               ;lisp-mode
  92 ;;
  93 ;;      Programmer may have bound all common modes into keys so that he can
  94 ;;      can access various modes very fast; changing modes is no
  95 ;;      problem. What is the problem, is that when you turn off the
  96 ;;      CODE-mode, all information about comment-start etc. vanish.
  97 ;;
  98 ;; Overview of features
  99 ;;
 100 ;;      o   This is LIBRARY package
 101 ;;      o   Try to identify buffer content
 102 ;;      o   Useful for checking what kind of file is in buffer and making
 103 ;;          decisions based on that. Suitable for hooks.
 104 ;;
 105 ;;  Imenu example
 106 ;;
 107 ;;      If you're using *imenu.el* to generate buffer jump points, it is
 108 ;;      very likely that the imenu command won't generate right jump points
 109 ;;      if you're in wrong mode. Let's use imenu example. Here is first
 110 ;;      try: The code sniffs around to see if we're on some mode and then
 111 ;;      configures imenu according to it.
 112 ;;
 113 ;;          (defun my-imenu-mouse (event)
 114 ;;            (interactive "e")
 115 ;;            (my-imenu))
 116 ;;
 117 ;;          (defun my-imenu (&optional arg)
 118 ;;            "Sets parameters to imenu."
 119 ;;            (let* (raise)
 120 ;;              (setq imenu-max-items 20
 121 ;;                 imenu-sort-function nil)
 122 ;;              (cond
 123 ;;              ((memq major-mode
 124 ;;                '(lisp-mode emacs-lisp-mode lisp-interaction-mode))
 125 ;;                (setq imenu-create-index-function
 126 ;;                      'imenu-example--create-lisp-index
 127 ;;                      imenu-sort-function
 128 ;;                      'imenu--sort-by-name
 129 ;;                      raise t))
 130 ;;               ((memq major-mode '(c++-mode))
 131 ;;                (setq imenu-create-index-function
 132 ;;                      'imenu-example--create-c++-index
 133 ;;                      imenu-sort-function
 134 ;;                      'imenu--sort-by-name
 135 ;;                      raise t))
 136 ;;               ((memq major-mode '(c-mode))
 137 ;;                (setq imenu-create-index-function
 138 ;;                      'imenu-example--create-c-index
 139 ;;                      imenu-sort-function
 140 ;;                      'imenu--sort-by-name
 141 ;;                      raise t)))
 142 ;;              (if raise
 143 ;;                  (imenu))))
 144 ;;
 145 ;;      Here is better and more robust way. It'll let you be in any
 146 ;;      mode while retaining right imenu.
 147 ;;
 148 ;;          (require 'imenu)
 149 ;;
 150 ;;          ;;  Separate functions for keyboard and mouse.
 151 ;;          (defun my-imenu-mouse (event &optional arg)
 152 ;;            (interactive "e\nP")
 153 ;;            (my-imenu arg))
 154 ;;
 155 ;;          (defun my-imenu (&optional arg)
 156 ;;            "Sets parameters to imenu. If called with arg, the output is
 157 ;;           unsorted."
 158 ;;            (interactive "P")
 159 ;;            (let* ((sort-func (if arg nil 'imenu--sort-by-name))
 160 ;;                   (table
 161 ;;                    '((lisp-mode
 162 ;;                       imenu-example--create-lisp-index)
 163 ;;                      (emacs-lisp-mode
 164 ;;                       imenu-example--create-lisp-index)
 165 ;;                      (c++-mode
 166 ;;                       imenu-example--create-c++-index)
 167 ;;                      (c-mode
 168 ;;                       imenu-example--create-c-index)))
 169 ;;                   ;;  So, in what mode were really?
 170 ;;                   (mode (or (ti::id-info t) major-mode))
 171 ;;                   (el (assoc mode table)))
 172 ;;              (if (null el)
 173 ;;                  (message "Sorry, no imenu for this buffer.")
 174 ;;                (setq imenu-max-items         20
 175 ;;                      imenu-sort-function             sort-func
 176 ;;                      imenu-create-index-function     (nth 1 el))
 177 ;;                (imenu))))
 178
 179 ;;}}}
 180
 181 ;;; Change Log:
 182
 183 ;;; Code:
 184
 185 ;;{{{ setup: require
 186
 187 (require 'tinylibm)
 188
 189 (eval-when-compile
 190   (ti::package-use-dynamic-compilation))
 191
 192 ;;}}}
 193 ;;{{{ setup: hooks
 194
 195 (defvar ti::id-:load-hook nil
 196   "*Hook run when file has been loaded.")
 197
 198 ;;}}}
 199 ;;{{{ setup: private
 200
 201 (defvar ti::id-:info  nil
 202   "Buffer local variable.This value is updated every time
 203 function ti::id-info called. For faster responses, you may wan to write your
 204 code like this:
 205
 206         (setq info ti::id-info nil 'var)
 207
 208 Because peeking the variable is 40x times faster.")
 209
 210 (make-variable-buffer-local 'ti::id-:info)
 211
 212 ;; Global variables set by functions.
 213 ;; - These are heavily used. User may check these too.
 214 ;; - They are Set after the buffer is studied.
 215
 216 (defconst ti::id-:global-buffer-name nil
 217   "Global: set by study func, buffer name")
 218
 219 (defconst ti::id-:global-buffer-file-name  nil
 220   "Global: set by study func, buffer file name")
 221
 222 (defconst ti::id-:global-buffer-extension nil
 223   "Global: set by study func, buffer fn ext.")
 224
 225 (defconst ti::id-:global-buffer-first-line nil
 226   "Global: set by study func, 1st line of buffer")
 227
 228 ;;}}}
 229 ;;{{{ setup: public, user configurable
 230
 231 ;;; it is INTENTIONAL that the variables are defconst, change these
 232 ;;; with ti::id-:load-hook
 233
 234 (defvar ti::id-:file-ext-re "[a-zA-Z0-9]\\(\\.\\)[a-zA-Z0-9]+$"
 235   "A regexp that says what files can have extension. Everything after the
 236 DOT is considered to form extension. Files like ~/.cshrc are not
 237 considered to have an extension.
 238
 239 The sub match at level 1 indicates the start of an extension.
 240
 241 References:
 242
 243   See function `ti::id-file-extension'.")
 244
 245 (defconst ti::id-:buffer-first-line-regexp-list
 246   '(("^#.*perl"          "code-perl")
 247     ("^#.*python"        "code-python")
 248     ("^#.*scm"           "code-scheme")
 249     ("^#.*tcl"           "code-tcl")
 250     ;;    Of course this is not bullet proof, but many lisp code package
 251     ;;    has first line describing the package.
 252     ("^;;[ \t]+.*\.el "  "code-lisp")
 253     ("^#.*awk"           "code-awk")
 254     ;; It's custom to start the file with ':' no-op, if it's
 255     ;; sh-coded, since it prevents accidental # for the first line
 256     ;; --> intepreted as csh code by shell if it sees # as first char
 257     ("^#.*\/sh\\|^[ \t]*:[ \t]*$"    "code-shell-sh")
 258     ("^#.*\/csh"                     "code-shell-csh")
 259     ("^#.*\/tcsh"                    "code-shell-tcsh")
 260     ("^#.*\/ksh"                     "code-shell-ksh")
 261     ("^#.*\/zsh"                     "code-shell-zsh")
 262     ("^#.*\/bash"                    "code-shell-bash")
 263     ;;  Fortran code uses comments beginning with "c", we assume that
 264     ;;  there must be at least TWO spaces after initial comment
 265     ("^c  +"             "code-fortran")
 266     ("^[ \t]*!"          "resource-x")  ;.Xinitrc ot the like comment
 267     ;; It's custom to start an nroff man page with a comment that
 268     ;; holds version control Id string. Comment is  = .\"
 269     ("^\.\\\""   "text-nroff")
 270     ;;  A "white paper" document that starts with TOC. See e.g tinytf.el
 271     ("^Table of contents" "text-white-paper-toc"))
 272   "*list of \(REGEXP str) where RE is tried upon 1 line match, normally
 273 a bang-slash or emacs --** notation")
 274
 275 ;;  - Remember, first one that macthes id useti::d! Put most restrictive at
 276 ;;    the beginning.
 277 ;;  - The regexp scanning should be the last resort, because its potential
 278 ;;    mishits.
 279 ;;  - There is no need to add regexp here if buffer can be identified by other
 280 ;;    means easily ie. all WWW files have universal .html extension.
 281
 282 (defconst ti::id-:buffer-match-regexp-list
 283   (list
 284    (list
 285     (concat
 286      ;;   interface CServicePreferences;  /* Forward references */
 287      "interface [0-9A-Za-z]+[ \t]+[0-9A-Za-z]+[ \t]*;"
 288      ;; exception InvalidRequest{TString aReason;};
 289      "\\|exception[ \t]+[0-9A-Za-z]+{.*;"
 290      ;; typedef sequence<CosPropertyService::PropertyNames> PropertyNamesList;
 291      "\\|typedef[ \t]+[0-9A-Za-z]+<")
 292     "code-idl")
 293    ;; *FvwmIdentBack MidnightBlue
 294    ;; *FvwmIdentFore Yellow
 295    ;; Style "FvwmButtons" CirculateSkip
 296    '("Style[ \t]+\"FvwmButtons\"[ \t]+[A-Z]\\|^[*]Fvwm"
 297      "resource-code-fvwm")
 298    '("^@c[ \t]"
 299      "text-texinfo")
 300    ;; :0
 301    ;; * condition
 302    ;; {
 303    ;;    <code block>
 304    ;; }
 305    '("^:0[ \t]*[\r\n]+[ \t]*[*{]"
 306      "code-procmail")
 307    '("<\\?php"
 308      "code-php")
 309    ;;  #declare Purple_Clouds = pigment {
 310    ;;  #include "woodmaps.inc"
 311    ;;  ...
 312    ;;  Paraboloid_Y
 313    ;;  scale <30.0, 10.0, 40.0>
 314    ;;  rotate 180.0*z
 315    ;;  translate <40.0, 14.0, 50.0>
 316    (list
 317     (concat
 318      "^#include[ \t]+.*.inc\""
 319      "\\|^#declare[ \t]+[^ \t]+[ \t]*="
 320      "\\|\\(scale\\|translate\\)[ \t]<[ \t]*[0-9.][ \t]*,.*>")
 321     "code-povray")
 322    (list
 323     (concat
 324      "[(][ \t]*\\(defmacro\\|defvar\\|defconst\||defun\\|setq"
 325      "\\|add-hook\\|remove-hook\\|let[*]"
 326      "\\)")
 327     "code-lisp")
 328    '("entity[ \t]+[a-z_A-Z]+[ \t]+is"                  "code-vhdl")
 329    (list
 330     (concat
 331      ;; 01  WORK-AREA.
 332      ;;     02 PI               PIC S9V9(14).
 333      ;;
 334      "01[ \t]+WORK-AREA\\.\\|01[ \t]+CONSTANTS\\."
 335      ;;         ACUCOBOL-85
 336      "\\|\\(working-storage\\|portability\\)[ \t]+section\\."
 337      "\\|perform[ \t]+initialize-environment\\."
 338      ;;         display "F4 = Exit Demonstration", line 11, column 8.
 339      "\\|display [\"].*,[ \t]*column[ \t]+[0-9]+\\.")
 340     "code-cobol")
 341    ;;  it's "write(*,*)" , and definitely fortran
 342    '("write[(][*],[*][)]"                               "code-fortran")
 343    (list
 344     (concat
 345      "class.+\\(extends\\implements\\)"
 346      "\\|"
 347      "\\(protected\\|public\\)[ \t]+"
 348      "\\(synchronized[ \t]+\\)?Object")
 349     "code-java")
 350    ;;  Function definition
 351    ;;    def add_doc(self, document, keyword_list):
 352    ;;    def __init__(self):
 353    '("^[ \t]+def[ \t]+[a-zA-Z_]+[(].*:"                 "code-python")
 354    ;;  Oracle sql
 355    ;;  select * from p_msc_rej where measurement_time = '1995061914124675';
 356    '("select.*from.*where.*=.*;"                        "code-sql")
 357    '("order[ \t]+by[ \t]+[^ \t\n]+.*\\(asc\\|desc\\)"   "code-sql")
 358    '("^[.]TH"                                           "text-nroff")
 359    '("^Newsgroup:"                                      "text-news")
 360    '("^To:.*@"                                          "text-mail")
 361    (list
 362     ;;  conjug     :: Words -> Words -> String
 363     ;;  netails    :: [a] -> [[a]]
 364     ;;  replies    :: Words -> Words -> [String]
 365     ;;
 366     "conjug[ \t]+::.*->\\|netails[ \t]+::.*->\\|replies::[ \t]+.*->"
 367     "code-hugs")
 368    ;;  %HOME\file\path
 369    (list
 370     "^REM[ \t]\\|^CALL[ \t].*%[^ \t\r\n]+%\\[^ \t\r\n]+"
 371     "code-bat"))
 372   "*List of \(REGEXP str\) where RE is tried upon whole file.
 373 First one matched is used to determine file type, so put most restrictive
 374 REs first.")
 375
 376 (defconst ti::id-:file-extension-alist
 377   '((".a"     . "code-ada")             ;Ada 83/87
 378     (".ada"   . "code-ada")             ;Ada 83/87
 379     (".ads"   . "code-ada")             ;ada 95
 380     (".adb"   . "code-ada")             ;Ada 95 body/implementation
 381     (".asp"   . "code-asp")
 382     (".awk"   . "code-awk")
 383     (".bat"   . "code-bat")
 384     (".bash"  . "code-shell-bash")
 385     (".c"     . "code-c")
 386     (".cbl"   . "code-cobol")         ;this is the standard hdr & strc
 387     (".cc"    . "code-c++")
 388     (".cmd"   . "code-bat")
 389     (".cob"   . "code-cobol")           ;non-standard unix
 390     (".cpp"   . "code-c++")
 391     (".csh"   . "code-shell-csh")
 392     (".cxx"   . "code-c++")
 393     (".C"     . "code-c++")
 394     (".el"    . "code-lisp")
 395     (".f"     . "code-fortran")
 396     (".F"     . "code-fortran")
 397     (".for"   . "code-fortran")
 398     (".fvwmrc". "resource-code-fvwm")
 399     (".h"     . "code-c-header")
 400     (".hh"    . "code-c++-header")
 401     (".hs"    . "code-hugs")
 402     (".i"     . "code-cobol-header")    ;non-standard unix
 403     (".idl"   . "code-idl")         ;CORBA idl, hassan@cs.stanford.edu
 404     (".html"  . "text-html")
 405     (".java"  . "code-java")
 406     (".class" . "code-java-compiled")
 407     (".jsp"   . "code-jsp")
 408     (".ksh"   . "code-shell-ksh")
 409     (".m"     . "code-objective-c")
 410     (".mod"   . "code-objective-c")
 411     (".md"    . "code-modula-header")   ;at least modula-2
 412     (".mi"    . "code-modula")          ;implementation modula-2
 413     (".pas"   . "code-pascal")
 414     (".php[34]?" . "code-php")
 415     (".pl"    . "code-perl-library")
 416     (".pls"   . "code-perl-shell")
 417     (".pm"    . "code-perl")
 418     ;;  also uses .inc and .map but I hesitate to add those extension,
 419     ;;  because some other may use .inc or .map too for other purposes.
 420     (".pov"   . "code-povray")
 421     (".py"    . "code-python")
 422     (".sh"    . "code-shell")           ;might be csh/ksh/csh
 423     (".sql"   . "code-sql")
 424     (".tex"   . "text-tex")
 425     (".texi"  . "text-tex-info")
 426     (".txt"   . "text-normal")
 427     (".vhd"   . "code-vhdl")
 428     (".vhdl"  . "code-vhdl")
 429     (".wml"   . "code-wml")
 430     (".xml"   . "code-xml")
 431     (".xsl"   . "code-xsl")
 432     (".xsp"   . "code-xsp"))
 433   "*List of (ASSOC-KEY STR) where KEY is tried upon
 434 buffer-file-name's extension.")
 435
 436 ;;  If the file cannot be identified by extension...
 437
 438 (defconst ti::id-:file-regexp-match-list
 439   '(("\\.ema"        "code-lisp")       ;.emacs , .emacs.dired
 440     ("\/\\.[Xx]"     "resource-x")      ;.Xdefauls, .xinirc
 441     ("\/\\.kshrc"    "resource-code-shell-ksh")
 442     ("\/\\.t?cshrc"  "resource-code-shell-csh") ;alike csh = tcsh
 443     ("\/\\.bashrc"   "resource-code-shell-bash")
 444     ("\/\\.bashrc"   "resource-code-shell-sh") ;alike bash = sh
 445     ("\\.csh"        "shell-csh"))      ;like .cshrc or myScript.csh
 446   "*List of (REGEXP STR) where RE is tried upon _whole_ buffer-file-name")
 447
 448 ;; - Buffers that do not have buffer-file-name property at all.
 449 ;; - Only put 'trusted' buffer names that are known to all here.
 450
 451 (defconst ti::id-:buffer-name-regexp-list
 452   '(("[*]info"       "text-manual-info")
 453     ("[*]man"        "text-manual-shell")
 454     ("[*]shell"      "process-shell")
 455     ("[*]ftp"        "process-ftp")
 456     ("[*]Article"    "text-news")
 457     ("[*]Summary"    "text-news"))
 458   "*List of (REGEXP STR) where RE is tried upon buffer-name")
 459
 460 (defconst ti::id-:function-list
 461   '( ;; This first line -*- test should represent exact mode, we trust
 462     ;;  to it blindly. If the content is not what this mode says, it's
 463     ;;  user's own mistake.
 464     ti::id-test-first-line-emacs-special
 465     ti::id-test-first-line
 466     ti::id-test-buffer-file-name
 467     ti::id-test-buffer-content-special
 468     ti::id-test-extension
 469     ti::id-test-buffer-name
 470     ti::id-test-buffer-search-regexp)
 471   "*List of unctions to call to determine buffer type.
 472 The calling of functions stops immediately when some function
 473 returns non-nil. Notice, that this is also the order of evaluation.")
 474
 475 (defconst ti::id-:type2mode
 476   '(("ada"                 ada-mode     "--")
 477     ("awk"                 awk-mode     "#")
 478     ("code-c$"             c-mode       "/*" "*/")
 479     ("code-c++"            c++-mode     "//")
 480     ("code-cobol"          cobol-mode   )
 481     ("code-fortran"        fortran-mode "C")
 482     ("code-fvwm"           fvwm-mode    )
 483     ("code-hugs"           hugs-mode    "--" )
 484     ("code-idl"            idl-mode     )
 485     ("code-java"           java-mode    "/*" "*/")
 486     ("code-objective-c"    c-mode       )
 487     ("code-pascal"         pascal-mode  )
 488     ("html"                html-mode    "<!---" "-->")
 489     ("code-php"            php-mode     "//")
 490     ("code-python"         python-mode  )
 491     ("code-scheme"         scheme-mode  )
 492     ("code-sql"            sql-mode     "-- ")
 493     ("code-tcl"            tcl-mode)
 494     ("pascal"              pascal-mode  "{" "}")
 495     ("perl"                perl-mode    "#")
 496     ("code-povray"         povray-mode  "/*" "*/")
 497     ("lisp\\|emacs-lisp"   lisp-mode    ";")
 498     ("text-tex"            tex-mode     "%")
 499     ("text-texinfo"        texinfo-mode "@c")
 500     ("text-tex-info"       texinfo-mode "%")
 501     ("text-mail"           mail-mode)
 502     ("text-news"           mail-mode)
 503     ("shell-sh"            sh-mode      "#")
 504     ("shell-csh"           csh-mode     "#")
 505     ("shell-ksh"           ksh-mode     "#")
 506     ("shell-zsh"           zsh-mode     "#")
 507     ("resource-code-shell-csh" csh-mode "#")
 508     ("resource-code-shell-sh"   sh-mode "#")
 509     ("tex$"                tex-mode     "%"))
 510   "*List of
 511 '((REGEXP MODE-NAME-SYMBOL [COMMENT-START COMMENT-END]) (
 512   (R M C C)
 513   ..)
 514 where RE represent match against string that describes the buffer
 515 contents. The comment-start and end fields are optional.")
 516
 517 ;;}}}
 518 ;;{{{ version
 519
 520 ;;; ....................................................... &v-version ...
 521
 522 (eval-and-compile
 523   (ti::macrof-version-bug-report
 524    "tinylibid.el"
 525    "tinylibid"
 526    ti::id-:version-id
 527    "$Id: tinylibid.el,v 2.50 2007/05/01 17:20:45 jaalto Exp $"
 528    '(ti::id-:load-hook
 529      ti::id-:function-list
 530
 531      ti::id-:global-buffer-name
 532      ti::id-:global-buffer-file-name
 533      ti::id-:global-buffer-extension
 534      ti::id-:global-buffer-first-line
 535
 536      ti::id-:file-ext-re
 537      ti::id-:buffer-first-line-regexp-list
 538      ti::id-:buffer-match-regexp-list
 539      ti::id-:file-extension-alist
 540      ti::id-:file-regexp-match-list
 541      ti::id-:buffer-name-regexp-list
 542      ti::id-:type2mode)))
 543
 544 ;;}}}
 545 ;;{{{ misc
 546
 547 ;;; ----------------------------------------------------------------------
 548 ;;;
 549 (defun ti::id-cnv-txt2mode (txt)
 550   "This is kinda fake function, it returns the original MODE based
 551 on the text that represents the buffer contents. This functions purpose
 552 is solely to return you a _symbol_ that is more commonly known to all, than
 553 the _string_ representing a mode.
 554
 555 NOTE:
 556  Symbol returned does not necessary representy any mode you can turn on.
 557  Use 'fboundp' test to be sure the symbol is callable function."
 558   (let (ret)
 559     (dolist (elt ti::id-:type2mode)
 560       (when (string-match (nth 0 elt) txt)
 561         (setq ret (nth 1 elt))          ;Mode name
 562         (return)))
 563     ret))
 564
 565 ;;; ----------------------------------------------------------------------
 566 ;;;
 567 (defun ti::id-cnv-txt2comment (txt)
 568   "Returns (COMMENT-START . COMMENT-END) variables for text representing
 569 the buffer contents. Notice that comment-end may be nil meaning it
 570 is not needed for mode."
 571   (let (com-s
 572         com-e
 573         re)
 574     (dolist (elt ti::id-:type2mode)
 575       (setq re (nth 0 elt))
 576       (if (> (length elt) 2)
 577           (setq com-s (nth 2 elt)))
 578       (if (> (length elt) 3)
 579           (setq com-s (nth 3 elt)))
 580       (if (null (string-match re txt))
 581           (setq com-s nil   com-e nil)
 582         (return)))
 583     (if com-s
 584         (cons com-s com-e))))
 585
 586 ;;}}}
 587 ;;{{{ id
 588
 589 ;;; ----------------------------------------------------------------------
 590 ;;;
 591 (defun ti::id-file-extension (file)
 592   "Return file extension.
 593
 594 References:
 595   See variable `ti::id-:file-ext-re' how file extension is determined."
 596   (let* ((re ti::id-:file-ext-re)
 597          point)
 598     (when (and file               ;doesn't have filename at all *temp*
 599                (string-match re file))
 600       (setq point (match-beginning 1))  ;dot position
 601       (substring file point))))
 602
 603 ;;; ----------------------------------------------------------------------
 604 ;;;
 605 (defun ti::id-read-first-line ()
 606   "Return first ID line of the file. Empty lines are skipped."
 607   (let* ((comment-beg   (regexp-quote (or comment-start " ")))
 608          (empty-re      (concat "[ \t]*" comment-beg "[ \t]*$")))
 609     (save-excursion
 610       (ti::widen-safe
 611         (ti::pmin)
 612         (while (and (not (eobp))        ;search first sensible line
 613                     (looking-at empty-re))
 614           (forward-line 1))
 615         (unless (eobp)
 616           (ti::read-current-line))))))
 617
 618 ;;; ----------------------------------------------------------------------
 619 ;;;
 620 (defun ti::id-read-first-line-emacs-mode (str)
 621   "Emacs supports special first line syntax e.g. -*-Emacs-Lisp-*-,
 622 to turn on mode when file loads. Try to find function <text>-mode
 623 from the internal symbol list of emacs if line contains -*- marks.
 624
 625 Return:
 626
 627   symbol    real mode function name found from emacs.
 628             Btw, emacs barks you automatically if functions given
 629             in line doesn't exist when file is loaded.
 630   nil."
 631   (let* (ret
 632          mode
 633          sym)
 634     (cond
 635      ((setq mode (ti::string-match "-[*]-\\(.*\\)-[*]-" 1 str))
 636       ;;  let's make symbol out of it
 637       (setq mode (concat (downcase mode) "-mode"))
 638       (if (null (setq sym (intern-soft mode)))
 639           (progn
 640             ;;  too bad, such mode not loaded into emacs, well if person
 641             ;;  has loaded file, emacs had barfed already about this unknown
 642             ;;  mode: "file mode specification error, void function, <mode>"
 643             nil)
 644         (if (fboundp sym)             ;let's make sure sym is func ...
 645             (setq ret sym)))))          ;it's valid mode
 646     ret))
 647
 648 ;;; ----------------------------------------------------------------------
 649 ;;;
 650 (defun ti::id-match (string list)
 651   "Match STRING against LIST el 1, return LIST elt 2"
 652   (let* (ret
 653          regexp)
 654     (dolist (elt list)
 655       (setq regexp (nth 0 elt))
 656       (when (string-match regexp string)
 657         (setq ret (nth 1 elt))
 658         (return)))
 659     ret))
 660
 661 ;;; ----------------------------------------------------------------------
 662 ;;;
 663 (defun ti::id-buffer-re-search (&optional point)
 664   "Search `ti::id-:buffer-match-regexp-list' from buffer.
 665 Start searching from `point-min' or from optional POINT."
 666   (let ((list   ti::id-:buffer-match-regexp-list)
 667         ret)
 668     (or point
 669         (setq point (point-min)))
 670     (save-excursion
 671       (ti::widen-safe
 672         (goto-char point)               ;start here
 673         (dolist (elt list)
 674           (when  (re-search-forward (nth 0 elt) nil t)
 675             (setq ret (nth 1 elt))
 676             (return)))))
 677     ret))
 678
 679 ;;}}}
 680 ;;{{{ study
 681
 682 ;;; ----------------------------------------------------------------------
 683 ;;;
 684 (defun ti::id-global-variable-reset ()
 685   "Reset some globals."
 686   (setq ti::id-:global-buffer-file-name  nil
 687         ti::id-:global-buffer-extension  nil
 688         ti::id-:global-buffer-first-line  nil))
 689
 690 ;;; ----------------------------------------------------------------------
 691 ;;;
 692 (defun ti::id-global-variable-set ()
 693   "Set some globals, so that they can be used by all functions.
 694 This reduces overhead of getting these variables multiple times."
 695   (let* ((bp  (current-buffer))
 696          (bn  (buffer-name))
 697          (bfn (buffer-file-name bp))
 698          (ext (ti::id-file-extension bn))
 699          (id  (ti::id-read-first-line)))
 700     (ti::id-global-variable-reset)
 701     (setq ti::id-:global-buffer-file-name   bfn
 702           ti::id-:global-buffer-extension  ext
 703           ti::id-:global-buffer-first-line   id
 704           ti::id-:global-buffer-name    bn)
 705     ;; so that can be hook
 706     nil))
 707
 708 ;;; ----------------------------------------------------------------------
 709 ;;;
 710 (defun ti::id-study-buffer (type)
 711   "Chew buffer contents.
 712 Be sure to run `ti::id-global-variable-set' first so that global variables get set.
 713
 714 Input:
 715   TYPE      symbol; See source code of function.
 716
 717 Return:
 718   string     type string
 719   symbol     if real mode found in first line -*- ..-*-
 720   nil"
 721   (let* ( ;; these are already set
 722          (id     ti::id-:global-buffer-first-line)
 723          (ext    ti::id-:global-buffer-extension)
 724          (bname  ti::id-:global-buffer-name)
 725          el
 726          ret)
 727     (cond
 728      ((eq type 'extension)
 729       (if (setq el (assoc ext ti::id-:file-extension-alist))
 730           (setq ret (cdr el))))
 731      ((eq type 'buffer-file-name)       ;buffer name test
 732       ;;  whole file match
 733       (setq ret (ti::id-match bname ti::id-:file-regexp-match-list)))
 734      ((eq type 'buffer-name)            ;buffer name test
 735       (setq ret (ti::id-match bname ti::id-:buffer-name-regexp-list)))
 736      ((and (eq type '1st-emacs)         ;special -*-Emacs-Lisp-*-
 737            (stringp id))
 738       (setq ret (ti::id-read-first-line-emacs-mode id)))
 739      ((and (eq type '1st-regexp)
 740            (stringp id))
 741       (setq ret (ti::id-match id ti::id-:buffer-first-line-regexp-list)))
 742      ((eq type 'buffer-regexp)          ;whole buffer is searched
 743       (setq ret (ti::id-buffer-re-search))))
 744     ret))
 745
 746 ;;; ----------------------------------------------------------------------
 747 ;;;
 748 (defun ti::id-test-buffer-content-special ()
 749   "Check special buffer content."
 750   (let* ((text  (memq major-mode '(fundamental-mode text-mode))))
 751     (cond
 752      ((and text
 753            (fboundp 'tinytf-text-format-p)
 754            (ti::funcall 'tinytf-text-format-p))
 755       "text-white-paper"))))
 756
 757 ;;; ----------------------------------------------------------------------
 758 ;;; - testing/evaluation  functions
 759
 760 (defun ti::id-test-extension ()
 761   ""
 762   (ti::id-study-buffer 'extension))
 763
 764 (defun ti::id-test-buffer-file-name ()
 765   ""
 766   (ti::id-study-buffer 'buffer-file-name))
 767
 768 (defun ti::id-test-buffer-name ()
 769   ""
 770   (ti::id-study-buffer 'buffer-name))
 771
 772 (defun ti::id-test-first-line ()
 773   ""
 774   (ti::id-study-buffer '1st-regexp))
 775
 776 (defun ti::id-test-first-line-emacs-special
 777   ()
 778   ""
 779   (ti::id-study-buffer '1st-emacs))
 780
 781 (defun ti::id-test-buffer-search-regexp
 782   ()
 783   ""
 784   (ti::id-study-buffer 'buffer-regexp))
 785
 786 ;;}}}
 787 ;;{{{ main
 788
 789 ;;; ############################################################ &main ###
 790
 791 ;;; ----------------------------------------------------------------------
 792 ;;;
 793 ;;;###autoload
 794 (defun ti::id-info (&optional mode variable-lookup verb)
 795   "Try to identify buffer type.
 796
 797 Function doesn't rely on mode, because that doesn't necessarily tell what
 798 the buffer holds. Many users still program their shell scripts in
 799 `fundamental-mode' or so. This means that `major-mode' isn't checked,
 800 because calling function can do it easily.
 801
 802 If this function returns nil, _then_ it's probably the time to check
 803 the `major-mode'.
 804
 805 The normal order of evaluation is as follows:
 806 -  First line in the file
 807 -  Whole filename including path = `buffer-file-name'
 808 -  File name extension
 809 -  `buffer-name' is checked. [temporary buffer has no file name]
 810 -  Whole buffer is searched for RE texts
 811
 812 Input:
 813
 814   MODE              flag, controls return value format
 815   VARIABLE-LOOKUP   flag, read buffer type from cache. (From previous call)
 816   VERB              if non-nil, verbose messages allowed.
 817
 818 Return values:
 819
 820   when optional MODE = nil
 821   Some appropriate _string_ that represents the content. notice that this
 822   string is usually generalised description, _but_ it the file has special
 823   1st line in form of -*-..-*- the string is direct mode name string.
 824
 825   when optional MODE = non-nil
 826   Return possible mode name as _symbol_
 827
 828   when VARIABLE is non-nil, the variable `ti::id-:info' is read instead.
 829   If it has non-nil value, the value is returned, otherwise full buffer
 830   is parsed again and variable's value is updated.
 831
 832 References:
 833
 834   `ti::id-func-alist'  order of evaluation.
 835   `ti::id-:info'            buffer local variable updated during every call."
 836
 837   (interactive)
 838   (let* ((funcs ti::id-:function-list)
 839          ret
 840          func
 841          doit)
 842     (ti::verb)
 843     ;; .................................................... do lookup? ...
 844     (setq ret ti::id-:info)
 845     (cond
 846      ((null variable-lookup)
 847       (setq doit t))
 848      ((and variable-lookup (null ti::id-:info)) ;no value stored
 849       (setq doit t))
 850      ((and variable-lookup              ;must same type
 851            (null mode)                  ;string request
 852            (not (stringp ti::id-:info)))
 853       (setq doit t))
 854      ((and variable-lookup              ;must same type
 855            mode                         ;symbol request
 856            (not (symbolp ti::id-:info)))
 857       (setq doit t)))
 858     ;; .................................................... do the job ...
 859     (when doit
 860       ;;  prepare globals to avoid overhead
 861       (ti::id-global-variable-set)
 862       (while (and (setq func (pop funcs))
 863                   (null (setq ret (funcall func)))))
 864       ;;  how the results should be returned ?
 865       (when ret                         ;found anything?
 866         (if mode
 867             (if (symbolp ret)           ;return symbol
 868                 ret                     ;it's real mode name
 869               (setq ret (ti::id-cnv-txt2mode ret))) ;return possible mode name
 870           (if (symbolp ret)
 871               (setq ret (symbol-name ret))))
 872         (if verb
 873             (message (prin1-to-string ret))))
 874       ;; Update the buffer local variable
 875       (setq ti::id-:info ret))
 876     ret))
 877
 878 ;;}}}
 879
 880 (provide   'tinylibid)
 881 (run-hooks 'ti::id-:load-hook)
 882
 883 ;;; tinylibid.el ends here