aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Kangas2021-03-30 23:09:14 +0200
committerStefan Kangas2021-03-30 23:11:24 +0200
commitd3aac3b34cc730b8a30ede34b0c77864f8f5a4b5 (patch)
tree09b6cc033e3726b588425bc53e5ba24e6ae9d6b7
parent4f3c9df047c3741160d717ad647d8754f3f01dcf (diff)
downloademacs-d3aac3b34cc730b8a30ede34b0c77864f8f5a4b5.tar.gz
emacs-d3aac3b34cc730b8a30ede34b0c77864f8f5a4b5.zip
Use lexical-binding in lpr.el and add rudimentary tests
* lisp/lpr.el: Use lexical-binding. Remove redundant :group args. (print-region-function): Declare MS-Windows specific function. * test/lisp/lpr-tests.el: New file.
-rw-r--r--lisp/lpr.el39
-rw-r--r--test/lisp/lpr-tests.el41
2 files changed, 56 insertions, 24 deletions
diff --git a/lisp/lpr.el b/lisp/lpr.el
index 012d2518929..29a0fd8d728 100644
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -1,4 +1,4 @@
1;;; lpr.el --- print Emacs buffer on line printer 1;;; lpr.el --- print Emacs buffer on line printer -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2021 Free Software 3;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2021 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
@@ -39,12 +39,10 @@
39 (memq system-type '(usg-unix-v hpux)) 39 (memq system-type '(usg-unix-v hpux))
40 "Non-nil if running on a system type that uses the \"lp\" command.") 40 "Non-nil if running on a system type that uses the \"lp\" command.")
41 41
42
43(defgroup lpr nil 42(defgroup lpr nil
44 "Print Emacs buffer on line printer." 43 "Print Emacs buffer on line printer."
45 :group 'text) 44 :group 'text)
46 45
47
48;;;###autoload 46;;;###autoload
49(defcustom printer-name 47(defcustom printer-name
50 (and (eq system-type 'ms-dos) "PRN") 48 (and (eq system-type 'ms-dos) "PRN")
@@ -65,8 +63,7 @@ file. If you want to discard the printed output, set this to \"NUL\"."
65 :tag "Printer Name" 63 :tag "Printer Name"
66 (const :tag "Default" nil) 64 (const :tag "Default" nil)
67 ;; could use string but then we lose completion for files. 65 ;; could use string but then we lose completion for files.
68 (file :tag "Name")) 66 (file :tag "Name")))
69 :group 'lpr)
70 67
71;;;###autoload 68;;;###autoload
72(defcustom lpr-switches nil 69(defcustom lpr-switches nil
@@ -74,16 +71,14 @@ file. If you want to discard the printed output, set this to \"NUL\"."
74It is recommended to set `printer-name' instead of including an explicit 71It is recommended to set `printer-name' instead of including an explicit
75switch on this list. 72switch on this list.
76See `lpr-command'." 73See `lpr-command'."
77 :type '(repeat (string :tag "Argument")) 74 :type '(repeat (string :tag "Argument")))
78 :group 'lpr)
79 75
80(defcustom lpr-add-switches (memq system-type '(berkeley-unix gnu/linux)) 76(defcustom lpr-add-switches (memq system-type '(berkeley-unix gnu/linux))
81 "Non-nil means construct `-T' and `-J' options for the printer program. 77 "Non-nil means construct `-T' and `-J' options for the printer program.
82These are made assuming that the program is `lpr'; 78These are made assuming that the program is `lpr';
83if you are using some other incompatible printer program, 79if you are using some other incompatible printer program,
84this variable should be nil." 80this variable should be nil."
85 :type 'boolean 81 :type 'boolean)
86 :group 'lpr)
87 82
88(defcustom lpr-printer-switch 83(defcustom lpr-printer-switch
89 (if lpr-lp-system 84 (if lpr-lp-system
@@ -94,8 +89,7 @@ This switch is used in conjunction with `printer-name'."
94 :type '(choice :menu-tag "Printer Name Switch" 89 :type '(choice :menu-tag "Printer Name Switch"
95 :tag "Printer Name Switch" 90 :tag "Printer Name Switch"
96 (const :tag "None" nil) 91 (const :tag "None" nil)
97 (string :tag "Printer Switch")) 92 (string :tag "Printer Switch")))
98 :group 'lpr)
99 93
100;;;###autoload 94;;;###autoload
101(defcustom lpr-command 95(defcustom lpr-command
@@ -116,8 +110,7 @@ Windows NT and Novell Netware respectively) are handled specially, using
116`printer-name' as the destination for output; any other program is 110`printer-name' as the destination for output; any other program is
117treated like `lpr' except that an explicit filename is given as the last 111treated like `lpr' except that an explicit filename is given as the last
118argument." 112argument."
119 :type 'string 113 :type 'string)
120 :group 'lpr)
121 114
122;; Default is nil, because that enables us to use pr -f 115;; Default is nil, because that enables us to use pr -f
123;; which is more reliable than pr with no args, which is what lpr -p does. 116;; which is more reliable than pr with no args, which is what lpr -p does.
@@ -127,22 +120,21 @@ If nil, we run `lpr-page-header-program' to make page headings
127and print the result." 120and print the result."
128 :type '(choice (const nil) 121 :type '(choice (const nil)
129 (string :tag "Single argument") 122 (string :tag "Single argument")
130 (repeat :tag "Multiple arguments" (string :tag "Argument"))) 123 (repeat :tag "Multiple arguments" (string :tag "Argument"))))
131 :group 'lpr)
132 124
133(defcustom print-region-function 125(defcustom print-region-function
134 (if (memq system-type '(ms-dos windows-nt)) 126 (if (memq system-type '(ms-dos windows-nt))
135 #'w32-direct-print-region-function 127 (progn
128 (declare-function w32-direct-print-region-function "w32-fns")
129 #'w32-direct-print-region-function)
136 #'call-process-region) 130 #'call-process-region)
137 "Function to call to print the region on a printer. 131 "Function to call to print the region on a printer.
138See definition of `print-region-1' for calling conventions." 132See definition of `print-region-1' for calling conventions."
139 :type 'function 133 :type 'function)
140 :group 'lpr)
141 134
142(defcustom lpr-page-header-program "pr" 135(defcustom lpr-page-header-program "pr"
143 "Name of program for adding page headers to a file." 136 "Name of program for adding page headers to a file."
144 :type 'string 137 :type 'string)
145 :group 'lpr)
146 138
147;; Berkeley systems support -F, and GNU pr supports both -f and -F, 139;; Berkeley systems support -F, and GNU pr supports both -f and -F,
148;; So it looks like -F is a better default. 140;; So it looks like -F is a better default.
@@ -151,8 +143,7 @@ See definition of `print-region-1' for calling conventions."
151If `%s' appears in any of the strings, it is substituted by the page title. 143If `%s' appears in any of the strings, it is substituted by the page title.
152Note that for correct quoting, `%s' should normally be a separate element. 144Note that for correct quoting, `%s' should normally be a separate element.
153The variable `lpr-page-header-program' specifies the program to use." 145The variable `lpr-page-header-program' specifies the program to use."
154 :type '(repeat string) 146 :type '(repeat string))
155 :group 'lpr)
156 147
157;;;###autoload 148;;;###autoload
158(defun lpr-buffer () 149(defun lpr-buffer ()
@@ -248,7 +239,7 @@ for further customization of the printer command."
248 nil 239 nil
249 ;; Run a separate program to get page headers. 240 ;; Run a separate program to get page headers.
250 (let ((new-coords (print-region-new-buffer start end))) 241 (let ((new-coords (print-region-new-buffer start end)))
251 (apply 'call-process-region (car new-coords) (cdr new-coords) 242 (apply #'call-process-region (car new-coords) (cdr new-coords)
252 lpr-page-header-program t t nil 243 lpr-page-header-program t t nil
253 (mapcar (lambda (e) (format e name)) 244 (mapcar (lambda (e) (format e name))
254 lpr-page-header-switches))) 245 lpr-page-header-switches)))
@@ -270,7 +261,7 @@ for further customization of the printer command."
270 (let ((retval 261 (let ((retval
271 (let ((tempbuf (current-buffer))) 262 (let ((tempbuf (current-buffer)))
272 (with-current-buffer buf 263 (with-current-buffer buf
273 (apply (or print-region-function 'call-process-region) 264 (apply (or print-region-function #'call-process-region)
274 start end lpr-command 265 start end lpr-command
275 nil tempbuf nil 266 nil tempbuf nil
276 (nconc (and name lpr-add-switches 267 (nconc (and name lpr-add-switches
diff --git a/test/lisp/lpr-tests.el b/test/lisp/lpr-tests.el
new file mode 100644
index 00000000000..bc31982a11d
--- /dev/null
+++ b/test/lisp/lpr-tests.el
@@ -0,0 +1,41 @@
1;;; lpr-tests.el --- Tests for lpr.el -*- lexical-binding: t -*-
2
3;; Copyright (C) 2021 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;;; Code:
23
24(require 'ert)
25(require 'lpr)
26
27(ert-deftest lpr-test-printify-region ()
28 (with-temp-buffer
29 (insert "foo\^@-\^h\^k\^n-\^_\177bar")
30 (printify-region (point-min) (point-max))
31 (should (equal (buffer-string) "foo\\^@-\\^H\\^K\\^N-\\^_\\7fbar"))))
32
33(ert-deftest lpr-test-lpr-eval-switch ()
34 (should (equal (lpr-eval-switch "foo") "foo"))
35 (should (equal (lpr-eval-switch (lambda () "foo")) "foo"))
36 (let ((v "foo"))
37 (should (equal (lpr-eval-switch v) "foo")))
38 (should (equal (lpr-eval-switch (list #'identity "foo")) "foo"))
39 (should (equal (lpr-eval-switch 1) nil)))
40
41;;; lpr-tests.el ends here