lpr-buffer-wrap.el

;;; lpr-buffer-wrap.el --- lpr-buffer auto sjis convert.  -*- lexical-binding: t; -*-

;; Copyright (C) 2014, 2018 fubuki

;; Author: fubuki@*****.org
;; Keywords: tools

;; 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 3 of the License.

;; 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Change the coding system sent to the default Printer to `print-region-coding-system'.
;; advice-add `print-region-1-wrap', `lpr-buffer', `print-buffer', `y-or-n-p'.
;; Replace dired P command.  `dired-do-print' to `dired-do-lpr-buffer',

;;; Installation:

;; (require 'lpr-buffer-wrap)

;;; Code:

(require 'lpr)
(require 'dired)

(defcustom lpr-switches-add nil
  "`lpr-switches' add switches."
  :type  '(choice
           (const nil)
           (repeat (string :tag "Option")))
  :group 'lpr)

(defcustom print-region-coding-system 'cp932-dos
  "Print region default coding system."
  :type  'coding-system
  :group 'lpr)

(defcustom lpr-switches-add-function
  '(lambda (file lpr-switches)
     (cons (concat "-T" file) lpr-switches))
  "Set up the filename option to ak2pr.exe."
  :type  'function
  :group 'lpr)

(defun print-region-1-wrap (func start end switches page-headers)
  "Change the coding system sent to the default Printer to `print-region-coding-system'.
If there is a prefix, append `lpr-switches-add' to SWITCHES."
  (let ((coding-system-for-write print-region-coding-system))
    (and
     lpr-switches-add current-prefix-arg
     (setq switches (append switches lpr-switches-add)))
    (funcall func start end switches page-headers)))
(advice-add 'print-region-1 :around 'print-region-1-wrap)

(defun y-or-n-p-lpr (func prompt)
  "Do not ask lpr interactively even if you start it.
(make it the same as the original specification).
for emacs 26.1"
  (let ((vec (this-command-keys-vector)))
    (setq  vec (elt vec (1- (length vec))))
    (if (and (string-match "default printer\\? $" prompt) (equal 13 vec))
        t
      (funcall func prompt))))
(advice-add 'y-or-n-p :around 'y-or-n-p-lpr)

(defun lpr-buffer-wrap (func)
  "Insurance when `lpr-buffer' is activated
by mistake in scene where `lpr-region' should be activated."
  (if (region-active-p)
      (lpr-region (region-beginning) (region-end))
    (funcall func)))
(advice-add 'lpr-buffer :around 'lpr-buffer-wrap)

(defun print-buffer-wrap (func)
  "Insurance when `print-buffer' is activated
by mistake in scene where `print-region' should be activated."
  (if (region-active-p)
      (print-region (region-beginning) (region-end))
    (funcall func)))
(advice-add 'print-buffer :around 'print-buffer-wrap)

;;
;; For dired P
;;
(defun dired-do-lpr-buffer (&optional arg)
  "Print a file marked with Dired.
By passing it to `lpr-buffer'. It send to the printer with the appropriate coding system..
If PREFIX, print the point file instead of the mark file."
  (interactive "P")
  (require 'lpr)
  (let* ((file-list (dired-get-marked-files t arg))
	 (lpr-switches (cons lpr-printer-switch lpr-switches)))
    (and (yes-or-no-p "Print file? ")
         (dolist (file file-list)
           (let ((lpr-switches (funcall lpr-switches-add-function file lpr-switches)))
             (with-temp-buffer
               (insert-file-contents file)
               (lpr-buffer)))))))

(define-key dired-mode-map [remap dired-do-print] 'dired-do-lpr-buffer)

(provide 'lpr-buffer-wrap)
;; Fin.