emacs_el/tiny-tools/tiny/tinycompile.el

   1 ;;; tinycompile.el --- Compile buffer extras. Minor mode.
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   6
   7 ;; Copyright (C)    1996-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 tinycompile-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 ;;  Put this file on your Emacs-Lisp load path, add following into your
  39 ;;  ~/.emacs startup file.
  40 ;;
  41 ;;      ;; You could also call M-x tinycompile-install / tinycompile-uninstall
  42 ;;      (add-hook tinycompile-:load-hook 'tinycompile-install)
  43 ;;      (require 'tinycompile)
  44 ;;
  45 ;;  or use this autoload; your ~/.emacs loads quicker
  46 ;;
  47 ;;       (autoload 'tinycompile-mode            "tinycompile" "" t)
  48 ;;       (autoload 'turn-on-tinycompile-mode    "tinycompile" "" t)
  49 ;;       (add-hook 'compilation-mode-hook 'turn-on-tinycompile-mode 'append)
  50 ;;
  51 ;; If you find any incorrect behavior, please immediately
  52 ;;
  53 ;;      o   Turn on debug with `M-x' `tinycompile-debug-toggle'
  54 ;;      o   Repeat the task
  55 ;;      o   Send bug report with included debug buffer contents.
  56
  57 ;;}}}
  58
  59 ;;{{{ Documentation
  60
  61 ;; ..................................................... &t-commentary ...
  62
  63 ;;; Commentary:
  64
  65 ;;  Preface, mar 1997
  66 ;;
  67 ;;      When I was doing grepping over multiple files with igrep.el the
  68 ;;      results that were inserted into buffer were too long: There were
  69 ;;      2-6 directory paths which occupied 40 characters and the actual
  70 ;;      grep hits were continued with \ character to the right. That was
  71 ;;      awfull to read. I couldn't get clear look at the grep results. I
  72 ;;      decided that there must be a way to clarify the results somehow, so
  73 ;;      I started writing this package.
  74 ;;
  75 ;;  Overview of features
  76 ;;
  77 ;;      o   Shorten long directory paths (to the right hand)
  78 ;;      o   Kill non-interesting files from the buffer
  79 ;;      o   Hide selected lines from display
  80
  81 ;;}}}
  82
  83 ;;; Change Log:
  84
  85 ;;; Code:
  86
  87 ;;{{{ setup: misc
  88
  89 ;;; ......................................................... &require ...
  90
  91 (require 'tinylibm)
  92
  93 (eval-when-compile
  94   (defvar mode-line-mode-menu)
  95   (defvar tinyurl-mode)
  96   (ti::package-use-dynamic-compilation))
  97
  98 (ti::package-defgroup-tiny TinyCompile tinycompile-: tools
  99   "Compile buffers additions.
 100   Overview of features
 101
 102         o   Shorten long directory paths (to the right hand)
 103         o   Kill non-interesting files from the buffer
 104         o   Hide selected lines from display")
 105
 106 ;;; .......................................................... &v-menu ...
 107
 108 (defcustom tinycompile-:menu-use-flag t
 109   "*Non-nil means to use echo-area menu."
 110   :type  'boolean
 111   :group 'TinyCompile)
 112
 113 (defvar tinycompile-:menu-main
 114   (list
 115    '(format
 116      "%sTinyCompile: k)ill files s)horten SPC)hide rRU)egexp RET)parse x)mode off"
 117      (if current-prefix-arg
 118          (format "%s "  (prin1-to-string current-prefix-arg)) "" ))
 119    '((?\177 . ( (tinycompile-kill-all-file-lines)))
 120      (?\b   . ( (tinycompile-kill-all-file-lines)))
 121      (?k    . ( (tinycompile-kill-all-file-lines)))
 122      (?s    . ( (tinycompile-shorten-lines)))
 123      (?\    . ( (tinycompile-show-hide-toggle)))
 124      (?r    . ( (call-interactively 'tinycompile-hide-by-regexp-whole-line)))
 125      (?R    . ( (call-interactively 'tinycompile-hide-by-regexp)))
 126      (?U    . ( (call-interactively 'tinycompile-unhide)))
 127      (?\C-m . ( (tinycompile-parse-line-goto)))
 128      (?x    . ( (turn-off-tinycompile-mode)))))
 129   "*TinyCompile echo menu.
 130
 131 k    Kill/Delete all lines that referer to current file
 132 s    If possible, shorten long path names in display
 133 SPC  Toggle hiding lines on/off
 134 r    Hide whole line matching regexp
 135 R    Hide (partial) text matching regexp
 136 U    Unhide all
 137 RET  Goto current file and line
 138 x    Turn mode off.")
 139
 140 ;;; ............................................................ &mode ...
 141
 142 ;;;###autoload (autoload 'tinycompile-version "tinycompile" "Display commentary." t)
 143 (ti::macrof-version-bug-report
 144  "tinycompile.el"
 145  "tinycompile"
 146  tinycompile-:version-id
 147  "$Id: tinycompile.el,v 2.52 2007/08/04 10:09:46 jaalto Exp $"
 148  '(tinycompile-:version-id
 149    tinycompile-:debug
 150    tinycompile-:menu-use-flag
 151    tinycompile-:menu-main
 152    tinycompile-:load-hook
 153    tinycompile-:table-hide)
 154  '(tinycompile-:debug-buffer))
 155
 156 ;;;### (autoload 'tinycompile-debug-toggle "tinycompile" "" t)
 157 ;;;### (autoload 'tinycompile-debug-show   "tinycompile" "" t)
 158
 159 (eval-and-compile (ti::macrof-debug-standard "tinycompile" "-:"))
 160
 161 ;;;###autoload (autoload 'turn-on-tinycompile-mode      "tinycompile" "" t)
 162 ;;;###autoload (autoload 'turn-off-tinycompile-mode     "tinycompile" "" t)
 163 ;;;###autoload (autoload 'tinycompile-mode              "tinycompile" "" t)
 164 ;;;###autoload (autoload 'tinycompile-commentary        "tinycompile" "" t)
 165
 166 (eval-and-compile
 167   (ti::macrof-minor-mode-wizard
 168    "tinycompile-" " Tco" "\C-c:" "Tco" 'TinyCompile "tinycompile-:" ;1-6
 169
 170    "Additional commands to Compile buffer. You can kill lines or
 171 shorten the file names and hide comments.
 172
 173 Defined keys:
 174
 175 Prefix key to access the minor mode is defined in
 176 `tinycompile-:mode-prefix-key'
 177
 178 \\{tinycompile-:mode-map}
 179 \\{tinycompile-:mode-prefix-map}"
 180
 181    "TinyCompile"
 182    (progn
 183      (if (and tinycompile-mode verb
 184               (not (string-match "compil" (symbol-name major-mode))))
 185          (message "TinyCompile: Are you sure this is compile buffer?")))
 186    "Compile buffer extras."
 187    (list
 188     tinycompile-:mode-easymenu-name
 189     ["Kill all matching file lines at point"  tinycompile-kill-all-file-lines t]
 190     ["Shorten directory names"            tinycompile-shorten-lines           t]
 191     ["Goto file at point"                 tinycompile-parse-line-goto         t]
 192     "----"
 193     ["Show or hide comments (toggle)"     tinycompile-show-hide-toggle        t]
 194     ["Hide by regexp - partial"           tinycompile-hide-by-regexp          t]
 195     ["Hide by regexp - whole line"        tinycompile-hide-by-regexp-whole-line t]
 196     ["Unhide all"                         tinycompile-unhide                  t]
 197     "----"
 198     ["Keyboard menu"                      tinycompile-menu-main               t]
 199     ["Package version"                    tinycompile-version                 t]
 200     ["Package commentary"                 tinycompile-commentary              t]
 201     ["Mode help"                          tinycompile-mode-help               t]
 202     ["Mode off"                           tinycompile-mode                    t])
 203
 204    (progn
 205      (if (ti::xemacs-p)
 206          (define-key root-map [(button2)] 'tinycompile-parse-line-goto)
 207        (define-key root-map [mouse-2]     'tinycompile-parse-line-goto))
 208      (cond
 209       (tinycompile-:menu-use-flag
 210        ;;  Using menu to remeber commands is easier if you don't use
 211        ;;  menu bar at all.
 212        (define-key root-map p 'tinycompile-menu-main))
 213       (t
 214        (define-key map  "k"      'tinycompile-kill-all-file-lines)
 215        (define-key map  "s"      'tinycompile-shorten-lines)
 216        (define-key map  " "      'tinycompile-show-hide-toggle)
 217        (define-key map  "r"      'tinycompile-hide-by-regexp-whole-line)
 218        (define-key map  "R"      'tinycompile-hide-by-regexp)
 219        (define-key map  "U"      'tinycompile-unhide)
 220        (define-key map  "x"      'turn-off-tinycompile-mode)
 221        (define-key map  "?"      'tinycompile-mode-help)
 222        (define-key map  "Hm"     'tinycompile-mode-help)
 223        (define-key map  "Hc"     'tinycompile-commentary)
 224        (define-key map  "Hv"     'tinycompile-version)
 225        ;;  Overwrite {compilation-minor-mode|grep-mode} definition
 226        (define-key root-map "\C-m" 'tinycompile-parse-line-goto))))))
 227
 228 ;;; ----------------------------------------------------------------------
 229 ;;;
 230 (defun tinycompile-menu-main (&optional arg)
 231   "Show echo area menu and pass ARG to `ti::menu-menu'."
 232   (interactive "P")
 233   (ti::menu-menu 'tinycompile-:menu-main arg))
 234
 235 ;;; ......................................................... &v-hooks ...
 236
 237 (defcustom tinycompile-:load-hook nil
 238   "*Hook that is run when package is loaded."
 239   :type 'hook
 240   :group 'TinyCompile)
 241
 242 ;;}}}
 243 ;;{{{ setup: public
 244
 245 ;;; ........................................................ &v-public ...
 246 ;;; User configurable
 247
 248 (defcustom tinycompile-:table-hide
 249   '(("^.*\\.el:"                        ;lisp
 250      "^.*:[ \t]*[;\"'].*")
 251     ("^.*\\.\\([cC][cC]?\\|[hH][hH]?\\):" ;C/C++
 252      ":[ \t]*/[/*].*"))
 253   "*List of FILENAME and HIDE regexps.
 254 If filename in the beginning of line matches elt1 then
 255 show/hide all lines matching elt2.
 256
 257 Format:
 258  '((FILENAME-REGEXP HIDE-REGEXP)
 259    (FILENAME-REGEXP HIDE-REGEXP)
 260    ...)"
 261   :type  '(repeat
 262            (string :tag "File Regexp")
 263            (string :tag "Hide Regexp"))
 264   :group 'TinyCompile)
 265
 266 ;;}}}
 267
 268 ;;{{{ code: macros
 269
 270 ;;; ----------------------------------------------------------------------
 271 ;;;
 272 (defsubst tinycompile-get-files  (&optional max-point)
 273   "Return all filenames in compile buffer, optionally until MAX-POINT."
 274   (beginning-of-line)
 275   (tinycompile-get-error-lines max-point 'car))
 276
 277 ;;}}}
 278 ;;{{{ code: support functions
 279
 280 ;;; ----------------------------------------------------------------------
 281 ;;;
 282 (defun tinycompile-install (&optional uninstall)
 283   "Install or optinally UNINSTALL package with prefix arg."
 284   (interactive "p")
 285   (cond
 286    (uninstall
 287     (if (boundp 'grep-mode-hook)
 288         (add-hook 'grep-mode-hook 'turn-on-tinycompile-mode 'append))
 289     (add-hook 'compilation-mode-hook 'turn-on-tinycompile-mode 'append))
 290    (t
 291     (if (boundp 'grep-mode-hook)
 292         (remove-hook 'grep-mode-hook 'turn-on-tinycompile-mode))
 293     (remove-hook 'compilation-mode-hook 'turn-on-tinycompile-mode))))
 294
 295 ;;; ----------------------------------------------------------------------
 296 ;;;
 297 (defun tinycompile-uninstall ()
 298   "Uninstall package."
 299   (interactive)
 300   (tinycompile-install 'remove))
 301
 302 ;;; ----------------------------------------------------------------------
 303 ;;;
 304 (defun tinycompile-cd-directory ()
 305   "Return the CD directory."
 306   ;; Emacs 22 uses line like:
 307   ;;      -*- mode: grep; default-directory: "~/elisp" -*-
 308   (save-excursion
 309     (goto-char (point-min))
 310     (or (ti::buffer-match "^-[*]- mode: grep.*\"\\([^\"]+\\)" 1)
 311         (ti::buffer-match "^cd +\\(.*\\)" 1))))
 312
 313 ;;; ----------------------------------------------------------------------
 314 ;;;
 315 (defun tinycompile-shorten-lines ()
 316   "Shorten the filenames in compile buffer.
 317
 318 Line format must be
 319   FILE:LINE: results"
 320   (interactive)
 321   (let* ( ;;  About 1000 lines, with 70 characters
 322          (treshold   (* 70 1000))
 323          (indicator  (and (> (- (point-max)
 324                                 (point-min))
 325                              treshold)
 326                           t))
 327          count
 328          prev-point
 329          dir
 330          cd
 331          path
 332          prev
 333          file)
 334     (buffer-enable-undo)
 335     (save-excursion
 336       (ti::pmin)
 337       (setq cd (tinycompile-cd-directory))
 338       (while (re-search-forward "^\\([/.][^:]+\\):" nil t)
 339         (setq path (match-string 1))
 340         (when (and indicator
 341                    ;;  count percentages only after 1000 chars.
 342                    (> (point) (+ prev-point 1000)))
 343           (setq count (/ (* 100 (point)) (point-max)))
 344           (message "Tinycompile: Wait, processing %d %%" count))
 345         ;; ./pie-mail/hypb.el --> {cd}/pie-mail/hypb.el
 346         (if (char= (aref path 0) ?.)
 347             (setq path (concat cd (substring path 2))))
 348         (when path
 349           (setq file (file-name-nondirectory path))
 350           (setq path (file-name-directory path))
 351           (ti::replace-match 1 file)
 352           (when
 353               (or (null prev)
 354                   (null dir)
 355                   (string= dir prev))
 356             (setq dir path))
 357           (unless
 358               (string= dir prev)
 359             (setq prev dir   dir path)
 360             (beginning-of-line)
 361             (insert "\ncd " dir "\n\n")))
 362         (if indicator
 363             (message "Tinycompile: Wait, processing done."))
 364         (end-of-line)))))
 365
 366 ;;; ----------------------------------------------------------------------
 367 ;;;
 368 (defun tinycompile-parse-line-goto ()
 369   "Go to line under cursor.
 370 The found file is loaded to emacs and cursor put to line. This works
 371 like `compile-goto-error'.
 372
 373 Note:
 374
 375   If TinyUrl package is present and current point holds TinyUrl overlay,
 376   then it is called to handle the line."
 377   (interactive)
 378   ;;    If TinyUrl is present, try it to resolve the line.
 379   ;;    If it marks anything, raise flag `tinyurl'
 380   (let* ((fid "tinycompile-parse-line-goto:")
 381          (elt        (ti::buffer-parse-line-main))
 382          (file       (and elt (car elt)))
 383          (absolute-p (and file (string-match "^[/\\~]" file)))
 384          tinyurl
 385          buffer
 386          win)
 387     (unless fid ;; XEmacs byte compiler silencer
 388       (setq fid nil))
 389     (when (and absolute-p
 390                (file-exists-p file)
 391                (ti::overlay-supported-p)
 392                (boundp 'tinyurl-mode)
 393                tinyurl-mode)
 394       (when (tinyurl-overlay-get)       ;line already marked
 395         (setq tinyurl t))
 396       (tinycompile-debug fid 'TinyUrl tinyurl (ti::read-current-line)))
 397     (cond
 398      (tinyurl                           ;Let this handle url first
 399       (tinyurl-dispatcher "\C-m" 'key)
 400       nil)
 401      (elt
 402       (multiple-value-bind (file line)
 403           elt
 404         (setq file (ti::file-name-for-correct-system file 'emacs))
 405         (setq buffer (or (find-buffer-visiting file)
 406                          (get-buffer file)
 407                          ;; We may have mistakenly grabbed 'cd' command and
 408                          ;; stucked it with buffers name.
 409                          ;; /users/foo/*scratch*  --> *scratch*
 410                          (get-buffer (file-name-nondirectory file))))
 411         ;;  If buffer exists and is diplayed in another frame, use it.
 412         (if buffer
 413             (setq win (get-buffer-window buffer t)))
 414         (tinycompile-debug fid "interactive" buffer 'file file)
 415         (cond
 416          ((and buffer win)
 417           (select-window win)
 418           (raise-frame (window-frame win)))
 419          (t
 420           (ti::select-frame-non-dedicated)
 421           (if (and buffer
 422                    (not (file-exists-p file)))
 423               (switch-to-buffer-other-window buffer)
 424             (switch-to-buffer-other-window
 425              (if (file-exists-p file)
 426                  (find-file-noselect file)
 427                (error "TinyCompile: file not found `%s'" file))))))
 428         (when line
 429           (goto-line line))))
 430      (t
 431       (message "TinyCompile: Can't read file/line information.")
 432       ;;  We don't know how to handle this line, Let the mode
 433       ;;  below us handle it
 434       (let (tinycompile-mode
 435             func)
 436         (setq func (lookup-key (current-local-map) "\C-m"))
 437         (message "TinyCompile: Passing control to underlying \C-m key: %s"
 438                  (symbol-name func))
 439         (when (fboundp func)
 440           (funcall func)))))))
 441
 442 ;;; ----------------------------------------------------------------------
 443 ;;;
 444 (defun tinycompile-get-error-lines  (&optional max-point list-func)
 445   "Get error lines in compile buffer from current point forward.
 446 Input:
 447
 448   MAX-POINT     max search point, defaults to `point-max'
 449   LIST-FUNC     if given apply it to extract data member.
 450                 Eg 'car, gives you only list of filenames
 451
 452 Return:
 453
 454  '((\"filename\" . NBR) ...)
 455  or whatever format LIST-FUNC says."
 456   (let* ((max-point   (or max-point (point-max)))
 457          table
 458          elt)
 459     (save-excursion
 460       (while (and (re-search-forward "^\\([^:]+\\):[0-9]+:" nil t)
 461                   (< (point) max-point))
 462         (setq elt (ti::buffer-parse-line-main))
 463         (if list-func
 464             (setq elt (funcall list-func elt)))
 465         (if (null (member elt table))
 466             (push elt table)))
 467       (nreverse table))))
 468
 469 ;;; ----------------------------------------------------------------------
 470 ;;;
 471 (defun tinycompile-kill-all-file-lines ()
 472   "Kill all lines associated with the file on the current line."
 473   (interactive)
 474   (let* ((fid  'tinycompile-kill-all-file-lines)
 475          (elt  (ti::buffer-parse-line-main))
 476          (cd   (save-excursion
 477                  (goto-char (point-min))
 478                  (when (looking-at "^cd \\(.+\\)")
 479                    (match-string 1))))
 480          file
 481          file2
 482          re
 483          point)
 484     (unless fid ;; XEmacs byte compiler silencer
 485       (setq fid nil))
 486     (if (null elt)
 487         (message "TinyCompile: Can't find file name in this line.")
 488       (beginning-of-line)
 489       (setq file  (car elt)
 490             file2 (when (and cd
 491                              (string-match
 492                               (concat (regexp-quote cd) "\\(.+\\)")
 493                               file))
 494                     (match-string 1 file))
 495             re    (format "^%s:\\|^%s:\\|^%s:\\|^%s:"
 496                           (file-name-nondirectory file)
 497                           (regexp-quote file)
 498                           (file-name-nondirectory file)
 499                           (if file2
 500                               file2
 501                             "#cannot-match-anything")))
 502       (tinycompile-debug fid 'file file 'RE re 'elt)
 503       ;;  Search previous line that is not the same as the line we want
 504       ;;  to kill
 505       (while (re-search-backward re nil t))
 506       (setq point (point))
 507       (buffer-enable-undo)
 508       (ti::pmin)
 509       (delete-matching-lines re)
 510       (if (< point (point-max))
 511           (goto-char point)))))
 512
 513 ;;; ----------------------------------------------------------------------
 514 ;;;
 515 (defun tinycompile-show-hide-toggle (&optional regexp)
 516   "Hide or show comment lines matching REGEXP.
 517 References:
 518  `tinycompile-:table-hide'"
 519   (interactive)
 520   (let* ((list tinycompile-:table-hide)
 521          search
 522          show)
 523     (save-excursion
 524       (unless regexp                    ;Find right value
 525         (setq show (y-or-n-p "Y = show, N = hide "))
 526         (dolist (elt list)
 527           (setq search (car elt))
 528           (if (ti::re-search-check search)
 529               (setq list   nil
 530                     regexp (nth 1 elt)))))
 531       (ti::pmin)
 532       (cond
 533        (show
 534         (set-text-properties (point-min) (point-max) nil)
 535         ;;  Won't update well otherwise
 536         (redraw-display))
 537        (t
 538         (if (null regexp)
 539             (message
 540              "TinyCompile: No matching regexp in tinycompile-:table-hide")
 541           (ti::text-re-search
 542            regexp nil nil nil
 543            (if show
 544                'null
 545              '(owner tinycompile  invisible t)))))))))
 546
 547 ;;; ----------------------------------------------------------------------
 548 ;;;
 549 (defun tinycompile-hide-by-regexp (regexp)
 550   "Hide lines matching REGEXP."
 551   (interactive "s[TinyCompile] Hide strings matching: ")
 552   (tinycompile-show-hide-toggle regexp))
 553
 554 ;;; ----------------------------------------------------------------------
 555 ;;;
 556 (defun tinycompile-hide-by-regexp-whole-line (regexp)
 557   "If REGEXP is found, hide whole line."
 558   (interactive "s[TinyCompile] Hide lines matching: ")
 559   (tinycompile-show-hide-toggle
 560    (format "^.*\\(%s\\).*[\r\n]+" regexp)))
 561
 562 ;;; ----------------------------------------------------------------------
 563 ;;;
 564 (defun tinycompile-unhide ()
 565   "UNhide all hidden text or lines.
 566 See `tinycompile-hide-by-regexp' and `tinycompile-hide-by-regexp-whole-line'."
 567   (interactive)
 568   (set-text-properties (point-min) (point-max) nil))
 569
 570 ;;}}}
 571
 572 ;; NOTE:  In some cases `tinycompile-mode' gets set globally
 573 ;; to value `t'. Reset this, because it would take out mouse-2.
 574 ;; Make sure that the global value is nil
 575
 576 (if (default-value 'tinycompile-mode)
 577     (setq-default tinycompile-mode nil))
 578
 579 (add-hook 'tinycompile-:mode-define-keys-hook  'tinycompile-mode-define-keys)
 580
 581 (provide   'tinycompile)
 582 (run-hooks 'tinycompile-:load-hook)
 583
 584 ;;; tinycompile.el ends here