git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/extras/perlcritic.el

   1 ;;; perlcritic.el --- minor mode for Perl::Critic integration
   2
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4 ;;;      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/extras/perlcritic.el $
   5 ;;;     $Date: 2008-03-16 17:40:45 -0500 (Sun, 16 Mar 2008) $
   6 ;;;   $Author: clonezone $
   7 ;;; $Revision: 2187 $
   8 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   9
  10
  11 ;;; Readme
  12 ;;
  13 ;; This is a minor mode for emacs intended to allow you to
  14 ;; automatically incorporate perlcritic into your daily code
  15 ;; writing. When enabled it can optionally prevent you from saving
  16 ;; code that doesn't pass your enabled perlcritic policies.
  17 ;;
  18 ;; Even if you don't enable the automatic code checking you can still
  19 ;; use the automatic checking or the `perlcritic' function.
  20
  21
  22 ;;; Installation instructions:
  23 ;;
  24 ;;   Copy perlcritic.el to your ~/.site-lib directory. If you don't
  25 ;;   have a .site-lib directory create it and add the following line
  26 ;;   to your .emacs file. This location isn't special, you could use
  27 ;;   a different location if you wished.
  28 ;;
  29 ;;     (add-to-list 'load-path "/home/your-name/.site-lisp")
  30 ;;
  31 ;;   Add the following lines to your .emacs file. This allows Emacs
  32 ;;   to load your perlcritic library only when needed.
  33 ;;
  34 ;;     (autoload 'perlcritic        "perlcritic" "" t)
  35 ;;     (autoload 'perlcritic-region "perlcritic" "" t)
  36 ;;     (autoload 'perlcritic-mode   "perlcritic" "" t)
  37 ;;
  38 ;;   Add the following to your .emacs file to get perlcritic-mode to
  39 ;;   run automatically for the `cperl-mode' and `perl-mode'.
  40 ;;
  41 ;;     (eval-after-load "cperl-mode"
  42 ;;      '(add-hook 'cperl-mode-hook 'perlcritic-mode))
  43 ;;     (eval-after-load "perl-mode"
  44 ;;      '(add-hook 'perl-mode-hook 'perlcritic-mode))
  45 ;;
  46 ;;
  47 ;;   If you think you need perlcritic loaded all the time you can
  48 ;;   make this unconditional by using the following command instead
  49 ;;   of the above autoloading.
  50 ;;
  51 ;;     (require 'perlcritic)
  52 ;;
  53 ;;   Compile the file for extra performance. This is optional. You
  54 ;;   will have to redo this everytime you modify or upgrade your
  55 ;;   perlcritic.el file.
  56 ;;
  57 ;;     M-x byte-compile-file ~/.site-lib/perlcritic.el
  58 ;;
  59 ;;   Additional customization can be found in the Perl::Critic group
  60 ;;   in the Tools section in the Programming section of your Emacs'
  61 ;;   customization menus.
  62
  63
  64 ;;;   TODO
  65 ;;
  66 ;;     Find out how to get perlcritic customization stuff into the
  67 ;;     customization menus without having to load perlcritic.el
  68 ;;     first.
  69 ;;
  70 ;;     This needs an installer. Is there anything I can use in
  71 ;;     ExtUtils::MakeMaker, Module::Build, or Module::Install?
  72 ;;     Alien::?
  73 ;;
  74 ;;     XEmacs compatibility. I use GNU Emacs and don't test in
  75 ;;     XEmacs. I'm happy to do what it takes to be compatible but
  76 ;;     someone will have to point things out to me.
  77 ;;
  78 ;;     Make all documentation strings start with a sentence that fits
  79 ;;     on one line. See "Tips for Documentation Strings" in the Emacs
  80 ;;     Lisp manual.
  81 ;;
  82 ;;     Any FIXME, TODO, or XXX tags below.
  83
  84
  85 ;;; Change Log:
  86 ;; 0.10
  87 ;;   * Synched up regexp alist with Perl::Critic::Utils and accounted for all
  88 ;;     past patterns too.
  89 ;; 0.09
  90 ;;   * Added documentation for perlcritic-top, perlcritic-include,
  91 ;;     perlcritic-exclude, perlcritic-force, perlcritic-verbose.
  92 ;;   * Added emacs/vim editor hints to the bottom.
  93 ;;   * Corrected indentation.
  94 ;; 0.08
  95 ;;   * Fixed perlcritic-compilation-error-regexp-alist for all
  96 ;;     severity levels.
  97 ;;   * Added documentation strings for functions.
  98 ;; 0.07
  99 ;;   * Moved perlcritic-compilation-error-regexp-alist so it is in the
 100 ;;     source before it's used. This only seems to matter when
 101 ;;     perlcritic.el is compiled to bytecode.
 102 ;;   * Added perlcritic-exclude, perlcritic-include
 103
 104 ;; 0.06
 105 ;;   * Code cleanliness.
 106 ;;   * Comment cleanliness.
 107 ;;   * Nice error message when perlcritic warns.
 108 ;;   * Documented perlcritic-top, perlcritic-verbose.
 109 ;;   * Regular expressions for the other standard -verbose levels.
 110 ;;   * Reversed Changes list so the most recent is first.
 111 ;;   * Standard emacs library declarations.
 112 ;;   * Added autoloading metadata.
 113 ;; 0.05
 114 ;;   * perlcritic-bin invocation now shown in output.
 115 ;;   * Fixed indentation.
 116 ;;   * perlcritic-region is now interactive.
 117 ;; 0.04
 118 ;;   * Removed a roque file-level (setq perlcritic-top 1)
 119 ;;   * Moved cl library to compile-time.
 120 ;; 0.03
 121 ;;   * compile.el integration. This makes for hotlink happiness.
 122 ;;   * Better sanity when starting the *perlcritic* buffer.
 123 ;; 0.02
 124 ;;   * perlcritic-severity-level added.
 125 ;;   * Touched up the installation documentation.
 126 ;;   * perlcritic-pass-required is now buffer local.
 127 ;; 0.01
 128 ;;   * It's new. I copied much of this from perl-lint-mode.
 129
 130 ;;; Copyright and license
 131 ;;
 132 ;;   2006 Joshua ben Jore <jjore@cpan.org>
 133 ;;
 134 ;;   This program is free software; you can redistribute it and/or
 135 ;;   modify it under the same terms as Perl itself
 136
 137
 138
 139 \f
 140 ;;; Code:
 141
 142 ;;; Customization and variables.
 143 (defgroup perlcritic nil "Perl::Critic"
 144   :prefix "perlcritic-"
 145   :group 'tools)
 146
 147 (defcustom perlcritic-bin "perlcritic"
 148   "The perlcritic program used by `perlcritic'."
 149   :type 'string
 150   :group 'perlcritic)
 151
 152 (defcustom perlcritic-pass-required nil
 153   "When \\[perlcritic-mode] is enabled then this boolean controls
 154 whether your file can be saved when there are perlcritic warnings.
 155
 156 This variable is automatically buffer-local and may be overridden on a
 157 per-file basis with File Variables."
 158   :type '(radio
 159           (const :tag "Require no warnings from perlcritic to save" t)
 160           (const :tag "Allow warnings from perlcritic when saving" nil))
 161   :group 'perlcritic)
 162 (make-variable-buffer-local 'perlcritic-pass-required)
 163
 164 (defcustom perlcritic-profile nil
 165   "Specify an alternate .perlcriticrc file. This is only used if
 166 non-nil."
 167   :type '(string)
 168   :group 'perlcritic)
 169 (make-variable-buffer-local 'perlcritic-profile)
 170
 171 (defcustom perlcritic-noprofile nil
 172   "Disables the use of any .perlcriticrc file."
 173   :type '(boolean)
 174   :group 'perlcritic)
 175 (make-variable-buffer-local 'perlcritic-noprofile)
 176
 177 (defcustom perlcritic-severity nil
 178   "Directs perlcritic to only report violations of Policies with a
 179 severity greater than N. Severity values are integers ranging from
 180 1 (least severe) to 5 (most severe). The default is 5. For a given
 181 -profile, decreasing the -severity will usually produce more
 182 violations.  Users can redefine the severity for any Policy in their
 183 .perlcriticrc file.
 184
 185 This variable is automatically buffer-local and may be overridden on a
 186 per-file basis with File Variables."
 187   ;; FIXME: My GNU Emacs doesn't show a radio widget or a menu here.
 188   :type '(radio
 189           (const :tag "Show only the most severe: 5" 5)
 190           (const :tag "4" 4)
 191           (const :tag "3" 3)
 192           (const :tag "2" 2)
 193           (const :tag "Show everything including the least severe: 1" 1))
 194   :group 'perlcritic)
 195 (make-variable-buffer-local 'perlcritic-severity)
 196
 197 (defcustom perlcritic-top nil
 198   "Directs \"perlcritic\" to report only the top N Policy violations in
 199 each file, ranked by their severity. If the -severity option is not
 200 explicitly given, the -top option implies that the minimum severity
 201 level is 1. Users can redefine the severity for any Policy in their
 202 .perlcriticrc file.
 203
 204 This variable is automatically buffer-local and may be overridden on a
 205 per-file basis with File Variables."
 206   :type '(integer)
 207   :group 'perlcritic)
 208 (make-variable-buffer-local 'perlcritic-top)
 209
 210 (defcustom perlcritic-include nil
 211   "Directs \"perlcritic\" to apply additional Policies that match the regex \"/PATTERN/imx\".
 212 Use this option to override your profile and/or the severity settings.
 213
 214 For example:
 215
 216   layout
 217
 218 This would cause \"perlcritic\" to apply all the \"CodeLayout::*\" policies
 219 even if they have a severity level that is less than the default level of 5,
 220 or have been disabled in your .perlcriticrc file.  You can specify multiple
 221 `perlcritic-include' options and you can use it in conjunction with the
 222 `perlcritic-exclude' option.  Note that `perlcritic-exclude' takes precedence
 223 over `perlcritic-include' when a Policy matches both patterns.  You can set
 224 the default value for this option in your .perlcriticrc file."
 225   :type '(string)
 226   :group 'perlcritic)
 227 (make-variable-buffer-local 'perlcritic-include)
 228
 229 (defcustom perlcritic-exclude nil
 230   "Directs \"perlcritic\" to not apply any Policy that matches the regex
 231 \"/PATTERN/imx\".  Use this option to temporarily override your profile and/or
 232 the severity settings at the command-line.  For example:
 233
 234   strict
 235
 236 This would cause \"perlcritic\" to not apply the \"RequireUseStrict\" and
 237 \"ProhibitNoStrict\" Policies even though they have the highest severity
 238 level.  You can specify multiple `perlcritic-exclude' options and you can use
 239 it in conjunction with the `perlcritic-include' option.  Note that
 240 `perlcritic-exclude' takes precedence over `perlcritic-include' when a Policy
 241 matches both patterns.  You can set the default value for this option in your
 242 .perlcriticrc file."
 243   :type '(string)
 244   :group 'perlcritic)
 245 (make-variable-buffer-local 'perlcritic-exclude)
 246
 247
 248 (defcustom perlcritic-force nil
 249   "Directs \"perlcritic\" to ignore the magical \"## no critic\"
 250 pseudo-pragmas in the source code. You can set the default value for this
 251 option in your .perlcriticrc file."
 252   :type '(boolean)
 253   :group 'perlcritic)
 254 (make-variable-buffer-local 'perlcritic-force)
 255
 256 (defcustom perlcritic-verbose nil
 257   "Sets the numeric verbosity level or format for reporting violations. If
 258 given a number (\"N\"), \"perlcritic\" reports violations using one of the
 259 predefined formats described below. If the `perlcritic-verbose' option is not
 260 specified, it defaults to either 4 or 5, depending on whether multiple files
 261 were given as arguments to \"perlcritic\".  You can set the default value for
 262 this option in your .perlcriticrc file.
 263
 264 Verbosity     Format Specification
 265 -----------   -------------------------------------------------------------
 266  1            \"%f:%l:%c:%m\n\",
 267  2            \"%f: (%l:%c) %m\n\",
 268  3            \"%m at %f line %l\n\",
 269  4            \"%m at line %l, column %c.  %e.  (Severity: %s)\n\",
 270  5            \"%f: %m at line %l, column %c.  %e.  (Severity: %s)\n\",
 271  6            \"%m at line %l, near ’%r’.  (Severity: %s)\n\",
 272  7            \"%f: %m at line %l near ’%r’.  (Severity: %s)\n\",
 273  8            \"[%p] %m at line %l, column %c.  (Severity: %s)\n\",
 274  9            \"[%p] %m at line %l, near ’%r’.  (Severity: %s)\n\",
 275 10            \"%m at line %l, column %c.\n  %p (Severity: %s)\n%d\n\",
 276 11            \"%m at line %l, near ’%r’.\n  %p (Severity: %s)\n%d\n\"
 277
 278 Formats are a combination of literal and escape characters similar to the way
 279 \"sprintf\" works.  See String::Format for a full explanation of the
 280 formatting capabilities.  Valid escape characters are:
 281
 282 Escape    Meaning
 283 -------   ----------------------------------------------------------------
 284 %c        Column number where the violation occurred
 285 %d        Full diagnostic discussion of the violation
 286 %e        Explanation of violation or page numbers in PBP
 287 %F        Just the name of the file where the violation occurred.
 288 %f        Path to the file where the violation occurred.
 289 %l        Line number where the violation occurred
 290 %m        Brief description of the violation
 291 %P        Full name of the Policy module that created the violation
 292 %p        Name of the Policy without the Perl::Critic::Policy:: prefix
 293 %r        The string of source code that caused the violation
 294 %s        The severity level of the violation
 295
 296 The purpose of these formats is to provide some compatibility with text
 297 editors that have an interface for parsing certain kinds of input.
 298
 299
 300 This variable is automatically buffer-local and may be overridden on a
 301 per-file basis with File Variables."
 302   :type '(integer)
 303   :group 'perlcritic)
 304 (make-variable-buffer-local 'perlcritic-verbose)
 305
 306 ;; TODO: Enable strings in perlcritic-verbose.
 307 ;; (defcustom perlcritic-verbose-regexp nil
 308 ;;   "An optional  regexp to match the warning output.
 309 ;;
 310 ;; This is used when `perlcritic-verbose' has a regexp instead of one of
 311 ;; the standard verbose levels.")
 312 ;; (make-local-variable 'perlcritic-verbose-regexp)
 313
 314
 315 ;; compile.el requires that something be the "filename." I've tagged
 316 ;; the severity with that. It happens to make it get highlighted in
 317 ;; red. The following advice on COMPILATION-FIND-FILE makes sure that
 318 ;; the "filename" is getting ignored when perlcritic is using it.
 319
 320 ;; These patterns are defined in Perl::Critic::Utils
 321
 322 (defvar perlcritic-compilation-error-regexp-alist
 323   '(;; Verbose level 1
 324     ;;  "%f:%l:%c:%m\n"
 325     ("^\\([^\n]+\\):\\([0-9]+\\):\\([0-9]+\\)" 1 2 3)
 326
 327     ;; Verbose level 2
 328     ;;  "%f: (%l:%c) %m\n"
 329     ("^\\([^\n]+\\): (\\([0-9]+\\):\\([0-9]+\\))" 1 2 3)
 330
 331     ;; Verbose level 3
 332     ;;   "%m at %f line %l\n"
 333     ("^[^\n]+ at \\([^\n]+\\) line \\([0-9]+\\)" 1 2)
 334     ;;   "%m at line %l, column %c.  %e.  (Severity: %s)\n"
 335     ("^[^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)." 1 2 3)
 336
 337     ;; Verbose level 4
 338     ;;   "%m at line %l, column %c.  %e.  (Severity: %s)\n"
 339     ("^[^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)." 1 2 3)
 340     ;;   "%f: %m at line %l, column %c.  %e.  (Severity: %s)\n"
 341     ("^\\([^\n]+\\): [^\n]+ at line \\([0-9]+\\), column \\([0-9]+\\)" 1 2 3)
 342
 343     ;; Verbose level 5
 344     ;;    "%m at line %l, near '%r'.  (Severity: %s)\n"
 345     ("^[^\n]+ at line\\( \\)\\([0-9]+\\)," 1 2)
 346     ;;    "%f: %m at line %l, column %c.  %e.  (Severity: %s)\n"
 347     ("^\\([^\n]+\\): [^\n]+ at line \\([0-9]+\\), column \\([0-9]+\\)" 1 2 3)
 348
 349     ;; Verbose level 6
 350     ;;    "%m at line %l, near '%r'.  (Severity: %s)\\n"
 351     ("^[^\n]+ at line\\( \\)\\([0-9]+\\)" 1 2)
 352     ;;    "%f: %m at line %l near '%r'.  (Severity: %s)\n"
 353     ("^\\([^\n]+\\): [^\n]+ at line \\([0-9]+\\)" 1 2)
 354
 355     ;; Verbose level 7
 356     ;;    "%f: %m at line %l near '%r'.  (Severity: %s)\n"
 357     ("^\\([^\n]+\\): [^\n]+ at line \\([0-9]+\\)" 1 2)
 358     ;;    "[%p] %m at line %l, column %c.  (Severity: %s)\n"
 359     ("^\\[[^\n]+\\] [^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)" 1 2 3)
 360
 361     ;; Verbose level 8
 362     ;;    "[%p] %m at line %l, column %c.  (Severity: %s)\n"
 363     ("^\\[[^\n]+\\] [^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)" 1 2 3)
 364     ;;    "[%p] %m at line %l, near '%r'.  (Severity: %s)\n"
 365     ("^\\[[^\n]+\\] [^\n]+ at line\\( \\)\\([0-9]+\\)" 1 2)
 366
 367     ;; Verbose level 9
 368     ;;    "%m at line %l, column %c.\n  %p (Severity: %s)\n%d\n"
 369     ("^[^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)" 1 2 3)
 370     ;;    "[%p] %m at line %l, near '%r'.  (Severity: %s)\n"
 371     ("^\\[[^\n]+\\] [^\n]+ at line\\( \\)\\([0-9]+\\)" 1 2)
 372
 373     ;; Verbose level 10
 374     ;;    "%m at line %l, near '%r'.\n  %p (Severity: %s)\n%d\n"
 375     ("^[^\n]+ at line\\( \\)\\([0-9]+\\)" 1 2)
 376     ;;    "%m at line %l, column %c.\n  %p (Severity: %s)\n%d\n"
 377     ("^[^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)" 1 2 3)
 378
 379     ;; Verbose level 11
 380     ;;    "%m at line %l, near '%r'.\n  %p (Severity: %s)\n%d\n"
 381     ("^[^\n]+ at line\\( \\)\\([0-9]+\\)" 1 2)
 382     )
 383   "Alist that specified how to match errors in perlcritic output.")
 384
 385
 386 \f
 387 ;; The Emacs Lisp manual says to do this with the cl library.
 388 (eval-when-compile (require 'cl))
 389
 390 ;;;###autoload
 391 (defun perlcritic ()
 392   "\\[perlcritic]] returns a either nil or t depending on whether the
 393 current buffer passes perlcritic's check. If there are any warnings
 394 those are displayed in a separate buffer."
 395   (interactive)
 396   (save-restriction
 397     (widen)
 398     (perlcritic-region (point-min) (point-max))))
 399
 400 ;;;###autoload
 401 (defun perlcritic-region (start end)
 402   "\\[perlcritic-region] returns a either nil or t depending on
 403 whether the region passes perlcritic's check. If there are any
 404 warnings those are displayed in a separate buffer."
 405
 406   (interactive "r")
 407
 408   ;; Kill the perlcritic buffer so I can make a new one.
 409   (if (get-buffer "*perlcritic*")
 410       (kill-buffer "*perlcritic*"))
 411
 412   ;; In the following lines I'll be switching between buffers
 413   ;; freely. This upper save-excursion will keep things sane.
 414   (save-excursion
 415     (let ((src-buf (current-buffer))
 416           (err-buf (get-buffer-create "*perlcritic*")))
 417
 418       (set-buffer src-buf)
 419       (let ((perlcritic-args (loop for p in (list
 420                                              ;; Add new bin/perlcritic
 421                                              ;; parameters here!
 422                                              (perlcritic--param-profile)
 423                                              (perlcritic--param-noprofile)
 424                                              (perlcritic--param-severity)
 425                                              (perlcritic--param-top)
 426                                              (perlcritic--param-include)
 427                                              (perlcritic--param-exclude)
 428                                              (perlcritic--param-force)
 429                                              (perlcritic--param-verbose))
 430                                    unless (null p)
 431                                    append p)))
 432                                         ;
 433         (message "Perl critic...running")
 434         ;; Seriously. Is this the nicest way to call
 435         ;; CALL-PROCESS-REGION with variadic arguments? This blows!
 436         ;; (apply FUNCTION (append STATIC-PART DYNAMIC-PART))
 437         (let ((rc (apply 'call-process-region
 438                          (nconc (list start end
 439                                       perlcritic-bin nil
 440                                       (list err-buf t)
 441                                       nil)
 442                                 perlcritic-args))))
 443
 444           ;; Figure out whether we're ok or not. perlcritic has to
 445           ;; return zero and the output buffer has to be empty except
 446           ;; for that "... source OK" line. Different versions of the
 447           ;; perlcritic script will print different things when
 448           ;; they're ok. I expect to see things like "some-file source
 449           ;; OK", "SCALAR=(0x123457) source OK", "STDIN source OK",
 450           ;; and "source OK".
 451           (let ((perlcritic-ok (and (numberp rc)
 452                                     (zerop rc)
 453                                     (progn
 454                                       (set-buffer err-buf)
 455                                       (goto-char (point-min))
 456                                       (delete-matching-lines "source OK$")
 457                                       (zerop (buffer-size))))))
 458             ;; Either clean up or finish setting up my output.
 459             (if perlcritic-ok
 460                 ;; Ok!
 461                 (progn
 462                   (kill-buffer err-buf)
 463                   (message "Perl critic...ok"))
 464
 465
 466               ;; Not ok!
 467               (message "Perl critic...not ok")
 468
 469               ;; Set up the output buffer now I know it'll be used.  I
 470               ;; scooped the guts out of compile-internal. It is
 471               ;; CRITICAL that the errors start at least two lines
 472               ;; from the top. compile.el normally assumes the first
 473               ;; line is an informational `cd somedirectory' command
 474               ;; and the second line shows the program's invocation.
 475               ;;
 476               ;; Since I have the space available I've put the
 477               ;; program's invocation here. Maybe it'd make sense to
 478               ;; put the buffer's directory here somewhere too.
 479               (set-buffer err-buf)
 480               (goto-char (point-min))
 481               (insert (reduce (lambda (a b) (concat a " " b))
 482                               (nconc (list perlcritic-bin)
 483                                      perlcritic-args))
 484                       "\n"
 485                       ;; TODO: instead of a blank line, print the
 486                       ;; buffer's directory+file.
 487                       "\n")
 488               (goto-char (point-min))
 489               ;; TODO: get `recompile' to work.
 490
 491               ;; just an fyi. compilation-mode will delete my local
 492               ;; variables so be sure to call it *first*.
 493               (compilation-mode "perlcritic")
 494               (set (make-local-variable 'perlcritic-buffer) src-buf)
 495               (set (make-local-variable 'compilation-error-regexp-alist)
 496                    perlcritic-compilation-error-regexp-alist)
 497               (ad-activate #'compilation-find-file)
 498                                         ; (ad-deactivate #'compilation-find-file)
 499               (display-buffer err-buf))
 500
 501             ;; Return our success or failure.
 502             perlcritic-ok))))))
 503
 504
 505
 506 \f
 507 ;;; Parameters for use by perlcritic-region.
 508 (defun perlcritic--param-profile ()
 509   "A private method that supplies the -profile FILENAME parameter for
 510 \\[perlcritic-region]"
 511   (if perlcritic-profile (list "-profile" perlcritic-profile)))
 512
 513 (defun perlcritic--param-noprofile ()
 514   "A private method that supplies the -noprofile parameter for
 515 \\[perlcritic-region]"
 516   (if perlcritic-noprofile (list "-noprofile")))
 517
 518 (defun perlcritic--param-force ()
 519   "A private method that supplies the -force parameter for
 520 \\[perlcritic-region]"
 521   (if perlcritic-force (list "-force")))
 522
 523 (defun perlcritic--param-severity ()
 524   "A private method that supplies the -severity NUMBER parameter for
 525 \\[perlcritic-region]"
 526   (cond ((stringp perlcritic-severity)
 527          (list "-severity" perlcritic-severity))
 528         ((numberp perlcritic-severity)
 529          (list "-severity" (number-to-string perlcritic-severity)))
 530         (t nil)))
 531
 532 (defun perlcritic--param-top ()
 533   "A private method that supplies the -top NUMBER parameter for
 534 \\[perlcritic-region]"
 535   (cond ((stringp perlcritic-top)
 536          (list "-top" perlcritic-top))
 537         ((numberp perlcritic-top)
 538          (list "-top" (number-to-string perlcritic-top)))
 539         (t nil)))
 540
 541 (defun perlcritic--param-include ()
 542   "A private method that supplies the -include REGEXP parameter for
 543 \\[perlcritic-region]"
 544   (if perlcritic-include
 545       (list "-include" perlcritic-include)
 546     nil))
 547
 548 (defun perlcritic--param-exclude ()
 549   "A private method that supplies the -exclude REGEXP parameter for
 550 \\[perlcritic-region]"
 551   (if perlcritic-exclude
 552       (list "-exclude" perlcritic-exclude)
 553     nil))
 554
 555 (defun perlcritic--param-verbose ()
 556   "A private method that supplies the -verbose NUMBER parameter for
 557 \\[perlcritic-region]"
 558   (cond ((stringp perlcritic-verbose)
 559          (list "-verbose" perlcritic-verbose))
 560         ((numberp perlcritic-verbose)
 561          (list "-verbose" (number-to-string perlcritic-verbose)))
 562         (t nil)))
 563
 564
 565 ;; Interactive functions for use by the user to modify parameters on
 566 ;; an adhoc basis. I'm sure there's room for significant niceness
 567 ;; here. Suggest something. Please.
 568 (defun perlcritic-profile (profile)
 569   "Sets perlcritic's -profile FILENAME parameter."
 570   (interactive "sperlcritic -profile: ")
 571   (setq perlcritic-profile (if (string= profile "") nil profile)))
 572
 573 (defun perlcritic-noprofile (noprofile)
 574   "Toggles perlcritic's -noprofile parameter."
 575   (interactive (list (yes-or-no-p "Enable perlcritic -noprofile? ")))
 576   (setq perlcritic-noprofile noprofile))
 577
 578 (defun perlcritic-force (force)
 579   "Toggles perlcritic's -force parameter."
 580   (interactive (list (yes-or-no-p "Enable perlcritic -force? ")))
 581   (setq perlcritic-force force))
 582
 583 (defun perlcritic-severity (severity)
 584   "Sets perlcritic's -severity NUMBER parameter."
 585   (interactive "nperlcritic -severity: ")
 586   (setq perlcritic-severity severity))
 587
 588 (defun perlcritic-top (top)
 589   "Sets perlcritic's -top NUMBER parameter."
 590   (interactive "nperlcritic -top: ")
 591   (setq perlcritic-top top))
 592
 593 (defun perlcritic-include (include)
 594   "Sets perlcritic's -include REGEXP parameter."
 595   (interactive "sperlcritic -include: ")
 596   (setq perlcritic-include include))
 597
 598 (defun perlcritic-exclude (exclude)
 599   "Sets perlcritic's -exclude REGEXP parameter."
 600   (interactive "sperlcritic -exclude: ")
 601   (setq perlcritic-exclude exclude))
 602
 603 (defun perlcritic-verbose (verbose)
 604   "Sets perlcritic's -verbose NUMBER parameter."
 605   (interactive "nperlcritic -verbose: ")
 606   (setq perlcritic-verbose verbose))
 607
 608
 609
 610
 611 \f
 612 ;; Hooks compile.el's compilation-find-file to enable our file-less
 613 ;; operation. We feed `perlcritic-bin' from STDIN, not from a file.
 614 (defadvice compilation-find-file (around perlcritic-find-file)
 615   "Lets perlcritic lookup into the buffer we just came from and don't
 616 require that the perl document exist in a file anywhere."
 617   (let ((debug-buffer (marker-buffer marker)))
 618     (if (local-variable-p 'perlcritic-buffer debug-buffer)
 619         (setq ad-return-value perlcritic-buffer)
 620       ad-do-it)))
 621
 622
 623
 624
 625
 626 ;; All the scaffolding of having a minor mode.
 627 (defvar perlcritic-mode nil
 628   "Toggle `perlcritic-mode'")
 629 (make-variable-buffer-local 'perlcritic-mode)
 630
 631 (defun perlcritic-write-hook ()
 632   "Check perlcritic during `write-file-hooks' for `perlcritic-mode'"
 633   (if perlcritic-mode
 634       (save-excursion
 635         (widen)
 636         (mark-whole-buffer)
 637         (let ((perlcritic-ok (perlcritic)))
 638           (if perlcritic-pass-required
 639               ;; Impede saving if we're not ok.
 640               (not perlcritic-ok)
 641             ;; Don't impede saving. We might not be ok but that
 642             ;; doesn't matter now.
 643             nil)))
 644     ;; Don't impede saving. We're not in perlcritic-mode.
 645     nil))
 646
 647 ;;;###autoload
 648 (defun perlcritic-mode (&optional arg)
 649   "Perl::Critic checking minor mode."
 650   (interactive "P")
 651
 652   ;; Enable/disable perlcritic-mode
 653   (setq perlcritic-mode (if (null arg)
 654                             ;; Nothing! Just toggle it.
 655                             (not perlcritic-mode)
 656                           ;; Set it.
 657                           (> (prefix-numeric-value arg) 0)))
 658
 659   (make-local-hook 'write-file-hooks)
 660   (if perlcritic-mode
 661       (add-hook 'write-file-hooks 'perlcritic-write-hook)
 662     (remove-hook 'write-file-hooks 'perlcritic-write-hook)))
 663
 664 ;; Make a nice name for perl critic mode. This string will appear at
 665 ;; the bottom of the screen.
 666 (if (not (assq 'perlcritic-mode minor-mode-alist))
 667     (setq minor-mode-alist
 668           (cons '(perlcritic-mode " Critic")
 669                 minor-mode-alist)))
 670
 671 (provide 'perlcritic)
 672
 673 ;; Local Variables:
 674 ;; mode: emacs-lisp
 675 ;; tab-width: 8
 676 ;; fill-column: 78
 677 ;; indent-tabs-mode: nil
 678 ;; End:
 679 ;; ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
 680
 681 ;;; perlcritic.el ends here