commit 7e8f7e089f3e72644c9a6e0d022d51d3166bbb07 (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Sat Aug 8 19:43:14 2015 -0400 * test/automated/ert-tests.el (ert-test-deftest): Add FIXME. diff --git a/test/automated/ert-tests.el b/test/automated/ert-tests.el index fcfc7ee..5382c40 100644 --- a/test/automated/ert-tests.el +++ b/test/automated/ert-tests.el @@ -345,6 +345,10 @@ This macro is used to test if macroexpansion in `should' works." (should (equal actual-condition expected-condition))))))) (ert-deftest ert-test-deftest () + ;; FIXME: These tests don't look very good. What is their intent, i.e. what + ;; are they really testing? The precise generated code shouldn't matter, so + ;; we should either test the behavior of the code, or else try to express the + ;; kind of efficiency guarantees we're looking for. (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar))) '(progn (ert-set-test 'abc commit 3a5f75193ed10ee5fb458e9879340947f31d5e12 Author: Stefan Monnier Date: Sat Aug 8 19:41:57 2015 -0400 * org.el: Fix up some lexical scoping warnings, and use dolist * lisp/org/org.el (org-set-regexps-and-options-for-tags, org-goto-map) (org-set-regexps-and-options, org-assign-fast-keys) (org-contextualize-keys, org-contextualize-validate-key) (org-notes-order-reversed-p, org-local-logging, org-map-entries) (org-find-olp, org-find-exact-heading-in-directory) (org-cycle-agenda-files, org-release-buffers, org-fill-template) (org-agenda-prepare-buffers, org-occur-in-agenda-files) (org-replace-escapes): Use dolist. (org-mode): Optimize away XEmacs-only code. (org-refile-get-targets): Remove unused var `f'. (org-fast-todo-selection): Remove unused var `e'. (org-make-tags-matcher): Use dolist. Remove unused var `term'. (org-fast-tag-selection): Use dolist. Remove unused var `e'. (org-format-latex): Use dolist. Remove unused var `e'. (org-toggle-heading): Access vars lexically rather than dynamically. (org-backward-sentence, org-forward-sentence, org-meta-return) (org-kill-line): Mark arg as unused. (org-submit-bug-report): Silence compiler warning. (org-occur-in-agenda-files): Don't use add-to-list on local vars. (org-get-cursor-date): Remove unused var `tm'. (org-comment-or-uncomment-region): Use standard name `_'. (reftex-docstruct-symbol, reftex-cite-format): Declare to silence byte-compiler. (org-reftex-citation): Add `org--' prefix to dynamically scoped `rds' var. diff --git a/lisp/org/org.el b/lisp/org/org.el index b545f9e..0cc185c 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -4860,8 +4860,8 @@ Support for group tags is controlled by the option (if (characterp (cdr tg)) (format "(%s)" (char-to-string (cdr tg))) ""))))) org-tag-alist))) - (let (e tgs g) - (while (setq e (pop tags)) + (let (tgs g) + (dolist (e tags) (cond ((equal e "{") (progn (push '(:startgroup) tgs) @@ -4875,7 +4875,8 @@ Support for group tags is controlled by the option ((equal e "\\n") (push '(:newline) tgs)) ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e) (push (cons (match-string 1 e) - (string-to-char (match-string 2 e))) tgs) + (string-to-char (match-string 2 e))) + tgs) (if (and g (> g 0)) (setcar org-tag-groups-alist (append (car org-tag-groups-alist) @@ -4887,7 +4888,7 @@ Support for group tags is controlled by the option (append (car org-tag-groups-alist) (list e)))) (if g (setq g (1+ g)))))) (org-set-local 'org-tag-alist nil) - (while (setq e (pop tgs)) + (dolist (e tgs) (or (and (stringp (car e)) (assoc (car e) org-tag-alist)) (push e org-tag-alist))) @@ -4957,7 +4958,8 @@ Support for group tags is controlled by the option ((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key) ;; general TODO-like setup (push (cons (intern (downcase (match-string 1 key))) - (org-split-string value splitre)) kwds)) + (org-split-string value splitre)) + kwds)) ((equal key "COLUMNS") (org-set-local 'org-columns-default-format value)) ((equal key "LINK") @@ -4978,8 +4980,8 @@ Support for group tags is controlled by the option (org-table-set-constants)) ((equal key "STARTUP") (let ((opts (org-split-string value splitre)) - l var val) - (while (setq l (pop opts)) + var val) + (dolist (l opts) (when (setq l (assoc l org-startup-options)) (setq var (nth 1 l) val (nth 2 l)) (if (not (nth 3 l)) @@ -5041,8 +5043,8 @@ Support for group tags is controlled by the option (default-value 'org-todo-keywords))))) (setq kwds (reverse kwds))) (setq kwds (nreverse kwds)) - (let (inter kws kw) - (while (setq kws (pop kwds)) + (let (inter kw) + (dolist (kws kwds) (let ((kws (or (run-hook-with-args-until-success 'org-todo-setup-filter-hook kws) @@ -5210,8 +5212,8 @@ This will extract info from a string like \"WAIT(w@/!)\"." (defun org-assign-fast-keys (alist) "Assign fast keys to a keyword-key alist. Respect keys that are already there." - (let (new e (alt ?0)) - (while (setq e (pop alist)) + (let (new (alt ?0)) + (dolist (e alist) (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup)) (cdr e)) ;; Key already assigned. (push e new) @@ -5330,8 +5332,9 @@ The following commands are available: (define-key org-mode-map [menu-bar show] 'undefined)) (org-load-modules-maybe) - (easy-menu-add org-org-menu) - (easy-menu-add org-tbl-menu) + (when (featurep 'xemacs) + (easy-menu-add org-org-menu) + (easy-menu-add org-tbl-menu)) (org-install-agenda-files-menu) (if org-descriptive-links (add-to-invisibility-spec '(org-link))) (add-to-invisibility-spec '(org-cwidth)) @@ -7265,9 +7268,8 @@ Optional arguments START and END can be used to limit the range." (setq org-goto-map (let ((map (make-sparse-keymap))) (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command - mouse-drag-region universal-argument org-occur)) - cmd) - (while (setq cmd (pop cmds)) + mouse-drag-region universal-argument org-occur))) + (dolist (cmd cmds) (substitute-key-definition cmd cmd map global-map))) (suppress-keymap map) (org-defkey map "\C-m" 'org-goto-ret) @@ -8564,7 +8566,8 @@ and still retain the repeater to cover future instances of the task." (goto-char (point-min)) (while (re-search-forward drawer-re nil t) (mapc (lambda (d) - (org-remove-empty-drawer-at d (point))) org-drawers))) + (org-remove-empty-drawer-at d (point))) + org-drawers))) (goto-char (point-min)) (when doshift (while (re-search-forward org-ts-regexp-both nil t) @@ -8598,7 +8601,8 @@ Optional argument WITH-CASE means sort case-sensitively." (while (string-match org-bracket-link-regexp s) (setq s (replace-match (if (match-end 2) (match-string 3 s) - (match-string 1 s)) t t s))) + (match-string 1 s)) + t t s))) (let ((st (format " %s " s))) (while (string-match org-emph-re st) (setq st (replace-match (format " %s " (match-string 4 st)) t t st))) @@ -9148,10 +9152,11 @@ definitions." (list (car c) (car c) (cadr c))) ((string= "" (cadr c)) (list (car c) (car c) (caddr c))) - (t c))) contexts)) - (a alist) c r s) + (t c))) + contexts)) + (a alist) r s) ;; loop over all commands or templates - (while (setq c (pop a)) + (dolist (c a) (let (vrules repl) (cond ((not (assoc (car c) contexts)) @@ -9161,7 +9166,8 @@ definitions." (car c) contexts))) (mapc (lambda (vr) (when (not (equal (car vr) (cadr vr))) - (setq repl vr))) vrules) + (setq repl vr))) + vrules) (if (not repl) (push c r) (push (cadr repl) s) (push @@ -9178,14 +9184,16 @@ definitions." (let ((tpl (car x))) (when (not (delq nil - (mapcar (lambda(y) - (equal y tpl)) s))) x))) + (mapcar (lambda (y) + (equal y tpl)) + s))) + x))) (reverse r)))))) (defun org-contextualize-validate-key (key contexts) "Check CONTEXTS for agenda or capture KEY." - (let (r rr res) - (while (setq r (pop contexts)) + (let (rr res) + (dolist (r contexts) (mapc (lambda (rr) (when @@ -9484,7 +9492,8 @@ active region." (funcall (caar sfuns))) (setq link (plist-get org-store-link-plist :link) desc (or (plist-get org-store-link-plist - :description) link)))) + :description) + link)))) ;; Store a link from a source code buffer ((org-src-edit-buffer-p) @@ -9664,7 +9673,8 @@ active region." ;; Return the link (if (not (and (or (org-called-interactively-p 'any) - executing-kbd-macro) link)) + executing-kbd-macro) + link)) (or agenda-link (and link (org-make-link-string link desc))) (push (list link desc) org-stored-links) (message "Stored: %s" (or desc link)) @@ -10897,7 +10907,7 @@ visibility around point, thus ignoring enclose the position of `org-open-link-marker'." (let ((m org-open-link-marker)) (catch 'exit - (while (apply 're-search-forward args) + (while (apply #'re-search-forward args) (unless (get-text-property (match-end group) 'intangible) ; Emacs 21 (goto-char (match-end group)) (if (and (or (not (eq (marker-buffer m) (current-buffer))) @@ -11248,12 +11258,9 @@ on the system \"/user@host:\"." ((eq t org-reverse-note-order) t) ((not (listp org-reverse-note-order)) nil) (t (catch 'exit - (let ((all org-reverse-note-order) - entry) - (while (setq entry (pop all)) - (if (string-match (car entry) buffer-file-name) - (throw 'exit (cdr entry)))) - nil))))) + (dolist (entry org-reverse-note-order) + (if (string-match (car entry) buffer-file-name) + (throw 'exit (cdr entry)))))))) (defvar org-refile-target-table nil "The list of refile targets, created by `org-refile'.") @@ -11318,10 +11325,10 @@ on the system \"/user@host:\"." (let ((case-fold-search nil) ;; otherwise org confuses "TODO" as a kw and "Todo" as a word (entries (or org-refile-targets '((nil . (:level . 1))))) - targets tgs txt re files f desc descre fast-path-p level pos0) + targets tgs txt re files desc descre fast-path-p level pos0) (message "Getting targets...") (with-current-buffer (or default-buffer (current-buffer)) - (while (setq entry (pop entries)) + (dolist (entry entries) (setq files (car entry) desc (cdr entry)) (setq fast-path-p nil) (cond @@ -11354,7 +11361,7 @@ on the system \"/user@host:\"." (cdr desc))) "\\}[ \t]"))) (t (error "Bad refiling target description %s" desc))) - (while (setq f (pop files)) + (dolist (f files) (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)) (or @@ -12736,20 +12743,19 @@ This hook runs even if there is no statistics cookie present, in which case (defun org-local-logging (value) "Get logging settings from a property VALUE." - (let* (words w a) - ;; directly set the variables, they are already local. - (setq org-log-done nil - org-log-repeat nil - org-todo-log-states nil) - (setq words (org-split-string value)) - (while (setq w (pop words)) + ;; Directly set the variables, they are already local. + (setq org-log-done nil + org-log-repeat nil + org-todo-log-states nil) + (dolist (w (org-split-string value)) + (let* (a) (cond ((setq a (assoc w org-startup-options)) - (and (member (nth 1 a) '(org-log-done org-log-repeat)) - (set (nth 1 a) (nth 2 a)))) + (and (member (nth 1 a) '(org-log-done org-log-repeat)) + (set (nth 1 a) (nth 2 a)))) ((setq a (org-extract-log-state-settings w)) - (and (member (car a) org-todo-keywords-1) - (push a org-todo-log-states))))))) + (and (member (car a) org-todo-keywords-1) + (push a org-todo-log-states))))))) (defun org-get-todo-sequence-head (kwd) "Return the head of the TODO sequence to which KWD belongs. @@ -12779,7 +12785,7 @@ Returns the new TODO keyword, or nil if no state change should occur." (expert nil) (fwidth (+ maxlen 3 1 3)) (ncol (/ (- (window-width) 4) fwidth)) - tg cnt e c tbl + tg cnt c tbl groups ingroup) (save-excursion (save-window-excursion @@ -12789,7 +12795,7 @@ Returns the new TODO keyword, or nil if no state change should occur." (erase-buffer) (org-set-local 'org-done-keywords done-keywords) (setq tbl fulltable cnt 0) - (while (setq e (pop tbl)) + (dolist (e tbl) (cond ((equal e '(:startgroup)) (push '() groups) (setq ingroup t) @@ -14123,7 +14129,7 @@ See also `org-scan-tags'. (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")) minus tag mm tagsmatch todomatch tagsmatcher todomatcher kwd matcher - orterms term orlist re-p str-p level-p level-op time-p + orterms orlist re-p str-p level-p level-op time-p prop-p pn pv po gv rest (start 0) (ss 0)) ;; Expand group tags (setq match (org-tags-expand match)) @@ -14152,7 +14158,7 @@ See also `org-scan-tags'. (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch))) (setq tagsmatcher t) (setq orterms (org-split-string tagsmatch "|") orlist nil) - (while (setq term (pop orterms)) + (dolist (term orterms) (while (and (equal (substring term -1) "\\") orterms) (setq term (concat term "|" (pop orterms)))) ; repair bad split (while (string-match re term) @@ -14213,7 +14219,7 @@ See also `org-scan-tags'. (if (or (not todomatch) (not (string-match "\\S-" todomatch))) (setq todomatcher t) (setq orterms (org-split-string todomatch "|") orlist nil) - (while (setq term (pop orterms)) + (dolist (term orterms) (while (string-match re term) (setq minus (and (match-end 1) (equal (match-string 1 term) "-")) @@ -14282,7 +14288,8 @@ When DOWNCASE is non-nil, expand downcased TAGS." (with-syntax-table stable (string-match (concat "\\(?1:[+-]?\\)\\(?2:\\<" - (regexp-opt tml) "\\>\\)") rtnmatch))) + (regexp-opt tml) "\\>\\)") + rtnmatch))) (let* ((dir (match-string 1 rtnmatch)) (tag (match-string 2 rtnmatch)) (tag (if downcased (downcase tag) tag))) @@ -14418,7 +14425,8 @@ ignore inherited ones." (reverse (delete-dups (reverse (append (org-remove-uninherited-tags - org-file-tags) tags))))))))) + org-file-tags) + tags))))))))) (defun org-add-prop-inherited (s) (add-text-properties 0 (length s) '(inherited t) s) @@ -14750,7 +14758,7 @@ Returns the new tags string, or nil to not change the current settings." (ncol (/ (- (window-width) 4) fwidth)) (i-face 'org-done) (c-face 'org-todo) - tg cnt e c char c1 c2 ntable tbl rtn + tg cnt c char c1 c2 ntable tbl rtn ov-start ov-end ov-prefix (exit-after-next org-fast-tag-selection-single-key) (done-keywords org-done-keywords) @@ -14785,7 +14793,7 @@ Returns the new tags string, or nil to not change the current settings." (org-fast-tag-show-exit exit-after-next) (org-set-current-tags-overlay current ov-prefix) (setq tbl fulltable char ?a cnt 0) - (while (setq e (pop tbl)) + (dolist (e tbl) (cond ((equal (car e) :startgroup) (push '() groups) (setq ingroup t) @@ -15077,7 +15085,7 @@ a *different* entry, you cannot use these techniques." ((eq scope 'file-with-archives) (setq scope (org-add-archive-files (list (buffer-file-name)))))) (org-agenda-prepare-buffers scope) - (while (setq file (pop scope)) + (dolist (file scope) (with-current-buffer (org-find-base-buffer-visiting file) (save-excursion (save-restriction @@ -16034,7 +16042,7 @@ only headings." (widen) (setq limit (point-max)) (goto-char (point-min)) - (while (setq heading (pop path)) + (dolist (heading path) (setq re (format org-complex-heading-regexp-format (regexp-quote heading))) (setq cnt 0 pos (point)) @@ -16079,7 +16087,7 @@ When the target headline is found, return a marker to this location." nil "\\`[^.#].*\\.org\\'")) file visiting m buffer) (catch 'found - (while (setq file (pop files)) + (dolist (file files) (message "trying %s" file) (setq visiting (org-find-base-buffer-visiting file)) (setq buffer (or visiting (find-file-noselect file))) @@ -18037,7 +18045,7 @@ If the current buffer does not, find the first agenda file." file) (unless files (user-error "No agenda files")) (catch 'exit - (while (setq file (pop files)) + (dolist (file files) (if (equal (file-truename file) tcf) (when (car files) (find-file (car files)) @@ -18123,8 +18131,8 @@ it to the list of buffers which might be released later." "Release all buffers in list, asking the user for confirmation when needed. When a buffer is unmodified, it is just killed. When modified, it is saved \(if the user agrees) and then killed." - (let (buf file) - (while (setq buf (pop blist)) + (let (file) + (dolist (buf blist) (setq file (buffer-file-name buf)) (when (and (buffer-modified-p buf) file @@ -18146,7 +18154,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved org-tag-groups-alist-for-agenda nil) (save-excursion (save-restriction - (while (setq file (pop files)) + (dolist (file files) (catch 'nextfile (if (bufferp file) (set-buffer file) @@ -18426,11 +18434,11 @@ Some of the options can be changed using the variable (optnew org-format-latex-options) (matchers (plist-get opt :matchers)) (re-list org-latex-regexps) - (cnt 0) txt hash link beg end re e checkdir + (cnt 0) txt hash link beg end re checkdir string m n block-type block linkfile movefile ov) ;; Check the different regular expressions - (while (setq e (pop re-list)) + (dolist (e re-list) (setq m (car e) re (nth 1 e) n (nth 2 e) block-type (nth 3 e) block (if block-type "\n\n" "")) (when (member m matchers) @@ -19054,7 +19062,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-i" 'org-cycle) (org-defkey org-mode-map [(tab)] 'org-cycle) (org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) -(org-defkey org-mode-map "\M-\t" 'pcomplete) +(org-defkey org-mode-map "\M-\t" #'pcomplete) ;; The following line is necessary under Suse GNU/Linux (unless (featurep 'xemacs) (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) @@ -19121,7 +19129,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright) (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft) - (org-defkey org-mode-map [?\e (tab)] 'pcomplete) + (org-defkey org-mode-map [?\e (tab)] #'pcomplete) (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading) (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft) (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright) @@ -20784,8 +20792,8 @@ number of stars to add." (insert (org-list-to-subtree (org-list-parse-list t) - '(:istart (concat stars add-stars (funcall get-stars depth)) - :icount (concat stars add-stars (funcall get-stars depth))))))) + `(:istart (concat ',stars ',add-stars (funcall get-stars depth)) + :icount (concat ',stars ',add-stars (funcall get-stars depth))))))) (setq toggled t)) (forward-line)))) ;; Case 3. Started at normal text: make every line an heading, @@ -20807,11 +20815,11 @@ number of stars to add." (forward-line))))))) (unless toggled (message "Cannot toggle heading from here")))) -(defun org-meta-return (&optional arg) +(defun org-meta-return (&optional _arg) "Insert a new heading or wrap a region in a table. Calls `org-insert-heading' or `org-table-wrap-region', depending on context. See the individual commands for more information." - (interactive "P") + (interactive) (org-check-before-invisible-edit 'insert) (or (run-hook-with-args-until-success 'org-metareturn-hook) (let* ((element (org-element-at-point)) @@ -21109,6 +21117,7 @@ output buffer into your mail program, as it gives us important information about your Org-mode version and configuration." (interactive) (require 'reporter) + (defvar reporter-prompt-for-summary-p) (org-load-modules-maybe) (org-require-autoloaded-modules) (let ((reporter-prompt-for-summary-p "Bug report subject: ")) @@ -21368,11 +21377,13 @@ upon the next fontification round." 'invisible 'org-link s)) (setq s (concat (substring s 0 b) (substring s (or (next-single-property-change - b 'invisible s) (length s))))))) + b 'invisible s) + (length s))))))) (while (setq b (text-property-any 0 (length s) 'org-cwidth t s)) (setq s (concat (substring s 0 b) (substring s (or (next-single-property-change - b 'org-cwidth s) (length s)))))) + b 'org-cwidth s) + (length s)))))) (setq l (string-width s) b -1) (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s)) (setq l (- l (get-text-property b 'org-dwidth-n s)))) @@ -21469,11 +21480,9 @@ N may optionally be the number of spaces to remove." (defun org-fill-template (template alist) "Find each %key of ALIST in TEMPLATE and replace it." - (let ((case-fold-search nil) - entry key value) - (setq alist (sort (copy-sequence alist) - (lambda (a b) (< (length (car a)) (length (car b)))))) - (while (setq entry (pop alist)) + (let ((case-fold-search nil)) + (dolist (entry (sort (copy-sequence alist) + (lambda (a b) (< (length (car a)) (length (car b)))))) (setq template (replace-regexp-in-string (concat "%" (regexp-quote (car entry))) @@ -21795,23 +21804,24 @@ block from point." "^[ \t]*:end:.*$" lim-up lim-down)))) -(defun org-occur-in-agenda-files (regexp &optional nlines) +(defun org-occur-in-agenda-files (regexp &optional _nlines) "Call `multi-occur' with buffers for all agenda files." - (interactive "sOrg-files matching: \np") + (interactive "sOrg-files matching: ") (let* ((files (org-agenda-files)) - (tnames (mapcar 'file-truename files)) - (extra org-agenda-text-search-extra-files) - f) + (tnames (mapcar #'file-truename files)) + (extra org-agenda-text-search-extra-files)) (when (eq (car extra) 'agenda-archives) (setq extra (cdr extra)) (setq files (org-add-archive-files files))) - (while (setq f (pop extra)) + (dolist (f extra) (unless (member (file-truename f) tnames) - (add-to-list 'files f 'append) - (add-to-list 'tnames (file-truename f) 'append))) + (unless (member f files) (setq files (append files (list f)))) + (setq tnames (append tnames (list (file-truename f)))))) (multi-occur (mapcar (lambda (x) (with-current-buffer + ;; FIXME: Why not just (find-file-noselect x)? + ;; Is it to avoid the "revert buffer" prompt? (or (get-file-buffer x) (find-file-noselect x)) (widen) (current-buffer))) @@ -21996,7 +22006,7 @@ so values can contain further %-escapes if they are define later in TABLE." (case-fold-search nil) (pchg 0) e re rpl) - (while (setq e (pop tbl)) + (dolist (e tbl) (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) (when (and (cdr e) (string-match re (cdr e))) (let ((sref (substring (cdr e) (match-beginning 0) (match-end 0))) @@ -22059,7 +22069,7 @@ This works in the calendar and in the agenda, anywhere else it just returns the current time. If WITH-TIME is non-nil, returns the time of the event at point (in the agenda) or the current time of the day." - (let (date day defd tp tm hod mod) + (let (date day defd tp hod mod) (when with-time (setq tp (get-text-property (point) 'time)) (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp)) @@ -22590,7 +22600,7 @@ If the line is empty, insert comment at its beginning." (insert "# ")) (defvar comment-empty-lines) ; From newcomment.el. -(defun org-comment-or-uncomment-region (beg end &rest ignore) +(defun org-comment-or-uncomment-region (beg end &rest _) "Comment or uncomment each non-blank line in the region. Uncomment each non-blank line between BEG and END if it only contains commented lines. Otherwise, comment them." @@ -22782,6 +22792,10 @@ this line is also exported in fixed-width font." (goto-char (match-end 0)) (insert org-quote-string " "))))))) +(defvar reftex-docstruct-symbol) +(defvar reftex-cite-format) +(defvar org--rds) + (defun org-reftex-citation () "Use reftex-citation to insert a citation into the buffer. This looks for a line like @@ -22796,9 +22810,9 @@ into the buffer. Export of such citations to both LaTeX and HTML is handled by the contributed package ox-bibtex by Taru Karttunen." (interactive) - (let ((reftex-docstruct-symbol 'rds) + (let ((reftex-docstruct-symbol 'org--rds) (reftex-cite-format "\\cite{%l}") - rds bib) + org--rds bib) (save-excursion (save-restriction (widen) @@ -22809,7 +22823,7 @@ package ox-bibtex by Taru Karttunen." (re-search-backward re nil t)))) (error "No bibliography defined in file") (setq bib (concat (match-string 1) ".bib") - rds (list (list 'bib bib))))))) + org--rds (list (list 'bib bib))))))) (call-interactively 'reftex-citation))) ;;;; Functions extending outline functionality @@ -22926,20 +22940,20 @@ the cursor is already beyond the end of the headline." (define-key org-mode-map "\C-a" 'org-beginning-of-line) (define-key org-mode-map "\C-e" 'org-end-of-line) -(defun org-backward-sentence (&optional arg) +(defun org-backward-sentence (&optional _arg) "Go to beginning of sentence, or beginning of table field. This will call `backward-sentence' or `org-table-beginning-of-field', depending on context." - (interactive "P") + (interactive) (cond ((org-at-table-p) (call-interactively 'org-table-beginning-of-field)) (t (call-interactively 'backward-sentence)))) -(defun org-forward-sentence (&optional arg) +(defun org-forward-sentence (&optional _arg) "Go to end of sentence, or end of table field. This will call `forward-sentence' or `org-table-end-of-field', depending on context." - (interactive "P") + (interactive) (cond ((org-at-table-p) (call-interactively 'org-table-end-of-field)) (t (call-interactively 'forward-sentence)))) @@ -22947,9 +22961,9 @@ depending on context." (define-key org-mode-map "\M-a" 'org-backward-sentence) (define-key org-mode-map "\M-e" 'org-forward-sentence) -(defun org-kill-line (&optional arg) +(defun org-kill-line (&optional _arg) "Kill line, to tags or end of line." - (interactive "P") + (interactive) (cond ((or (not org-special-ctrl-k) (bolp) commit 45987b34535e5ae97fa14535630e283f34af94dd Merge: c208eef feadec3 Author: Nicolas Petton Date: Sat Aug 8 21:54:45 2015 +0200 Merge remote-tracking branch 'origin/fix/subsequence-error-with-negative-sequences' commit c208eefcef22183a03d0f03a95a830a14242970c Author: Eli Zaretskii Date: Sat Aug 8 20:42:53 2015 +0300 ; Fix some of my ChangeLog entries diff --git a/ChangeLog.2 b/ChangeLog.2 index 751e558..281edc5 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -121,7 +121,6 @@ 2015-08-02 Eli Zaretskii Whitespace fixes - Whitespace fixes. 2015-08-02 Evgeny Fraimovitch (tiny change) @@ -282,8 +281,6 @@ 2015-07-31 Eli Zaretskii - ;* src/w32fns.c (syms_of_w32fns): Fix last commit. - Allow to use the old key processing code on MS-Windows * src/w32fns.c (syms_of_w32fns) : New variable. @@ -1489,10 +1486,6 @@ * doc/emacs/display.texi (Displaying Boundaries): * doc/emacs/search.texi (Word Search): Add cross references. -2015-07-02 Eli Zaretskii - - ;* src/bidi.c (bpa_stack_entry): Update commentary for Unicode 8.0. - 2015-07-02 Paul Eggert -batch should not affect ‘’ -> `' display @@ -2719,8 +2712,6 @@ 2015-06-15 Eli Zaretskii - ;* src/fontset.c: Update obsolete commentary. - Fix current-iso639-language on MS-Windows * lisp/international/mule-cmds.el (set-locale-environment): Downcase the locale name before interning it. This is so the commit b085bb426952be02bbc975ebdacd1b8fe8bf99d5 Author: Paul Eggert Date: Sat Aug 8 09:47:37 2015 -0700 Electric quote if coding is undecided or no conv * lisp/electric.el (electric--insertable-p): Also say that a string is insertable if the buffer file coding system is undecided or uses no conversion, as curved quotes will work in either case. diff --git a/lisp/electric.el b/lisp/electric.el index ca05c8c..8ca0931 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -428,8 +428,10 @@ The variable `electric-layout-rules' says when and how to insert newlines." :type 'boolean :safe 'booleanp :group 'electricity) (defun electric--insertable-p (string) - (not (unencodable-char-position nil nil buffer-file-coding-system - nil string))) + (or (not buffer-file-coding-system) + (eq (coding-system-base buffer-file-coding-system) 'undecided) + (not (unencodable-char-position nil nil buffer-file-coding-system + nil string)))) (defun electric-quote-post-self-insert-function () "Function that ‘electric-quote-mode’ adds to ‘post-self-insert-hook’. commit ab574175a4696a1eff95ed0aa2dadf821f9aafc7 Author: David Kastrup Date: Sat Aug 8 18:00:17 2015 +0200 ; Add missing ChangeLog entry diff --git a/ChangeLog.2 b/ChangeLog.2 index 4d36087..751e558 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -1,3 +1,47 @@ +2015-08-04 David Kastrup + + Do not overwrite preexisting contents of unread-command-events + * lisp/vc/emerge.el (emerge-show-file-name): + * lisp/progmodes/vhdl-mode.el (vhdl-electric-dash) + (vhdl-comment-insert, vhdl-hooked-abbrev): + * lisp/progmodes/octave.el (inferior-octave-dynamic-list-input-ring): + * lisp/progmodes/fortran.el (fortran-window-create-momentarily): + * lisp/progmodes/ebrowse.el (ebrowse-hack-electric-buffer-menu): + * lisp/progmodes/cperl-mode.el (cperl-putback-char): + * lisp/obsolete/vip.el (vip-escape-to-emacs) + (vip-prefix-arg-value, vip-prefix-arg-com): + * lisp/obsolete/terminal.el (te-escape-extended-command-unread): + * lisp/leim/quail/tibetan.el (quail-tibetan-update-translation) + (quail-tibkey-update-translation): + * lisp/leim/quail/lrt.el (quail-lrt-update-translation): + * lisp/leim/quail/lao.el (quail-lao-update-translation): + * lisp/leim/quail/japanese.el (quail-japanese-update-translation) + (quail-japanese-self-insert-and-switch-to-alpha): + * lisp/leim/quail/hangul.el (hangul2-input-method) + (hangul3-input-method, hangul390-input-method): + * lisp/language/hanja-util.el (hangul-to-hanja-char): + * lisp/international/robin.el (robin-input-method): + * lisp/international/quail.el (quail-start-translation) + (quail-start-conversion): + * lisp/gnus/gnus-art.el (gnus-article-describe-key) + (gnus-article-describe-key-briefly): + * lisp/eshell/em-hist.el (eshell-list-history): + * lisp/term.el (term-dynamic-list-input-ring) + (term-dynamic-list-completions): + * lisp/subr.el (momentary-string-display): + * lisp/simple.el (read-quoted-char): + * lisp/pcomplete.el (pcomplete-show-completions): + * lisp/kmacro.el (kmacro-repeat-on-last-key): + * lisp/info.el (Info-summary): + * lisp/ehelp.el (electric-help-command-loop): + * lisp/ebuff-menu.el (electric-buffer-list) + (Electric-buffer-menu-exit): + * lisp/double.el (double-translate-key): + * lisp/comint.el (comint-dynamic-list-input-ring) + (comint-dynamic-list-completions): Do not overwrite preexisting + contents of `unread-command-events' when putting new events into + it. + 2015-08-04 Daniel Colascione Improve ansi-color filtering of unrecognized escape sequences commit ac9960b9a0e7d381ad3d33c29df10e5022b5bc4e Author: Eli Zaretskii Date: Sat Aug 8 18:54:10 2015 +0300 ; Remove accidentally duplicated redisplay test. ; * test/redisplay-testsuite.el (test-redisplay-4): Remove accidentally duplicated test. diff --git a/test/redisplay-testsuite.el b/test/redisplay-testsuite.el index a5ec1e8..332eeb1 100644 --- a/test/redisplay-testsuite.el +++ b/test/redisplay-testsuite.el @@ -263,14 +263,6 @@ static unsigned char x_bits[] = {0xff, 0x81, 0xbd, 0xa5, 0xa5, 0xbd, 0x81, 0xff (insert "XYZ\n") ;; Overlay strings with partial `invisibility' property and with a ;; display property on the before-string. - (insert "\n Expected: A...C") - (insert "\n Result: ") - (let ((opoint (point))) - (insert "X\n") - (let ((ov (make-overlay opoint (1+ opoint))) - (str "ABC")) - (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis str) - (overlay-put ov 'display str))) (insert "\n Expected: ..." (propertize "DEF" 'display '(image :type xpm :file "close.xpm")) (propertize "ABC" 'face 'highlight) "XYZ") commit 46387c54ad61155b615c6ad49f2bb19ad8311aee Author: Paul Eggert Date: Sat Aug 8 08:25:51 2015 -0700 * configure.ac (HAVE_STACK_OVERFLOW_HANDLING): Simplify configuration. diff --git a/configure.ac b/configure.ac index 863c9a9..16d4484 100644 --- a/configure.ac +++ b/configure.ac @@ -4556,18 +4556,11 @@ if test $emacs_cv_func_sigsetjmp = yes; then [Define to 1 if sigsetjmp and siglongjmp work.]) fi -# We need all of these features to handle C stack overflows. -if test "$emacs_cv_func_sigsetjmp" = "yes" && - test "$emacs_cv_alternate_stack" = yes; then - AC_DEFINE([HAVE_STACK_OVERFLOW_HANDLING], 1, - [Define to 1 if C stack overflow can be handled in some cases.]) -fi - -# WINDOWSNT can handle C stack overflows even without the above features -if test "${opsys}" = "mingw32"; then - AC_DEFINE([HAVE_STACK_OVERFLOW_HANDLING], 1, - [Define to 1 if C stack overflow can be handled in some cases.]) -fi +case $emacs_cv_func_sigsetjmp,$emacs_cv_alternate_stack,$opsys in + yes,yes,* | *,*,mingw32) + AC_DEFINE([HAVE_STACK_OVERFLOW_HANDLING], 1, + [Define to 1 if C stack overflow can be handled in some cases.]);; +esac case $opsys in sol2* | unixware ) commit 1bb08a8cb10f0b8aa862d93a57edf70591fd135e Author: Eli Zaretskii Date: Sat Aug 8 16:55:26 2015 +0300 Fix overlay string display regressions introduced in Emacs 24.5 * src/xdisp.c (pop_it): Reset the flag to ignore overlays at this buffer position, if we move the iterator to a new position as result of jumping over text covered by a "replacing" display property. * test/redisplay-testsuite.el (test-redisplay-4): Add 2 new tests. diff --git a/src/xdisp.c b/src/xdisp.c index e7626d1..711fe08 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5972,6 +5972,7 @@ pop_it (struct it *it) { struct iterator_stack_entry *p; bool from_display_prop = it->from_disp_prop_p; + ptrdiff_t prev_pos = IT_CHARPOS (*it); eassert (it->sp > 0); --it->sp; @@ -6060,6 +6061,11 @@ pop_it (struct it *it) && IT_STRING_BYTEPOS (*it) == it->bidi_it.bytepos) || (CONSP (it->object) && it->method == GET_FROM_STRETCH)); } + /* If we move the iterator over text covered by a display property + to a new buffer position, any info about previously seen overlays + is no longer valid. */ + if (from_display_prop && it->sp == 0 && CHARPOS (it->position) != prev_pos) + it->ignore_overlay_strings_at_pos_p = false; } diff --git a/test/redisplay-testsuite.el b/test/redisplay-testsuite.el index 40a21b7..a5ec1e8 100644 --- a/test/redisplay-testsuite.el +++ b/test/redisplay-testsuite.el @@ -251,6 +251,41 @@ static unsigned char x_bits[] = {0xff, 0x81, 0xbd, 0xa5, 0xa5, 0xbd, 0x81, 0xff (str "ABC")) (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis str) (overlay-put ov 'display str))) + ;; Overlay string over invisible text and non-default face. + (insert "\n Expected: ..." (propertize "ABC" 'face 'highlight) "XYZ") + (insert "\n Result: ") + (insert (propertize "foo" 'invisible 'test-redisplay--ellipsis-invis)) + (let ((ov (make-overlay (point) (point)))) + (overlay-put ov 'invisible t) + (overlay-put ov 'window (selected-window)) + (overlay-put ov 'after-string + (propertize "ABC" 'face 'highlight))) + (insert "XYZ\n") + ;; Overlay strings with partial `invisibility' property and with a + ;; display property on the before-string. + (insert "\n Expected: A...C") + (insert "\n Result: ") + (let ((opoint (point))) + (insert "X\n") + (let ((ov (make-overlay opoint (1+ opoint))) + (str "ABC")) + (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis str) + (overlay-put ov 'display str))) + (insert "\n Expected: ..." + (propertize "DEF" 'display '(image :type xpm :file "close.xpm")) + (propertize "ABC" 'face 'highlight) "XYZ") + (insert "\n Result: ") + (insert (propertize "foo" 'invisible 'test-redisplay--ellipsis-invis)) + (let ((ov (make-overlay (point) (point)))) + (overlay-put ov 'invisible t) + (overlay-put ov 'window (selected-window)) + (overlay-put ov 'after-string + (propertize "ABC" 'face 'highlight)) + (overlay-put ov 'before-string + (propertize "DEF" + 'display '(image :type xpm :file "close.xpm")))) + (insert "XYZ\n") + ;; Overlay string with 2 adjacent and different invisible ;; properties. This caused an infloop before Emacs 25. (insert "\n Expected: ABC") commit feadec307da148af70cf87013c99771ca4db91e4 (refs/remotes/origin/fix/subsequence-error-with-negative-sequences) Author: Phillip Lord Date: Fri Aug 7 22:12:59 2015 +0100 Improve error signalling for seq-subseq. The existing behaviour for seq-subseq is to error when indexes are too large, but to silently ignore numbers which are too negative for lists. String and vector handling errors in both cases. This has been regularlised. Error signalling behaviour has been explicitly added to the docstring of seq-subseq, and also to cl-subseq which largely defers to seq-subseq (and is therefore also impacted by this change). Tests have been added for these exceptional cases, as well as one non exceptional base case. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 101864d..9742014 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -518,7 +518,9 @@ This sets the values of: `cl-most-positive-float', `cl-most-negative-float', (defun cl-subseq (seq start &optional end) "Return the subsequence of SEQ from START to END. If END is omitted, it defaults to the length of the sequence. -If START or END is negative, it counts from the end." +If START or END is negative, it counts from the end. +Signal an error if START or END are outside of the sequence (i.e +too large if positive or too small if negative)" (declare (gv-setter (lambda (new) (macroexp-let2 nil new new diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 9eed36e..038b20e 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -221,12 +221,17 @@ TESTFN is used to compare elements, or `equal' if TESTFN is nil." (defun seq-subseq (seq start &optional end) "Return the subsequence of SEQ from START to END. If END is omitted, it defaults to the length of the sequence. -If START or END is negative, it counts from the end." +If START or END is negative, it counts from the end. + +Signal an error if START or END are outside of the sequence (i.e +too large if positive or too small if negative)" (cond ((or (stringp seq) (vectorp seq)) (substring seq start end)) ((listp seq) (let (len (errtext (format "Bad bounding indices: %s, %s" start end))) (and end (< end 0) (setq end (+ end (setq len (seq-length seq))))) (if (< start 0) (setq start (+ start (or len (setq len (seq-length seq)))))) + (unless (>= start 0) + (error "%s" errtext)) (when (> start 0) (setq seq (nthcdr (1- start) seq)) (or seq (error "%s" errtext)) diff --git a/test/automated/seq-tests.el b/test/automated/seq-tests.el index 3643ce5..74c0700 100644 --- a/test/automated/seq-tests.el +++ b/test/automated/seq-tests.el @@ -187,7 +187,12 @@ Evaluate BODY for each created sequence. (should-not (seq-subseq '(1 2 3) 3)) (should (seq-subseq '(1 2 3) -3)) (should-error (seq-subseq '(1 2 3) 1 4)) - (should (seq-subseq '(1 2 3) 1 3))) + (should (seq-subseq '(1 2 3) 1 3)) + (should-error (seq-subseq '() -1)) + (should-error (seq-subseq [] -1)) + (should-error (seq-subseq "" -1)) + (should-not (seq-subseq '() 0)) + (should-error(seq-subseq '() 0 -1))) (ert-deftest test-seq-concatenate () (with-test-sequences (seq '(2 4 6))