commit c7a50740273a338285abe7c9bb24a1f45928e02a (HEAD, refs/remotes/origin/master) Author: Boruch Baum Date: Fri Dec 22 23:06:22 2017 -0500 * lisp/mail/footnote.el (footnote-align-to-fn-text): New config var (footnote-mode): Declare. (Footnote--get-area-point-min): Fix last change to use 'car` instead of the undefined 'first'. (Footnote--calc-fn-alignment-column, Footnote--fill-prefix-string) (Footnote--adaptive-fill-function): New functions. (footnote-mode): Use them. diff --git a/etc/NEWS b/etc/NEWS index 714e964c96..1f8fe67152 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -87,6 +87,11 @@ strings in non-text modes. * Changes in Specialized Modes and Packages in Emacs 27.1 +** Footnote-mode +*** Support Hebrew-style footnotes +*** Footnote text lines are now aligned. +Can be controlled via the new variable 'footnote-align-to-fn-text'. + ** CSS mode --- diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index 272672904b..adfe03d306 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -156,13 +156,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 + "If non-nil, align footnote text lines. +If nil, footnote text lines are to be aligned flush left with left side +of the footnote number. If non-nil footnote text lines are to be aligned +with the first character of footnote text." + :type 'boolean) + ;;; Private variables (defvar footnote-style-number nil @@ -180,6 +188,8 @@ 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]+" @@ -675,6 +685,22 @@ Return nil if the cursor is not over a footnote." (or (get-text-property (point) 'footnote-number) (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." @@ -688,12 +714,12 @@ 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 (first footnote-text-marker-alist))) + ((not before-tag) (cdr (car footnote-text-marker-alist))) ((string-equal footnote-section-tag "") - (cdr (first footnote-text-marker-alist))) + (cdr (car footnote-text-marker-alist))) (t (save-excursion - (goto-char (cdr (first footnote-text-marker-alist))) + (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!") @@ -713,7 +739,7 @@ instead, if applicable." ;; function, and repeat. ;; ;; TODO: integrate sanity checks at reasonable operational points. - (cdr (first footnote-text-marker-alist))))))) + (cdr (car footnote-text-marker-alist))))))) (defun Footnote--get-area-point-max () "Return the end of footnote area. @@ -722,6 +748,18 @@ 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 () @@ -913,6 +951,12 @@ 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) (make-local-variable 'footnote-style) @@ -922,6 +966,9 @@ 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. commit 57d54a0edd0c59fbd09efd826db1ef2b3f41b902 Author: Stefan Monnier Date: Fri Dec 22 22:34:15 2017 -0500 * lisp/textmodes/fill.el (adaptive-fill-function): Change default Use 'ignore' rather than nil since they behave identically, except that 'ignore' interacts correctly with add/remove-function. diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 96023265b0..d218db0fac 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -128,10 +128,11 @@ if it would act as a paragraph-starter on the second line." :type 'regexp :group 'fill) -(defcustom adaptive-fill-function nil - "Function to call to choose a fill prefix for a paragraph, or nil. -A nil value means the function has not determined the fill prefix." - :type '(choice (const nil) function) +(defcustom adaptive-fill-function #'ignore + "Function to call to choose a fill prefix for a paragraph. +A nil return value means the function has not determined the fill prefix." + :version "27.1" + :type 'function :group 'fill) (defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks. commit 4ee066381cfe941f58040c117fec83a9712cc80a Author: Boruch Baum Date: Fri Dec 22 21:44:52 2017 -0500 * lisp/mail/footnote.el: Misc changes in preparation for more (footnote-section-tag-regexp): Don't require the trailing space. (Footnote--point-in-body-p, Footnote--get-area-point-min) (Footnote--get-area-point-max): New functions. (Footnote-narrow-to-footnotes, Footnote-text-under-cursor): Use them. diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index 0c39f62f3e..272672904b 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1997, 2000-2017 Free Software Foundation, Inc. ;; Author: Steven L Baur +;; Boruch Baum ;; 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: @@ -101,11 +129,15 @@ footnotes." :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) @@ -532,20 +564,15 @@ styles." footnote-end-tag) 'footnote-number to))))) -;; Not needed? +;; Not needed? <-- 2017-12 Boruch: Not my comment! BUT, when I +;; starting hacking the code, this function +;; `Footnote-narrow-to-footnotes' was never narrowing, and the result +;; wasn't breaking anything. (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 () "Move to end of buffer or prior to start of .signature." @@ -625,28 +652,22 @@ styles." (< (car e1) (car e2))))) (defun Footnote-text-under-cursor () - "Return the number of footnote if in footnote text. + "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))) + (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. @@ -654,6 +675,53 @@ Return nil if the cursor is not over a footnote." (or (get-text-property (point) 'footnote-number) (Footnote-text-under-cursor))) +(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 (first footnote-text-marker-alist))) + ((string-equal footnote-section-tag "") + (cdr (first footnote-text-marker-alist))) + (t + (save-excursion + (goto-char (cdr (first 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 (first 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))) + ;;; User functions (defun Footnote-make-hole () @@ -739,7 +807,7 @@ 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)))))) @@ -855,6 +923,8 @@ play around with the following keys: (make-local-variable 'footnote-start-tag) (make-local-variable 'footnote-end-tag) + ;; 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 commit 3404a87f29b28b449a2e6188f075df2f761caac5 Merge: 5ee4f2fa87 34fcfc5c04 Author: Glenn Morris Date: Fri Dec 22 13:23:16 2017 -0500 Merge from origin/emacs-26 34fcfc5 (origin/emacs-26, emacs-26) * lisp/emacs-lisp/inline.el (defi... f7a62c2 Fix doc string of 'footnote-style-alist' c3b6742 Improve documentation of selecting windows 861d110 Improve documentation of records 22b3075 * etc/NEWS: Mention the removal of pinentry.el. (Bug#27445) 689526b Fix interactive spec of 'semantic-ia-show-variants' 90ca37f Fix documentation of 'mouse-drag-and-drop-region' and friends d60faf3 Improve detection of speller version in ispell.el a0e3b06 Document 'mouse-drag-and-drop-region' options and mention the... 164e84c Fix uses of 'nil' and 'non-nil' in manuals and a few more min... 798f07f Document that mode commands should be idempotent. ad2a47c ; * src/xdisp.c (extend_face_to_end_of_line): Fix last change. 88ddf53 Fontify a CPP construct correctly when a comment follows with... de7de9c Prevent infloop in redisplay on TTY frames 293720e Fix loss of documentation face in certain CC Mode doc comment... # Conflicts: # etc/NEWS # lisp/mail/footnote.el commit 5ee4f2fa8792ebaa84184f1a82219fbcd93e8103 Merge: 639fe3dddf 8a73b7003e Author: Glenn Morris Date: Fri Dec 22 13:18:06 2017 -0500 ; Merge from origin/emacs-26 The following commit was skipped: 8a73b70 Remove pinentry.el commit 639fe3dddfe67a75e4ad831d2240fd6420f81573 Author: Stefan Monnier Date: Fri Dec 22 10:29:20 2017 -0500 * lisp/progmodes/cperl-mode.el: Split table for electric kwd abbrevs (cperl-mode-electric-keywords-abbrev-table): New abbrev table. (cperl-mode-abbrev-table): Use it. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index c4f1ff2ec7..ed53a1974e 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1060,35 +1060,42 @@ versions of Emacs." (eval-when-compile (mapc #'require '(imenu easymenu etags timer man info))) -(define-abbrev-table 'cperl-mode-abbrev-table - ;; FIXME: Use a separate abbrev table for that, enabled conditionally, - ;; as we did with python-mode-skeleton-abbrev-table! - (when (cperl-val 'cperl-electric-keywords) - '( - ("if" "if" cperl-electric-keyword :system t) - ("elsif" "elsif" cperl-electric-keyword :system t) - ("while" "while" cperl-electric-keyword :system t) - ("until" "until" cperl-electric-keyword :system t) - ("unless" "unless" cperl-electric-keyword :system t) - ("else" "else" cperl-electric-else :system t) - ("continue" "continue" cperl-electric-else :system t) - ("for" "for" cperl-electric-keyword :system t) - ("foreach" "foreach" cperl-electric-keyword :system t) - ("formy" "formy" cperl-electric-keyword :system t) - ("foreachmy" "foreachmy" cperl-electric-keyword :system t) - ("do" "do" cperl-electric-keyword :system t) - ("=pod" "=pod" cperl-electric-pod :system t) - ("=begin" "=begin" cperl-electric-pod 0 :system t) - ("=over" "=over" cperl-electric-pod :system t) - ("=head1" "=head1" cperl-electric-pod :system t) - ("=head2" "=head2" cperl-electric-pod :system t) - ("pod" "pod" cperl-electric-pod :system t) - ("over" "over" cperl-electric-pod :system t) - ("head1" "head1" cperl-electric-pod :system t) - ("head2" "head2" cperl-electric-pod :system t))) - "Abbrev table in use in CPerl mode buffers.") +(define-abbrev-table 'cperl-mode-electric-keywords-abbrev-table + (mapcar (lambda (x) + (let ((name (car x)) + (fun (cadr x))) + (list name name fun :system t))) + '(("if" cperl-electric-keyword) + ("elsif" cperl-electric-keyword) + ("while" cperl-electric-keyword) + ("until" cperl-electric-keyword) + ("unless" cperl-electric-keyword) + ("else" cperl-electric-else) + ("continue" cperl-electric-else) + ("for" cperl-electric-keyword) + ("foreach" cperl-electric-keyword) + ("formy" cperl-electric-keyword) + ("foreachmy" cperl-electric-keyword) + ("do" cperl-electric-keyword) + ("=pod" cperl-electric-pod) + ("=begin" cperl-electric-pod t) + ("=over" cperl-electric-pod) + ("=head1" cperl-electric-pod) + ("=head2" cperl-electric-pod) + ("pod" cperl-electric-pod) + ("over" cperl-electric-pod) + ("head1" cperl-electric-pod) + ("head2" cperl-electric-pod))) + "Abbrev table for electric keywords. Controlled by `cperl-electric-keywords'." + :case-fixed t + :enable-function (lambda () (cperl-val 'cperl-electric-keywords))) + +(define-abbrev-table 'cperl-mode-abbrev-table () + "Abbrev table in use in CPerl mode buffers." + :parents (list cperl-mode-electric-keywords-abbrev-table)) (when (boundp 'edit-var-mode-alist) + ;; FIXME: What package uses this? (add-to-list 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-")))) (defvar cperl-mode-map commit 168382db92d7ab9b8d7997b0bb91165b338e41e6 Author: Stefan Monnier Date: Fri Dec 22 10:06:49 2017 -0500 * lisp/progmodes/cperl-mode.el: Use cl-lib. Fix comment convention (defgroup, defcustom, defface, x-color-defined-p, uncomment-region) (ps-extend-face-list, eval-after-load, turn-on-font-lock): Assume defined. (cperl-calculate-indent): Use 'functionp' to test if a value is a function. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 64ee8c1b7e..c4f1ff2ec7 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -23,7 +23,7 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;;; Corrections made by Ilya Zakharevich ilyaz@cpan.org +;; Corrections made by Ilya Zakharevich ilyaz@cpan.org ;;; Commentary: @@ -66,7 +66,7 @@ ;; (define-key global-map [M-S-down-mouse-3] 'imenu) -;;; Font lock bugs as of v4.32: +;;;; Font lock bugs as of v4.32: ;; The following kinds of Perl code erroneously start strings: ;; \$` \$' \$" @@ -75,6 +75,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defvar vc-rcs-header) (defvar vc-sccs-header) @@ -90,24 +92,6 @@ (defvar font-lock-background-mode) ; not in Emacs (defvar font-lock-display-type) ; ditto (defvar paren-backwards-message) ; Not in newer XEmacs? - (or (fboundp 'defgroup) - (defmacro defgroup (_name _val _doc &rest _) - nil)) - (or (fboundp 'custom-declare-variable) - (defmacro defcustom (name val doc &rest _) - `(defvar ,name ,val ,doc))) - (or (fboundp 'custom-declare-variable) - (defmacro defface (&rest _) - nil)) - ;; Avoid warning (tmp definitions) - (or (fboundp 'x-color-defined-p) - (defmacro x-color-defined-p (col) - (cond ((fboundp 'color-defined-p) `(color-defined-p ,col)) - ;; XEmacs >= 19.12 - ((fboundp 'valid-color-name-p) `(valid-color-name-p ,col)) - ;; XEmacs 19.11 - ((fboundp 'x-valid-color-name-p) `(x-valid-color-name-p ,col)) - (t '(error "Cannot implement color-defined-p"))))) (defmacro cperl-is-face (arg) ; Takes quoted arg (cond ((fboundp 'find-face) `(find-face ,arg)) @@ -224,10 +208,10 @@ for constructs with multiline if/unless/while/until/for/foreach condition." :type 'integer :group 'cperl-indentation-details) -;; Is is not unusual to put both things like perl-indent-level and -;; cperl-indent-level in the local variable section of a file. If only +;; It is not unusual to put both things like perl-indent-level and +;; cperl-indent-level in the local variable section of a file. If only ;; one of perl-mode and cperl-mode is in use, a warning will be issued -;; about the variable. Autoload these here, so that no warning is +;; about the variable. Autoload these here, so that no warning is ;; issued when using either perl-mode or cperl-mode. ;;;###autoload(put 'cperl-indent-level 'safe-local-variable 'integerp) ;;;###autoload(put 'cperl-brace-offset 'safe-local-variable 'integerp) @@ -459,7 +443,7 @@ Font for POD headers." :type 'face :group 'cperl-faces) -;;; Some double-evaluation happened with font-locks... Needed with 21.2... +;; Some double-evaluation happened with font-locks... Needed with 21.2... (defvar cperl-singly-quote-face (featurep 'xemacs)) (defcustom cperl-invalid-face 'underline @@ -1017,11 +1001,6 @@ In regular expressions (including character classes): (defun cperl-putback-char (c) ; XEmacs >= 19.12 (push (character-to-event c) unread-command-events))) -(or (fboundp 'uncomment-region) - (defun uncomment-region (beg end) - (interactive "r") - (comment-region beg end -1))) - (defvar cperl-do-not-fontify ;; FIXME: This is not doing what it claims! (if (string< emacs-version "19.30") @@ -1079,20 +1058,7 @@ versions of Emacs." ;; (setq interpreter-mode-alist (append interpreter-mode-alist ;; '(("miniperl" . perl-mode)))))) (eval-when-compile - (mapc (lambda (p) - (condition-case nil - (require p) - (error nil))) - '(imenu easymenu etags timer man info)) - (if (fboundp 'ps-extend-face-list) - (defmacro cperl-ps-extend-face-list (arg) - `(ps-extend-face-list ,arg)) - (defmacro cperl-ps-extend-face-list (_) - `(error "This version of Emacs has no `ps-extend-face-list'"))) - ;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs, - ;; macros instead of defsubsts don't work on Emacs, so we do the - ;; expansion manually. Any other suggestions? - (require 'cl)) + (mapc #'require '(imenu easymenu etags timer man info))) (define-abbrev-table 'cperl-mode-abbrev-table ;; FIXME: Use a separate abbrev table for that, enabled conditionally, @@ -1299,15 +1265,15 @@ versions of Emacs." ["Class Hierarchy from TAGS" cperl-tags-hier-init t] ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] ("Tags" -;;; ["Create tags for current file" cperl-etags t] -;;; ["Add tags for current file" (cperl-etags t) t] -;;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] -;;; ["Add tags for Perl files in directory" (cperl-etags t t) t] -;;; ["Create tags for Perl files in (sub)directories" -;;; (cperl-etags nil 'recursive) t] -;;; ["Add tags for Perl files in (sub)directories" -;;; (cperl-etags t 'recursive) t]) -;;;; cperl-write-tags (&optional file erase recurse dir inbuffer) + ;; ["Create tags for current file" cperl-etags t] + ;; ["Add tags for current file" (cperl-etags t) t] + ;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] + ;; ["Add tags for Perl files in directory" (cperl-etags t t) t] + ;; ["Create tags for Perl files in (sub)directories" + ;; (cperl-etags nil 'recursive) t] + ;; ["Add tags for Perl files in (sub)directories" + ;; (cperl-etags t 'recursive) t]) + ;; ;;? cperl-write-tags (&optional file erase recurse dir inbuffer) ["Create tags for current file" (cperl-write-tags nil t) t] ["Add tags for current file" (cperl-write-tags) t] ["Create tags for Perl files in directory" @@ -1366,12 +1332,12 @@ versions of Emacs." The expansion is entirely correct because it uses the C preprocessor." t) -;;; These two must be unwound, otherwise take exponential time +;; These two must be unwound, otherwise take exponential time (defconst cperl-maybe-white-and-comment-rex "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*" "Regular expression to match optional whitespace with interspersed comments. Should contain exactly one group.") -;;; This one is tricky to unwind; still very inefficient... +;; This one is tricky to unwind; still very inefficient... (defconst cperl-white-and-comment-rex "\\([ \t\n]\\|#[^\n]*\n\\)+" "Regular expression to match whitespace with interspersed comments. Should contain exactly one group.") @@ -1425,13 +1391,13 @@ the last)." (defun cperl-char-ends-sub-keyword-p (char) "Return T if CHAR is the last character of a perl sub keyword." - (loop for keyword in cperl-sub-keywords - when (eq char (aref keyword (1- (length keyword)))) - return t)) + (cl-loop for keyword in cperl-sub-keywords + when (eq char (aref keyword (1- (length keyword)))) + return t)) -;;; Details of groups in this are used in `cperl-imenu--create-perl-index' -;;; and `cperl-outline-level'. -;;;; Was: 2=sub|package; now 2=package-group, 5=package-name 8=sub-name (+3) +;; Details of groups in this are used in `cperl-imenu--create-perl-index' +;; and `cperl-outline-level'. +;; Was: 2=sub|package; now 2=package-group, 5=package-name 8=sub-name (+3) (defvar cperl-imenu--function-name-regexp-perl (concat "^\\(" ; 1 = all @@ -1914,24 +1880,24 @@ or as help on variables `cperl-tips', `cperl-problems', (cperl-make-indent comment-column 1) ; Indent min 1 c))))) -;;;(defun cperl-comment-indent-fallback () -;;; "Is called if the standard comment-search procedure fails. -;;;Point is at start of real comment." -;;; (let ((c (current-column)) target cnt prevc) -;;; (if (= c comment-column) nil -;;; (setq cnt (skip-chars-backward "[ \t]")) -;;; (setq target (max (1+ (setq prevc -;;; (current-column))) ; Else indent at comment column -;;; comment-column)) -;;; (if (= c comment-column) nil -;;; (delete-backward-char cnt) -;;; (while (< prevc target) -;;; (insert "\t") -;;; (setq prevc (current-column))) -;;; (if (> prevc target) (progn (delete-char -1) (setq prevc (current-column)))) -;;; (while (< prevc target) -;;; (insert " ") -;;; (setq prevc (current-column))))))) +;;(defun cperl-comment-indent-fallback () +;; "Is called if the standard comment-search procedure fails. +;;Point is at start of real comment." +;; (let ((c (current-column)) target cnt prevc) +;; (if (= c comment-column) nil +;; (setq cnt (skip-chars-backward "[ \t]")) +;; (setq target (max (1+ (setq prevc +;; (current-column))) ; Else indent at comment column +;; comment-column)) +;; (if (= c comment-column) nil +;; (delete-backward-char cnt) +;; (while (< prevc target) +;; (insert "\t") +;; (setq prevc (current-column))) +;; (if (> prevc target) (progn (delete-char -1) (setq prevc (current-column)))) +;; (while (< prevc target) +;; (insert " ") +;; (setq prevc (current-column))))))) (defun cperl-indent-for-comment () "Substitute for `indent-for-comment' in CPerl." @@ -2647,17 +2613,17 @@ PRESTART is the position basing on which START was found." (defun cperl-beginning-of-property (p prop &optional lim) "Given that P has a property PROP, find where the property starts. Will not look before LIM." - ;;; XXXX What to do at point-max??? +;;; XXXX What to do at point-max??? (or (previous-single-property-change (cperl-1+ p) prop lim) (point-min)) -;;; (cond ((eq p (point-min)) -;;; p) -;;; ((and lim (<= p lim)) -;;; p) -;;; ((not (get-text-property (1- p) prop)) -;;; p) -;;; (t (or (previous-single-property-change p look-prop lim) -;;; (point-min)))) + ;; (cond ((eq p (point-min)) + ;; p) + ;; ((and lim (<= p lim)) + ;; p) + ;; ((not (get-text-property (1- p) prop)) + ;; p) + ;; (t (or (previous-single-property-change p look-prop lim) + ;; (point-min)))) ) (defun cperl-sniff-for-indent (&optional parse-data) ; was parse-start @@ -2968,7 +2934,7 @@ and closing parentheses and brackets." (cond (what (let ((action (cadr what))) - (cond ((fboundp action) (apply action (list i parse-data))) + (cond ((functionp action) (apply action (list i parse-data))) ((numberp action) (+ action (current-indentation))) (t action)))) ;; @@ -3392,8 +3358,8 @@ Works before syntax recognition is done." (or now (put-text-property b e 'cperl-postpone (cons type val))) (put-text-property b e type val))) -;;; Here is how the global structures (those which cannot be -;;; recognized locally) are marked: +;; Here is how the global structures (those which cannot be +;; recognized locally) are marked: ;; a) PODs: ;; Start-to-end is marked `in-pod' ==> t ;; Each non-literal part is marked `syntax-type' ==> `pod' @@ -3413,8 +3379,8 @@ Works before syntax recognition is done." ;; (or 0 if declaration); up to `{' or ';': `syntax-type' => `sub-decl'. ;; f) Multiline my/our declaration lists etc: `syntax-type' => `multiline' -;;; In addition, some parts of RExes may be marked as `REx-interpolated' -;;; (value: 0 in //o, 1 if "interpolated variable" is whole-REx, t otherwise). +;; In addition, some parts of RExes may be marked as `REx-interpolated' +;; (value: 0 in //o, 1 if "interpolated variable" is whole-REx, t otherwise). (defun cperl-unwind-to-safe (before &optional end) ;; if BEFORE, go to the previous start-of-line on each step of unwinding @@ -3451,7 +3417,7 @@ Works before syntax recognition is done." (setq end (point))))) (or end pos))))) -;;; These are needed for byte-compile (at least with v19) +;; These are needed for byte-compile (at least with v19) (defvar cperl-nonoverridable-face) (defvar font-lock-variable-name-face) (defvar font-lock-function-name-face) @@ -3586,7 +3552,7 @@ Should be called with the point before leading colon of an attribute." (goto-char endbracket) ; just in case something misbehaves??? t)) -;;; Debugging this may require (setq max-specpdl-size 2000)... +;; Debugging this may require (setq max-specpdl-size 2000)... (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max end-of-here-doc) "Scans the buffer for hard-to-parse Perl constructions. If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify @@ -4489,7 +4455,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (setq REx-subgr-end qtag) ;End smart-highlighted ;; Apparently, I can't put \] into a charclass ;; in m]]: m][\\\]\]] produces [\\]] -;;; POSIX? [:word:] [:^word:] only inside [] +;;; POSIX? [:word:] [:^word:] only inside [] ;;; "\\=\\(\\\\.\\|[^][\\\\]\\|\\[:\\^?\sw+:]\\|\\[[^:]\\)*]") (while ; look for unescaped ] (and argument @@ -4769,12 +4735,12 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (forward-sexp -1) (looking-at (concat cperl-sub-regexp "[ \t\n\f#]")))))))))) -;;; What is the difference of (cperl-after-block-p lim t) and (cperl-block-p)? -;;; No save-excursion; condition-case ... In (cperl-block-p) the block -;;; may be a part of an in-statement construct, such as -;;; ${something()}, print {FH} $data. -;;; Moreover, one takes positive approach (looks for else,grep etc) -;;; another negative (looks for bless,tr etc) +;; What is the difference of (cperl-after-block-p lim t) and (cperl-block-p)? +;; No save-excursion; condition-case ... In (cperl-block-p) the block +;; may be a part of an in-statement construct, such as +;; ${something()}, print {FH} $data. +;; Moreover, one takes positive approach (looks for else,grep etc) +;; another negative (looks for bless,tr etc) (defun cperl-after-block-p (lim &optional pre-block) "Return true if the preceding } (if PRE-BLOCK, following {) delimits a block. Would not look before LIM. Assumes that LIM is a good place to begin a @@ -5551,7 +5517,7 @@ indentation and initial hashes. Behaves usually outside of comment." (defun cperl-outline-level () (looking-at outline-regexp) (cond ((not (match-beginning 1)) 0) ; beginning-of-file -;;;; 2=package-group, 5=package-name 8=sub-name 16=head-level + ;; 2=package-group, 5=package-name 8=sub-name 16=head-level ((match-beginning 2) 0) ; package ((match-beginning 8) 1) ; sub ((match-beginning 16) @@ -5574,10 +5540,9 @@ indentation and initial hashes. Behaves usually outside of comment." (if (memq major-mode '(perl-mode cperl-mode)) (progn (or cperl-faces-init (cperl-init-faces))))))) - (if (fboundp 'eval-after-load) - (eval-after-load - "ps-print" - '(or cperl-faces-init (cperl-init-faces))))))) + (eval-after-load + "ps-print" + '(or cperl-faces-init (cperl-init-faces)))))) (defvar cperl-font-lock-keywords-1 nil "Additional expressions to highlight in Perl mode. Minimal set.") @@ -5626,6 +5591,7 @@ indentation and initial hashes. Behaves usually outside of comment." (cons (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" + ;; FIXME: Use regexp-opt. (mapconcat #'identity (append @@ -5647,6 +5613,7 @@ indentation and initial hashes. Behaves usually outside of comment." (list (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" + ;; FIXME: Use regexp-opt. ;; "CORE" "__FILE__" "__LINE__" "__SUB__" "abs" "accept" "alarm" ;; "and" "atan2" "bind" "binmode" "bless" "caller" ;; "chdir" "chmod" "chown" "chr" "chroot" "close" @@ -5863,41 +5830,34 @@ indentation and initial hashes. Behaves usually outside of comment." '("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend))) (setq t-font-lock-keywords-1 - (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock - ;; not yet as of XEmacs 19.12, works with 21.1.11 - (or - (not (featurep 'xemacs)) - (string< "21.1.9" emacs-version) - (and (string< "21.1.10" emacs-version) - (string< emacs-version "21.1.2"))) - '( - ("\\(\\([@%]\\|\\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 - (if (eq (char-after (match-beginning 2)) ?%) - 'cperl-hash-face - 'cperl-array-face) - t) ; arrays and hashes - ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" - 1 - (if (= (- (match-end 2) (match-beginning 2)) 1) - (if (eq (char-after (match-beginning 3)) ?{) - 'cperl-hash-face - 'cperl-array-face) ; arrays and hashes - font-lock-variable-name-face) ; Just to put something - t) - ("\\(@\\|\\$#\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" - (1 cperl-array-face) - (2 font-lock-variable-name-face)) - ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" - (1 cperl-hash-face) - (2 font-lock-variable-name-face)) - ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") - ;;; Too much noise from \s* @s[ and friends - ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" - ;;(3 font-lock-function-name-face t t) - ;;(4 - ;; (if (cperl-slash-is-regexp) - ;; font-lock-function-name-face 'default) nil t)) - ))) + '( + ("\\(\\([@%]\\|\\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 + (if (eq (char-after (match-beginning 2)) ?%) + 'cperl-hash-face + 'cperl-array-face) + t) ; arrays and hashes + ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" + 1 + (if (= (- (match-end 2) (match-beginning 2)) 1) + (if (eq (char-after (match-beginning 3)) ?{) + 'cperl-hash-face + 'cperl-array-face) ; arrays and hashes + font-lock-variable-name-face) ; Just to put something + t) + ("\\(@\\|\\$#\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" + (1 cperl-array-face) + (2 font-lock-variable-name-face)) + ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" + (1 cperl-hash-face) + (2 font-lock-variable-name-face)) +;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") +;;; Too much noise from \s* @s[ and friends + ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" + ;;(3 font-lock-function-name-face t t) + ;;(4 + ;; (if (cperl-slash-is-regexp) + ;; font-lock-function-name-face 'default) nil t)) + )) (if cperl-highlight-variables-indiscriminately (setq t-font-lock-keywords-1 (append t-font-lock-keywords-1 @@ -5992,13 +5952,6 @@ indentation and initial hashes. Behaves usually outside of comment." ;; Do it the dull way, without choose-color (defvar cperl-guessed-background nil "Display characteristics as guessed by cperl.") - ;; (or (fboundp 'x-color-defined-p) - ;; (defalias 'x-color-defined-p - ;; (cond ((fboundp 'color-defined-p) 'color-defined-p) - ;; ;; XEmacs >= 19.12 - ;; ((fboundp 'valid-color-name-p) 'valid-color-name-p) - ;; ;; XEmacs 19.11 - ;; (t 'x-valid-color-name-p)))) (cperl-force-face font-lock-constant-face "Face for constant and label names") (cperl-force-face font-lock-variable-name-face @@ -6064,16 +6017,7 @@ indentation and initial hashes. Behaves usually outside of comment." (let ((background (if (boundp 'font-lock-background-mode) font-lock-background-mode - 'light)) - ;; (face-list (and (fboundp 'face-list) (face-list))) - ) - ;; (fset 'cperl-is-face - ;; (cond ((fboundp 'find-face) - ;; (symbol-function 'find-face)) - ;; (face-list - ;; (function (lambda (face) (member face face-list)))) - ;; (t - ;; (function (lambda (face) (boundp face)))))) + 'light))) (defvar cperl-guessed-background (if (and (boundp 'font-lock-display-type) (eq font-lock-display-type 'grayscale)) @@ -6112,40 +6056,40 @@ indentation and initial hashes. Behaves usually outside of comment." (if (x-color-defined-p "orchid1") "orchid1" "orange"))))) -;;; (if (cperl-is-face 'font-lock-other-emphasized-face) nil -;;; (copy-face 'bold-italic 'font-lock-other-emphasized-face) -;;; (cond -;;; ((eq background 'light) -;;; (set-face-background 'font-lock-other-emphasized-face -;;; (if (x-color-defined-p "lightyellow2") -;;; "lightyellow2" -;;; (if (x-color-defined-p "lightyellow") -;;; "lightyellow" -;;; "light yellow")))) -;;; ((eq background 'dark) -;;; (set-face-background 'font-lock-other-emphasized-face -;;; (if (x-color-defined-p "navy") -;;; "navy" -;;; (if (x-color-defined-p "darkgreen") -;;; "darkgreen" -;;; "dark green")))) -;;; (t (set-face-background 'font-lock-other-emphasized-face "gray90")))) -;;; (if (cperl-is-face 'font-lock-emphasized-face) nil -;;; (copy-face 'bold 'font-lock-emphasized-face) -;;; (cond -;;; ((eq background 'light) -;;; (set-face-background 'font-lock-emphasized-face -;;; (if (x-color-defined-p "lightyellow2") -;;; "lightyellow2" -;;; "lightyellow"))) -;;; ((eq background 'dark) -;;; (set-face-background 'font-lock-emphasized-face -;;; (if (x-color-defined-p "navy") -;;; "navy" -;;; (if (x-color-defined-p "darkgreen") -;;; "darkgreen" -;;; "dark green")))) -;;; (t (set-face-background 'font-lock-emphasized-face "gray90")))) + ;; (if (cperl-is-face 'font-lock-other-emphasized-face) nil + ;; (copy-face 'bold-italic 'font-lock-other-emphasized-face) + ;; (cond + ;; ((eq background 'light) + ;; (set-face-background 'font-lock-other-emphasized-face + ;; (if (x-color-defined-p "lightyellow2") + ;; "lightyellow2" + ;; (if (x-color-defined-p "lightyellow") + ;; "lightyellow" + ;; "light yellow")))) + ;; ((eq background 'dark) + ;; (set-face-background 'font-lock-other-emphasized-face + ;; (if (x-color-defined-p "navy") + ;; "navy" + ;; (if (x-color-defined-p "darkgreen") + ;; "darkgreen" + ;; "dark green")))) + ;; (t (set-face-background 'font-lock-other-emphasized-face "gray90")))) + ;; (if (cperl-is-face 'font-lock-emphasized-face) nil + ;; (copy-face 'bold 'font-lock-emphasized-face) + ;; (cond + ;; ((eq background 'light) + ;; (set-face-background 'font-lock-emphasized-face + ;; (if (x-color-defined-p "lightyellow2") + ;; "lightyellow2" + ;; "lightyellow"))) + ;; ((eq background 'dark) + ;; (set-face-background 'font-lock-emphasized-face + ;; (if (x-color-defined-p "navy") + ;; "navy" + ;; (if (x-color-defined-p "darkgreen") + ;; "darkgreen" + ;; "dark green")))) + ;; (t (set-face-background 'font-lock-emphasized-face "gray90")))) (if (cperl-is-face 'font-lock-variable-name-face) nil (copy-face 'italic 'font-lock-variable-name-face)) (if (cperl-is-face 'font-lock-constant-face) nil @@ -6194,7 +6138,7 @@ Style of printout regulated by the variable `cperl-ps-print-face-properties'." (require 'ps-print) ; To get ps-print-face-extension-alist (let ((ps-print-color-p t) (ps-print-face-extension-alist ps-print-face-extension-alist)) - (cperl-ps-extend-face-list cperl-ps-print-face-properties) + (ps-extend-face-list cperl-ps-print-face-properties) (ps-print-buffer-with-faces file))) ;; (defun cperl-ps-print-init () @@ -7171,8 +7115,7 @@ One may build such TAGS files from CPerl mode menu." (setq update ;; (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy)) (if (if (fboundp 'display-popup-menus-p) - (let ((f 'display-popup-menus-p)) - (funcall f)) + (display-popup-menus-p) window-system) (x-popup-menu t (nth 2 cperl-hierarchy)) (require 'tmm) @@ -8529,7 +8472,7 @@ the appropriate statement modifier." :type 'file :group 'cperl) -;;; By Nick Roberts (with changes) +;; By Nick Roberts (with changes) (defun cperl-pod-to-manpage () "Create a virtual manpage in Emacs from the Perl Online Documentation." (interactive) @@ -8546,7 +8489,7 @@ the appropriate statement modifier." (format (cperl-pod2man-build-command) pod2man-args)) 'Man-bgproc-sentinel))))) -;;; Updated version by him too +;; Updated version by him too (defun cperl-build-manpage () "Create a virtual manpage in Emacs from the POD in the file." (interactive) @@ -8619,7 +8562,7 @@ a result of qr//, this is not a performance hit), t for the rest." (if pp (goto-char pp) (message "No more interpolated REx")))) -;;; Initial version contributed by Trey Belew +;; Initial version contributed by Trey Belew (defun cperl-here-doc-spell () "Spell-check HERE-documents in the Perl buffer. If a region is highlighted, restricts to the region." @@ -8668,7 +8611,7 @@ function returns nil." (setq cont (funcall func pos posend prop))) (setq pos posend))))) -;;; Based on code by Masatake YAMATO: +;; Based on code by Masatake YAMATO: (defun cperl-get-here-doc-region (&optional pos pod) "Return HERE document region around the point. Return nil if the point is not in a HERE document region. If POD is non-nil, @@ -8857,7 +8800,7 @@ do extra unwind via `cperl-unwind-to-safe'." (font-lock-default-fontify-region beg end loudly)) (defvar cperl-d-l nil) -(defvar edebug-backtrace-buffer) +(defvar edebug-backtrace-buffer) ;FIXME: Why? (defun cperl-fontify-syntaxically (end) ;; Some vars for debugging only ;; (message "Syntaxifying...") commit f6e6f5937356158287e1095a8e51422a5cbd2abc Author: Boruch Baum Date: Fri Dec 22 16:39:44 2017 +0200 Support Hebrew-style footnotes in footnote.el * lisp/mail/footnote.el (footnote-hebrew-numeric-regex) (footnote-hebrew-symbolic-regex): New defconsts. (Footnote-hebrew-numeric, Footnote-hebrew-symbolic): New functions. (footnote-style-alist): Add new Hebrew styles. Doc fix. (footnote-style): Add new Hebrew styles. (Bug#29759) diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index 5e18d892d4..d82f741020 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -310,6 +310,48 @@ Use Unicode characters for footnoting." (push (aref footnote-unicode-string modulus) result)) (apply #'string result))) +;; Hebrew + +(defconst footnote-hebrew-numeric-regex "[אבגדהוזחטיכלמנסעפצקרשת']+") +; (defconst footnote-hebrew-numeric-regex "\\([אבגדהוזחט]'\\)?\\(ת\\)?\\(ת\\)?\\([קרשת]\\)?\\([טיכלמנסעפצ]\\)?\\([אבגדהוזחט]\\)?") + +(defconst footnote-hebrew-numeric + '( + ("א" "ב" "ג" "ד" "ה" "ו" "ז" "ח" "ט") + ("י" "כ" "ל" "מ" "נ" "ס" "ע" "פ" "צ") + ("ק" "ר" "ש" "ת" "תק" "תר"" תש" "תת" "תתק"))) + +(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 (if (not (= tens 1)) nil + (or (when (= units 5) "טו") + (when (= 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))) + (if special 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-regex "[אבגדהוזחטיכלמנסעפצקרשת]") + +(defconst 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) @@ -318,9 +360,12 @@ Use Unicode characters for footnoting." (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)) + (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 +By default, Arabic numbers, English letters, Roman Numerals, +Latin and Unicode superscript characters, and Hebrew numerals are available. See footnote-han.el, footnote-greek.el and footnote-hebrew.el for more exciting styles.") @@ -334,6 +379,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 commit 2b6912c3d1ca99719c9eb6efb5eb1e7986ad280d Author: Ian Johnson Date: Fri Dec 22 16:11:00 2017 +0200 Support French password prompts in shell French punctuation rules require a space (preferably non-breaking) before the colon. * lisp/comint.el (comint-password-prompt-regexp): Support spaces (including non-breaking spaces) before and after password prompt colon. (Bug#29729) Copyright-paperwork-exempt: yes diff --git a/lisp/comint.el b/lisp/comint.el index 5ee4e48d63..430e83888c 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -364,10 +364,10 @@ This variable is buffer-local." "\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)" "\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?" ;; "[[:alpha:]]" used to be "for", which fails to match non-English. - "\\(?: [[:alpha:]]+ .+\\)?[:：៖]\\s *\\'") + "\\(?: [[:alpha:]]+ .+\\)?[\\s  ]*[:：៖][\\s  ]*\\'") "Regexp matching prompts for passwords in the inferior process. This is used by `comint-watch-for-password-prompt'." - :version "26.1" + :version "27.1" :type 'regexp :group 'comint) commit ebe91f6026edf54d5de936d3d6b696d5c76ef705 Merge: 3521efce1a b5a5790d20 Author: Eli Zaretskii Date: Fri Dec 22 15:49:57 2017 +0200 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit b5a5790d2075a6cfcca32c7ad0809c76582e40ff Author: Ted Zlatanov Date: Fri Dec 22 08:49:21 2017 -0500 * lisp/registry.el (registry-collect-prune-candidates): Skip invalid entries diff --git a/lisp/registry.el b/lisp/registry.el index 17dc23d68e..3d0502a8f4 100644 --- a/lisp/registry.el +++ b/lisp/registry.el @@ -358,11 +358,12 @@ return LIMIT such candidates. If SORTFUNC is provided, sort entries first and return candidates from beginning of list." (let* ((precious (oref db precious)) (precious-p (lambda (entry-key) - (cdr (memq (car entry-key) precious)))) + (cdr (memq (car-safe entry-key) precious)))) (data (oref db data)) (candidates (cl-loop for k being the hash-keys of data using (hash-values v) - when (cl-notany precious-p v) + when (and (listp v) + (cl-notany precious-p v)) collect (cons k v)))) ;; We want the full entries for sorting, but should only return a ;; list of entry keys. commit 3521efce1a9c3094e9911445a7db23f87cd3e5f4 Author: Francesco Potortì Date: Fri Dec 22 15:48:19 2017 +0200 Improve Rmail Subject normalization when replying * lisp/mail/rmail.el (rmail-simplified-subject): A more thorough implementation which removes more prefixes from Subject. (Bug#29659) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 994570edcb..c32f000d30 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. commit e92f5537a8222187525ef5066dba051211db5290 Author: Eli Zaretskii Date: Fri Dec 22 15:31:32 2017 +0200 Improve the description of 'electric-quote-replace-double' * etc/NEWS: Improve the description of 'electric-quote-replace-double'. (Bug#29806) diff --git a/etc/NEWS b/etc/NEWS index 1ab1930ea7..714e964c96 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -77,9 +77,12 @@ This controls how long Emacs will wait for updates to the graphical state to take effect (making a frame visible, for example). +++ -** The new user option 'electric-quote-replace-double' controls -whether '"' is also replaced in 'electric-quote-mode'. If non-nil, -'"' is replaced by a double typographic quote. +** New user option 'electric-quote-replace-double'. +This option controls whether '"' is replaced in 'electric-quote-mode', +in addition to other quote characters. If non-nil, ASCII double-quote +characters that quote text "like this" are replaced by double +typographic quotes, “like this”, in text modes, and in comments and +strings in non-text modes. * Changes in Specialized Modes and Packages in Emacs 27.1 commit 34fcfc5c049bb99d68945bb24fb9d6a0789a33dd Author: Eli Zaretskii Date: Fri Dec 22 12:37:19 2017 +0200 * lisp/emacs-lisp/inline.el (define-inline): Add a doc string. diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el index ff27158f83..b9f63c9447 100644 --- a/lisp/emacs-lisp/inline.el +++ b/lisp/emacs-lisp/inline.el @@ -124,6 +124,10 @@ After VARS is handled, BODY is evaluated in the new environment." ;;;###autoload (defmacro define-inline (name args &rest body) + "Define an inline function NAME with arguments ARGS and body in BODY. + +This is like `defmacro', but has several advantages. +See Info node `(elisp)Defining Functions' for more details." ;; FIXME: How can this work with CL arglists? (declare (indent defun) (debug defun) (doc-string 3)) (let ((doc (if (stringp (car-safe body)) (list (pop body)))) commit f7a62c2b488ceb8c56cba1f44aec73f8c1108816 Author: Eli Zaretskii Date: Fri Dec 22 12:25:09 2017 +0200 Fix doc string of 'footnote-style-alist' * lisp/mail/footnote.el (footnote-style-alist): Remove a reference to non-existing files from doc string. (Bug#29759) diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index 5e18d892d4..68e5e47477 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -321,9 +321,7 @@ Use Unicode characters for footnoting." (unicode Footnote-unicode ,footnote-unicode-regexp)) "Styles of footnote tags available. By default only boring Arabic numbers, English letters and Roman Numerals -are available. -See footnote-han.el, footnote-greek.el and footnote-hebrew.el for more -exciting styles.") +are available.") (defcustom footnote-style 'numeric "Default style used for footnoting. commit c3b6742b3fb7459af64eec4986837c4714636c51 Author: Eli Zaretskii Date: Fri Dec 22 12:18:12 2017 +0200 Improve documentation of selecting windows * doc/lispref/windows.texi (Basic Windows, Selecting Windows): Clarify what selecting a window means for keyboard input, and that input focus may need to be considered when selecting windows on other frames. See http://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00372.html for more details. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 07c8f27bc8..d73b410f97 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -125,11 +125,13 @@ including for the case where @var{object} is a deleted window. as @dfn{selected within the frame}. For the selected frame, that window is called the @dfn{selected window}---the one in which most editing takes place, and in which the cursor for selected windows -appears (@pxref{Cursor Parameters}). The selected window's buffer is -usually also the current buffer, except when @code{set-buffer} has -been used (@pxref{Current Buffer}). As for non-selected frames, the -window selected within the frame becomes the selected window if the -frame is ever selected. @xref{Selecting Windows}. +appears (@pxref{Cursor Parameters}). Keyboard input that inserts or +deletes text is also normally directed to this window. The selected +window's buffer is usually also the current buffer, except when +@code{set-buffer} has been used (@pxref{Current Buffer}). As for +non-selected frames, the window selected within the frame becomes the +selected window if the frame is ever selected. @xref{Selecting +Windows}. @defun selected-window This function returns the selected window (which is always a live @@ -1726,7 +1728,7 @@ windows. @defun select-window window &optional norecord This function makes @var{window} the selected window and the window -selected within its frame (@pxref{Basic Windows}) and selects that +selected within its frame (@pxref{Basic Windows}), and selects that frame. It also makes @var{window}'s buffer (@pxref{Buffers and Windows}) current and sets that buffer's value of @code{point} to the value of @code{window-point} (@pxref{Window Point}) in @var{window}. @@ -1743,6 +1745,11 @@ next time. If @var{norecord} is non-@code{nil}, such updates are usually not performed. If, however, @var{norecord} equals the special symbol @code{mark-for-redisplay}, the additional actions mentioned above are omitted but @var{window} will be nevertheless updated. + +Note that sometimes selecting a window is not enough to show it, or +make its frame the top-most frame on display: you may also need to +raise the frame or make sure input focus is directed to that frame. +@xref{Input Focus}. @end defun @cindex select window hook commit 861d1100784ad2f4c7285a7afdc21e0ce216682c Author: Eli Zaretskii Date: Fri Dec 22 12:04:23 2017 +0200 Improve documentation of records * doc/lispref/Makefile.in (srcs): Add the forgotten records.texi. * doc/lispref/records.texi (Records): Recommend that record type names use package-naming conventions. * etc/NEWS: Add the naming convention recommendation for record types. diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in index 9fa5901a1a..50d6d161ef 100644 --- a/doc/lispref/Makefile.in +++ b/doc/lispref/Makefile.in @@ -118,6 +118,7 @@ srcs = \ $(srcdir)/package.texi \ $(srcdir)/positions.texi \ $(srcdir)/processes.texi \ + $(srcdir)/records.texi \ $(srcdir)/searching.texi \ $(srcdir)/sequences.texi \ $(srcdir)/streams.texi \ diff --git a/doc/lispref/records.texi b/doc/lispref/records.texi index 7cc36f1406..cae0f31f27 100644 --- a/doc/lispref/records.texi +++ b/doc/lispref/records.texi @@ -5,7 +5,7 @@ @c See the file elisp.texi for copying conditions. @node Records @chapter Records -@cindex record +@cindex records The purpose of records is to allow programmers to create objects with new types that are not built into Emacs. They are used as the @@ -28,6 +28,13 @@ type descriptor, the symbol naming its type will be returned; list specifying the contents. The first list element must be the record type. The following elements are the record slots. + To avoid conflicts with other type names, Lisp programs that define +new types of records should normally use the naming conventions of the +package where these record types are introduced for the names of the +types. Note that the names of the types which could possibly conflict +might not be known at the time the package defining a record type is +loaded; they could be loaded at some future point in time. + A record is considered a constant for evaluation: the result of evaluating it is the same record. This does not evaluate or even examine the slots. @xref{Self-Evaluating Forms}. diff --git a/etc/NEWS b/etc/NEWS index ccd819077e..692c28a721 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1584,6 +1584,10 @@ functions 'make-record', 'record', and 'recordp'. Records are now used internally to represent cl-defstruct and defclass instances, for example. +If your program defines new record types, you should use +package-naming conventions for naming those types. This is so any +potential conflicts with other types are avoided. + +++ ** 'save-some-buffers' now uses 'save-some-buffers-default-predicate' to decide which buffers to ask about, if the PRED argument is nil. commit 22b3075bb216c69ee7660151fda4eda70b9c3296 Author: Eli Zaretskii Date: Fri Dec 22 11:48:15 2017 +0200 * etc/NEWS: Mention the removal of pinentry.el. (Bug#27445) diff --git a/etc/NEWS b/etc/NEWS index 6e3001f5fa..ccd819077e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1489,6 +1489,19 @@ passing '&optional' multiple times: Previously, Emacs would just ignore the extra keyword, or give incorrect results in certain cases. +--- +** The pinentry.el library has been removed. +That package (and the corresponding change in GnuPG and pinentry) +was intended to provide a way to input passphrase through Emacs with +GnuPG 2.0. However, the change to support that was only implemented +in GnuPG >= 2.1 and didn't get backported to GnuPG 2.0. And with +GnuPG 2.1 and later, pinentry.el is not needed at all. So the +library was useless, and we removed it. GnuPG 2.0 is no longer +supported by the upstream project. + +To adapt to the change, you may need to set 'epa-pinentry-mode' to the +symbol 'loopback'. + * Lisp Changes in Emacs 26.1 commit 689526b714c3b4182110dc1ee59ff207b98d2fb6 Author: Eli Zaretskii Date: Fri Dec 22 11:32:38 2017 +0200 Fix interactive spec of 'semantic-ia-show-variants' * lisp/cedet/semantic/ia.el (semantic-ia-show-variants): Fix the interactive spec to match the function's expectations. (Bug#29770) diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el index 625c3ae975..7ca29bd24b 100644 --- a/lisp/cedet/semantic/ia.el +++ b/lisp/cedet/semantic/ia.el @@ -252,7 +252,7 @@ Completion options are calculated with `semantic-analyze-possible-completions'." ;;;###autoload (defun semantic-ia-show-variants (point) "Display a list of all variants for the symbol under POINT." - (interactive "P") + (interactive "d") (let* ((ctxt (semantic-analyze-current-context point)) (comp nil)) commit 90ca37feed236a2eb9d61e412dc3805aa8ad8933 Author: Eli Zaretskii Date: Fri Dec 22 11:19:56 2017 +0200 Fix documentation of 'mouse-drag-and-drop-region' and friends * doc/emacs/frames.texi (Drag and Drop): Index 'mouse-drag-and-drop-region-cut-when-buffers-differ', 'mouse-drag-and-drop-region-show-tooltip', and 'mouse-drag-and-drop-region-show-cursor'. * etc/NEWS: Fix the format of the related entries. diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index 5a052600ce..0c99407832 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -1114,6 +1114,9 @@ names a modifier key, such as @samp{shift}, @samp{control} or will copy it instead of cutting it, even if you drop on the same buffer as the one from which the text came. +@vindex mouse-drag-and-drop-region-cut-when-buffers-differ +@vindex mouse-drag-and-drop-region-show-tooltip +@vindex mouse-drag-and-drop-region-show-cursor In order to cut text even when source and destination buffers differ, set the option @code{mouse-drag-and-drop-region-cut-when-buffers-differ} to a diff --git a/etc/NEWS b/etc/NEWS index 7ad852ec71..6e3001f5fa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -256,18 +256,18 @@ whether the output buffer of an asynchronous command is shown immediately, or only when there is output. +++ -** The new user option 'mouse-select-region-move-to-beginning' -controls the position of point when double-clicking mouse-1 on the end -of a parenthetical grouping or string-delimiter: the default value nil -keeps point at the end of the region, setting it to non-nil moves -point to the beginning of the region. +** New user option 'mouse-select-region-move-to-beginning'. +This option controls the position of point when double-clicking +mouse-1 on the end of a parenthetical grouping or string-delimiter: +the default value nil keeps point at the end of the region, setting it +to non-nil moves point to the beginning of the region. +++ -** The new user option 'mouse-drag-and-drop-region' allows to drag the -entire region of text to another place or another buffer. Its -behavior is customizable via the new options +** New user option 'mouse-drag-and-drop-region'. +This option allows to drag the entire region of text to another place +or another buffer. Its behavior is customizable via the new options 'mouse-drag-and-drop-region-cut-when-buffers-differ', -'mouse-drag-and-drop-region-show-tooltip' and +'mouse-drag-and-drop-region-show-tooltip', and 'mouse-drag-and-drop-region-show-cursor'. +++ commit d60faf32757ef007c7b5d07a8b248ee4a6f8f83e Author: Eli Zaretskii Date: Fri Dec 22 11:11:29 2017 +0200 Improve detection of speller version in ispell.el * lisp/textmodes/ispell.el (ispell-check-version): Accept more general forms of version numbers for Aspell, Hunspell, and Enchant, to include various beta and prereleases. (Bug#29801) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 6a169622f5..25f62e317c 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -712,10 +712,10 @@ Otherwise returns the library directory name, if that is defined." (error "%s exited with %s %s" ispell-program-name (if (stringp status) "signal" "code") status)) - ;; Get relevant version strings. Only xx.yy.... format works well + ;; Get relevant version strings. (let (case-fold-search) (setq ispell-program-version - (and (search-forward-regexp "\\([0-9]+\\.[0-9\\.]+\\)" nil t) + (and (search-forward-regexp "\\([0-9]+\\.[0-9.]+\\)" nil t) (match-string 1))) ;; Make sure these variables are (re-)initialized to the default value @@ -725,19 +725,23 @@ Otherwise returns the library directory name, if that is defined." (goto-char (point-min)) (or (setq ispell-really-aspell - (and (search-forward-regexp - "(but really Aspell \\([0-9]+\\.[0-9\\.-]+\\)?)" nil t) - (match-string 1))) + (and + (search-forward-regexp + "(but really Aspell \\([0-9]+\\.[0-9.]+\\([-._+ ]?[a-zA-Z0-9]+\\)?\\)?)" + nil t) + (match-string 1))) (setq ispell-really-hunspell - (and (search-forward-regexp - "(but really Hunspell \\([0-9]+\\.[0-9\\.-]+\\)?)" - nil t) - (match-string 1))) + (and + (search-forward-regexp + "(but really Hunspell \\([0-9]+\\.[0-9.]+\\([-._+ ]?[a-zA-Z0-9]+\\)?\\)?)" + nil t) + (match-string 1))) (setq ispell-really-enchant - (and (search-forward-regexp - "(but really Enchant \\([0-9]+\\.[0-9\\.-]+\\)?)" - nil t) - (match-string 1))))) + (and + (search-forward-regexp + "(but really Enchant \\([0-9]+\\.[0-9.]+\\([-._+ ]?[a-zA-Z0-9]+\\)?\\)?)" + nil t) + (match-string 1))))) (let* ((aspell8-minver "0.60") (ispell-minver "3.1.12") commit a0e3b06725a48379a2e341f90dd090f042ad8e18 Author: Tak Kunihiro Date: Fri Dec 22 09:39:07 2017 +0100 Document 'mouse-drag-and-drop-region' options and mention them in NEWS * doc/emacs/frames.texi (Drag and Drop): * etc/NEWS (times): Document options for 'mouse-drag-and-drop-region' and mention them in NEWS. diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index 58e70eefaf..5a052600ce 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -1114,6 +1114,15 @@ names a modifier key, such as @samp{shift}, @samp{control} or will copy it instead of cutting it, even if you drop on the same buffer as the one from which the text came. +In order to cut text even when source and destination buffers differ, +set the option +@code{mouse-drag-and-drop-region-cut-when-buffers-differ} to a +non-@code{nil} value. By default, on a graphic display the selected +text is shown in a tooltip and point moves together with the mouse +cursor during dragging. To suppress such behavior, set the options +@code{mouse-drag-and-drop-region-show-tooltip} and/or +@code{mouse-drag-and-drop-region-show-cursor} to @code{nil}. + @node Menu Bars @section Menu Bars diff --git a/etc/NEWS b/etc/NEWS index d751adde9b..7ad852ec71 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -264,7 +264,11 @@ point to the beginning of the region. +++ ** The new user option 'mouse-drag-and-drop-region' allows to drag the -entire region of text to another place or another buffer. +entire region of text to another place or another buffer. Its +behavior is customizable via the new options +'mouse-drag-and-drop-region-cut-when-buffers-differ', +'mouse-drag-and-drop-region-show-tooltip' and +'mouse-drag-and-drop-region-show-cursor'. +++ ** The new user option 'confirm-kill-processes' allows the user to commit 164e84c9773d9738c80b49630c4e45d539b337ef Author: Martin Rudalics Date: Fri Dec 22 09:20:41 2017 +0100 Fix uses of 'nil' and 'non-nil' in manuals and a few more minor issues * doc/emacs/building.texi (Grep Searching): Fix doc of 'grep-save-buffers'. (Drag and Drop): Reorder paragraphs. Fix doc of 'mouse-drag-and-drop-region'. * doc/emacs/frames.texi (Word and Line Mouse): * doc/emacs/search.texi (Other Repeating Search): * doc/lispref/compile.texi (Compilation Functions): * doc/lispref/files.texi (Directory Names): * doc/lispref/functions.texi (Advising Named Functions): * doc/lispref/keymaps.texi (Controlling Active Maps): * doc/lispref/lists.texi (Association Lists): * doc/lispref/windows.texi (Quitting Windows): Fix uses of 'non-nil' and 'nil'. diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index e108a4e7c1..f342aef705 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -394,10 +394,11 @@ match will be highlighted, instead of the entire source line. The @command{grep} commands will offer to save buffers before running. This is controlled by the @code{grep-save-buffers} variable. The possible values are either @code{nil} (don't save), @code{ask} -(ask before saving), a function which will be used as a predicate (and -is called with the file name as the parameter and should return -non-nil if the buffer is to be saved), and any other non-@code{nil} -value means that all buffers should be saved without asking. +(ask before saving), or a function which will be used as a predicate +(and is called with the file name as the parameter and should return +non-@code{nil} if the buffer is to be saved). Any other +non-@code{nil} value means that all buffers should be saved without +asking. @findex grep-find @findex find-grep diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index c94d690cf7..58e70eefaf 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -243,9 +243,9 @@ location of point. Double-clicking on the end of a parenthetical grouping or end string-delimiter keeps point at the end of the region by default, so the beginning of the region will not be visible if it is above the top of the window; setting the user option -@code{mouse-select-region-move-to-beginning} to non-nil changes this -to move point to the beginning of the region, scrolling the display -backward if necessary. +@code{mouse-select-region-move-to-beginning} to non-@code{nil} changes +this to move point to the beginning of the region, scrolling the +display backward if necessary. @item Double-Drag-mouse-1 Select the text you drag across, in the form of whole words. @@ -1094,18 +1094,6 @@ file on a Dired buffer moves or copies the file (according to the conventions of the application it came from) into the directory displayed in that buffer. -@vindex mouse-drag-and-drop-region - Emacs can also optionally drag the region of text by mouse into -another portion of this or another buffer. To enable that, customize -the variable @code{mouse-drag-and-drop-region} to a non-nil value. -Normally, the text is moved, i.e. cut and pasted, when the destination -is the same buffer as the origin; dropping the region on another -buffer copies the text instead. If the value of this variable names a -modifier key, such as @samp{shift} or @samp{control} or @samp{alt}, -then pressing that modifier key when dropping the text will copy it -instead of cutting it, even if you drop on the same buffer as the one -from which the text came. - @vindex dnd-open-file-other-window Dropping a file normally visits it in the window you drop it on. If you prefer to visit the file in a new window in such cases, customize @@ -1114,6 +1102,19 @@ the variable @code{dnd-open-file-other-window}. The XDND and Motif drag and drop protocols, and the old KDE 1.x protocol, are currently supported. +@vindex mouse-drag-and-drop-region + Emacs can also optionally drag the region with the mouse into +another portion of this or another buffer. To enable that, customize +the variable @code{mouse-drag-and-drop-region} to a non-@code{nil} +value. Normally, the text is moved, i.e. cut and pasted, when the +destination is the same buffer as the origin; dropping the region on +another buffer copies the text instead. If the value of this variable +names a modifier key, such as @samp{shift}, @samp{control} or +@samp{alt}, then pressing that modifier key when dropping the text +will copy it instead of cutting it, even if you drop on the same +buffer as the one from which the text came. + + @node Menu Bars @section Menu Bars @cindex Menu Bar mode diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 7b334733d6..c4853686ae 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1746,12 +1746,13 @@ prompt, you can reuse search strings from previous incremental searches. The text that matched is highlighted using the @code{match} face. A numeric argument @var{n} specifies that @var{n} lines of context are to be displayed before and after each matching line. + The default number of context lines is specified by the variable -@code{list-matching-lines-default-context-lines}. -When @code{list-matching-lines-jump-to-current-line} is non-nil, -the current line is shown highlighted with face -@code{list-matching-lines-current-line-face} and the point is set -at the first match after such line. +@code{list-matching-lines-default-context-lines}. When +@code{list-matching-lines-jump-to-current-line} is non-@code{nil} the +current line is shown highlighted with face +@code{list-matching-lines-current-line-face} and the point is set at +the first match after such line. You can also run @kbd{M-s o} when an incremental search is active; this uses the current search string. diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index 57ff06085d..9123e93a5b 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -94,7 +94,7 @@ the @code{byte-compile} function. You can compile a whole file with recorded in a buffer called @file{*Compile-Log*}, which uses Compilation mode. @xref{Compilation Mode,,,emacs, The GNU Emacs Manual}. However, if the variable @code{byte-compile-debug} is -non-nil, error message will be signaled as Lisp errors instead +non-@code{nil}, error messages will be signaled as Lisp errors instead (@pxref{Errors}). @cindex macro compilation diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 254eab03ea..d249ce8783 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2284,7 +2284,8 @@ because this is not portable. Always use @code{file-name-as-directory}. To avoid the issues mentioned above, or if the @var{dirname} value -might be nil (for example, from an element of @code{load-path}), use: +might be @code{nil} (for example, from an element of @code{load-path}), +use: @example (expand-file-name @var{relfile} @var{dirname}) diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 466a12f7a4..58eaf6b80e 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1748,8 +1748,8 @@ code) obey the advice and other calls (from C code) do not. @defmac define-advice symbol (where lambda-list &optional name depth) &rest body This macro defines a piece of advice and adds it to the function named @var{symbol}. The advice is an anonymous function if @var{name} is -nil or a function named @code{symbol@@name}. See @code{advice-add} -for explanation of other arguments. +@code{nil} or a function named @code{symbol@@name}. See +@code{advice-add} for explanation of other arguments. @end defmac @defun advice-add symbol where function &optional props diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 73f5572e69..71b054e063 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -988,8 +988,9 @@ function is called with no arguments, prior to running each command, while @var{keymap} is active; it should return non-@code{nil} if @var{keymap} should stay active. -The optional argument @var{on-exit}, if non-nil, specifies a function -that is called, with no arguments, after @var{keymap} is deactivated. +The optional argument @var{on-exit}, if non-@code{nil}, specifies a +function that is called, with no arguments, after @var{keymap} is +deactivated. This function works by adding and removing @var{keymap} from the variable @code{overriding-terminal-local-map}, which takes precedence diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 0c99380682..230ea4b48e 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1514,9 +1514,10 @@ of property lists and association lists. @defun assoc key alist &optional testfn This function returns the first association for @var{key} in @var{alist}, comparing @var{key} against the alist elements using -@var{testfn} if non-nil, or @code{equal} if nil (@pxref{Equality -Predicates}). It returns @code{nil} if no association in @var{alist} -has a @sc{car} equal to @var{key}. For example: +@var{testfn} if it is non-@code{nil} and @code{equal} otherwise +(@pxref{Equality Predicates}). It returns @code{nil} if no +association in @var{alist} has a @sc{car} equal to @var{key}. For +example: @smallexample (setq trees '((pine . cones) (oak . acorns) (maple . seeds))) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 08ed092c48..07c8f27bc8 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -3059,7 +3059,7 @@ This function handles @var{window} and its buffer after quitting. The optional argument @var{window} must be a live window and defaults to the selected one. The function's behavior is determined by the four elements of the @code{quit-restore} window parameter (@pxref{Window -Parameters}), which is set to nil afterwards. +Parameters}), which is set to @code{nil} afterwards. The window is deleted entirely if: 1) the first element of the @code{quit-restore} parameter is one of 'window or 'frame, 2) the @@ -3126,7 +3126,7 @@ possible to set it manually, using the following code for displaying @end group @end example -Setting the window history to nil ensures that a future call to +Setting the window history to @code{nil} ensures that a future call to @code{quit-window} can delete the window altogether. @end defun commit 798f07f1509ac973a379db921bd796e0df7f2982 Author: Philipp Stephani Date: Sun Oct 8 17:25:31 2017 +0200 Document that mode commands should be idempotent. * doc/lispref/modes.texi (Major Mode Conventions, Minor Mode Conventions): Document that the mode commands should be idempotent. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index bd94aeadf1..1a601baee8 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -313,6 +313,11 @@ The major mode command should set the variable @code{mode-name} to the Data}, for other possible forms). The name of the mode appears in the mode line. +@item +Calling the major mode command twice in direct succession should not +fail and should do the same thing as calling the command only once. +In other words, the major mode command should be idempotent. + @item @cindex functions in modes Since all global names are in the same name space, all the global @@ -1412,6 +1417,10 @@ a minor mode in a mode hook is a little uglier: @noindent However, this is not very commonly done. + Enabling or disabling a minor mode twice in direct succession should +not fail and should do the same thing as enabling or disabling it only +once. In other words, the minor mode command should be idempotent. + @item Add an element to @code{minor-mode-alist} for each minor mode (@pxref{Definition of minor-mode-alist}), if you want to indicate the commit ad2a47ce83c5c6fada96706a0e596ecc79d77696 Author: Eli Zaretskii Date: Thu Dec 21 20:28:55 2017 +0200 ; * src/xdisp.c (extend_face_to_end_of_line): Fix last change. diff --git a/src/xdisp.c b/src/xdisp.c index c3a46651da..538c3e6b87 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20274,13 +20274,14 @@ extend_face_to_end_of_line (struct it *it) it->area = LEFT_MARGIN_AREA; it->face_id = default_face->id; while (it->glyph_row->used[LEFT_MARGIN_AREA] - < WINDOW_LEFT_MARGIN_WIDTH (it->w)) + < WINDOW_LEFT_MARGIN_WIDTH (it->w) + && g < it->glyph_row->glyphs[TEXT_AREA]) { PRODUCE_GLYPHS (it); /* term.c:produce_glyphs advances it->current_x only for TEXT_AREA. */ it->current_x += it->pixel_width; - ++it->glyph_row->used[LEFT_MARGIN_AREA]; + g++; } it->current_x = saved_x; @@ -20314,11 +20315,12 @@ extend_face_to_end_of_line (struct it *it) it->area = RIGHT_MARGIN_AREA; it->face_id = default_face->id; while (it->glyph_row->used[RIGHT_MARGIN_AREA] - < WINDOW_RIGHT_MARGIN_WIDTH (it->w)) + < WINDOW_RIGHT_MARGIN_WIDTH (it->w) + && g < it->glyph_row->glyphs[LAST_AREA]) { PRODUCE_GLYPHS (it); it->current_x += it->pixel_width; - ++it->glyph_row->used[RIGHT_MARGIN_AREA]; + g++; } it->area = TEXT_AREA; commit 88ddf53ef086ee2f2e0ea729bc4afbf34d88d82b Author: Alan Mackenzie Date: Thu Dec 21 17:49:14 2017 +0000 Fontify a CPP construct correctly when a comment follows without spaces Do this by removing a broken optimization in the state cache which put category text properties on a character between the end of the CPP construct and the beginning of the comment. This can't work when there's no such character. * lisp/progmodes/cc-defs.el (c-cpp-delimiter, c-set-cpp-delimiters) (c-clear-cpp-delimiters, c-comment-out-cpps, c-with-cpps-commented-out) (c-with-all-but-one-cpps-commented-out): Remove. * lisp/progmodes/cc-engine.el (c-no-comment-end-of-macro): Return the comment start position rather than one character before it. (c-invalidate-state-cache, c-parse-state): Remove the invocations of c-with-all-but-one-cpps-commented-out and c-with-cpps-commented-out. * lisp/progmodes/cc-mode.el (c-neutralize-syntax-in-and-mark-CPP): Rename to c-neutralize-syntax-in-CPP and remove the bits which applied category properties. * lisp/progmodes/cc-langs.el (c-before-font-lock-functions): Incorporate the new name of the function c-neutralize-syntax-in-CPP. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 973d97c256..e837ce1973 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1414,59 +1414,6 @@ with value CHAR in the region [FROM to)." ;;;;;;;;;;;;;;; -(defconst c-cpp-delimiter '(14)) ; generic comment syntax -;; This is the value of the `category' text property placed on every # -;; which introduces a CPP construct and every EOL (or EOB, or character -;; preceding //, etc.) which terminates it. We can instantly "comment -;; out" all CPP constructs by giving `c-cpp-delimiter' a syntax-table -;; property '(14) (generic comment delimiter). -(defmacro c-set-cpp-delimiters (beg end) - ;; This macro does a hidden buffer change. - `(progn - (c-put-char-property ,beg 'category 'c-cpp-delimiter) - (if (< ,end (point-max)) - (c-put-char-property ,end 'category 'c-cpp-delimiter)))) -(defmacro c-clear-cpp-delimiters (beg end) - ;; This macro does a hidden buffer change. - `(progn - (c-clear-char-property ,beg 'category) - (if (< ,end (point-max)) - (c-clear-char-property ,end 'category)))) - -(defsubst c-comment-out-cpps () - ;; Render all preprocessor constructs syntactically commented out. - (put 'c-cpp-delimiter 'syntax-table c-cpp-delimiter)) -(defsubst c-uncomment-out-cpps () - ;; Restore the syntactic visibility of preprocessor constructs. - (put 'c-cpp-delimiter 'syntax-table nil)) - -(defmacro c-with-cpps-commented-out (&rest forms) - ;; Execute FORMS... whilst the syntactic effect of all characters in - ;; all CPP regions is suppressed. In particular, this is to suppress - ;; the syntactic significance of parens/braces/brackets to functions - ;; such as `scan-lists' and `parse-partial-sexp'. - `(unwind-protect - (c-save-buffer-state () - (c-comment-out-cpps) - ,@forms) - (c-save-buffer-state () - (c-uncomment-out-cpps)))) - -(defmacro c-with-all-but-one-cpps-commented-out (beg end &rest forms) - ;; Execute FORMS... whilst the syntactic effect of all characters in - ;; every CPP region APART FROM THE ONE BETWEEN BEG and END is - ;; suppressed. - `(unwind-protect - (c-save-buffer-state () - (save-restriction - (widen) - (c-clear-cpp-delimiters ,beg ,end)) - ,`(c-with-cpps-commented-out ,@forms)) - (c-save-buffer-state () - (save-restriction - (widen) - (c-set-cpp-delimiters ,beg ,end))))) - (defmacro c-self-bind-state-cache (&rest forms) ;; Bind the state cache to itself and execute the FORMS. Return the result ;; of the last FORM executed. It is assumed that no buffer changes will diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 12ec8f74fe..7b9baee6f7 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -238,8 +238,8 @@ ;; `c-macro-cache'. (defvar c-macro-cache-no-comment nil) (make-variable-buffer-local 'c-macro-cache-no-comment) -;; Either nil, or the last character of the macro currently represented by -;; `c-macro-cache' which isn't in a comment. */ +;; Either nil, or the position of a comment which is open at the end of the +;; macro represented by `c-macro-cache'. (defun c-invalidate-macro-cache (beg _end) ;; Called from a before-change function. If the change region is before or @@ -382,8 +382,9 @@ comment at the start of cc-engine.el for more info." (point))) (defun c-no-comment-end-of-macro () - ;; Go to the end of a CPP directive, or a pos just before which isn't in a - ;; comment. For this purpose, open strings are ignored. + ;; Go to the start of the comment which is open at the end of the current + ;; CPP directive, or to the end of that directive. For this purpose, open + ;; strings are ignored. ;; ;; This function must only be called from the beginning of a CPP construct. ;; @@ -401,7 +402,7 @@ comment at the start of cc-engine.el for more info." (setq s (parse-partial-sexp here there))) (when (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table))) ; no pseudo comments. - (goto-char (1- (nth 8 s)))) + (goto-char (nth 8 s))) (setq c-macro-cache-no-comment (point))) (point))) @@ -3862,14 +3863,7 @@ comment at the start of cc-engine.el for more info." (if (eval-when-compile (memq 'category-properties c-emacs-features)) ;; Emacs (c-with-<->-as-parens-suppressed - (if (and c-state-old-cpp-beg - (< c-state-old-cpp-beg here)) - (c-with-all-but-one-cpps-commented-out - c-state-old-cpp-beg - c-state-old-cpp-end - (c-invalidate-state-cache-1 here)) - (c-with-cpps-commented-out - (c-invalidate-state-cache-1 here)))) + (c-invalidate-state-cache-1 here)) ;; XEmacs (c-invalidate-state-cache-1 here))) @@ -3902,12 +3896,7 @@ comment at the start of cc-engine.el for more info." (if (eval-when-compile (memq 'category-properties c-emacs-features)) ;; Emacs (c-with-<->-as-parens-suppressed - (if (and here-cpp-beg (> here-cpp-end here-cpp-beg)) - (c-with-all-but-one-cpps-commented-out - here-cpp-beg here-cpp-end - (c-parse-state-1)) - (c-with-cpps-commented-out - (c-parse-state-1)))) + (c-parse-state-1)) ;; XEmacs (c-parse-state-1)) (setq c-state-old-cpp-beg diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 169b61c3dd..12a15873b1 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -518,13 +518,13 @@ parameters \(point-min) and \(point-max).") (c objc) '(c-depropertize-new-text c-parse-quotes-after-change c-extend-font-lock-region-for-macros - c-neutralize-syntax-in-and-mark-CPP + c-neutralize-syntax-in-CPP c-change-expand-fl-region) c++ '(c-depropertize-new-text c-parse-quotes-after-change c-extend-font-lock-region-for-macros c-after-change-re-mark-raw-strings - c-neutralize-syntax-in-and-mark-CPP + c-neutralize-syntax-in-CPP c-restore-<>-properties c-change-expand-fl-region) java '(c-depropertize-new-text diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 22dea039cd..4073a5a1b1 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1016,15 +1016,10 @@ Note that the style variables are always made local to the buffer." t) (t nil))))))) -(defun c-neutralize-syntax-in-and-mark-CPP (_begg _endd _old-len) - ;; (i) "Neutralize" every preprocessor line wholly or partially in the - ;; changed region. "Restore" lines which were CPP lines before the change - ;; and are no longer so. - ;; - ;; (ii) Mark each CPP construct by placing a `category' property value - ;; `c-cpp-delimiter' at its start and end. The marked characters are the - ;; opening # and usually the terminating EOL, but sometimes the character - ;; before a comment delimiter. +(defun c-neutralize-syntax-in-CPP (_begg _endd _old-len) + ;; "Neutralize" every preprocessor line wholly or partially in the changed + ;; region. "Restore" lines which were CPP lines before the change and are + ;; no longer so. ;; ;; That is, set syntax-table properties on characters that would otherwise ;; interact syntactically with those outside the CPP line(s). @@ -1044,12 +1039,7 @@ Note that the style variables are always made local to the buffer." (c-save-buffer-state (limits) ;; Clear 'syntax-table properties "punctuation": ;; (c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1)) - - ;; CPP "comment" markers: - (if (eval-when-compile (memq 'category-properties c-emacs-features));Emacs. - (c-clear-char-property-with-value - c-new-BEG c-new-END 'category 'c-cpp-delimiter)) - ;; FIXME!!! What about the "<" and ">" category properties? 2009-11-16 + ;; The above is now done in `c-depropertize-CPP'. ;; Add needed properties to each CPP construct in the region. (goto-char c-new-BEG) @@ -1076,11 +1066,7 @@ Note that the style variables are always made local to the buffer." (goto-char (match-beginning 1)) (setq mbeg (point)) (if (> (c-no-comment-end-of-macro) mbeg) - (progn - (c-neutralize-CPP-line mbeg (point)) ; "punctuation" properties - (if (eval-when-compile - (memq 'category-properties c-emacs-features)) ;Emacs. - (c-set-cpp-delimiters mbeg (point)))) ; "comment" markers + (c-neutralize-CPP-line mbeg (point)) ; "punctuation" properties (forward-line)) ; no infinite loop with, e.g., "#//" ))))) commit de7de9cc0cfcef1c7651887fd36fc2a346dadd6c Author: Eli Zaretskii Date: Thu Dec 21 19:43:07 2017 +0200 Prevent infloop in redisplay on TTY frames * src/xdisp.c (extend_face_to_end_of_line): Avoid infloop when filling up display margins with the default face's background. (Bug#29789) diff --git a/src/xdisp.c b/src/xdisp.c index 7601e26a90..c3a46651da 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20280,6 +20280,7 @@ extend_face_to_end_of_line (struct it *it) /* term.c:produce_glyphs advances it->current_x only for TEXT_AREA. */ it->current_x += it->pixel_width; + ++it->glyph_row->used[LEFT_MARGIN_AREA]; } it->current_x = saved_x; @@ -20317,6 +20318,7 @@ extend_face_to_end_of_line (struct it *it) { PRODUCE_GLYPHS (it); it->current_x += it->pixel_width; + ++it->glyph_row->used[RIGHT_MARGIN_AREA]; } it->area = TEXT_AREA; commit 293720e930ac33e007d3402b677d6c482d0a3dbf Author: Alan Mackenzie Date: Thu Dec 21 17:18:40 2017 +0000 Fix loss of documentation face in certain CC Mode doc comment situations * lisp/progmodes/cc-fonts.el (c-font-lock-doc-comments): Take into account the possibility of font-lock-comment-delimiter-face. Test rigorously for "/**" (etc.) being itself inside a literal, rather than just depending on the face of the previous character. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 7b99c2f54e..83038e07ca 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -2670,8 +2670,8 @@ need for `pike-font-lock-extra-types'.") ;; This function might do hidden buffer changes. (let (comment-beg region-beg) - (if (eq (get-text-property (point) 'face) - 'font-lock-comment-face) + (if (memq (get-text-property (point) 'face) + '(font-lock-comment-face font-lock-comment-delimiter-face)) ;; Handle the case when the fontified region starts inside a ;; comment. (let ((start (c-literal-start))) @@ -2691,8 +2691,15 @@ need for `pike-font-lock-extra-types'.") (or (not (c-got-face-at comment-beg c-literal-faces)) (and (/= comment-beg (point-min)) + ;; Cheap check which is unreliable (the previous + ;; character could be the end of a previous + ;; comment). (c-got-face-at (1- comment-beg) - c-literal-faces)))) + c-literal-faces) + ;; Expensive reliable check. + (save-excursion + (goto-char comment-beg) + (c-in-literal))))) (setq comment-beg nil)) (setq region-beg comment-beg)) commit 8a73b7003e5db5a57550270602841d9ee2194cf5 Author: Daiki Ueno Date: Fri Nov 24 16:11:48 2017 +0100 Remove pinentry.el * lisp/epg.el (epg--start): Remove the use of pinentry.el. * lisp/net/pinentry.el: Remove (bug#27445). diff --git a/lisp/epg.el b/lisp/epg.el index 35e5811649..b2d80023f0 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -551,8 +551,6 @@ callback data (if any)." (defun epg-errors-to-string (errors) (mapconcat #'epg-error-to-string errors "; ")) -(declare-function pinentry-start "pinentry" (&optional quiet)) - (defun epg--start (context args) "Start `epg-gpg-program' in a subprocess with given ARGS." (if (and (epg-context-process context) @@ -604,23 +602,6 @@ callback data (if any)." (setq process-environment (cons (concat "GPG_TTY=" terminal-name) (cons "TERM=xterm" process-environment)))) - ;; Automatically start the Emacs Pinentry server if appropriate. - (when (and (fboundp 'pinentry-start) - ;; Emacs Pinentry is useless if Emacs has no interactive session. - (not noninteractive) - ;; Prefer pinentry-mode over Emacs Pinentry. - (null (epg-context-pinentry-mode context)) - ;; Check if the allow-emacs-pinentry option is set. - (executable-find epg-gpgconf-program) - (with-temp-buffer - (when (= (call-process epg-gpgconf-program nil t nil - "--list-options" "gpg-agent") - 0) - (goto-char (point-min)) - (re-search-forward - "^allow-emacs-pinentry:\\(?:.*:\\)\\{8\\}1" - nil t)))) - (pinentry-start 'quiet)) (setq process-environment (cons (format "INSIDE_EMACS=%s,epg" emacs-version) process-environment)) diff --git a/lisp/net/pinentry.el b/lisp/net/pinentry.el deleted file mode 100644 index f8d81fde91..0000000000 --- a/lisp/net/pinentry.el +++ /dev/null @@ -1,460 +0,0 @@ -;;; pinentry.el --- GnuPG Pinentry server implementation -*- lexical-binding: t -*- - -;; Copyright (C) 2015-2017 Free Software Foundation, Inc. - -;; Author: Daiki Ueno -;; Version: 0.1 -;; Keywords: GnuPG - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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, or -;; (at your option) any later version. - -;; GNU Emacs 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 . - -;;; Commentary: - -;; This package allows GnuPG passphrase to be prompted through the -;; minibuffer instead of graphical dialog. -;; -;; To use, add "allow-emacs-pinentry" to "~/.gnupg/gpg-agent.conf", -;; reload the configuration with "gpgconf --reload gpg-agent", and -;; start the server with M-x pinentry-start. -;; -;; The actual communication path between the relevant components is -;; as follows: -;; -;; gpg --> gpg-agent --> pinentry --> Emacs -;; -;; where pinentry and Emacs communicate through a Unix domain socket -;; created at: -;; -;; ${TMPDIR-/tmp}/emacs$(id -u)/pinentry -;; -;; under the same directory which server.el uses. The protocol is a -;; subset of the Pinentry Assuan protocol described in (info -;; "(pinentry) Protocol"). -;; -;; NOTE: As of August 2015, this feature requires newer versions of -;; GnuPG (2.1.5+) and Pinentry (0.9.5+). - -;;; Code: - -(eval-when-compile (require 'cl-lib)) - -(defgroup pinentry nil - "The Pinentry server" - :version "25.1" - :group 'external) - -(defcustom pinentry-popup-prompt-window t - "If non-nil, display multiline prompt in another window." - :type 'boolean - :group 'pinentry) - -(defcustom pinentry-prompt-window-height 5 - "Number of lines used to display multiline prompt." - :type 'integer - :group 'pinentry) - -(defvar pinentry-debug nil) -(defvar pinentry-debug-buffer nil) -(defvar pinentry--server-process nil) -(defvar pinentry--connection-process-list nil) - -(defvar pinentry--labels nil) -(put 'pinentry-read-point 'permanent-local t) -(defvar pinentry--read-point nil) -(put 'pinentry--read-point 'permanent-local t) - -(defvar pinentry--prompt-buffer nil) - -;; We use the same location as `server-socket-dir', when local sockets -;; are supported. -(defvar pinentry--socket-dir - (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid)) - "The directory in which to place the server socket. -If local sockets are not supported, this is nil.") - -(defconst pinentry--set-label-commands - '("SETPROMPT" "SETTITLE" "SETDESC" - "SETREPEAT" "SETREPEATERROR" - "SETOK" "SETCANCEL" "SETNOTOK")) - -;; These error codes are defined in libgpg-error/src/err-codes.h.in. -(defmacro pinentry--error-code (code) - (logior (lsh 5 24) code)) -(defconst pinentry--error-not-implemented - (cons (pinentry--error-code 69) "not implemented")) -(defconst pinentry--error-cancelled - (cons (pinentry--error-code 99) "cancelled")) -(defconst pinentry--error-not-confirmed - (cons (pinentry--error-code 114) "not confirmed")) - -(autoload 'server-ensure-safe-dir "server") - -(defvar pinentry-prompt-mode-map - (let ((keymap (make-sparse-keymap))) - (define-key keymap "q" 'quit-window) - keymap)) - -(define-derived-mode pinentry-prompt-mode special-mode "Pinentry" - "Major mode for `pinentry--prompt-buffer'." - (buffer-disable-undo) - (setq truncate-lines t - buffer-read-only t)) - -(defun pinentry--prompt (labels query-function &rest query-args) - (let ((desc (cdr (assq 'desc labels))) - (error (cdr (assq 'error labels))) - (prompt (cdr (assq 'prompt labels)))) - (when (string-match "[ \n]*\\'" prompt) - (setq prompt (concat - (substring - prompt 0 (match-beginning 0)) " "))) - (when error - (setq desc (concat "Error: " (propertize error 'face 'error) - "\n" desc))) - (if (and desc pinentry-popup-prompt-window) - (save-window-excursion - (delete-other-windows) - (unless (and pinentry--prompt-buffer - (buffer-live-p pinentry--prompt-buffer)) - (setq pinentry--prompt-buffer (generate-new-buffer "*Pinentry*"))) - (if (get-buffer-window pinentry--prompt-buffer) - (delete-window (get-buffer-window pinentry--prompt-buffer))) - (with-current-buffer pinentry--prompt-buffer - (let ((inhibit-read-only t) - buffer-read-only) - (erase-buffer) - (insert desc)) - (pinentry-prompt-mode) - (goto-char (point-min))) - (if (> (window-height) - pinentry-prompt-window-height) - (set-window-buffer (split-window nil - (- (window-height) - pinentry-prompt-window-height)) - pinentry--prompt-buffer) - (pop-to-buffer pinentry--prompt-buffer) - (if (> (window-height) pinentry-prompt-window-height) - (shrink-window (- (window-height) - pinentry-prompt-window-height)))) - (prog1 (apply query-function prompt query-args) - (quit-window))) - (apply query-function (concat desc "\n" prompt) query-args)))) - -;;;###autoload -(defun pinentry-start (&optional quiet) - "Start a Pinentry service. - -Once the environment is properly set, subsequent invocations of -the gpg command will interact with Emacs for passphrase input. - -If the optional QUIET argument is non-nil, messages at startup -will not be shown." - (interactive) - (unless (featurep 'make-network-process '(:family local)) - (error "local sockets are not supported")) - (if (process-live-p pinentry--server-process) - (unless quiet - (message "Pinentry service is already running")) - (let* ((server-file (expand-file-name "pinentry" pinentry--socket-dir))) - (server-ensure-safe-dir pinentry--socket-dir) - ;; Delete the socket files made by previous server invocations. - (ignore-errors - (let (delete-by-moving-to-trash) - (delete-file server-file))) - (cl-letf (((default-file-modes) ?\700)) - (setq pinentry--server-process - (make-network-process - :name "pinentry" - :server t - :noquery t - :sentinel #'pinentry--process-sentinel - :filter #'pinentry--process-filter - :coding 'no-conversion - :family 'local - :service server-file)) - (process-put pinentry--server-process :server-file server-file))))) - -(defun pinentry-stop () - "Stop a Pinentry service." - (interactive) - (when (process-live-p pinentry--server-process) - (delete-process pinentry--server-process)) - (setq pinentry--server-process nil) - (dolist (process pinentry--connection-process-list) - (when (buffer-live-p (process-buffer process)) - (kill-buffer (process-buffer process)))) - (setq pinentry--connection-process-list nil)) - -(defun pinentry--labels-to-shortcuts (labels) - "Convert strings in LABEL by stripping mnemonics." - (mapcar (lambda (label) - (when label - (let (c) - (if (string-match "\\(?:\\`\\|[^_]\\)_\\([[:alnum:]]\\)" label) - (let ((key (match-string 1 label))) - (setq c (downcase (aref key 0))) - (setq label (replace-match - (propertize key 'face 'underline) - t t label))) - (setq c (if (= (length label) 0) - ?? - (downcase (aref label 0))))) - ;; Double underscores mean a single underscore. - (when (string-match "__" label) - (setq label (replace-match "_" t t label))) - (cons c label)))) - labels)) - -(defun pinentry--escape-string (string) - "Escape STRING in the Assuan percent escape." - (let ((length (length string)) - (index 0) - (count 0)) - (while (< index length) - (if (memq (aref string index) '(?\n ?\r ?%)) - (setq count (1+ count))) - (setq index (1+ index))) - (setq index 0) - (let ((result (make-string (+ length (* count 2)) ?\0)) - (result-index 0) - c) - (while (< index length) - (setq c (aref string index)) - (if (memq c '(?\n ?\r ?%)) - (let ((hex (format "%02X" c))) - (aset result result-index ?%) - (setq result-index (1+ result-index)) - (aset result result-index (aref hex 0)) - (setq result-index (1+ result-index)) - (aset result result-index (aref hex 1)) - (setq result-index (1+ result-index))) - (aset result result-index c) - (setq result-index (1+ result-index))) - (setq index (1+ index))) - result))) - -(defun pinentry--unescape-string (string) - "Unescape STRING in the Assuan percent escape." - (let ((length (length string)) - (index 0)) - (let ((result (make-string length ?\0)) - (result-index 0) - c) - (while (< index length) - (setq c (aref string index)) - (if (and (eq c '?%) (< (+ index 2) length)) - (progn - (aset result result-index - (string-to-number (substring string - (1+ index) - (+ index 3)) - 16)) - (setq result-index (1+ result-index)) - (setq index (+ index 2))) - (aset result result-index c) - (setq result-index (1+ result-index))) - (setq index (1+ index))) - (substring result 0 result-index)))) - -(defun pinentry--send-data (process escaped) - "Send a string ESCAPED to a process PROCESS. -ESCAPED will be split if it exceeds the line length limit of the -Assuan protocol." - (let ((length (length escaped)) - (index 0)) - (if (= length 0) - (process-send-string process "D \n") - (while (< index length) - ;; 997 = ASSUAN_LINELENGTH (= 1000) - strlen ("D \n") - (let* ((sub-length (min (- length index) 997)) - (sub (substring escaped index (+ index sub-length)))) - (unwind-protect - (progn - (process-send-string process "D ") - (process-send-string process sub) - (process-send-string process "\n")) - (clear-string sub)) - (setq index (+ index sub-length))))))) - -(defun pinentry--send-error (process error) - (process-send-string process (format "ERR %d %s\n" (car error) (cdr error)))) - -(defun pinentry--process-filter (process input) - (unless (buffer-live-p (process-buffer process)) - (let ((buffer (generate-new-buffer " *pinentry*"))) - (set-process-buffer process buffer) - (with-current-buffer buffer - (if (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil)) - (make-local-variable 'pinentry--read-point) - (setq pinentry--read-point (point-min)) - (make-local-variable 'pinentry--labels)))) - (with-current-buffer (process-buffer process) - (when pinentry-debug - (with-current-buffer - (or pinentry-debug-buffer - (setq pinentry-debug-buffer (generate-new-buffer - " *pinentry-debug*"))) - (goto-char (point-max)) - (insert input))) - (save-excursion - (goto-char (point-max)) - (insert input) - (goto-char pinentry--read-point) - (beginning-of-line) - (while (looking-at ".*\n") ;the input line finished - (if (looking-at "\\([A-Z_]+\\) ?\\(.*\\)") - (let ((command (match-string 1)) - (string (pinentry--unescape-string (match-string 2)))) - (pcase command - ((and set (guard (member set pinentry--set-label-commands))) - (when (> (length string) 0) - (let* ((symbol (intern (downcase (substring set 3)))) - (entry (assq symbol pinentry--labels)) - (label (decode-coding-string string 'utf-8))) - (if entry - (setcdr entry label) - (push (cons symbol label) pinentry--labels)))) - (ignore-errors - (process-send-string process "OK\n"))) - ("NOP" - (ignore-errors - (process-send-string process "OK\n"))) - ("GETPIN" - (let ((confirm (not (null (assq 'repeat pinentry--labels)))) - passphrase escaped-passphrase encoded-passphrase) - (unwind-protect - (condition-case err - (progn - (setq passphrase - (pinentry--prompt - pinentry--labels - #'read-passwd confirm)) - (setq escaped-passphrase - (pinentry--escape-string - passphrase)) - (setq encoded-passphrase (encode-coding-string - escaped-passphrase - 'utf-8)) - (ignore-errors - (pinentry--send-data - process encoded-passphrase) - (process-send-string process "OK\n"))) - (error - (message "GETPIN error %S" err) - (ignore-errors - (pinentry--send-error - process - pinentry--error-cancelled)))) - (if passphrase - (clear-string passphrase)) - (if escaped-passphrase - (clear-string escaped-passphrase)) - (if encoded-passphrase - (clear-string encoded-passphrase)))) - (setq pinentry--labels nil)) - ("CONFIRM" - (let ((prompt - (or (cdr (assq 'prompt pinentry--labels)) - "Confirm? ")) - (buttons - (delq nil - (pinentry--labels-to-shortcuts - (list (cdr (assq 'ok pinentry--labels)) - (cdr (assq 'notok pinentry--labels)) - (cdr (assq 'cancel pinentry--labels)))))) - entry) - (if buttons - (progn - (setq prompt - (concat prompt " (" - (mapconcat #'cdr buttons - ", ") - ") ")) - (if (setq entry (assq 'prompt pinentry--labels)) - (setcdr entry prompt) - (setq pinentry--labels (cons (cons 'prompt prompt) - pinentry--labels))) - (condition-case nil - (let ((result (pinentry--prompt pinentry--labels - #'read-char))) - (if (eq result (caar buttons)) - (ignore-errors - (process-send-string process "OK\n")) - (if (eq result (car (nth 1 buttons))) - (ignore-errors - (pinentry--send-error - process - pinentry--error-not-confirmed)) - (ignore-errors - (pinentry--send-error - process - pinentry--error-cancelled))))) - (error - (ignore-errors - (pinentry--send-error - process - pinentry--error-cancelled))))) - (if (setq entry (assq 'prompt pinentry--labels)) - (setcdr entry prompt) - (setq pinentry--labels (cons (cons 'prompt prompt) - pinentry--labels))) - (if (condition-case nil - (pinentry--prompt pinentry--labels #'y-or-n-p) - (quit)) - (ignore-errors - (process-send-string process "OK\n")) - (ignore-errors - (pinentry--send-error - process - pinentry--error-not-confirmed)))) - (setq pinentry--labels nil))) - (_ (ignore-errors - (pinentry--send-error - process - pinentry--error-not-implemented)))) - (forward-line) - (setq pinentry--read-point (point)))))))) - -(defun pinentry--process-sentinel (process _status) - "The process sentinel for Emacs server connections." - ;; If this is a new client process, set the query-on-exit flag to nil - ;; for this process (it isn't inherited from the server process). - (when (and (eq (process-status process) 'open) - (process-query-on-exit-flag process)) - (push process pinentry--connection-process-list) - (set-process-query-on-exit-flag process nil) - (ignore-errors - (process-send-string process "OK Your orders please\n"))) - ;; Kill the process buffer of the connection process. - (when (and (not (process-contact process :server)) - (eq (process-status process) 'closed)) - (when (buffer-live-p (process-buffer process)) - (kill-buffer (process-buffer process))) - (setq pinentry--connection-process-list - (delq process pinentry--connection-process-list))) - ;; Delete the associated connection file, if applicable. - ;; Although there's no 100% guarantee that the file is owned by the - ;; running Emacs instance, server-start uses server-running-p to check - ;; for possible servers before doing anything, so it *should* be ours. - (and (process-contact process :server) - (eq (process-status process) 'closed) - (ignore-errors - (delete-file (process-get process :server-file))))) - -(provide 'pinentry) - -;;; pinentry.el ends here