rc/xemacs/perltidy.el

   1 ;;; perltidy-mode.el --- Minor mode to automatically perltidy.
   2
   3 ;;; Perltidy is a program that is available on CPAN.
   4
   5 ;;; Copyright 2006 Joshua ben Jore
   6
   7 ;;; Author: Joshua ben Jore <jjore@cpan.org>
   8 ;;; Version: 0.02
   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/
  12
  13 ;;; This program is free software; you can redistribute it and/or
  14 ;;; modify it under the same terms as Perl itself.
  15
  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.
  19 ;;;
  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.
  22 ;;;
  23 ;;;   (add-to-list 'load-path "~/.site-lisp/")
  24 ;;;   (autoload 'perltidy "perltidy-mode" nil t)
  25 ;;;   (autoload 'perltidy-mode "perltidy-mode" nil t)
  26 ;;;
  27 ;;; Add the following snippet to enable full-auto mode.
  28 ;;;
  29 ;;;   (eval-after-load "cperl-mode"
  30 ;;;     '(add-hook 'cperl-mode-hook 'perltidy-mode))
  31 ;;;
  32 ;;; Add the following snippet to set the C-ct key sequence to trigger
  33 ;;; perltidy.
  34 ;;;
  35 ;;;   ; Run perltidy when the C-ct key sequence is used.
  36 ;;;   (global-set-key "\C-ct" 'perltidy)
  37
  38
  39
  40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41 ;                              Perltidy
  42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43 (defvar perltidy-bin "perltidy"
  44   "The command to run perltidy.")
  45
  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)
  50       `mark-active
  51     `(mark)))
  52
  53 (defun perltidy (start-in end-in)
  54   "Run perltidy on the current region or buffer."
  55   (interactive "r")
  56
  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*")))
  61
  62     ; Clear the error buffer if needed.
  63     (or (zerop (buffer-size error-buffer))
  64         (save-excursion (set-buffer error-buffer)
  65                         (erase-buffer)))
  66
  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.
  70     (let ((result
  71            (save-excursion
  72              (if (zerop (shell-command-on-region start end perltidy-bin error-buffer))
  73                  ; Success! Clean up.
  74                  (progn
  75                    (kill-buffer error-buffer)
  76                    t)
  77
  78                ; Oops! Show our error and give back the text that
  79                ; shell-command-on-region stole.
  80                (progn (undo)
  81                       (display-buffer error-buffer)
  82                       nil)))))
  83
  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)
  87       result)))
  88
  89
  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.
  96   (let ((line 1)
  97         (original-point (point)))
  98     (goto-char (point-min))
  99     (while (< (point) point)
 100       (incf line)
 101       (forward-line))
 102     (goto-char original-point)
 103     line))
 104
 105
 106
 107
 108
 109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 110 ;                         Automatic perltidy
 111 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 112 (defvar perltidy-mode nil
 113   "Automatically `perltidy' when saving.")
 114 (make-variable-buffer-local 'perltidy-mode)
 115
 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."
 119   (if perltidy-mode
 120       (save-restriction
 121         (widen)
 122         ; Impede the save if perltidy is false.
 123         (not (perltidy (point-min) (point-max))))
 124     ; Don't impede the save.
 125     nil))
 126
 127 (defun perltidy-mode (&optional arg)
 128   "Perltidy minor mode."
 129   (interactive "P")
 130
 131   ; Cargo-culted from the Extending Emacs book.
 132   (setq perltidy-mode (if (null arg)
 133                           ; Toggle it on and off.
 134                           (not perltidy-mode)
 135                         ; Enable if >0.
 136                         (> (prefix-numeric-value arg) 0)))
 137
 138   (make-local-hook 'write-file-hooks)
 139   (funcall (if perltidy-mode #'add-hook #'remove-hook)
 140            'write-file-hooks 'perltidy-write-hook))
 141
 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")
 146                 minor-mode-alist)))
 147
 148 (provide 'perltidy-mode)
 149
 150 ;;; perltidy-mode.el ends here