1 ;;; perltidy-mode.el --- Minor mode to automatically perltidy.
3 ;;; Perltidy is a program that is available on CPAN.
5 ;;; Copyright 2006 Joshua ben Jore
7 ;;; Author: Joshua ben Jore <jjore@cpan.org>
9 ;;; CVS Version: $Id: perltidy.el,v 1.1 2009/04/23 15:46:13 andrew Exp $
10 ;;; Keywords: perl perltidy
11 ;;; X-URL: http://search.cpan.org/~jjore/perltidy-mode/
13 ;;; This program is free software; you can redistribute it and/or
14 ;;; modify it under the same terms as Perl itself.
16 ;;; To install this first generate your perltidy-mode.el file by running
17 ;;; perltidy-mode.PL with your copy of perl. Copy the generated perltidy-mode.el to
18 ;;; your ~/.site-lisp/ directory or a different preferred location.
20 ;;; Add the following lines to your .emacs file to inform emacs of the directory
21 ;;; and of the two main functions provided by this library.
23 ;;; (add-to-list 'load-path "~/.site-lisp/")
24 ;;; (autoload 'perltidy "perltidy-mode" nil t)
25 ;;; (autoload 'perltidy-mode "perltidy-mode" nil t)
27 ;;; Add the following snippet to enable full-auto mode.
29 ;;; (eval-after-load "cperl-mode"
30 ;;; '(add-hook 'cperl-mode-hook 'perltidy-mode))
32 ;;; Add the following snippet to set the C-ct key sequence to trigger
35 ;;; ; Run perltidy when the C-ct key sequence is used.
36 ;;; (global-set-key "\C-ct" 'perltidy)
40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
43 (defvar perltidy-bin "perltidy"
44 "The command to run perltidy.")
46 (defmacro mark-active ()
47 "Xemacs/emacs compatibility macro. It returns either nil or non-nil
48 and there are no guarantees about what constitutes \"non-nil\"."
49 (if (boundp 'mark-active)
53 (defun perltidy (start-in end-in)
54 "Run perltidy on the current region or buffer."
57 (let ((start (or start-in (point-min)))
58 (end (or end-in (point-max)))
59 (original-line (point->line (point)))
60 (error-buffer (get-buffer-create "*perltidy-errors*")))
62 ; Clear the error buffer if needed.
63 (or (zerop (buffer-size error-buffer))
64 (save-excursion (set-buffer error-buffer)
67 ; Inexplicably, save-excursion doesn't work to restore the
68 ; point. I'm using it to restore the mark and point and manually
69 ; navigating to the proper new-line.
72 (if (zerop (shell-command-on-region start end perltidy-bin error-buffer))
75 (kill-buffer error-buffer)
78 ; Oops! Show our error and give back the text that
79 ; shell-command-on-region stole.
81 (display-buffer error-buffer)
84 ; This goto-line is outside the save-excursion becuase it'd get
85 ; removed otherwise. I hate this bug. It makes things so ugly.
86 (goto-line original-line)
90 (defun point->line (point)
91 "Get the line number that POINT is on."
92 ; I'm not bothering to use save-excursion because I think I'm
93 ; calling this function from inside other things that are likely to
94 ; use that and all I really need to do is restore my current
95 ; point. So that's what I'm doing manually.
97 (original-point (point)))
98 (goto-char (point-min))
99 (while (< (point) point)
102 (goto-char original-point)
109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
111 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
112 (defvar perltidy-mode nil
113 "Automatically `perltidy' when saving.")
114 (make-variable-buffer-local 'perltidy-mode)
116 (defun perltidy-write-hook ()
117 "Perltidys a buffer during `write-file-hooks' for
118 `perltidy-mode'. If perltidy returns nil then the buffer isn't saved."
122 ; Impede the save if perltidy is false.
123 (not (perltidy (point-min) (point-max))))
124 ; Don't impede the save.
127 (defun perltidy-mode (&optional arg)
128 "Perltidy minor mode."
131 ; Cargo-culted from the Extending Emacs book.
132 (setq perltidy-mode (if (null arg)
133 ; Toggle it on and off.
136 (> (prefix-numeric-value arg) 0)))
138 (make-local-hook 'write-file-hooks)
139 (funcall (if perltidy-mode #'add-hook #'remove-hook)
140 'write-file-hooks 'perltidy-write-hook))
142 ; Add this to the list of minor modes.
143 (if (not (assq 'perltidy-mode minor-mode-alist))
144 (setq minor-mode-alist
145 (cons '(perltidy-mode " Perltidy")
148 (provide 'perltidy-mode)
150 ;;; perltidy-mode.el ends here