view release on metacpan or  search on metacpan

elisp/perl-minlint.el  view on Meta::CPAN

	    "{F5->lint}" "!NO LINT!")
  :global nil
  (let ((hook 'after-save-hook) (fn 'perl-minlint-run)
	(buf (current-buffer)))
    (cond ((and (boundp 'mmm-temp-buffer-name)
		(equal (buffer-name) mmm-temp-buffer-name))
	   (message "skipping perl-minlint-mode for %s" buf)
	   nil)
	  (perl-minlint-mode
	   (setq perl-minlint-is-available
		 (perl-minlint-find-executable buf))
	   (when (not perl-minlint-is-available)
	     (error "FATAL: perlminlint: Can't find executable for %s"
		    perl-minlint-script))
	   (message "enabling perl-minlint-mode for %s" buf)
	   (add-hook hook fn nil t))
	  (t
	   (message "disabling perl-minlint-mode for %s" buf)
	   (remove-hook hook fn t)))))

;;;###autoload
(defun perl-minlint-run (&optional force)
  "Run perlminlint for current buffer.
By default, this runs only in perl-minlint-mode.
To use this in other mode, please give t for optional argument FORCE."
  (interactive "P")
  (let ((buf (current-buffer)))
    (if (or force perl-minlint-mode)
	(perl-minlint-run-and-raise buf)
      (message "Not in perl-minlint-mode, skipped."))))

(defun perl-minlint-run-and-raise (buffer)
  (perl-minlint-plist-bind (file line err rc)
      (perl-minlint-run-and-parse-lint-result buffer)
    (unless (eq rc 0)
      (beep))

    (when (and file
	       (not (equal (expand-file-name file)
			   (perl-minlint-tramp-localname buffer)))
	       (not (equal file "-")))
	(message "opening error file: %s" file)
	(find-file-other-window file))
    (when (and file line)
      (goto-line (string-to-number line)))
    (if perl-minlint-alert-face
        (perl-minlint-set-mode-line-alert (not (eq rc 0))))
    (message "%s"
	     (cond ((> (length err) 0)
		    err)
		   ((not (eq rc 0))
		    "Unknown error")
		   (t
		    "lint OK")))))

(defun perl-minlint-set-mode-line-alert (err)
  (cond (err
         (setq perl-minlint-saved-color-cookie
               (mapc (lambda (f)
                         (face-remap-add-relative f
                                                  ':background "orange"))
                       perl-minlint-alert-face)))
        (t
         (when perl-minlint-saved-color-cookie
           (mapc (lambda (ck)
                     (face-remap-remove-relative ck))
                   perl-minlint-saved-color-cookie)
           (setq perl-minlint-saved-color-cookie nil)))))

(defun perl-minlint-run-and-parse-lint-result (buffer)
  (perl-minlint-plist-bind (rc err)
      (perl-minlint-shell-command (perl-minlint-find-executable buffer)
				  " "
				   (perl-minlint-tramp-localname buffer))
    (when rc
      (let (match diag)
	(when (setq match
		    (perl-minlint-match
		     perl-minlint-re-perl-errors
		     err 'file 1 'line 2))
	  (setq diag (substring err 0 (plist-get match 'pos))))
	(append `(rc ,rc err ,(or diag err)) match)))))

(defun perl-minlint-shell-command (cmd &rest args)
  (let ((tmpbuf (generate-new-buffer " *perl-minlint-temp*"))
	rc err)
    (save-window-excursion
      (unwind-protect
	  (setq rc (perl-minlint-tramp-command-in
		    (current-buffer)
		    cmd args tmpbuf))
	(setq err (with-current-buffer tmpbuf
		    ;; To remove last \n
		    (goto-char (point-max))
		    (skip-chars-backward "\n")
		    (delete-region (point) (point-max))
		    (buffer-string)))
	;; (message "error=(((%s)))" err)
	(kill-buffer tmpbuf)))
    `(rc ,rc err ,err)))

;;;;========================================
;;; Codes for tramp support

(defun perl-minlint-tramp-command-in (curbuf cmd args &optional outbuf errorbuf)
  (let ((command (apply #'concat (perl-minlint-tramp-localname cmd)
			args)))
    (if (perl-minlint-is-tramp (buffer-file-name curbuf))
	(tramp-handle-shell-command
	 command outbuf errorbuf)
      (shell-command command outbuf errorbuf))))

(defun perl-minlint-tramp-localname (fn-or-buf)
  ;;; XXX: How about accepting dissected-vec as argument?
  (let ((fn (cond ((stringp fn-or-buf)
		   fn-or-buf)
		  ((bufferp fn-or-buf)
		   (buffer-file-name fn-or-buf))
		  (t
		   (error "Invalid argument %s" fn-or-buf)))))
    (if (perl-minlint-is-tramp fn)