251 lines
7.6 KiB
EmacsLisp
251 lines
7.6 KiB
EmacsLisp
;;; perltidy.el --- Tidy perl code
|
|
|
|
;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
|
|
;;
|
|
;; Author: Ye Wenbin <wenbinye@gmail.com>
|
|
;; Maintainer: Kirill Babikhin <mrakobes86reg@yandex.ru>
|
|
;; 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))
|
|
(perltidyrc-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 perltidyrc-remote t)
|
|
(setq perltidyrc perltidyrc-remote)))
|
|
|
|
(if perltidyrc
|
|
(setq perltidy-run-list
|
|
(append perltidy-run-list
|
|
(list (concat "-pro=" perltidyrc)))))
|
|
|
|
(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
|