summaryrefslogtreecommitdiff
path: root/lisp/mail
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/mail')
-rw-r--r--lisp/mail/binhex.el20
-rw-r--r--lisp/mail/emacsbug.el33
-rw-r--r--lisp/mail/flow-fill.el3
-rw-r--r--lisp/mail/footnote.el463
-rw-r--r--lisp/mail/hashcash.el10
-rw-r--r--lisp/mail/ietf-drums.el12
-rw-r--r--lisp/mail/rfc2231.el7
-rw-r--r--lisp/mail/rmail.el22
-rw-r--r--lisp/mail/sendmail.el15
-rw-r--r--lisp/mail/smtpmail.el2
-rw-r--r--lisp/mail/uudecode.el37
-rw-r--r--lisp/mail/yenc.el8
12 files changed, 390 insertions, 242 deletions
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el
index 04044042e9a..299fc0b2341 100644
--- a/lisp/mail/binhex.el
+++ b/lisp/mail/binhex.el
@@ -1,4 +1,4 @@
-;;; binhex.el --- decode BinHex-encoded text
+;;; binhex.el --- decode BinHex-encoded text -*- lexical-binding:t -*-
;; Copyright (C) 1998-2018 Free Software Foundation, Inc.
@@ -29,8 +29,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(eval-and-compile
(defalias 'binhex-char-int
(if (fboundp 'char-int)
@@ -193,7 +191,7 @@ input and write the converted data to its standard output."
(defvar binhex-last-char)
(defvar binhex-repeat)
-(defun binhex-push-char (char &optional count ignored buffer)
+(defun binhex-push-char (char &optional ignored buffer)
(cond
(binhex-repeat
(if (eq char 0)
@@ -241,10 +239,10 @@ If HEADER-ONLY is non-nil only decode header and return filename."
counter (1+ counter)
inputpos (1+ inputpos))
(cond ((= counter 4)
- (binhex-push-char (lsh bits -16) 1 nil work-buffer)
- (binhex-push-char (logand (lsh bits -8) 255) 1 nil
+ (binhex-push-char (lsh bits -16) nil work-buffer)
+ (binhex-push-char (logand (lsh bits -8) 255) nil
work-buffer)
- (binhex-push-char (logand bits 255) 1 nil
+ (binhex-push-char (logand bits 255) nil
work-buffer)
(setq bits 0 counter 0))
(t (setq bits (lsh bits 6)))))
@@ -263,12 +261,12 @@ If HEADER-ONLY is non-nil only decode header and return filename."
(setq tmp (and tmp (not (eq inputpos end)))))
(cond
((= counter 3)
- (binhex-push-char (logand (lsh bits -16) 255) 1 nil
+ (binhex-push-char (logand (lsh bits -16) 255) nil
work-buffer)
- (binhex-push-char (logand (lsh bits -8) 255) 1 nil
+ (binhex-push-char (logand (lsh bits -8) 255) nil
work-buffer))
((= counter 2)
- (binhex-push-char (logand (lsh bits -10) 255) 1 nil
+ (binhex-push-char (logand (lsh bits -10) 255) nil
work-buffer))))
(if header-only nil
(binhex-verify-crc work-buffer
@@ -287,7 +285,7 @@ If HEADER-ONLY is non-nil only decode header and return filename."
(defun binhex-decode-region-external (start end)
"Binhex decode region between START and END using external decoder."
(interactive "r")
- (let ((cbuf (current-buffer)) firstline work-buffer status
+ (let ((cbuf (current-buffer)) firstline work-buffer
(file-name (expand-file-name
(concat (binhex-decode-region-internal start end t)
".data")
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 503919106f0..cb34a75fa1c 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -232,13 +232,32 @@ usually do not have translators for other languages.\n\n")))
"', version "
(mapconcat 'number-to-string (x-server-version) ".") "\n")
(error t)))
- (let ((lsb (with-temp-buffer
- (if (eq 0 (ignore-errors
- (call-process "lsb_release" nil '(t nil)
- nil "-d")))
- (buffer-string)))))
- (if (stringp lsb)
- (insert "System " lsb "\n")))
+ (let (os)
+ ;; Maybe this should be factored out in a standalone function,
+ ;; eg emacs-os-description.
+ (cond ((eq system-type 'darwin)
+ (with-temp-buffer
+ (when (eq 0 (ignore-errors
+ (call-process "sw_vers" nil '(t nil) nil)))
+ (dolist (s '("ProductName" "ProductVersion"))
+ (goto-char (point-min))
+ (if (re-search-forward (format "^%s\\s-*:\\s-+\\(.*\\)$" s)
+ nil t)
+ (setq os (concat os " " (match-string 1))))))))
+ ;; TODO include other branches here.
+ ;; MS Windows: systeminfo ?
+ ;; Cygwin, *BSD, etc: ?
+ (t
+ (with-temp-buffer
+ (when (eq 0 (ignore-errors
+ (call-process "lsb_release" nil '(t nil)
+ nil "-d")))
+ (goto-char (point-min))
+ (if (looking-at "^\\sw+:\\s-+")
+ (goto-char (match-end 0)))
+ (setq os (buffer-substring (point) (line-end-position)))))))
+ (if (stringp os)
+ (insert "System Description: " os "\n\n")))
(let ((message-buf (get-buffer "*Messages*")))
(if message-buf
(let (beg-pos
diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el
index 65f2421cb9a..db2a30ad15e 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -1,4 +1,4 @@
-;;; flow-fill.el --- interpret RFC2646 "flowed" text
+;;; flow-fill.el --- interpret RFC2646 "flowed" text -*- lexical-binding:t -*-
;; Copyright (C) 2000-2018 Free Software Foundation, Inc.
@@ -49,7 +49,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(defcustom fill-flowed-display-column 'fill-column
"Column beyond which format=flowed lines are wrapped, when displayed.
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 5a04eea25ac..d35b87046fe 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -1,8 +1,9 @@
-;;; footnote.el --- footnote support for message mode
+;;; footnote.el --- footnote support for message mode -*- lexical-binding:t -*-
;; Copyright (C) 1997, 2000-2018 Free Software Foundation, Inc.
-;; Author: Steven L Baur <steve@xemacs.org>
+;; Author: Steven L Baur <steve@xemacs.org> (1997-2011)
+;; Boruch Baum <boruch_baum@gmx.com> (2017-)
;; Keywords: mail, news
;; Version: 0.19
@@ -29,9 +30,36 @@
;; [1] Footnotes look something like this. Along with some decorative
;; stuff.
-;; TODO:
-;; Reasonable Undo support.
-;; more language styles.
+;;;; TODO:
+;; + Reasonable Undo support.
+;; - could use an `apply' entry in the buffer-undo-list to be warned when
+;; a footnote we inserted is removed via undo.
+;; - should try to handle the more general problem of deleting/removing
+;; footnotes via standard editing commands rather than via footnote
+;; commands.
+;; + more language styles.
+;; + The key sequence 'C-c ! a C-y C-c ! b' should auto-fill the
+;; footnote in adaptive fill mode. This does not seem to be a bug in
+;; `adaptive-fill' because it behaves that way on all point movements
+;; + Handle footmode mode elegantly in all modes, even if that means refuses to
+;; accept the burden. For example, in a programming language mode, footnotes
+;; should be commented.
+;; + Manually autofilling the a first footnote should not cause it to
+;; wrap into the footnote section tag
+;; + Current solution adds a second newline after the section tag, so it is
+;; clearly a separate paragraph. There may be stylistic objections to this.
+;; + Footnotes with multiple paragraphs should not have their first
+;; line out-dented.
+;; + Upon leaving footnote area, perform an auto-fill on an entire
+;; footnote (including multiple paragraphs), or on entire footnote area.
+;; + fill-paragraph takes arg REGION, but seemingly only when called
+;; interactively.
+;; + At some point, it became necessary to change `footnote-section-tag-regexp'
+;; to remove its trailing space. (Adaptive fill side-effect?)
+;; + useful for lazy testing
+;; (setq footnote-narrow-to-footnotes-when-editing t)
+;; (setq footnote-section-tag "Footnotes: ")
+;; (setq footnote-section-tag-regexp "Footnotes\\(\\[.\\]\\)?:")
;;; Code:
@@ -92,20 +120,25 @@ After that, changing the prefix key requires manipulating keymaps."
;;; Interface variables that probably shouldn't be changed
-(defcustom footnote-section-tag "Footnotes: "
+(defcustom footnote-section-tag "Footnotes:"
"Tag inserted at beginning of footnote section.
If you set this to the empty string, no tag is inserted and the
value of `footnote-section-tag-regexp' is ignored. Customizing
this variable has no effect on buffers already displaying
footnotes."
+ :version "27.1"
:type 'string
:group 'footnote)
-(defcustom footnote-section-tag-regexp "Footnotes\\(\\[.\\]\\)?: "
+(defcustom footnote-section-tag-regexp
+ ;; Even if `footnote-section-tag' has a trailing space, let's not require it
+ ;; here, since it might be trimmed by various commands.
+ "Footnotes\\(\\[.\\]\\)?:"
"Regexp which indicates the start of a footnote section.
This variable is disregarded when `footnote-section-tag' is the
empty string. Customizing this variable has no effect on buffers
already displaying footnotes."
+ :version "27.1"
:type 'regexp
:group 'footnote)
@@ -124,13 +157,21 @@ has no effect on buffers already displaying footnotes."
:type 'string
:group 'footnote)
-(defcustom footnote-signature-separator (if (boundp 'message-signature-separator)
- message-signature-separator
- "^-- $")
+(defcustom footnote-signature-separator
+ (if (boundp 'message-signature-separator)
+ message-signature-separator
+ "^-- $")
"Regexp used by Footnote mode to recognize signatures."
:type 'regexp
:group 'footnote)
+(defcustom footnote-align-to-fn-text t
+ "How to left-align footnote text.
+If nil, footnote text is to be aligned flush left with left side
+of the footnote number. If non-nil, footnote text is to be aligned
+left with the first character of footnote text."
+ :type 'boolean)
+
;;; Private variables
(defvar footnote-style-number nil
@@ -148,12 +189,14 @@ has no effect on buffers already displaying footnotes."
(defvar footnote-mouse-highlight 'highlight
"Text property name to enable mouse over highlight.")
+(defvar footnote-mode)
+
;;; Default styles
;;; NUMERIC
(defconst footnote-numeric-regexp "[0-9]+"
"Regexp for digits.")
-(defun Footnote-numeric (n)
+(defun footnote--numeric (n)
"Numeric footnote style.
Use Arabic numerals for footnoting."
(int-to-string n))
@@ -165,7 +208,7 @@ Use Arabic numerals for footnoting."
(defconst footnote-english-upper-regexp "[A-Z]+"
"Regexp for upper case English alphabet.")
-(defun Footnote-english-upper (n)
+(defun footnote--english-upper (n)
"Upper case English footnoting.
Wrapping around the alphabet implies successive repetitions of letters."
(let* ((ltr (mod (1- n) (length footnote-english-upper)))
@@ -184,7 +227,7 @@ Wrapping around the alphabet implies successive repetitions of letters."
(defconst footnote-english-lower-regexp "[a-z]+"
"Regexp of lower case English alphabet.")
-(defun Footnote-english-lower (n)
+(defun footnote--english-lower (n)
"Lower case English footnoting.
Wrapping around the alphabet implies successive repetitions of letters."
(let* ((ltr (mod (1- n) (length footnote-english-lower)))
@@ -202,27 +245,28 @@ Wrapping around the alphabet implies successive repetitions of letters."
(50 . "l") (100 . "c") (500 . "d") (1000 . "m"))
"List of roman numerals with their values.")
-(defconst footnote-roman-lower-regexp "[ivxlcdm]+"
+(defconst footnote-roman-lower-regexp
+ (concat "[" (mapconcat #'cdr footnote-roman-lower-list "") "]+")
"Regexp of roman numerals.")
-(defun Footnote-roman-lower (n)
+(defun footnote--roman-lower (n)
"Generic Roman number footnoting."
- (Footnote-roman-common n footnote-roman-lower-list))
+ (footnote--roman-common n footnote-roman-lower-list))
;;; ROMAN UPPER
(defconst footnote-roman-upper-list
- '((1 . "I") (5 . "V") (10 . "X")
- (50 . "L") (100 . "C") (500 . "D") (1000 . "M"))
+ (mapcar (lambda (x) (cons (car x) (upcase (cdr x))))
+ footnote-roman-lower-list)
"List of roman numerals with their values.")
-(defconst footnote-roman-upper-regexp "[IVXLCDM]+"
+(defconst footnote-roman-upper-regexp (upcase footnote-roman-lower-regexp)
"Regexp of roman numerals. Not complete")
-(defun Footnote-roman-upper (n)
+(defun footnote--roman-upper (n)
"Generic Roman number footnoting."
- (Footnote-roman-common n footnote-roman-upper-list))
+ (footnote--roman-common n footnote-roman-upper-list))
-(defun Footnote-roman-common (n footnote-roman-list)
+(defun footnote--roman-common (n footnote-roman-list)
"Lower case Roman footnoting."
(let* ((our-list footnote-roman-list)
(rom-lngth (length our-list))
@@ -257,22 +301,22 @@ Wrapping around the alphabet implies successive repetitions of letters."
;; (message "pairs are: rom-low: %S, rom-high: %S, rom-div: %S"
;; rom-low-pair rom-high-pair rom-div-pair)
(cond
- ((< n 0) (error "Footnote-roman-common called with n < 0"))
+ ((< n 0) (error "footnote--roman-common called with n < 0"))
((= n 0) "")
((= n (car rom-low-pair)) (cdr rom-low-pair))
((= n (car rom-high-pair)) (cdr rom-high-pair))
((= (car rom-low-pair) (car rom-high-pair))
(concat (cdr rom-low-pair)
- (Footnote-roman-common
+ (footnote--roman-common
(- n (car rom-low-pair))
footnote-roman-list)))
((>= rom-div 0) (concat (cdr rom-div-pair) (cdr rom-high-pair)
- (Footnote-roman-common
+ (footnote--roman-common
(- n (- (car rom-high-pair)
(car rom-div-pair)))
footnote-roman-list)))
(t (concat (cdr rom-low-pair)
- (Footnote-roman-common
+ (footnote--roman-common
(- n (car rom-low-pair))
footnote-roman-list)))))))
@@ -285,7 +329,7 @@ Wrapping around the alphabet implies successive repetitions of letters."
(defconst footnote-latin-regexp (concat "[" footnote-latin-string "]")
"Regexp for Latin-1 footnoting characters.")
-(defun Footnote-latin (n)
+(defun footnote--latin (n)
"Latin-1 footnote style.
Use a range of Latin-1 non-ASCII characters for footnoting."
(string (aref footnote-latin-string
@@ -299,7 +343,7 @@ Use a range of Latin-1 non-ASCII characters for footnoting."
(defconst footnote-unicode-regexp (concat "[" footnote-unicode-string "]+")
"Regexp for Unicode footnoting characters.")
-(defun Footnote-unicode (n)
+(defun footnote--unicode (n)
"Unicode footnote style.
Use Unicode characters for footnoting."
(let (modulus result done)
@@ -310,18 +354,70 @@ Use Unicode characters for footnoting."
(push (aref footnote-unicode-string modulus) result))
(apply #'string result)))
+;; Hebrew
+
+(defconst footnote-hebrew-numeric
+ '(
+ ("א" "ב" "ג" "ד" "ה" "ו" "ז" "ח" "ט")
+ ("י" "כ" "ל" "מ" "נ" "ס" "ע" "פ" "צ")
+ ("ק" "ר" "ש" "ת" "תק" "תר" "תש" "תת" "תתק")))
+
+(defconst footnote-hebrew-numeric-regex
+ (concat "[" (apply #'concat (apply #'append footnote-hebrew-numeric)) "']+"))
+;; (defconst footnote-hebrew-numeric-regex "\\([אבגדהוזחט]'\\)?\\(ת\\)?\\(ת\\)?\\([קרשת]\\)?\\([טיכלמנסעפצ]\\)?\\([אבגדהוזחט]\\)?")
+
+(defun footnote--hebrew-numeric (n)
+ "Supports 9999 footnotes, then rolls over."
+ (let* ((n (+ (mod n 10000) (/ n 10000)))
+ (thousands (/ n 1000))
+ (hundreds (/ (mod n 1000) 100))
+ (tens (/ (mod n 100) 10))
+ (units (mod n 10))
+ (special (cond
+ ((not (= tens 1)) nil)
+ ((= units 5) "טו")
+ ((= units 6) "טז"))))
+ (concat
+ (when (/= 0 thousands)
+ (concat (nth (1- thousands) (nth 0 footnote-hebrew-numeric)) "'"))
+ (when (/= 0 hundreds)
+ (nth (1- hundreds) (nth 2 footnote-hebrew-numeric)))
+ (or special
+ (concat
+ (when (/= 0 tens) (nth (1- tens) (nth 1 footnote-hebrew-numeric)))
+ (when (/= 0 units) (nth (1- units) (nth 0 footnote-hebrew-numeric))))))))
+
+(defconst footnote-hebrew-symbolic
+ '(
+ "א" "ב" "ג" "ד" "ה" "ו" "ז" "ח" "ט" "י" "כ" "ל" "מ" "נ" "ס" "ע" "פ" "צ" "ק" "ר" "ש" "ת"))
+
+(defconst footnote-hebrew-symbolic-regex
+ (concat "[" (apply #'concat footnote-hebrew-symbolic) "]"))
+
+(defun footnote--hebrew-symbolic (n)
+ "Only 22 elements, per the style of eg. 'פירוש שפתי חכמים על רש״י'.
+Proceeds from `י' to `כ', from `צ' to `ק'. After `ת', rolls over to `א'."
+ (nth (mod (1- n) 22) footnote-hebrew-symbolic))
+
;;; list of all footnote styles
(defvar footnote-style-alist
- `((numeric Footnote-numeric ,footnote-numeric-regexp)
- (english-lower Footnote-english-lower ,footnote-english-lower-regexp)
- (english-upper Footnote-english-upper ,footnote-english-upper-regexp)
- (roman-lower Footnote-roman-lower ,footnote-roman-lower-regexp)
- (roman-upper Footnote-roman-upper ,footnote-roman-upper-regexp)
- (latin Footnote-latin ,footnote-latin-regexp)
- (unicode Footnote-unicode ,footnote-unicode-regexp))
+ `((numeric footnote--numeric ,footnote-numeric-regexp)
+ (english-lower footnote--english-lower ,footnote-english-lower-regexp)
+ (english-upper footnote--english-upper ,footnote-english-upper-regexp)
+ (roman-lower footnote--roman-lower ,footnote-roman-lower-regexp)
+ (roman-upper footnote--roman-upper ,footnote-roman-upper-regexp)
+ (latin footnote--latin ,footnote-latin-regexp)
+ (unicode footnote--unicode ,footnote-unicode-regexp)
+ (hebrew-numeric footnote--hebrew-numeric ,footnote-hebrew-numeric-regex)
+ (hebrew-symbolic footnote--hebrew-symbolic ,footnote-hebrew-symbolic-regex))
"Styles of footnote tags available.
-By default only boring Arabic numbers, English letters and Roman Numerals
-are available.")
+By default, Arabic numbers, English letters, Roman Numerals,
+Latin and Unicode superscript characters, and Hebrew numerals
+are available.
+Each element of the list should be of the form (NAME FUNCTION REGEXP)
+where NAME is a symbol, FUNCTION takes a footnote number and
+returns the corresponding representation in that style as a string,
+and REGEXP should be a regexp that matches any output of FUNCTION.")
(defcustom footnote-style 'numeric
"Default style used for footnoting.
@@ -332,6 +428,8 @@ roman-lower == i, ii, iii, iv, v, ...
roman-upper == I, II, III, IV, V, ...
latin == ¹ ² ³ º ª § ¶
unicode == ¹, ², ³, ...
+hebrew-numeric == א, ב, ..., יא, ..., תקא...
+hebrew-symbolic == א, ב, ..., י, כ, ..., צ, ק, ..., ת, א
See also variables `footnote-start-tag' and `footnote-end-tag'.
Note: some characters in the unicode style may not show up
@@ -339,36 +437,36 @@ properly if the default font does not contain those characters.
Customizing this variable has no effect on buffers already
displaying footnotes. To change the style of footnotes in such a
-buffer use the command `Footnote-set-style'."
+buffer use the command `footnote-set-style'."
:type (cons 'choice (mapcar (lambda (x) (list 'const (car x)))
footnote-style-alist))
:group 'footnote)
;;; Style utilities & functions
-(defun Footnote-style-p (style)
+(defun footnote--style-p (style)
"Return non-nil if style is a valid style known to `footnote-mode'."
(assq style footnote-style-alist))
-(defun Footnote-index-to-string (index)
+(defun footnote--index-to-string (index)
"Convert a binary index into a string to display as a footnote.
Conversion is done based upon the current selected style."
- (let ((alist (if (Footnote-style-p footnote-style)
+ (let ((alist (if (footnote--style-p footnote-style)
(assq footnote-style footnote-style-alist)
(nth 0 footnote-style-alist))))
(funcall (nth 1 alist) index)))
-(defun Footnote-current-regexp ()
+(defun footnote--current-regexp ()
"Return the regexp of the index of the current style."
(concat (nth 2 (or (assq footnote-style footnote-style-alist)
(nth 0 footnote-style-alist)))
"*"))
-(defun Footnote-refresh-footnotes (&optional index-regexp)
+(defun footnote--refresh-footnotes (&optional index-regexp)
"Redraw all footnotes.
You must call this or arrange to have this called after changing footnote
styles."
(unless index-regexp
- (setq index-regexp (Footnote-current-regexp)))
+ (setq index-regexp (footnote--current-regexp)))
(save-excursion
;; Take care of the pointers first
(let ((i 0) locn alist)
@@ -387,7 +485,7 @@ styles."
(propertize
(concat
footnote-start-tag
- (Footnote-index-to-string (1+ i))
+ (footnote--index-to-string (1+ i))
footnote-end-tag)
'footnote-number (1+ i) footnote-mouse-highlight t)
nil "\\1"))
@@ -406,13 +504,13 @@ styles."
(propertize
(concat
footnote-start-tag
- (Footnote-index-to-string (1+ i))
+ (footnote--index-to-string (1+ i))
footnote-end-tag)
'footnote-number (1+ i))
nil "\\1"))
(setq i (1+ i))))))
-(defun Footnote-assoc-index (key alist)
+(defun footnote--assoc-index (key alist)
"Give index of key in alist."
(let ((i 0) (max (length alist)) rc)
(while (and (null rc)
@@ -422,33 +520,33 @@ styles."
(setq i (1+ i)))
rc))
-(defun Footnote-cycle-style ()
+(defun footnote-cycle-style ()
"Select next defined footnote style."
(interactive)
- (let ((old (Footnote-assoc-index footnote-style footnote-style-alist))
+ (let ((old (footnote--assoc-index footnote-style footnote-style-alist))
(max (length footnote-style-alist))
idx)
(setq idx (1+ old))
(when (>= idx max)
(setq idx 0))
(setq footnote-style (car (nth idx footnote-style-alist)))
- (Footnote-refresh-footnotes (nth 2 (nth old footnote-style-alist)))))
+ (footnote--refresh-footnotes (nth 2 (nth old footnote-style-alist)))))
-(defun Footnote-set-style (&optional style)
+(defun footnote-set-style (&optional style)
"Select a specific style."
(interactive
(list (intern (completing-read
"Footnote Style: "
- obarray #'Footnote-style-p 'require-match))))
- (let ((old (Footnote-assoc-index footnote-style footnote-style-alist)))
+ obarray #'footnote--style-p 'require-match))))
+ (let ((old (footnote--assoc-index footnote-style footnote-style-alist)))
(setq footnote-style style)
- (Footnote-refresh-footnotes (nth 2 (nth old footnote-style-alist)))))
+ (footnote--refresh-footnotes (nth 2 (nth old footnote-style-alist)))))
;; Internal functions
-(defun Footnote-insert-numbered-footnote (arg &optional mousable)
+(defun footnote--insert-numbered-footnote (arg &optional mousable)
"Insert numbered footnote at (point)."
(let ((string (concat footnote-start-tag
- (Footnote-index-to-string arg)
+ (footnote--index-to-string arg)
footnote-end-tag)))
(insert-before-markers
(if mousable
@@ -456,7 +554,7 @@ styles."
string 'footnote-number arg footnote-mouse-highlight t)
(propertize string 'footnote-number arg)))))
-(defun Footnote-renumber (from to pointer-alist text-alist)
+(defun footnote--renumber (_from to pointer-alist text-alist)
"Renumber a single footnote."
(let* ((posn-list (cdr pointer-alist)))
(setcar pointer-alist to)
@@ -464,49 +562,40 @@ styles."
(while posn-list
(goto-char (car posn-list))
(when (looking-back (concat (regexp-quote footnote-start-tag)
- (Footnote-current-regexp)
+ (footnote--current-regexp)
(regexp-quote footnote-end-tag))
(line-beginning-position))
(replace-match
(propertize
(concat footnote-start-tag
- (Footnote-index-to-string to)
+ (footnote--index-to-string to)
footnote-end-tag)
'footnote-number to footnote-mouse-highlight t)))
(setq posn-list (cdr posn-list)))
(goto-char (cdr text-alist))
(when (looking-at (concat (regexp-quote footnote-start-tag)
- (Footnote-current-regexp)
+ (footnote--current-regexp)
(regexp-quote footnote-end-tag)))
(replace-match
(propertize
(concat footnote-start-tag
- (Footnote-index-to-string to)
+ (footnote--index-to-string to)
footnote-end-tag)
'footnote-number to)))))
-;; Not needed?
-(defun Footnote-narrow-to-footnotes ()
+(defun footnote--narrow-to-footnotes ()
"Restrict text in buffer to show only text of footnotes."
- (interactive) ; testing
- (goto-char (point-max))
- (when (re-search-backward footnote-signature-separator nil t)
- (let ((end (point)))
- (cond
- ((and (not (string-equal footnote-section-tag ""))
- (re-search-backward
- (concat "^" footnote-section-tag-regexp) nil t))
- (narrow-to-region (point) end))
- (footnote-text-marker-alist
- (narrow-to-region (cdar footnote-text-marker-alist) end))))))
+ (interactive) ; testing
+ (narrow-to-region (footnote--get-area-point-min)
+ (footnote--get-area-point-max)))
-(defun Footnote-goto-char-point-max ()
+(defun footnote--goto-char-point-max ()
"Move to end of buffer or prior to start of .signature."
(goto-char (point-max))
(or (re-search-backward footnote-signature-separator nil t)
(point)))
-(defun Footnote-insert-text-marker (arg locn)
+(defun footnote--insert-text-marker (arg locn)
"Insert a marker pointing to footnote ARG, at buffer location LOCN."
(let ((marker (make-marker)))
(unless (assq arg footnote-text-marker-alist)
@@ -514,9 +603,9 @@ styles."
(setq footnote-text-marker-alist
(cons (cons arg marker) footnote-text-marker-alist))
(setq footnote-text-marker-alist
- (Footnote-sort footnote-text-marker-alist)))))
+ (footnote--sort footnote-text-marker-alist)))))
-(defun Footnote-insert-pointer-marker (arg locn)
+(defun footnote--insert-pointer-marker (arg locn)
"Insert a marker pointing to footnote ARG, at buffer location LOCN."
(let ((marker (make-marker))
alist)
@@ -527,14 +616,14 @@ styles."
(setq footnote-pointer-marker-alist
(cons (cons arg (list marker)) footnote-pointer-marker-alist))
(setq footnote-pointer-marker-alist
- (Footnote-sort footnote-pointer-marker-alist)))))
+ (footnote--sort footnote-pointer-marker-alist)))))
-(defun Footnote-insert-footnote (arg)
+(defun footnote--insert-footnote (arg)
"Insert a footnote numbered ARG, at (point)."
(push-mark)
- (Footnote-insert-pointer-marker arg (point))
- (Footnote-insert-numbered-footnote arg t)
- (Footnote-goto-char-point-max)
+ (footnote--insert-pointer-marker arg (point))
+ (footnote--insert-numbered-footnote arg t)
+ (footnote--goto-char-point-max)
(if (cond
((not (string-equal footnote-section-tag ""))
(re-search-backward (concat "^" footnote-section-tag-regexp) nil t))
@@ -542,8 +631,8 @@ styles."
(goto-char (cdar footnote-text-marker-alist))))
(save-restriction
(when footnote-narrow-to-footnotes-when-editing
- (Footnote-narrow-to-footnotes))
- (Footnote-goto-footnote (1- arg)) ; evil, FIXME (less evil now)
+ (footnote--narrow-to-footnotes))
+ (footnote-goto-footnote (1- arg)) ; evil, FIXME (less evil now)
;; (message "Inserting footnote %d" arg)
(unless
(or (eq arg 1)
@@ -552,11 +641,11 @@ styles."
"\n\n"
(concat "\n"
(regexp-quote footnote-start-tag)
- (Footnote-current-regexp)
+ (footnote--current-regexp)
(regexp-quote footnote-end-tag)))
nil t)
(unless (beginning-of-line) t))
- (Footnote-goto-char-point-max)
+ (footnote--goto-char-point-max)
(cond
((not (string-equal footnote-section-tag ""))
(re-search-backward
@@ -570,46 +659,115 @@ styles."
(unless (string-equal footnote-section-tag "")
(insert footnote-section-tag "\n")))
(let ((old-point (point)))
- (Footnote-insert-numbered-footnote arg nil)
- (Footnote-insert-text-marker arg old-point)))
+ (footnote--insert-numbered-footnote arg nil)
+ (footnote--insert-text-marker arg old-point)))
-(defun Footnote-sort (list)
+(defun footnote--sort (list)
(sort list (lambda (e1 e2)
(< (car e1) (car e2)))))
-(defun Footnote-text-under-cursor ()
- "Return the number of footnote if in footnote text.
+(defun footnote--text-under-cursor ()
+ "Return the number of the current footnote if in footnote text.
Return nil if the cursor is not positioned over the text of
a footnote."
- (when (and (let ((old-point (point)))
- (save-excursion
- (save-restriction
- (Footnote-narrow-to-footnotes)
- (and (>= old-point (point-min))
- (<= old-point (point-max))))))
- footnote-text-marker-alist
- (>= (point) (cdar footnote-text-marker-alist)))
- (let ((i 1)
- alist-txt rc)
+ (when (and footnote-text-marker-alist
+ (<= (footnote--get-area-point-min)
+ (point)
+ (footnote--get-area-point-max)))
+ (let ((i 1) alist-txt result)
(while (and (setq alist-txt (nth i footnote-text-marker-alist))
- (null rc))
- (when (< (point) (cdr alist-txt))
- (setq rc (car (nth (1- i) footnote-text-marker-alist))))
- (setq i (1+ i)))
- (when (and (null rc)
- (null alist-txt))
- (setq rc (car (nth (1- i) footnote-text-marker-alist))))
- rc)))
-
-(defun Footnote-under-cursor ()
+ (null result))
+ (when (< (point) (cdr alist-txt))
+ (setq result (car (nth (1- i) footnote-text-marker-alist))))
+ (setq i (1+ i)))
+ (when (and (null result) (null alist-txt))
+ (setq result (car (nth (1- i) footnote-text-marker-alist))))
+ result)))
+
+(defun footnote--under-cursor ()
"Return the number of the footnote underneath the cursor.
Return nil if the cursor is not over a footnote."
(or (get-text-property (point) 'footnote-number)
- (Footnote-text-under-cursor)))
+ (footnote--text-under-cursor)))
+
+(defun footnote--calc-fn-alignment-column ()
+ "Calculate the left alignment for footnote text."
+ ;; FIXME: Maybe it would be better to go to the footnote's beginning and
+ ;; see at which column it starts.
+ (+ footnote-body-tag-spacing
+ (string-width
+ (concat footnote-start-tag footnote-end-tag
+ (footnote--index-to-string
+ (caar (last footnote-text-marker-alist)))))))
+
+(defun footnote--fill-prefix-string ()
+ "Return the fill prefix to be used by footnote mode."
+ ;; TODO: Prefix to this value other prefix strings, such as those
+ ;; designating a comment line, a message response, or a boxquote.
+ (make-string (footnote--calc-fn-alignment-column) ?\s))
+
+(defun footnote--point-in-body-p ()
+ "Return non-nil if point is in the buffer text area,
+i.e. before the beginning of the footnote area."
+ (< (point) (footnote--get-area-point-min)))
+
+(defun footnote--get-area-point-min (&optional before-tag)
+ "Return start of the first footnote.
+If there is no footnote area, returns `point-max'.
+With optional arg BEFORE-TAG, return position of the `footnote-section-tag'
+instead, if applicable."
+ (cond
+ ;; FIXME: Shouldn't we use `footnote--get-area-point-max' instead?
+ ((not footnote-text-marker-alist) (point-max))
+ ((not before-tag) (cdr (car footnote-text-marker-alist)))
+ ((string-equal footnote-section-tag "")
+ (cdr (car footnote-text-marker-alist)))
+ (t
+ (save-excursion
+ (goto-char (cdr (car footnote-text-marker-alist)))
+ (if (re-search-backward (concat "^" footnote-section-tag-regexp) nil t)
+ (match-beginning 0)
+ (message "Footnote section tag not found!")
+ ;; This `else' should never happen, and indicates an error,
+ ;; ie. footnotes already exist and a footnote-section-tag is defined,
+ ;; but the section tag hasn't been found. We choose to assume that the
+ ;; user deleted it intentionally and wants us to behave in this buffer
+ ;; as if the section tag was set "", so we do that, now.
+ ;;(setq footnote-section-tag "")
+ ;;
+ ;; HOWEVER: The rest of footnote mode does not currently honor or
+ ;; account for this.
+ ;;
+ ;; To illustrate the difference in behavior, create a few footnotes,
+ ;; delete the section tag, and create another footnote. Then undo,
+ ;; comment the above line (that sets the tag to ""), re-evaluate this
+ ;; function, and repeat.
+ ;;
+ ;; TODO: integrate sanity checks at reasonable operational points.
+ (cdr (car footnote-text-marker-alist)))))))
+
+(defun footnote--get-area-point-max ()
+ "Return the end of footnote area.
+This is either `point-max' or the start of a `.signature' string, as
+defined by variable `footnote-signature-separator'. If there is no
+footnote area, returns `point-max'."
+ (save-excursion (footnote--goto-char-point-max)))
+
+(defun footnote--adaptive-fill-function (orig-fun)
+ (or
+ (and
+ footnote-mode
+ footnote-align-to-fn-text
+ (footnote--text-under-cursor)
+ ;; (not (footnote--point-in-body-p))
+ ;; (< (point) (footnote--signature-area-start-point))
+ (footnote--fill-prefix-string))
+ ;; If not within a footnote's text, fallback to the default.
+ (funcall orig-fun)))
;;; User functions
-(defun Footnote-make-hole ()
+(defun footnote--make-hole ()
(save-excursion
(let ((i 0)
(notes (length footnote-pointer-marker-alist))
@@ -622,32 +780,32 @@ Return nil if the cursor is not over a footnote."
(setq rc (car alist-ptr)))
(save-excursion
(message "Renumbering from %s to %s"
- (Footnote-index-to-string (car alist-ptr))
- (Footnote-index-to-string
+ (footnote--index-to-string (car alist-ptr))
+ (footnote--index-to-string
(1+ (car alist-ptr))))
- (Footnote-renumber (car alist-ptr)
+ (footnote--renumber (car alist-ptr)
(1+ (car alist-ptr))
alist-ptr
alist-txt)))
(setq i (1+ i)))
rc)))
-(defun Footnote-add-footnote (&optional arg)
+(defun footnote-add-footnote ()
"Add a numbered footnote.
The number the footnote receives is dependent upon the relative location
of any other previously existing footnotes.
If the variable `footnote-narrow-to-footnotes-when-editing' is set,
the buffer is narrowed to the footnote body. The restriction is removed
-by using `Footnote-back-to-message'."
- (interactive "*P")
+by using `footnote-back-to-message'."
+ (interactive "*")
(let ((num
(if footnote-text-marker-alist
(if (< (point) (cl-cadar (last footnote-pointer-marker-alist)))
- (Footnote-make-hole)
+ (footnote--make-hole)
(1+ (caar (last footnote-text-marker-alist))))
1)))
(message "Adding footnote %d" num)
- (Footnote-insert-footnote num)
+ (footnote--insert-footnote num)
(insert-before-markers (make-string footnote-body-tag-spacing ? ))
(let ((opoint (point)))
(save-excursion
@@ -656,18 +814,18 @@ by using `Footnote-back-to-message'."
"\n\n"
"\n"))
(when footnote-narrow-to-footnotes-when-editing
- (Footnote-narrow-to-footnotes)))
+ (footnote--narrow-to-footnotes)))
;; Emacs/XEmacs bug? save-excursion doesn't restore point when using
;; insert-before-markers.
(goto-char opoint))))
-(defun Footnote-delete-footnote (&optional arg)
+(defun footnote-delete-footnote (&optional arg)
"Delete a numbered footnote.
With no parameter, delete the footnote under (point). With ARG specified,
delete the footnote with that number."
(interactive "*P")
(unless arg
- (setq arg (Footnote-under-cursor)))
+ (setq arg (footnote--under-cursor)))
(when (and arg
(or (not footnote-prompt-before-deletion)
(y-or-n-p (format "Really delete footnote %d?" arg))))
@@ -681,7 +839,7 @@ delete the footnote with that number."
(save-excursion
(goto-char (car locn))
(when (looking-back (concat (regexp-quote footnote-start-tag)
- (Footnote-current-regexp)
+ (footnote--current-regexp)
(regexp-quote footnote-end-tag))
(line-beginning-position))
(delete-region (match-beginning 0) (match-end 0))))
@@ -692,20 +850,20 @@ delete the footnote with that number."
(point)
(if footnote-spaced-footnotes
(search-forward "\n\n" nil t)
- (save-restriction
+ (save-restriction ; <= 2017-12 Boruch: WHY?? I see no narrowing / widening here.
(end-of-line)
(next-single-char-property-change
- (point) 'footnote-number nil (Footnote-goto-char-point-max))))))
+ (point) 'footnote-number nil (footnote--goto-char-point-max))))))
(setq footnote-pointer-marker-alist
(delq alist-ptr footnote-pointer-marker-alist))
(setq footnote-text-marker-alist
(delq alist-txt footnote-text-marker-alist))
- (Footnote-renumber-footnotes)
+ (footnote-renumber-footnotes)
(when (and (null footnote-text-marker-alist)
(null footnote-pointer-marker-alist))
(save-excursion
(if (not (string-equal footnote-section-tag ""))
- (let* ((end (Footnote-goto-char-point-max))
+ (let* ((end (footnote--goto-char-point-max))
(start (1- (re-search-backward
(concat "^" footnote-section-tag-regexp)
nil t))))
@@ -715,13 +873,13 @@ delete the footnote with that number."
(delete-region start (if (< end (point-max))
end
(point-max))))
- (Footnote-goto-char-point-max)
+ (footnote--goto-char-point-max)
(when (looking-back "\n\n" (- (point) 2))
(kill-line -1))))))))
-(defun Footnote-renumber-footnotes (&optional arg)
+(defun footnote-renumber-footnotes ()
"Renumber footnotes, starting from 1."
- (interactive "*P")
+ (interactive "*")
(save-excursion
(let ((i 0)
(notes (length footnote-pointer-marker-alist))
@@ -730,16 +888,16 @@ delete the footnote with that number."
(setq alist-ptr (nth i footnote-pointer-marker-alist))
(setq alist-txt (nth i footnote-text-marker-alist))
(unless (= (1+ i) (car alist-ptr))
- (Footnote-renumber (car alist-ptr) (1+ i) alist-ptr alist-txt))
+ (footnote--renumber (car alist-ptr) (1+ i) alist-ptr alist-txt))
(setq i (1+ i))))))
-(defun Footnote-goto-footnote (&optional arg)
+(defun footnote-goto-footnote (&optional arg)
"Jump to the text of a footnote.
With no parameter, jump to the text of the footnote under (point). With ARG
specified, jump to the text of that footnote."
(interactive "P")
(unless arg
- (setq arg (Footnote-under-cursor)))
+ (setq arg (footnote--under-cursor)))
(let ((footnote (assq arg footnote-text-marker-alist)))
(cond
(footnote
@@ -755,13 +913,13 @@ specified, jump to the text of that footnote."
(t
(error "I don't see a footnote here")))))
-(defun Footnote-back-to-message (&optional arg)
+(defun footnote-back-to-message ()
"Move cursor back to footnote referent.
If the cursor is not over the text of a footnote, point is not changed.
If the buffer was narrowed due to `footnote-narrow-to-footnotes-when-editing'
being set it is automatically widened."
- (interactive "P")
- (let ((note (Footnote-text-under-cursor)))
+ (interactive)
+ (let ((note (footnote--text-under-cursor)))
(when note
(when footnote-narrow-to-footnotes-when-editing
(widen))
@@ -769,13 +927,13 @@ being set it is automatically widened."
(defvar footnote-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "a" 'Footnote-add-footnote)
- (define-key map "b" 'Footnote-back-to-message)
- (define-key map "c" 'Footnote-cycle-style)
- (define-key map "d" 'Footnote-delete-footnote)
- (define-key map "g" 'Footnote-goto-footnote)
- (define-key map "r" 'Footnote-renumber-footnotes)
- (define-key map "s" 'Footnote-set-style)
+ (define-key map "a" 'footnote-add-footnote)
+ (define-key map "b" 'footnote-back-to-message)
+ (define-key map "c" 'footnote-cycle-style)
+ (define-key map "d" 'footnote-delete-footnote)
+ (define-key map "g" 'footnote-goto-footnote)
+ (define-key map "r" 'footnote-renumber-footnotes)
+ (define-key map "s" 'footnote-set-style)
map))
(defvar footnote-minor-mode-map
@@ -798,8 +956,14 @@ play around with the following keys:
:lighter footnote-mode-line-string
:keymap footnote-minor-mode-map
;; (filladapt-mode t)
+ (unless adaptive-fill-function
+ ;; nil and `ignore' have the same semantics for adaptive-fill-function,
+ ;; but only `ignore' behaves correctly with add/remove-function.
+ (setq adaptive-fill-function #'ignore))
+ (remove-function (local 'adaptive-fill-function)
+ #'footnote--adaptive-fill-function)
(when footnote-mode
- ;; (Footnote-setup-keybindings)
+ ;; (footnote-setup-keybindings)
(make-local-variable 'footnote-style)
(make-local-variable 'footnote-body-tag-spacing)
(make-local-variable 'footnote-spaced-footnotes)
@@ -807,7 +971,12 @@ play around with the following keys:
(make-local-variable 'footnote-section-tag-regexp)
(make-local-variable 'footnote-start-tag)
(make-local-variable 'footnote-end-tag)
+ (make-local-variable 'adaptive-fill-function)
+ (add-function :around (local 'adaptive-fill-function)
+ #'footnote--adaptive-fill-function)
+ ;; filladapt is an XEmacs package which AFAIK has never been ported
+ ;; to Emacs.
(when (boundp 'filladapt-token-table)
;; add tokens to filladapt to match footnotes
;; 1] xxxxxxxxxxx x x x or [1] x x x x x x x
diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el
index aa2e0cb3e74..b5fb1aec00f 100644
--- a/lisp/mail/hashcash.el
+++ b/lisp/mail/hashcash.el
@@ -1,4 +1,4 @@
-;;; hashcash.el --- Add hashcash payments to email
+;;; hashcash.el --- Add hashcash payments to email -*- lexical-binding:t -*-
;; Copyright (C) 2003-2005, 2007-2018 Free Software Foundation, Inc.
@@ -47,7 +47,7 @@
;;; Code:
-(eval-when-compile (require 'cl)) ; for case
+(eval-when-compile (require 'cl-lib))
(defgroup hashcash nil
"Hashcash configuration."
@@ -139,12 +139,12 @@ For example, you may want to set this to (\"-Z2\") to reduce header length."
(defun hashcash-token-substring ()
(save-excursion
(let ((token ""))
- (loop
+ (cl-loop
(setq token
(concat token (buffer-substring (point) (hashcash-point-at-eol))))
(goto-char (hashcash-point-at-eol))
(forward-char 1)
- (unless (looking-at "[ \t]") (return token))
+ (unless (looking-at "[ \t]") (cl-return token))
(while (looking-at "[ \t]") (forward-char 1))))))
(defun hashcash-payment-required (addr)
@@ -298,7 +298,7 @@ BUFFER defaults to the current buffer."
(let* ((split (split-string token ":"))
(key (if (< (hashcash-version token) 1.2)
(nth 1 split)
- (case (string-to-number (nth 0 split))
+ (pcase (string-to-number (nth 0 split))
(0 (nth 2 split))
(1 (nth 3 split))))))
(cond ((null resource)
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index 1b72d39126d..83042b42e87 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -1,4 +1,4 @@
-;;; ietf-drums.el --- Functions for parsing RFC822bis headers
+;;; ietf-drums.el --- Functions for parsing RFC822bis headers -*- lexical-binding:t -*-
;; Copyright (C) 1998-2018 Free Software Foundation, Inc.
@@ -37,7 +37,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defvar ietf-drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177"
"US-ASCII control characters excluding CR, LF and white space.")
@@ -78,10 +78,10 @@ backslash and doublequote.")
(defun ietf-drums-token-to-list (token)
"Translate TOKEN into a list of characters."
(let ((i 0)
- b e c out range)
+ b c out range)
(while (< i (length token))
(setq c (aref token i))
- (incf i)
+ (cl-incf i)
(cond
((eq c ?-)
(if b
@@ -90,7 +90,7 @@ backslash and doublequote.")
(range
(while (<= b c)
(push (make-char 'ascii b) out)
- (incf b))
+ (cl-incf b))
(setq range nil))
((= i (length token))
(push (make-char 'ascii c) out))
@@ -115,7 +115,7 @@ backslash and doublequote.")
(setq c (char-after))
(cond
((eq c ?\")
- (condition-case err
+ (condition-case nil
(forward-sexp 1)
(error (goto-char (point-max)))))
((eq c ?\()
diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el
index fb03ab4f220..4da3641893b 100644
--- a/lisp/mail/rfc2231.el
+++ b/lisp/mail/rfc2231.el
@@ -1,4 +1,4 @@
-;;; rfc2231.el --- Functions for decoding rfc2231 headers
+;;; rfc2231.el --- Functions for decoding rfc2231 headers -*- lexical-binding:t -*-
;; Copyright (C) 1998-2018 Free Software Foundation, Inc.
@@ -22,7 +22,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'ietf-drums)
(require 'rfc2047)
(autoload 'mm-encode-body "mm-bodies")
@@ -181,7 +180,7 @@ must never cause a Lisp error."
;; Now collect and concatenate continuation parameters.
(let ((cparams nil)
elem)
- (loop for (attribute value part encoded)
+ (cl-loop for (attribute value part encoded)
in (sort parameters (lambda (e1 e2)
(< (or (caddr e1) 0)
(or (caddr e2) 0))))
@@ -291,7 +290,7 @@ the result of this function."
(insert param "*=")
(while (not (eobp))
(insert (if (>= num 0) " " "")
- param "*" (format "%d" (incf num)) "*=")
+ param "*" (format "%d" (cl-incf num)) "*=")
(forward-line 1))))
(spacep
(goto-char (point-min))
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 6b0c93d60cb..7b542638743 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -3399,21 +3399,15 @@ Interactively, empty argument means use same regexp used last time."
(defun rmail-simplified-subject (&optional msgnum)
"Return the simplified subject of message MSGNUM (or current message).
-Simplifying the subject means stripping leading and trailing whitespace,
-and typical reply prefixes such as Re:."
- (let ((subject (or (rmail-get-header "Subject" msgnum) "")))
+Simplifying the subject means stripping leading and trailing
+whitespace, replacing whitespace runs with a single space and
+removing prefixes such as Re:, Fwd: and so on and mailing list
+tags such as [tag]."
+ (let ((subject (or (rmail-get-header "Subject" msgnum) ""))
+ (regexp "\`[ \t\n]*\\(\\(\\w\\{1,3\\}:\\|\\[[^]]+]\\)[ \t\n]+\\)*"))
(setq subject (rfc2047-decode-string subject))
- (if (string-match "\\`[ \t]+" subject)
- (setq subject (substring subject (match-end 0))))
- (if (string-match rmail-reply-regexp subject)
- (setq subject (substring subject (match-end 0))))
- (if (string-match "[ \t]+\\'" subject)
- (setq subject (substring subject 0 (match-beginning 0))))
- ;; If Subject is long, mailers will break it into several lines at
- ;; arbitrary places, so normalize whitespace by replacing every
- ;; run of whitespace characters with a single space.
- (setq subject (replace-regexp-in-string "[ \t\n]+" " " subject))
- subject))
+ (setq subject (replace-regexp-in-string regexp "" subject))
+ (replace-regexp-in-string "[ \t\n]+" " " subject)))
(defun rmail-simplified-subject-regexp ()
"Return a regular expression matching the current simplified subject.
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index b6d0b53ce06..da2d3174ce1 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -243,15 +243,6 @@ Used by `mail-yank-original' via `mail-indent-citation'."
:type 'integer
:group 'sendmail)
-(defvar mail-yank-hooks nil
- "Obsolete hook for modifying a citation just inserted in the mail buffer.
-Each hook function can find the citation between (point) and (mark t).
-And each hook function should leave point and mark around the citation
-text as modified.
-This is a normal hook, misnamed for historical reasons.
-It is obsolete and mail agents should no longer use it.")
-(make-obsolete-variable 'mail-yank-hooks 'mail-citation-hook "19.34")
-
;;;###autoload
(defcustom mail-citation-hook nil
"Hook for modifying a citation just inserted in the mail buffer.
@@ -1718,8 +1709,6 @@ and don't delete any header fields."
(rfc822-goto-eoh)
(point))))))
(run-hooks 'mail-citation-hook)))
- (mail-yank-hooks
- (run-hooks 'mail-yank-hooks))
(t
(mail-indent-citation)))))
;; This is like exchange-point-and-mark, but doesn't activate the mark.
@@ -1788,9 +1777,7 @@ and don't delete any header fields."
(rfc822-goto-eoh)
(point))))))
(run-hooks 'mail-citation-hook))
- (if mail-yank-hooks
- (run-hooks 'mail-yank-hooks)
- (mail-indent-citation))))))))
+ (mail-indent-citation)))))))
(defun mail-split-line ()
"Split current line, moving portion beyond point vertically down.
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 571089d2144..20cbeb5f4ea 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -941,7 +941,7 @@ Returns an error if the server cannot be contacted."
(if (and (multibyte-string-p data)
smtpmail-code-conv-from)
- (setq data (string-as-multibyte
+ (setq data (string-as-multibyte ;FIXME: ???
(encode-coding-string data smtpmail-code-conv-from))))
(if smtpmail-debug-info
diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el
index e1ed1c9eb8e..0cdceca6ff5 100644
--- a/lisp/mail/uudecode.el
+++ b/lisp/mail/uudecode.el
@@ -1,4 +1,4 @@
-;;; uudecode.el -- elisp native uudecode
+;;; uudecode.el -- elisp native uudecode -*- lexical-binding:t -*-
;; Copyright (C) 1998-2018 Free Software Foundation, Inc.
@@ -24,13 +24,10 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
-(eval-and-compile
- (defalias 'uudecode-char-int
- (if (fboundp 'char-int)
- 'char-int
- 'identity)))
+(defalias 'uudecode-char-int
+ (if (fboundp 'char-int)
+ 'char-int
+ 'identity))
(defgroup uudecode nil
"Decoding of uuencoded data."
@@ -78,7 +75,7 @@ input and write the converted data to its standard output."
If FILE-NAME is non-nil, save the result to FILE-NAME. The program
used is specified by `uudecode-decoder-program'."
(interactive "r\nP")
- (let ((cbuf (current-buffer)) tempfile firstline status)
+ (let ((cbuf (current-buffer)) tempfile firstline)
(save-excursion
(goto-char start)
(when (re-search-forward uudecode-begin-line nil t)
@@ -110,7 +107,7 @@ used is specified by `uudecode-decoder-program'."
(insert "begin 600 " (file-name-nondirectory tempfile) "\n")
(insert-buffer-substring cbuf firstline end)
(cd (file-name-directory tempfile))
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min)
(point-max)
uudecode-decoder-program
@@ -128,20 +125,6 @@ used is specified by `uudecode-decoder-program'."
(message "Can not uudecode")))
(ignore-errors (or file-name (delete-file tempfile))))))
-(eval-and-compile
- (defalias 'uudecode-string-to-multibyte
- (cond
- ((featurep 'xemacs)
- 'identity)
- ((fboundp 'string-to-multibyte)
- 'string-to-multibyte)
- (t
- (lambda (string)
- "Return a multibyte string with the same individual chars as string."
- (mapconcat
- (lambda (ch) (string-as-multibyte (char-to-string ch)))
- string ""))))))
-
;;;###autoload
(defun uudecode-decode-region-internal (start end &optional file-name)
"Uudecode region between START and END without using an external program.
@@ -216,13 +199,13 @@ If FILE-NAME is non-nil, save the result to FILE-NAME."
(if file-name
(with-temp-file file-name
(unless (featurep 'xemacs) (set-buffer-multibyte nil))
- (insert (apply 'concat (nreverse result))))
+ (insert (apply #'concat (nreverse result))))
(or (markerp end) (setq end (set-marker (make-marker) end)))
(goto-char start)
(if enable-multibyte-characters
(dolist (x (nreverse result))
- (insert (uudecode-string-to-multibyte x)))
- (insert (apply 'concat (nreverse result))))
+ (insert (decode-coding-string x 'binary)))
+ (insert (apply #'concat (nreverse result))))
(delete-region (point) end))))))
;;;###autoload
diff --git a/lisp/mail/yenc.el b/lisp/mail/yenc.el
index 4e3eea729a9..25b4ebb9bda 100644
--- a/lisp/mail/yenc.el
+++ b/lisp/mail/yenc.el
@@ -1,4 +1,4 @@
-;;; yenc.el --- elisp native yenc decoder
+;;; yenc.el --- elisp native yenc decoder -*- lexical-binding:t -*-
;; Copyright (C) 2002-2018 Free Software Foundation, Inc.
@@ -32,7 +32,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defconst yenc-begin-line
"^=ybegin.*$")
@@ -97,14 +97,14 @@
(cond ((or (eq char ?\r)
(eq char ?\n)))
((eq char ?=)
- (setq char (char-after (incf first)))
+ (setq char (char-after (cl-incf first)))
(with-current-buffer work-buffer
(insert-char (mod (- char 106) 256) 1)))
(t
(with-current-buffer work-buffer
;;(insert-char (mod (- char 42) 256) 1)
(insert-char (aref yenc-decoding-vector char) 1))))
- (incf first))
+ (cl-incf first))
(setq bytes (buffer-size work-buffer))
(unless (and (= (cdr (assq 'size header-alist)) bytes)
(= (cdr (assq 'size footer-alist)) bytes))
View Lorry Controller Status