From 749ae5975871961494f0f7fe152c6aefddc76f0f Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Thu, 11 May 2023 18:23:07 +0200 Subject: [PATCH] add perlcritic perltidy Signed-off-by: Andreas Gerler --- lisp/perlcritic.el | 678 +++++++++++++++++++++++++++++++++++++++++++++ lisp/perltidy.el | 249 +++++++++++++++++ 2 files changed, 927 insertions(+) create mode 100644 lisp/perlcritic.el create mode 100644 lisp/perltidy.el diff --git a/lisp/perlcritic.el b/lisp/perlcritic.el new file mode 100644 index 00000000..f2c0a047 --- /dev/null +++ b/lisp/perlcritic.el @@ -0,0 +1,678 @@ +;;; perlcritic.el --- minor mode for Perl::Critic integration + +;;; Readme +;; +;; This is a minor mode for emacs intended to allow you to +;; automatically incorporate perlcritic into your daily code +;; writing. When enabled it can optionally prevent you from saving +;; code that doesn't pass your enabled perlcritic policies. +;; +;; Even if you don't enable the automatic code checking you can still +;; use the automatic checking or the `perlcritic' function. + + +;;; Installation instructions: +;; +;; Copy perlcritic.el to your ~/.site-lib directory. If you don't +;; have a .site-lib directory create it and add the following line +;; to your .emacs file. This location isn't special, you could use +;; a different location if you wished. +;; +;; (add-to-list 'load-path "/home/your-name/.site-lisp") +;; +;; Add the following lines to your .emacs file. This allows Emacs +;; to load your perlcritic library only when needed. +;; +;; (autoload 'perlcritic "perlcritic" "" t) +;; (autoload 'perlcritic-region "perlcritic" "" t) +;; (autoload 'perlcritic-mode "perlcritic" "" t) +;; +;; Add the following to your .emacs file to get perlcritic-mode to +;; run automatically for the `cperl-mode' and `perl-mode'. +;; +;; (eval-after-load "cperl-mode" +;; '(add-hook 'cperl-mode-hook 'perlcritic-mode)) +;; (eval-after-load "perl-mode" +;; '(add-hook 'perl-mode-hook 'perlcritic-mode)) +;; +;; +;; If you think you need perlcritic loaded all the time you can +;; make this unconditional by using the following command instead +;; of the above autoloading. +;; +;; (require 'perlcritic) +;; +;; Compile the file for extra performance. This is optional. You +;; will have to redo this everytime you modify or upgrade your +;; perlcritic.el file. +;; +;; M-x byte-compile-file ~/.site-lib/perlcritic.el +;; +;; Additional customization can be found in the Perl::Critic group +;; in the Tools section in the Programming section of your Emacs' +;; customization menus. + + +;;; TODO +;; +;; Find out how to get perlcritic customization stuff into the +;; customization menus without having to load perlcritic.el +;; first. +;; +;; This needs an installer. Is there anything I can use in +;; ExtUtils::MakeMaker, Module::Build, or Module::Install? +;; Alien::? +;; +;; XEmacs compatibility. I use GNU Emacs and don't test in +;; XEmacs. I'm happy to do what it takes to be compatible but +;; someone will have to point things out to me. +;; +;; Make all documentation strings start with a sentence that fits +;; on one line. See "Tips for Documentation Strings" in the Emacs +;; Lisp manual. +;; +;; Any FIXME, TODO, or XXX tags below. + + +;;; Change Log: +;; 0.10 +;; * Synched up regexp alist with Perl::Critic::Utils and accounted for all +;; past patterns too. +;; 0.09 +;; * Added documentation for perlcritic-top, perlcritic-include, +;; perlcritic-exclude, perlcritic-force, perlcritic-verbose. +;; * Added emacs/vim editor hints to the bottom. +;; * Corrected indentation. +;; 0.08 +;; * Fixed perlcritic-compilation-error-regexp-alist for all +;; severity levels. +;; * Added documentation strings for functions. +;; 0.07 +;; * Moved perlcritic-compilation-error-regexp-alist so it is in the +;; source before it's used. This only seems to matter when +;; perlcritic.el is compiled to bytecode. +;; * Added perlcritic-exclude, perlcritic-include + +;; 0.06 +;; * Code cleanliness. +;; * Comment cleanliness. +;; * Nice error message when perlcritic warns. +;; * Documented perlcritic-top, perlcritic-verbose. +;; * Regular expressions for the other standard -verbose levels. +;; * Reversed Changes list so the most recent is first. +;; * Standard emacs library declarations. +;; * Added autoloading metadata. +;; 0.05 +;; * perlcritic-bin invocation now shown in output. +;; * Fixed indentation. +;; * perlcritic-region is now interactive. +;; 0.04 +;; * Removed a roque file-level (setq perlcritic-top 1) +;; * Moved cl library to compile-time. +;; 0.03 +;; * compile.el integration. This makes for hotlink happiness. +;; * Better sanity when starting the *perlcritic* buffer. +;; 0.02 +;; * perlcritic-severity-level added. +;; * Touched up the installation documentation. +;; * perlcritic-pass-required is now buffer local. +;; 0.01 +;; * It's new. I copied much of this from perl-lint-mode. + +;;; Copyright and license +;; +;; 2006 Joshua ben Jore +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the same terms as Perl itself + + + + +;;; Code: + +;;; Customization and variables. +(defgroup perlcritic nil "Perl::Critic" + :prefix "perlcritic-" + :group 'tools) + +(defcustom perlcritic-bin "perlcritic" + "The perlcritic program used by `perlcritic'." + :type 'string + :group 'perlcritic) + +(defcustom perlcritic-pass-required nil + "When \\[perlcritic-mode] is enabled then this boolean controls +whether your file can be saved when there are perlcritic warnings. + +This variable is automatically buffer-local and may be overridden on a +per-file basis with File Variables." + :type '(radio + (const :tag "Require no warnings from perlcritic to save" t) + (const :tag "Allow warnings from perlcritic when saving" nil)) + :group 'perlcritic) +(make-variable-buffer-local 'perlcritic-pass-required) + +(defcustom perlcritic-profile nil + "Specify an alternate .perlcriticrc file. This is only used if +non-nil." + :type '(string) + :group 'perlcritic) +(make-variable-buffer-local 'perlcritic-profile) + +(defcustom perlcritic-noprofile nil + "Disables the use of any .perlcriticrc file." + :type '(boolean) + :group 'perlcritic) +(make-variable-buffer-local 'perlcritic-noprofile) + +(defcustom perlcritic-severity nil + "Directs perlcritic to only report violations of Policies with a +severity greater than N. Severity values are integers ranging from +1 (least severe) to 5 (most severe). The default is 5. For a given +-profile, decreasing the -severity will usually produce more +violations. Users can redefine the severity for any Policy in their +.perlcriticrc file. + +This variable is automatically buffer-local and may be overridden on a +per-file basis with File Variables." + :type '(radio + (const :tag "Show only the most severe: 5" 5) + (const :tag "4" 4) + (const :tag "3" 3) + (const :tag "2" 2) + (const :tag "Show everything including the least severe: 1" 1) + (const :tag "Default from .perlcriticrc" nil)) + :group 'perlcritic) +(make-variable-buffer-local 'perlcritic-severity) + +(defcustom perlcritic-top nil + "Directs \"perlcritic\" to report only the top N Policy violations in +each file, ranked by their severity. If the -severity option is not +explicitly given, the -top option implies that the minimum severity +level is 1. Users can redefine the severity for any Policy in their +.perlcriticrc file. + +This variable is automatically buffer-local and may be overridden on a +per-file basis with File Variables." + :type '(integer) + :group 'perlcritic) +(make-variable-buffer-local 'perlcritic-top) + +(defcustom perlcritic-include nil + "Directs \"perlcritic\" to apply additional Policies that match the regex \"/PATTERN/imx\". +Use this option to override your profile and/or the severity settings. + +For example: + + layout + +This would cause \"perlcritic\" to apply all the \"CodeLayout::*\" policies +even if they have a severity level that is less than the default level of 5, +or have been disabled in your .perlcriticrc file. You can specify multiple +`perlcritic-include' options and you can use it in conjunction with the +`perlcritic-exclude' option. Note that `perlcritic-exclude' takes precedence +over `perlcritic-include' when a Policy matches both patterns. You can set +the default value for this option in your .perlcriticrc file." + :type '(string) + :group 'perlcritic) +(make-variable-buffer-local 'perlcritic-include) + +(defcustom perlcritic-exclude nil + "Directs \"perlcritic\" to not apply any Policy that matches the regex +\"/PATTERN/imx\". Use this option to temporarily override your profile and/or +the severity settings at the command-line. For example: + + strict + +This would cause \"perlcritic\" to not apply the \"RequireUseStrict\" and +\"ProhibitNoStrict\" Policies even though they have the highest severity +level. You can specify multiple `perlcritic-exclude' options and you can use +it in conjunction with the `perlcritic-include' option. Note that +`perlcritic-exclude' takes precedence over `perlcritic-include' when a Policy +matches both patterns. You can set the default value for this option in your +.perlcriticrc file." + :type '(string) + :group 'perlcritic) +(make-variable-buffer-local 'perlcritic-exclude) + + +(defcustom perlcritic-force nil + "Directs \"perlcritic\" to ignore the magical \"## no critic\" +pseudo-pragmas in the source code. You can set the default value for this +option in your .perlcriticrc file." + :type '(boolean) + :group 'perlcritic) +(make-variable-buffer-local 'perlcritic-force) + +(defcustom perlcritic-verbose nil + "Sets the numeric verbosity level or format for reporting violations. If +given a number (\"N\"), \"perlcritic\" reports violations using one of the +predefined formats described below. If the `perlcritic-verbose' option is not +specified, it defaults to either 4 or 5, depending on whether multiple files +were given as arguments to \"perlcritic\". You can set the default value for +this option in your .perlcriticrc file. + +Verbosity Format Specification +----------- ------------------------------------------------------------- + 1 \"%f:%l:%c:%m\n\", + 2 \"%f: (%l:%c) %m\n\", + 3 \"%m at %f line %l\n\", + 4 \"%m at line %l, column %c. %e. (Severity: %s)\n\", + 5 \"%f: %m at line %l, column %c. %e. (Severity: %s)\n\", + 6 \"%m at line %l, near ’%r’. (Severity: %s)\n\", + 7 \"%f: %m at line %l near ’%r’. (Severity: %s)\n\", + 8 \"[%p] %m at line %l, column %c. (Severity: %s)\n\", + 9 \"[%p] %m at line %l, near ’%r’. (Severity: %s)\n\", +10 \"%m at line %l, column %c.\n %p (Severity: %s)\n%d\n\", +11 \"%m at line %l, near ’%r’.\n %p (Severity: %s)\n%d\n\" + +Formats are a combination of literal and escape characters similar to the way +\"sprintf\" works. See String::Format for a full explanation of the +formatting capabilities. Valid escape characters are: + +Escape Meaning +------- ---------------------------------------------------------------- +%c Column number where the violation occurred +%d Full diagnostic discussion of the violation +%e Explanation of violation or page numbers in PBP +%F Just the name of the file where the violation occurred. +%f Path to the file where the violation occurred. +%l Line number where the violation occurred +%m Brief description of the violation +%P Full name of the Policy module that created the violation +%p Name of the Policy without the Perl::Critic::Policy:: prefix +%r The string of source code that caused the violation +%s The severity level of the violation + +The purpose of these formats is to provide some compatibility with text +editors that have an interface for parsing certain kinds of input. + + +This variable is automatically buffer-local and may be overridden on a +per-file basis with File Variables." + :type '(integer) + :group 'perlcritic) +(make-variable-buffer-local 'perlcritic-verbose) + +;; TODO: Enable strings in perlcritic-verbose. +;; (defcustom perlcritic-verbose-regexp nil +;; "An optional regexp to match the warning output. +;; +;; This is used when `perlcritic-verbose' has a regexp instead of one of +;; the standard verbose levels.") +;; (make-local-variable 'perlcritic-verbose-regexp) + + +;; compile.el requires that something be the "filename." I've tagged +;; the severity with that. It happens to make it get highlighted in +;; red. The following advice on COMPILATION-FIND-FILE makes sure that +;; the "filename" is getting ignored when perlcritic is using it. + +;; These patterns are defined in Perl::Critic::Utils + +(defvar perlcritic-error-error-regexp-alist nil + "Alist that specified how to match errors in perlcritic output.") +(setq perlcritic-error-error-regexp-alist + '(;; Verbose level 1 + ;; "%f:%l:%c:%m\n" + ("^\\([^\n]+\\):\\([0-9]+\\):\\([0-9]+\\)" 1 2 3 1) + + ;; Verbose level 2 + ;; "%f: (%l:%c) %m\n" + ("^\\([^\n]+\\): (\\([0-9]+\\):\\([0-9]+\\))" 1 2 3 1) + + ;; Verbose level 3 + ;; "%m at %f line %l\n" + ("^[^\n]+ at \\([^\n]+\\) line \\([0-9]+\\)" 1 2 nil 1) + ;; "%m at line %l, column %c. %e. (Severity: %s)\n" + ("^[^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)." nil 2 3 1) + + ;; Verbose level 4 + ;; "%m at line %l, column %c. %e. (Severity: %s)\n" + ("^[^\n]+\\( \\)at line \\([0-9]+\\), column \\([0-9]+\\)" nil 2 3) + ;; "%f: %m at line %l, column %c. %e. (Severity: %s)\n" + ("^\\([^\n]+\\): [^\n]+ at line \\([0-9]+\\), column \\([0-9]+\\)" 1 2 3) + + ;; Verbose level 5 + ;; "%m at line %l, near '%r'. (Severity: %s)\n" + ("^[^\n]+ at line\\( \\)\\([0-9]+\\)," nil 2) + ;; "%f: %m at line %l, column %c. %e. (Severity: %s)\n" + ("^\\([^\n]+\\): [^\n]+ at line \\([0-9]+\\), column \\([0-9]+\\)" 1 2 3) + + ;; Verbose level 6 + ;; "%m at line %l, near '%r'. (Severity: %s)\\n" + ("^[^\n]+ at line\\( \\)\\([0-9]+\\)" nil 2) + ;; "%f: %m at line %l near '%r'. (Severity: %s)\n" + ("^\\([^\n]+\\): [^\n]+ at line \\([0-9]+\\)" 1 2) + + ;; Verbose level 7 + ;; "%f: %m at line %l near '%r'. (Severity: %s)\n" + ("^\\([^\n]+\\): [^\n]+ at line \\([0-9]+\\)" 1 2) + ;; "[%p] %m at line %l, column %c. (Severity: %s)\n" + ("^\\[[^\n]+\\] [^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)" nil 2 3) + + ;; Verbose level 8 + ;; "[%p] %m at line %l, column %c. (Severity: %s)\n" + ("^\\[[^\n]+\\] [^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)" nil 2 3) + ;; "[%p] %m at line %l, near '%r'. (Severity: %s)\n" + ("^\\[[^\n]+\\] [^\n]+ at line\\( \\)\\([0-9]+\\)" nil 2) + + ;; Verbose level 9 + ;; "%m at line %l, column %c.\n %p (Severity: %s)\n%d\n" + ("^[^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)" nil 2 3) + ;; "[%p] %m at line %l, near '%r'. (Severity: %s)\n" + ("^\\[[^\n]+\\] [^\n]+ at line\\( \\)\\([0-9]+\\)" nil 2) + + ;; Verbose level 10 + ;; "%m at line %l, near '%r'.\n %p (Severity: %s)\n%d\n" + ("^[^\n]+ at line\\( \\)\\([0-9]+\\)" nil 2) + ;; "%m at line %l, column %c.\n %p (Severity: %s)\n%d\n" + ("^[^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)" nil 2 3) + + ;; Verbose level 11 + ;; "%m at line %l, near '%r'.\n %p (Severity: %s)\n%d\n" + ("^[^\n]+ at line\\( \\)\\([0-9]+\\)" nil 2) + )) + + + +;; The Emacs Lisp manual says to do this with the cl library. +(eval-when-compile (require 'cl)) + +(define-compilation-mode perlcritic-error-mode "perlcritic-error" + "..." + (set (make-local-variable 'perlcritic-buffer) src-buf) + (ad-activate #'compilation-find-file)) + +;;;###autoload +(defun perlcritic () + "\\[perlcritic]] returns a either nil or t depending on whether the +current buffer passes perlcritic's check. If there are any warnings +those are displayed in a separate buffer." + (interactive) + (save-restriction + (widen) + (perlcritic-region (point-min) (point-max)))) + +;;;###autoload +(defun perlcritic-region (start end) + "\\[perlcritic-region] returns a either nil or t depending on +whether the region passes perlcritic's check. If there are any +warnings those are displayed in a separate buffer." + + (interactive "r") + + ;; Kill the perlcritic buffer so I can make a new one. + (if (get-buffer "*perlcritic*") + (save-excursion + (set-buffer "*perlcritic*") + (read-only-mode -1) + (erase-buffer))) + ; (kill-buffer "*perlcritic*"))) + + ;; In the following lines I'll be switching between buffers + ;; freely. This upper save-excursion will keep things sane. + (save-window-excursion + (let ((src-buf (current-buffer)) + (err-buf (get-buffer-create "*perlcritic*"))) + + (set-buffer src-buf) + (let ((perlcritic-args (loop for p in (list + ;; Add new bin/perlcritic + ;; parameters here! + (perlcritic--param-profile) + (perlcritic--param-noprofile) + (perlcritic--param-severity) + (perlcritic--param-top) + (perlcritic--param-include) + (perlcritic--param-exclude) + (perlcritic--param-force) + (perlcritic--param-verbose)) + unless (null p) + append p))) + ; + (message "Perl critic...running") + ;; Seriously. Is this the nicest way to call + ;; CALL-PROCESS-REGION with variadic arguments? This blows! + ;; (apply FUNCTION (append STATIC-PART DYNAMIC-PART)) + (let ((rc (apply 'call-process-region + (nconc (list start end + perlcritic-bin nil + (list err-buf t) + nil) + perlcritic-args)))) + + ;; Figure out whether we're ok or not. perlcritic has to + ;; return zero and the output buffer has to be empty except + ;; for that "... source OK" line. Different versions of the + ;; perlcritic script will print different things when + ;; they're ok. I expect to see things like "some-file source + ;; OK", "SCALAR=(0x123457) source OK", "STDIN source OK", + ;; and "source OK". + (let ((perlcritic-ok (and (numberp rc) + (zerop rc) + (progn + (set-buffer err-buf) + (goto-char (point-min)) + (delete-matching-lines "source OK$") + (zerop (buffer-size)))))) + ;; Either clean up or finish setting up my output. + (if perlcritic-ok + ;; Ok! + (progn + (kill-buffer err-buf) + (message "Perl critic...ok")) + + + ;; Not ok! + (message "Perl critic...not ok") + + ;; Set up the output buffer now I know it'll be used. I + ;; scooped the guts out of compile-internal. It is + ;; CRITICAL that the errors start at least two lines + ;; from the top. compile.el normally assumes the first + ;; line is an informational `cd somedirectory' command + ;; and the second line shows the program's invocation. + ;; + ;; Since I have the space available I've put the + ;; program's invocation here. Maybe it'd make sense to + ;; put the buffer's directory here somewhere too. + (set-buffer err-buf) + (goto-char (point-min)) + (insert (reduce (lambda (a b) (concat a " " b)) + (nconc (list perlcritic-bin) + perlcritic-args)) + "\n" + ;; TODO: instead of a blank line, print the + ;; buffer's directory+file. + "\n") + (goto-char (point-min)) + ;; TODO: get `recompile' to work. + + ;; just an fyi. compilation-mode will delete my local + ;; variables so be sure to call it *first*. + (perlcritic-error-mode) + ;; (ad-deactivate #'compilation-find-file) + (display-buffer err-buf)) + + ;; Return our success or failure. + perlcritic-ok)))))) + + + + +;;; Parameters for use by perlcritic-region. +(defun perlcritic--param-profile () + "A private method that supplies the -profile FILENAME parameter for +\\[perlcritic-region]" + (if perlcritic-profile (list "-profile" perlcritic-profile))) + +(defun perlcritic--param-noprofile () + "A private method that supplies the -noprofile parameter for +\\[perlcritic-region]" + (if perlcritic-noprofile (list "-noprofile"))) + +(defun perlcritic--param-force () + "A private method that supplies the -force parameter for +\\[perlcritic-region]" + (if perlcritic-force (list "-force"))) + +(defun perlcritic--param-severity () + "A private method that supplies the -severity NUMBER parameter for +\\[perlcritic-region]" + (cond ((stringp perlcritic-severity) + (list "-severity" perlcritic-severity)) + ((numberp perlcritic-severity) + (list "-severity" (number-to-string perlcritic-severity))) + (t nil))) + +(defun perlcritic--param-top () + "A private method that supplies the -top NUMBER parameter for +\\[perlcritic-region]" + (cond ((stringp perlcritic-top) + (list "-top" perlcritic-top)) + ((numberp perlcritic-top) + (list "-top" (number-to-string perlcritic-top))) + (t nil))) + +(defun perlcritic--param-include () + "A private method that supplies the -include REGEXP parameter for +\\[perlcritic-region]" + (if perlcritic-include + (list "-include" perlcritic-include) + nil)) + +(defun perlcritic--param-exclude () + "A private method that supplies the -exclude REGEXP parameter for +\\[perlcritic-region]" + (if perlcritic-exclude + (list "-exclude" perlcritic-exclude) + nil)) + +(defun perlcritic--param-verbose () + "A private method that supplies the -verbose NUMBER parameter for +\\[perlcritic-region]" + (cond ((stringp perlcritic-verbose) + (list "-verbose" perlcritic-verbose)) + ((numberp perlcritic-verbose) + (list "-verbose" (number-to-string perlcritic-verbose))) + (t nil))) + + +;; Interactive functions for use by the user to modify parameters on +;; an adhoc basis. I'm sure there's room for significant niceness +;; here. Suggest something. Please. +(defun perlcritic-profile (profile) + "Sets perlcritic's -profile FILENAME parameter." + (interactive "sperlcritic -profile: ") + (setq perlcritic-profile (if (string= profile "") nil profile))) + +(defun perlcritic-noprofile (noprofile) + "Toggles perlcritic's -noprofile parameter." + (interactive (list (yes-or-no-p "Enable perlcritic -noprofile? "))) + (setq perlcritic-noprofile noprofile)) + +(defun perlcritic-force (force) + "Toggles perlcritic's -force parameter." + (interactive (list (yes-or-no-p "Enable perlcritic -force? "))) + (setq perlcritic-force force)) + +(defun perlcritic-severity (severity) + "Sets perlcritic's -severity NUMBER parameter." + (interactive "nperlcritic -severity: ") + (setq perlcritic-severity severity)) + +(defun perlcritic-top (top) + "Sets perlcritic's -top NUMBER parameter." + (interactive "nperlcritic -top: ") + (setq perlcritic-top top)) + +(defun perlcritic-include (include) + "Sets perlcritic's -include REGEXP parameter." + (interactive "sperlcritic -include: ") + (setq perlcritic-include include)) + +(defun perlcritic-exclude (exclude) + "Sets perlcritic's -exclude REGEXP parameter." + (interactive "sperlcritic -exclude: ") + (setq perlcritic-exclude exclude)) + +(defun perlcritic-verbose (verbose) + "Sets perlcritic's -verbose NUMBER parameter." + (interactive "nperlcritic -verbose: ") + (setq perlcritic-verbose verbose)) + + + + + +;; Hooks compile.el's compilation-find-file to enable our file-less +;; operation. We feed `perlcritic-bin' from STDIN, not from a file. +(defadvice compilation-find-file (around perlcritic-find-file) + "Lets perlcritic lookup into the buffer we just came from and don't +require that the perl document exist in a file anywhere." + (let ((debug-buffer (marker-buffer marker))) + (if (local-variable-p 'perlcritic-buffer debug-buffer) + (setq ad-return-value perlcritic-buffer) + ad-do-it))) + + + + + +;; All the scaffolding of having a minor mode. +(defvar perlcritic-mode nil + "Toggle `perlcritic-mode'") +(make-variable-buffer-local 'perlcritic-mode) + +(defun perlcritic-write-hook () + "Check perlcritic during `write-file-hooks' for `perlcritic-mode'" + (if perlcritic-mode + (save-mark-and-excursion + (widen) + (mark-whole-buffer) + (let ((perlcritic-ok (perlcritic))) + (if perlcritic-pass-required + ;; Impede saving if we're not ok. + (not perlcritic-ok) + ;; Don't impede saving. We might not be ok but that + ;; doesn't matter now. + nil))) + ;; Don't impede saving. We're not in perlcritic-mode. + nil)) + +;;;###autoload +(defun perlcritic-mode (&optional arg) + "Perl::Critic checking minor mode." + (interactive "P") + + ;; Enable/disable perlcritic-mode + (setq perlcritic-mode (if (null arg) + ;; Nothing! Just toggle it. + (not perlcritic-mode) + ;; Set it. + (> (prefix-numeric-value arg) 0))) + + (if perlcritic-mode + (add-hook 'write-file-hooks 'perlcritic-write-hook nil "local") + (remove-hook 'write-file-hooks 'perlcritic-write-hook))) + +;; Make a nice name for perl critic mode. This string will appear at +;; the bottom of the screen. +(if (not (assq 'perlcritic-mode minor-mode-alist)) + (setq minor-mode-alist + (cons '(perlcritic-mode " Critic") + minor-mode-alist))) + +(provide 'perlcritic) + +;; Local Variables: +;; mode: emacs-lisp +;; tab-width: 8 +;; fill-column: 78 +;; indent-tabs-mode: nil +;; End: +;; ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround : + +;;; perlcritic.el ends here diff --git a/lisp/perltidy.el b/lisp/perltidy.el new file mode 100644 index 00000000..f52bca26 --- /dev/null +++ b/lisp/perltidy.el @@ -0,0 +1,249 @@ +;;; perltidy.el --- Tidy perl code + +;; Copyright (C) 2007-2015 Free Software Foundation, Inc. +;; +;; Author: Ye Wenbin +;; Maintainer: Kirill Babikhin +;; Created: 22 Dec 2007 +;; Version: 0.05 +;; Keywords: tools, convenience, languages + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; As the PBP(Perl Best Practice) suggest, put this to your ~/.perltidyrc: +;; ## .perltidyrc --- configuration for perltidy +;; # Max line width is 78 cols +;; -l=78 +;; # Indent level is 4 cols +;; -i=4 +;; # Continuation indent is 4 cols +;; -ci=4 +;; # Output to STDOUT +;; -st +;; # Errors to STDERR +;; -se +;; # Maximal vertical tightness +;; -vt=2 +;; # No extra indentation for closing brackets +;; -cti=0 +;; # Medium parenthesis tightness +;; -pt=1 +;; # Medium brace tightness +;; -bt=1 +;; # Medium square bracket tightness +;; -sbt=1 +;; # Medium block brace tightness +;; -bbt=1 +;; # No space before semicolons +;; -nsfs +;; # Don't outdent long quoted strings +;; -nolq +;; # Break before all operators +;; -wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" + +;; Put this file into your load-path and the following into your ~/.emacs: +;; (require 'perltidy) + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(defgroup perltidy nil + "Tidy perl code using perltidy" + :group 'tools + :group 'pde) + +(defcustom perltidy-program "perltidy" + "*Program name of perltidy" + :type 'string + :group 'perltidy) + +(defcustom perltidy-program-params + '(;; I/O control + "--standard-output" + "--standard-error-output" + "--force-read-binary" + "--quiet" + + ;; FORMATTING OPTIONS + "--no-check-syntax" + ) + "*perltidy run options" + :type 'list + :group 'perltidy) + +(defcustom perltidy-rcregex "\\.perltidyrc" + "perltidyrc file regex" + :type 'string + :group 'perltidy) + +(defmacro perltidy-save-point (&rest body) + (declare (indent 0) (debug t)) + `(let ((old-point (point))) + ,@body + (goto-char old-point))) + +;;;###autoload +(defun perltidy-region (beg end) + "Tidy perl code in the region." + (interactive "r") + (or (get 'perltidy-program 'has-perltidy) + (if (executable-find perltidy-program) + (put 'perltidy-program 'has-perltidy t) + (error "Seem perltidy is not installed"))) + (perltidy-save-point + + (let ((old-perltidy-env (getenv "PERLTIDY")) + (remote? (tramp-tramp-file-p buffer-file-name)) + (perltidyrc (perltidy-find-perltidyrc buffer-file-truename)) + (pertidyrc-remote (expand-file-name "perltidyrc-remote" temporary-file-directory)) + (perltidy-run-list perltidy-program-params) + ) + + (if (and (bound-and-true-p remote?) + perltidyrc) + (progn + (require 'tramp-sh) + (tramp-sh-handle-copy-file perltidyrc pertidyrc-remote t) + (setq perltidyrc pertidyrc-remote) + (setq perltidy-run-list + (append perltidy-run-list + (list (concat "-pro=" pertidyrc-remote)))))) + + (apply #'call-process-region + (append (list beg end perltidy-program + t + t + t + ) + perltidy-run-list))) + t)) + +;;;###autoload +(defun perltidy-buffer () + "Call perltidy for whole buffer." + (interactive) + (perltidy-region (point-min) (point-max))) + +;;;###autoload +(defun perltidy-subroutine () + "Call perltidy for subroutine at point." + (interactive) + + (save-excursion + (let ((current-point (point)) + b e) + (setq b (progn (beginning-of-defun) (point))) + (when (and + (looking-at "\\s-*sub\\s-+") + (< b current-point) + (> (save-excursion + (setq e (progn (end-of-defun) (point)))) + current-point)) + (perltidy-region b e))))) + +;;;###autoload +(defun perltidy-dwim-safe (arg) + "Perltidy Do What I Mean safe. +If region is active call perltidy on the region. +If inside subroutine, call perltidy on the subroutine, +otherwise stop." + (interactive "P") + (let ((buf (current-buffer)) + beg end) + (cond ((and mark-active transient-mark-mode) + (setq beg (region-beginning) + end (region-end))) + ((save-excursion + (let ((current-point (point)) + b e) + (setq b (progn (beginning-of-defun) (point))) + (when (and + (looking-at "\\s-*sub\\s-+") + (< b current-point) + (> (save-excursion + (setq e (progn (end-of-defun) (point)))) + current-point)) + (setq beg b + end e))))) + (t (setq beg nil + end nil))) + (if (and beg + end) + (progn + (perltidy-region beg end) + (font-lock-fontify-buffer))))) + +;;;###autoload +(defun perltidy-dwim (arg) + "Perltidy Do What I Mean. +If region is active call perltidy on the region. +If inside subroutine, call perltidy on the subroutine, +otherwise call perltidy for whole buffer." + (interactive "P") + (let ((buf (current-buffer)) + beg end) + (cond ((and mark-active transient-mark-mode) + (setq beg (region-beginning) + end (region-end))) + ((save-excursion + (let ((current-point (point)) + b e) + (setq b (progn (beginning-of-defun) (point))) + (when (and + (looking-at "\\s-*sub\\s-+") + (< b current-point) + (> (save-excursion + (setq e (progn (end-of-defun) (point)))) + current-point)) + (setq beg b + end e))))) + (t (setq beg (point-min) + end (point-max)))) + (perltidy-region beg end) + (font-lock-fontify-buffer))) + +(defun perltidy-find-perltidyrc (&optional dir rcregex) + (unless dir (setq dir (buffer-file-name))) + (unless rcregex (setq rcregex perltidy-rcregex)) + (setq dir (file-name-directory dir)) + + (let (rcfile) + (catch 'my-tag + (locate-dominating-file + dir + (lambda (parent) + (let ((rc (car (ignore-errors (directory-files parent t rcregex)))) + (pparent (file-name-directory (directory-file-name parent)))) + (setq rcfile rc) + (cond ((equal parent + pparent) + (if (= (length rc) 0) + (throw 'my-tag rc) + (throw 'my-tag nil))) + + ((and (= (length rc) 0) + (file-exists-p (expand-file-name "lib" pparent)) + (file-directory-p (expand-file-name "lib" pparent))) + (setq rcfile (car (ignore-errors (directory-files pparent t rcregex)))) + (throw 'my-tag rcfile)) + (t rc)))))) + rcfile)) + +(provide 'perltidy) +;;; perltidy.el ends here -- 2.47.3