commit b82330077556ca07b7e76951863a08100a6b0f82 (HEAD, refs/remotes/origin/master) Author: Stefan Kangas Date: Mon Aug 10 01:03:09 2020 +0200 ; Fix typos. diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el index a3a6f3fdd9..ce60d1a3ad 100644 --- a/lisp/language/cyril-util.el +++ b/lisp/language/cyril-util.el @@ -47,7 +47,7 @@ ;;;###autoload (defun standard-display-cyrillic-translit (&optional cyrillic-language) - "Display a cyrillic buffer using a transliteration. + "Display a Cyrillic buffer using a transliteration. For readability, the table is slightly different from the one used for the input method `cyrillic-translit'. diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el index 19cba91556..f38dead5a2 100644 --- a/lisp/language/hanja-util.el +++ b/lisp/language/hanja-util.el @@ -22,7 +22,7 @@ ;;; Commentary: -;; This file defines korean hanja table and symbol table. +;; This file defines the Korean Hanja table and symbol table. ;;; Code: @@ -31,7 +31,7 @@ (defvar hanja-table nil "A char table for Hanja characters. -It maps a hangul character to a list of the corresponding Hanja characters. +It maps a Hangul character to a list of the corresponding Hanja characters. Each element of the list has the form CHAR or (CHAR . STRING) where CHAR is a Hanja character and STRING is the meaning of that character. This variable is initialized by `hanja-init-load'.") diff --git a/lisp/language/indian.el b/lisp/language/indian.el index eb882c810e..657ad6915e 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -25,7 +25,7 @@ ;;; Commentary: ;; This file contains definitions of Indian language environments, and -;; setups for displaying the scrtipts used there. +;; setups for displaying the scripts used there. ;;; Code: commit ecba3aa1a20d0e3dd3d5b28194741a7ebfc5daca Author: Stefan Kangas Date: Mon Aug 10 00:56:33 2020 +0200 ; * lisp/man.el (manual-entry): Fix comment to say we will keep it. diff --git a/lisp/man.el b/lisp/man.el index 3121334c6f..da8a15f69b 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -836,7 +836,8 @@ POS defaults to `point'." ;; ====================================================================== ;; Top level command and background process sentinel -;; For compatibility with older versions. +;; This alias was originally for compatibility with older versions. +;; Some users got used to having it, so we will not remove it. ;;;###autoload (defalias 'manual-entry 'man) commit b8b88fad58800bcfad8b23a01d3914441c8e9ee7 Author: Stefan Kangas Date: Mon Aug 10 00:16:44 2020 +0200 * lisp/vt100-led.el: Use lexical-binding. diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el index 7552fbb99c..1e81dd241f 100644 --- a/lisp/vt100-led.el +++ b/lisp/vt100-led.el @@ -1,4 +1,4 @@ -;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones +;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones -*- lexical-binding:t -*- ;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc. commit f1e2d366e5ff30c72ab92d38dacd14b544324066 Author: Lars Ingebrigtsen Date: Sun Aug 9 23:51:24 2020 +0200 Revert "Indent python multiline strings to start and previous levels" This reverts commit b78583cde7d8aaa1fa19c20975c03d689c78baef. The multi-line string indentation was incorrect after applying this patch. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index dcdadae0c4..3af55be4a1 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1070,18 +1070,11 @@ possibilities can be narrowed to specific indentation points." (`(:no-indent . ,_) (prog-first-column)) ; usually 0 (`(,(or :after-line :after-comment + :inside-string :after-backslash) . ,start) ;; Copy previous indentation. (goto-char start) (current-indentation)) - (`(,(or :inside-string - :inside-docstring) . ,start) - ;; Copy previous indentation inside string - (let ((prev (progn (forward-line -1) - (current-indentation))) - (base (progn (goto-char start) - (current-column)))) - (sort (delete-dups (list 0 prev base)) #'<))) (`(,(or :inside-paren-at-closing-paren :inside-paren-at-closing-nested-paren) . ,start) (goto-char (+ 1 start)) @@ -1090,6 +1083,12 @@ possibilities can be narrowed to specific indentation points." (current-indentation) ;; Align with opening paren. (current-column))) + (`(:inside-docstring . ,start) + (let* ((line-indentation (current-indentation)) + (base-indent (progn + (goto-char start) + (current-indentation)))) + (max line-indentation base-indent))) (`(,(or :after-block-start :after-backslash-first-line :after-backslash-assignment-continuation commit 450644e9f7923c30ef3d885638e69d3263bfa3a8 Author: Matthew White Date: Thu Jul 23 21:14:32 2020 +0000 Add ability to mark/unmark/delete all bookmarks Thanks to Karl Fogel for pre-commit review. * lisp/bookmark.el (bookmark-delete-all): New function to delete all bookmarks. (bookmark-bmenu-mark-all): New function to mark all bookmarks in the bookmark list buffer. (bookmark-bmenu-unmark-all): New function to unmark all bookmarks in the bookmark list buffer. (bookmark-bmenu-delete-all): New function to mark for deletion all bookmarks in the bookmark list buffer. (bookmark-map): Map "D" to `bookmark-delete-all'. (bookmark-bmenu-mode-map): New mappping for "M" to `bookmark-bmenu-mark-all'. (bookmark-bmenu-mode-map): New mappping for "U" to `bookmark-bmenu-unmark-all'. (bookmark-bmenu-mode-map): New mappping for "D" to `bookmark-bmenu-delete-all'. (bookmark-bmenu-mark-all): New bookmark menu to `bookmark-delete-all'. (easy-menu-define): New bookmark menu to `bookmark-bmenu-mark-all'. (easy-menu-define): New bookmark menu to `bookmark-bmenu-unmark-all'. (easy-menu-define): New bookmark menu to `bookmark-bmenu-delete-all'. (bookmark-bmenu-select): Update docstring to include a reference to `bookmark-bmenu-mark-all'. (bookmark-bmenu-mode): Update docstring. Add/Update description: `bookmark-bmenu-mark-all', `bookmark-bmenu-delete-all', `bookmark-bmenu-execute-deletions', and `bookmark-bmenu-unmark-all'. * test/lisp/bookmark-resources/test-list.bmk: New bookmark file to test a list of bookmarks. * test/lisp/bookmark-tests.el (bookmark-tests-bookmark-file-list): New reference to the bookmark file used for testing a list of bookmarks. (bookmark-tests-bookmark-list-0, bookmark-tests-bookmark-list-1, bookmark-tests-bookmark-list-2): New cached values for testing a list of bookmark. (bookmark-tests-cache-timestamp-list): New variable to set `bookmark-bookmarks-timestamp'. (with-bookmark-test-list): New macro environment to test a list of bookmarks. (with-bookmark-test-file-list): New macro environment to test a list of bookmarks with example.txt. (with-bookmark-bmenu-test-list): New macro environment to test functions about a list of bookmarks from `bookmark-bmenu-list'. (bookmark-tests-all-names-list, bookmark-tests-get-bookmark-list, bookmark-tests-get-bookmark-record-list): New functions to test the records of the list of bookmarks. (bookmark-tests-make-record-list): New function to test the creation of a record from example.txt with a list of bookmarks loaded. (bookmark-tests-delete-all): New function to test `bookmark-delete-all'. (bookmark-test-bmenu-any-marks-list): New function to test `bookmark-bmenu-any-marks' with a list of bookmarks. (bookmark-test-bmenu-mark-all): New function to test `bookmark-bmenu-mark-all'. (bookmark-test-bmenu-unmark-all): New function to test `bookmark-bmenu-unmark-all'. (bookmark-test-bmenu-delete-all): New function to test `bookmark-bmenu-delete-all'. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index fb293adb77..36a361c3f4 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -200,6 +200,7 @@ A non-nil value may result in truncated bookmark names." (define-key map "f" 'bookmark-insert-location) ;"f"ind (define-key map "r" 'bookmark-rename) (define-key map "d" 'bookmark-delete) + (define-key map "D" 'bookmark-delete-all) (define-key map "l" 'bookmark-load) (define-key map "w" 'bookmark-write) (define-key map "s" 'bookmark-save) @@ -1374,6 +1375,23 @@ probably because we were called from there." (bookmark-save))) +;;;###autoload +(defun bookmark-delete-all (&optional no-confirm) + "Permanently delete all bookmarks. +If optional argument NO-CONFIRM is non-nil, don't ask for +confirmation." + (interactive "P") + (when (or no-confirm + (yes-or-no-p "Permanently delete all bookmarks? ")) + (bookmark-maybe-load-default-file) + (setq bookmark-alist-modification-count + (+ bookmark-alist-modification-count (length bookmark-alist))) + (setq bookmark-alist nil) + (bookmark-bmenu-surreptitiously-rebuild-list) + (when (bookmark-time-to-save-p) + (bookmark-save)))) + + (defun bookmark-time-to-save-p (&optional final-time) "Return t if it is time to save bookmarks to disk, nil otherwise. Optional argument FINAL-TIME means this is being called when Emacs @@ -1600,12 +1618,15 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." (define-key map "\C-d" 'bookmark-bmenu-delete-backwards) (define-key map "x" 'bookmark-bmenu-execute-deletions) (define-key map "d" 'bookmark-bmenu-delete) + (define-key map "D" 'bookmark-bmenu-delete-all) (define-key map " " 'next-line) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) (define-key map "\177" 'bookmark-bmenu-backup-unmark) (define-key map "u" 'bookmark-bmenu-unmark) + (define-key map "U" 'bookmark-bmenu-unmark-all) (define-key map "m" 'bookmark-bmenu-mark) + (define-key map "M" 'bookmark-bmenu-mark-all) (define-key map "l" 'bookmark-bmenu-load) (define-key map "r" 'bookmark-bmenu-rename) (define-key map "R" 'bookmark-bmenu-relocate) @@ -1627,8 +1648,10 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." ["Select Marked Bookmarks" bookmark-bmenu-select t] "---" ["Mark Bookmark" bookmark-bmenu-mark t] + ["Mark all Bookmarks" bookmark-bmenu-mark-all t] ["Unmark Bookmark" bookmark-bmenu-unmark t] ["Unmark Backwards" bookmark-bmenu-backup-unmark t] + ["Unmark all Bookmarks" bookmark-bmenu-unmark-all t] ["Toggle Display of Filenames" bookmark-bmenu-toggle-filenames t] ["Display Location of Bookmark" bookmark-bmenu-locate t] "---" @@ -1636,6 +1659,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." ["Rename Bookmark" bookmark-bmenu-rename t] ["Relocate Bookmark's File" bookmark-bmenu-relocate t] ["Mark Bookmark for Deletion" bookmark-bmenu-delete t] + ["Mark all Bookmarks for Deletion" bookmark-bmenu-delete-all t] ["Delete Marked Bookmarks" bookmark-bmenu-execute-deletions t]) ("Annotations" ["Show Annotation for Current Bookmark" bookmark-bmenu-show-annotation t] @@ -1761,6 +1785,7 @@ Letters do not insert themselves; instead, they are commands. Bookmark names preceded by a \"*\" have annotations. \\ \\[bookmark-bmenu-mark] -- mark bookmark to be displayed. +\\[bookmark-bmenu-mark-all] -- mark all listed bookmarks to be displayed. \\[bookmark-bmenu-select] -- select bookmark of line point is on. Also show bookmarks marked using m in other windows. \\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names). @@ -1777,13 +1802,15 @@ Bookmark names preceded by a \"*\" have annotations. \\[bookmark-bmenu-relocate] -- relocate this bookmark's file (prompts for new file). \\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down. \\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up. -\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'. +\\[bookmark-bmenu-delete-all] -- mark all listed bookmarks as to be deleted. +\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]' or `\\[bookmark-bmenu-delete-all]'. \\[bookmark-bmenu-save] -- save the current bookmark list in the default file. With a prefix arg, prompts for a file to save in. \\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.) \\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line. With prefix argument, also move up one line. \\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks. +\\[bookmark-bmenu-unmark-all] -- remove all kinds of marks from all listed bookmarks. \\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark in another buffer. \\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer. @@ -1950,9 +1977,23 @@ If the annotation does not exist, do nothing." (bookmark-bmenu-ensure-position)))) +(defun bookmark-bmenu-mark-all () + "Mark all listed bookmarks to be displayed by \\\\[bookmark-bmenu-select]." + (interactive) + (save-excursion + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (with-buffer-modified-unmodified + (let ((inhibit-read-only t)) + (while (not (eobp)) + (delete-char 1) + (insert ?>) + (forward-line 1)))))) + + (defun bookmark-bmenu-select () "Select this line's bookmark; also display bookmarks marked with `>'. -You can mark bookmarks with the \\\\[bookmark-bmenu-mark] command." +You can mark bookmarks with the \\\\[bookmark-bmenu-mark] or \\\\[bookmark-bmenu-mark-all] commands." (interactive) (let ((bmrk (bookmark-bmenu-bookmark)) (menu (current-buffer)) @@ -2121,6 +2162,20 @@ Optional BACKUP means move up." (bookmark-bmenu-ensure-position)) +(defun bookmark-bmenu-unmark-all () + "Cancel all requested operations on all listed bookmarks." + (interactive) + (save-excursion + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (with-buffer-modified-unmodified + (let ((inhibit-read-only t)) + (while (not (eobp)) + (delete-char 1) + (insert " ") + (forward-line 1)))))) + + (defun bookmark-bmenu-delete () "Mark bookmark on this line to be deleted. To carry out the deletions that you've marked, use \\\\[bookmark-bmenu-execute-deletions]." @@ -2146,6 +2201,22 @@ To carry out the deletions that you've marked, use \\\\ (bookmark-bmenu-ensure-position)) +(defun bookmark-bmenu-delete-all () + "Mark all listed bookmarks as to be deleted. +To remove all deletion marks, use \\\\[bookmark-bmenu-unmark-all]. +To carry out the deletions that you've marked, use \\\\[bookmark-bmenu-execute-deletions]." + (interactive) + (save-excursion + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (with-buffer-modified-unmodified + (let ((inhibit-read-only t)) + (while (not (eobp)) + (delete-char 1) + (insert ?D) + (forward-line 1)))))) + + (defun bookmark-bmenu-execute-deletions () "Delete bookmarks flagged `D'." (interactive) @@ -2305,6 +2376,9 @@ strings returned are not." (bindings--define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) + (bindings--define-key map [delete-all] + '(menu-item "Delete all Bookmarks..." bookmark-delete-all + :help "Delete all bookmarks from the bookmark list")) (bindings--define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) diff --git a/test/lisp/bookmark-resources/test-list.bmk b/test/lisp/bookmark-resources/test-list.bmk new file mode 100644 index 0000000000..696d64979b --- /dev/null +++ b/test/lisp/bookmark-resources/test-list.bmk @@ -0,0 +1,20 @@ +;;;; Emacs Bookmark Format Version 1 ;;;; -*- coding: utf-8-emacs -*- +;;; This format is meant to be slightly human-readable; +;;; nevertheless, you probably don't want to edit it. +;;; -*- End Of Bookmark File Format Version Stamp -*- +(("name-0" + (filename . "/some/file-0") + (front-context-string . "abc") + (rear-context-string . "def") + (position . 3)) +("name-1" + (filename . "/some/file-1") + (front-context-string . "abc") + (rear-context-string . "def") + (position . 3)) +("name-2" + (filename . "/some/file-2") + (front-context-string . "abc") + (rear-context-string . "def") + (position . 3)) +) diff --git a/test/lisp/bookmark-tests.el b/test/lisp/bookmark-tests.el index b9c6ff9c54..c5959e46d8 100644 --- a/test/lisp/bookmark-tests.el +++ b/test/lisp/bookmark-tests.el @@ -83,6 +83,70 @@ the lexically-bound variable `buffer'." ,@body) (kill-buffer buffer)))) +(defvar bookmark-tests-bookmark-file-list + (expand-file-name "test-list.bmk" bookmark-tests-data-dir) + "Bookmark file used for testing a list of bookmarks.") + +;; The values below should match `bookmark-tests-bookmark-file-list' +;; content. We cache these values to speed up tests. +(eval-and-compile ; needed by `with-bookmark-test-list' macro + (defvar bookmark-tests-bookmark-list-0 '("name-0" + (filename . "/some/file-0") + (front-context-string . "ghi") + (rear-context-string . "jkl") + (position . 4)) + "Cached value used in bookmark-tests.el.")) + +;; The values below should match `bookmark-tests-bookmark-file-list' +;; content. We cache these values to speed up tests. +(eval-and-compile ; needed by `with-bookmark-test-list' macro + (defvar bookmark-tests-bookmark-list-1 '("name-1" + (filename . "/some/file-1") + (front-context-string . "mno") + (rear-context-string . "pqr") + (position . 5)) + "Cached value used in bookmark-tests.el.")) + +;; The values below should match `bookmark-tests-bookmark-file-list' +;; content. We cache these values to speed up tests. +(eval-and-compile ; needed by `with-bookmark-test-list' macro + (defvar bookmark-tests-bookmark-list-2 '("name-2" + (filename . "/some/file-2") + (front-context-string . "stu") + (rear-context-string . "vwx") + (position . 6)) + "Cached value used in bookmark-tests.el.")) + +(defvar bookmark-tests-cache-timestamp-list + (cons bookmark-tests-bookmark-file-list + (nth 5 (file-attributes + bookmark-tests-bookmark-file-list))) + "Cached value used in bookmark-tests.el.") + +(defmacro with-bookmark-test-list (&rest body) + "Create environment for testing bookmark.el and evaluate BODY. +Ensure a clean environment for testing, and do not change user +data when running tests interactively." + `(with-temp-buffer + (let ((bookmark-alist (quote (,(copy-sequence bookmark-tests-bookmark-list-0) + ,(copy-sequence bookmark-tests-bookmark-list-1) + ,(copy-sequence bookmark-tests-bookmark-list-2)))) + (bookmark-default-file bookmark-tests-bookmark-file-list) + (bookmark-bookmarks-timestamp bookmark-tests-cache-timestamp-list) + bookmark-save-flag) + ,@body))) + +(defmacro with-bookmark-test-file-list (&rest body) + "Create environment for testing bookmark.el and evaluate BODY. +Same as `with-bookmark-test-list' but also opens the resource file +example.txt in a buffer, which can be accessed by callers through +the lexically-bound variable `buffer'." + `(let ((buffer (find-file-noselect bookmark-tests-example-file))) + (unwind-protect + (with-bookmark-test-list + ,@body) + (kill-buffer buffer)))) + (ert-deftest bookmark-tests-all-names () (with-bookmark-test (should (equal (bookmark-all-names) '("name"))))) @@ -95,6 +159,30 @@ the lexically-bound variable `buffer'." (with-bookmark-test (should (equal (bookmark-get-bookmark-record "name") (cdr bookmark-tests-bookmark))))) +(ert-deftest bookmark-tests-all-names-list () + (with-bookmark-test-list + (should (equal (bookmark-all-names) '("name-0" + "name-1" + "name-2"))))) + +(ert-deftest bookmark-tests-get-bookmark-list () + (with-bookmark-test-list + (should (equal (bookmark-get-bookmark "name-0") + bookmark-tests-bookmark-list-0)) + (should (equal (bookmark-get-bookmark "name-1") + bookmark-tests-bookmark-list-1)) + (should (equal (bookmark-get-bookmark "name-2") + bookmark-tests-bookmark-list-2)))) + +(ert-deftest bookmark-tests-get-bookmark-record-list () + (with-bookmark-test-list + (should (equal (bookmark-get-bookmark-record "name-0") + (cdr bookmark-tests-bookmark-list-0))) + (should (equal (bookmark-get-bookmark-record "name-1") + (cdr bookmark-tests-bookmark-list-1))) + (should (equal (bookmark-get-bookmark-record "name-2") + (cdr bookmark-tests-bookmark-list-2))))) + (ert-deftest bookmark-tests-record-getters-and-setters-new () (with-temp-buffer (let* ((buffer-file-name "test") @@ -130,6 +218,19 @@ the lexically-bound variable `buffer'." ;; calling twice gives same record (should (equal (bookmark-make-record) record)))))) +(ert-deftest bookmark-tests-make-record-list () + (with-bookmark-test-file-list + (let* ((record `("example.txt" (filename . ,bookmark-tests-example-file) + (front-context-string . "is text file is ") + (rear-context-string) + (position . 3) + (defaults "example.txt")))) + (with-current-buffer buffer + (goto-char 3) + (should (equal (bookmark-make-record) record)) + ;; calling twice gives same record + (should (equal (bookmark-make-record) record)))))) + (ert-deftest bookmark-tests-make-record-function () (with-bookmark-test (let ((buffer-file-name "test")) @@ -267,6 +368,11 @@ the lexically-bound variable `buffer'." (bookmark-delete "name") (should (equal bookmark-alist nil)))) +(ert-deftest bookmark-tests-delete-all () + (with-bookmark-test-list + (bookmark-delete-all t) + (should (equal bookmark-alist nil)))) + (defmacro with-bookmark-test-save-load (&rest body) "Create environment for testing bookmark.el and evaluate BODY. Same as `with-bookmark-test' but also sets a temporary @@ -340,6 +446,18 @@ testing `bookmark-bmenu-list'." ,@body) (kill-buffer bookmark-bmenu-buffer))))) +(defmacro with-bookmark-bmenu-test-list (&rest body) + "Create environment for testing `bookmark-bmenu-list' and evaluate BODY. +Same as `with-bookmark-test-list' but with additions suitable for +testing `bookmark-bmenu-list'." + `(with-bookmark-test-list + (let ((bookmark-bmenu-buffer "*Bookmark List - Testing*")) + (unwind-protect + (save-window-excursion + (bookmark-bmenu-list) + ,@body) + (kill-buffer bookmark-bmenu-buffer))))) + (ert-deftest bookmark-test-bmenu-edit-annotation/show-annotation () (with-bookmark-bmenu-test (bookmark-set-annotation "name" "foo") @@ -402,6 +520,52 @@ testing `bookmark-bmenu-list'." (beginning-of-line) (should (bookmark-bmenu-any-marks)))) +(ert-deftest bookmark-test-bmenu-mark-all () + (with-bookmark-bmenu-test-list + (let ((here (point-max))) + ;; Expect to not move the point + (goto-char here) + (bookmark-bmenu-mark-all) + (should (equal here (point))) + ;; Verify that all bookmarks are marked + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (should (looking-at "^> ")) + (should (equal bookmark-tests-bookmark-list-0 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^> ")) + (should (equal bookmark-tests-bookmark-list-1 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^> ")) + (should (equal bookmark-tests-bookmark-list-2 + (bookmark-get-bookmark (bookmark-bmenu-bookmark))))))) + +(ert-deftest bookmark-test-bmenu-any-marks-list () + (with-bookmark-bmenu-test-list + ;; Mark just the second item + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (forward-line 1) + (bookmark-bmenu-mark) + ;; Verify that only the second item is marked + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (should (looking-at "^ ")) + (should (equal bookmark-tests-bookmark-list-0 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^> ")) + (should (equal bookmark-tests-bookmark-list-1 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^ ")) + (should (equal bookmark-tests-bookmark-list-2 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + ;; There should be at least one mark + (should (bookmark-bmenu-any-marks)))) + (ert-deftest bookmark-test-bmenu-unmark () (with-bookmark-bmenu-test (bookmark-bmenu-mark) @@ -410,12 +574,63 @@ testing `bookmark-bmenu-list'." (beginning-of-line) (should (looking-at "^ ")))) +(ert-deftest bookmark-test-bmenu-unmark-all () + (with-bookmark-bmenu-test-list + (bookmark-bmenu-mark-all) + (let ((here (point-max))) + ;; Expect to not move the point + (goto-char here) + (bookmark-bmenu-unmark-all) + (should (equal here (point))) + ;; Verify that all bookmarks are unmarked + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (should (looking-at "^ ")) + (should (equal bookmark-tests-bookmark-list-0 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^ ")) + (should (equal bookmark-tests-bookmark-list-1 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^ ")) + (should (equal bookmark-tests-bookmark-list-2 + (bookmark-get-bookmark (bookmark-bmenu-bookmark))))))) + (ert-deftest bookmark-test-bmenu-delete () (with-bookmark-bmenu-test (bookmark-bmenu-delete) (bookmark-bmenu-execute-deletions) (should (equal (length bookmark-alist) 0)))) +(ert-deftest bookmark-test-bmenu-delete-all () + (with-bookmark-bmenu-test-list + ;; Verify that unmarked bookmarks aren't deleted + (bookmark-bmenu-execute-deletions) + (should-not (eq bookmark-alist nil)) + (let ((here (point-max))) + ;; Expect to not move the point + (goto-char here) + (bookmark-bmenu-delete-all) + (should (equal here (point))) + ;; Verify that all bookmarks are marked for deletion + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (should (looking-at "^D ")) + (should (equal bookmark-tests-bookmark-list-0 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^D ")) + (should (equal bookmark-tests-bookmark-list-1 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^D ")) + (should (equal bookmark-tests-bookmark-list-2 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + ;; Verify that all bookmarks are deleted + (bookmark-bmenu-execute-deletions) + (should (eq bookmark-alist nil))))) + (ert-deftest bookmark-test-bmenu-locate () (let (msg) (cl-letf (((symbol-function 'message) commit b03b8d6e5567ae422bb357f39b32423615e7a36b Author: Wolfgang Scherer Date: Sun Aug 9 21:48:37 2020 +0200 Use one src status -a call for vc-src-dir-status-files lisp/vc/vc-src.el: (vc-src--parse-state) new function. (vc-src-state) use vc-src--parse-state. (vc-src-dir-status-files) use recursive calls to `src status -a' (bug#39502). diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el index db127ee726..4eb638978a 100644 --- a/lisp/vc/vc-src.el +++ b/lisp/vc/vc-src.el @@ -146,6 +146,20 @@ For a description of possible values, see `vc-check-master-templates'." (progn (defun vc-src-registered (f) (vc-default-registered 'src f))) +(defun vc-src--parse-state (out) + (when (null (string-match "does not exist or is unreadable" out)) + (let ((state (aref out 0))) + (cond + ;; FIXME: What to do about L code? + ((eq state ?.) 'up-to-date) + ((eq state ?A) 'added) + ((eq state ?M) 'edited) + ((eq state ?I) 'ignored) + ((eq state ?R) 'removed) + ((eq state ?!) 'missing) + ((eq state ??) 'unregistered) + (t 'up-to-date))))) + (defun vc-src-state (file) "SRC-specific version of `vc-state'." (let* @@ -163,32 +177,41 @@ For a description of possible values, see `vc-check-master-templates'." "status" "-a" (file-relative-name file)) (error nil))))))) (when (eq 0 status) - (when (null (string-match "does not exist or is unreadable" out)) - (let ((state (aref out 0))) - (cond - ;; FIXME: What to do about A and L codes? - ((eq state ?.) 'up-to-date) - ((eq state ?A) 'added) - ((eq state ?M) 'edited) - ((eq state ?I) 'ignored) - ((eq state ?R) 'removed) - ((eq state ?!) 'missing) - ((eq state ??) 'unregistered) - (t 'up-to-date))))))) + (vc-src--parse-state out)))) (autoload 'vc-expand-dirs "vc") (defun vc-src-dir-status-files (dir files update-function) - ;; FIXME: Use one src status -a call for this - (if (not files) (setq files (vc-expand-dirs (list dir) 'SRC))) - (let ((result nil)) - (dolist (file files) - (let ((state (vc-state file)) - (frel (file-relative-name file))) - (when (and (eq (vc-backend file) 'SRC) - (not (eq state 'up-to-date))) - (push (list frel state) result)))) - (funcall update-function result))) + (let* ((result nil) + (status nil) + (default-directory (or dir default-directory)) + (out + (with-output-to-string + (with-current-buffer standard-output + (setq status + (ignore-errors + (apply + #'process-file vc-src-program nil t nil + "status" "-a" + (mapcar #'file-relative-name files))))))) + dlist) + (when (eq 0 status) + (dolist (line (split-string out "[\n\r]" t)) + (let* ((pair (split-string line "[\t]" t)) + (state (vc-src--parse-state (car pair))) + (frel (cadr pair))) + (if (file-directory-p frel) + (push frel dlist) + (when (not (eq state 'up-to-date)) + (push (list frel state) result))))) + (dolist (drel dlist) + (let ((dresult (vc-src-dir-status-files + (expand-file-name drel) nil #'identity))) + (dolist (dres dresult) + (push (list (concat (file-name-as-directory drel) (car dres)) + (cadr dres)) + result)))) + (funcall update-function result)))) (defun vc-src-command (buffer file-or-list &rest flags) "A wrapper around `vc-do-command' for use in vc-src.el. commit 8b4e022c5ec8a2f11fee5ec3438f7e91f09c6cc5 Author: Kristian Hole Date: Sun Aug 9 20:55:52 2020 +0200 Adds backslash as escape character to mysql syntax-alist * lisp/progmodes/sql.el (sql-product-alist): The \ character is an escape character in mysql (bug#37459). (sql-mode): Changes the example from the incorrect use of punctuation rule, to the escape character rule. Copyright-paperwork-exempt: yes diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index a70b5ed60d..7c4feb38c3 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -455,7 +455,7 @@ file. Since that is a plaintext file, this could be dangerous." :prompt-regexp "^mysql> " :prompt-length 6 :prompt-cont-regexp "^ -> " - :syntax-alist ((?# . "< b")) + :syntax-alist ((?# . "< b") (?\\ . "\\")) :input-filter sql-remove-tabs-filter) (oracle @@ -4203,7 +4203,7 @@ must tell Emacs. Here's how to do that in your init file: \(add-hook \\='sql-mode-hook (lambda () - (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))" + (modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))" :abbrev-table sql-mode-abbrev-table (if sql-mode-menu commit b78583cde7d8aaa1fa19c20975c03d689c78baef Author: Carlos Pita Date: Sun Aug 9 20:44:50 2020 +0200 Indent python multiline strings to start and previous levels * progmodes/python.el (python-indent--calculate-indentation): Add an additional indentation point to match indentation of previous line in a multiline string. Then Tab iterates between 0, the start indentation level and the previous line level (bug#37726). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 3af55be4a1..dcdadae0c4 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1070,11 +1070,18 @@ possibilities can be narrowed to specific indentation points." (`(:no-indent . ,_) (prog-first-column)) ; usually 0 (`(,(or :after-line :after-comment - :inside-string :after-backslash) . ,start) ;; Copy previous indentation. (goto-char start) (current-indentation)) + (`(,(or :inside-string + :inside-docstring) . ,start) + ;; Copy previous indentation inside string + (let ((prev (progn (forward-line -1) + (current-indentation))) + (base (progn (goto-char start) + (current-column)))) + (sort (delete-dups (list 0 prev base)) #'<))) (`(,(or :inside-paren-at-closing-paren :inside-paren-at-closing-nested-paren) . ,start) (goto-char (+ 1 start)) @@ -1083,12 +1090,6 @@ possibilities can be narrowed to specific indentation points." (current-indentation) ;; Align with opening paren. (current-column))) - (`(:inside-docstring . ,start) - (let* ((line-indentation (current-indentation)) - (base-indent (progn - (goto-char start) - (current-indentation)))) - (max line-indentation base-indent))) (`(,(or :after-block-start :after-backslash-first-line :after-backslash-assignment-continuation commit 5fef06fcf7ba284f206061293c3f9bcfac2daafc Author: Philipp Stephani Date: Sun Aug 9 19:31:01 2020 +0200 * src/json.c (lisp_to_json): Simplify. diff --git a/src/json.c b/src/json.c index 814afc6d74..8c9583631a 100644 --- a/src/json.c +++ b/src/json.c @@ -479,9 +479,7 @@ lisp_to_json (Lisp_Object lisp, struct json_configuration *conf) { intmax_t low = TYPE_MINIMUM (json_int_t); intmax_t high = TYPE_MAXIMUM (json_int_t); - intmax_t value; - if (! (integer_to_intmax (lisp, &value) && low <= value && value <= high)) - args_out_of_range_3 (lisp, make_int (low), make_int (high)); + intmax_t value = check_integer_range (lisp, low, high); return json_check (json_integer (value)); } else if (FLOATP (lisp)) commit 781bcce1196376b3db26a1c298f72779e819db76 Author: Stefan Kangas Date: Sun Aug 9 18:23:45 2020 +0200 Revert obsoletion of manual-entry Ref: https://lists.gnu.org/archive/html/emacs-devel/2020-08/msg00167.html * lisp/man.el (manual-entry): Revert obsoletion of this alias. diff --git a/lisp/man.el b/lisp/man.el index e1dd5037c4..3121334c6f 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -838,7 +838,7 @@ POS defaults to `point'." ;; For compatibility with older versions. ;;;###autoload -(define-obsolete-function-alias 'manual-entry 'man "28.1") +(defalias 'manual-entry 'man) (defvar Man-completion-cache nil ;; On my machine, "man -k" is so fast that a cache makes no sense, commit ec323389e75303c469b68a54b02bcd7123e2d60b Author: Eli Zaretskii Date: Sun Aug 9 19:13:53 2020 +0300 Fix recently added documentation bits * lisp/simple.el (async-shell-command-buffer) (async-shell-command, shell-command, shell-command-on-region): * lisp/dired-aux.el (dired-do-async-shell-command) (dired-do-shell-command): * doc/misc/tramp.texi (Remote processes): * doc/emacs/misc.texi (Single Shell): * etc/NEWS: Fix wording and punctuation of recently added documentation. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index cb9fc61f32..39aae87efa 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -807,7 +807,7 @@ old region and replaces it with the output from the shell command. see what keys are in the buffer. If the buffer contains a GnuPG key, type @kbd{C-x h M-| gpg @key{RET}} to feed the entire buffer contents to @command{gpg}. This will output the list of keys to the -buffer named @code{shell-command-buffer-name}. +buffer whose name is the value of @code{shell-command-buffer-name}. @vindex shell-file-name The above commands use the shell specified by the variable diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index ae6fe3d9ea..23221b6a7b 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3378,8 +3378,8 @@ host. Example: @end group @end example -@command{tail} command outputs continuously to the local buffer, -named @code{shell-command-buffer-name-async} +@command{tail} command outputs continuously to the local buffer whose +name is the value of the variable @code{shell-command-buffer-name-async}. @kbd{M-x auto-revert-tail-mode @key{RET}} runs similarly showing continuous output. diff --git a/etc/NEWS b/etc/NEWS index 8118272070..e3d7ff0bef 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -81,9 +81,11 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 +++ -** The new constants 'shell-command-buffer-name' and +** New variables that hold default buffer names for shell output. +The new constants 'shell-command-buffer-name' and 'shell-command-buffer-name-async' store the default buffer names -for the output of shell commands. +for the output of, respectively, synchronous and async shell +commands. ** Support for '(box . SIZE)' 'cursor-type'. By default, 'box' cursor always has a filled box shape. But if you @@ -201,6 +203,7 @@ as a data list rather than as a piece of code. ** Calendar ++++ *** New variable 'calendar-use-numeric-time-zones' to use numeric time zones. If non-nil, functions that display time zones (like the 'S' command in calendar mode that displays the sunrise time) will display time zones @@ -233,12 +236,12 @@ their 'default-directory' under VC. Bookmark locations can refer to VC directory buffers. --- -*** New user option 'vc-hg-create-bookmark' controls whether a bookmark -or branch will be created when you invoke 'C-u C-x v s' ('vc-create-tag'). +*** New user option 'vc-hg-create-bookmark'. +It controls whether a bookmark or branch will be created when you +invoke 'C-u C-x v s' ('vc-create-tag'). --- -*** 'vc-hg' now uses 'hg summary' command to populate extra 'vc-dir' -headers. +*** 'vc-hg' now uses 'hg summary' to populate extra 'vc-dir' headers. ** Gnus diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 84d8c36f45..69b175339a 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -688,7 +688,7 @@ are executed in the background on each file sequentially waiting for each command to terminate before running the next command. In shell syntax this means separating the individual commands with `;'. -The output appears in the buffer `shell-command-buffer-name-async'." +The output appears in the buffer named by `shell-command-buffer-name-async'." (interactive (let ((files (dired-get-marked-files t current-prefix-arg nil nil t))) (list @@ -726,16 +726,16 @@ it, write `*\"\"' in place of just `*'. This is equivalent to just `*' in the shell, but avoids Dired's special handling. If COMMAND ends in `&', `;', or `;&', it is executed in the -background asynchronously, and the output appears in the buffer -`shell-command-buffer-name-async'. When operating on multiple files and COMMAND -ends in `&', the shell command is executed on each file in parallel. -However, when COMMAND ends in `;' or `;&' then commands are executed -in the background on each file sequentially waiting for each command -to terminate before running the next command. You can also use -`dired-do-async-shell-command' that automatically adds `&'. +background asynchronously, and the output appears in the buffer named +by `shell-command-buffer-name-async'. When operating on multiple files +and COMMAND ends in `&', the shell command is executed on each file +in parallel. However, when COMMAND ends in `;' or `;&', then commands +are executed in the background on each file sequentially waiting for +each command to terminate before running the next command. You can +also use `dired-do-async-shell-command' that automatically adds `&'. Otherwise, COMMAND is executed synchronously, and the output -appears in the buffer `shell-command-buffer-name'. +appears in the buffer named by `shell-command-buffer-name'. This feature does not try to redisplay Dired buffers afterward, as there's no telling what files COMMAND may have changed. diff --git a/lisp/simple.el b/lisp/simple.el index 6c9584aaa3..4a774bc9b4 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3441,8 +3441,9 @@ to `shell-command-history'." (defcustom async-shell-command-buffer 'confirm-new-buffer "What to do when the output buffer is used by another shell command. This option specifies how to resolve the conflict where a new command -wants to direct its output to the buffer `shell-command-buffer-name-async', -but this buffer is already taken by another running shell command. +wants to direct its output to the buffer whose name is stored +in `shell-command-buffer-name-async', but that buffer is already +taken by another running shell command. The value `confirm-kill-process' is used to ask for confirmation before killing the already running process and running a new process @@ -3593,14 +3594,18 @@ whose `car' is BUFFER." Like `shell-command', but adds `&' at the end of COMMAND to execute it asynchronously. -The output appears in the buffer `shell-command-buffer-name-async'. -That buffer is in shell mode. +The output appears in the buffer whose name is stored in the +variable `shell-command-buffer-name-async'. That buffer is in +shell mode. You can configure `async-shell-command-buffer' to specify what to do -when the `shell-command-buffer-name-async' buffer is already taken by another -running shell command. To run COMMAND without displaying the output -in a window you can configure `display-buffer-alist' to use the action -`display-buffer-no-window' for the buffer `shell-command-buffer-name-async'. +when the buffer specified by `shell-command-buffer-name-async' is +already taken by another running shell command. + +To run COMMAND without displaying the output in a window you can +configure `display-buffer-alist' to use the action +`display-buffer-no-window' for the buffer given by +`shell-command-buffer-name-async'. In Elisp, you will often be better served by calling `start-process' directly, since it offers more control and does not impose the use of @@ -3636,16 +3641,18 @@ If `shell-command-prompt-show-cwd' is non-nil, show the current directory in the prompt. If COMMAND ends in `&', execute it asynchronously. -The output appears in the buffer `shell-command-buffer-name-async'. -That buffer is in shell mode. You can also use -`async-shell-command' that automatically adds `&'. +The output appears in the buffer whose name is specified +by `shell-command-buffer-name-async'. That buffer is in shell +mode. You can also use `async-shell-command' that automatically +adds `&'. Otherwise, COMMAND is executed synchronously. The output appears in -the buffer `shell-command-buffer-name'. If the output is short enough to -display in the echo area (which is determined by the variables -`resize-mini-windows' and `max-mini-window-height'), it is shown -there, but it is nonetheless available in buffer `*Shell Command -Output*' even though that buffer is not automatically displayed. +the buffer named by `shell-command-buffer-name'. If the output is +short enough to display in the echo area (which is determined by the +variables `resize-mini-windows' and `max-mini-window-height'), it is +shown there, but it is nonetheless available in buffer named by +`shell-command-buffer-name' even though that buffer is not +automatically displayed. To specify a coding system for converting non-ASCII characters in the shell command output, use \\[universal-coding-system-argument] \ @@ -3916,9 +3923,9 @@ and are used only if a pop-up buffer is displayed." error-buffer display-error-buffer region-noncontiguous-p) "Execute string COMMAND in inferior shell with region as input. -Normally display output (if any) in temp buffer `shell-command-buffer-name'; -Prefix arg means replace the region with it. Return the exit code of -COMMAND. +Normally display output (if any) in temp buffer specified +by `shell-command-buffer-name'; prefix arg means replace the region +with it. Return the exit code of COMMAND. To specify a coding system for converting non-ASCII characters in the input and output to the shell command, use \\[universal-coding-system-argument] @@ -3935,7 +3942,7 @@ in the echo area or in a buffer. If the output is short enough to display in the echo area \(determined by the variable `max-mini-window-height' if `resize-mini-windows' is non-nil), it is shown there. -Otherwise it is displayed in the buffer `shell-command-buffer-name'. +Otherwise it is displayed in the buffer named by `shell-command-buffer-name'. The output is available in that buffer in both cases. If there is output and an error, a message about the error @@ -3945,7 +3952,7 @@ Optional fourth arg OUTPUT-BUFFER specifies where to put the command's output. If the value is a buffer or buffer name, erase that buffer and insert the output there; a non-nil value of `shell-command-dont-erase-buffer' prevent to erase the buffer. -If the value is nil, use the buffer `shell-command-buffer-name'. +If the value is nil, use the buffer specified by `shell-command-buffer-name'. Any other non-nil value means to insert the output in the current buffer after START. commit 1a845a672dc73c8e98e6cb9bb734616e168e60ba Author: Carlos Pita Date: Sun Aug 9 15:57:51 2020 +0200 Improve client/daemon xdg/systemd experience * Makefile.in: Add emacsclient.desktop generation. * etc/emacsclient.desktop: Add file, use emacsd as StartupWMClass. * etc/emacs.service: Run with name emacsd (bug#37847). diff --git a/Makefile.in b/Makefile.in index 67e15cfecd..fbb1891ba7 100644 --- a/Makefile.in +++ b/Makefile.in @@ -714,6 +714,13 @@ install-etc: ${srcdir}/etc/emacs.desktop > $${tmp}; \ ${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop"; \ rm -f $${tmp} + tmp=etc/emacsclient.tmpdesktop; rm -f $${tmp}; \ + client_name=`echo emacsclient | sed '$(TRANSFORM)'`${EXEEXT}; \ + sed -e "/^Exec=emacsclient/ s|emacsclient|${bindir}/$${client_name}|" \ + -e "/^Icon=emacs/ s/emacs/${EMACS_NAME}/" \ + ${srcdir}/etc/emacsclient.desktop > $${tmp}; \ + ${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/$${client_name}.desktop"; \ + rm -f $${tmp} umask 022; ${MKDIR_P} "$(DESTDIR)${appdatadir}" tmp=etc/emacs.tmpappdata; rm -f $${tmp}; \ sed -e "s/emacs\.desktop/${EMACS_NAME}.desktop/" \ diff --git a/etc/emacs.service b/etc/emacs.service index c99c6779f5..0dc2418269 100644 --- a/etc/emacs.service +++ b/etc/emacs.service @@ -8,7 +8,7 @@ Documentation=info:emacs man:emacs(1) https://gnu.org/software/emacs/ [Service] Type=notify -ExecStart=emacs --fg-daemon +ExecStart=@emacs emacsd --fg-daemon ExecStop=emacsclient --eval "(kill-emacs)" # The location of the SSH auth socket varies by distribution, and some # set it from PAM, so don't override by default. diff --git a/etc/emacsclient.desktop b/etc/emacsclient.desktop new file mode 100644 index 0000000000..3feb83c729 --- /dev/null +++ b/etc/emacsclient.desktop @@ -0,0 +1,12 @@ +[Desktop Entry] +Name=Emacs (Client) +GenericName=Text Editor +Comment=Edit text +MimeType=text/english;text/plain;text/x-makefile;text/x-c++hdr;text/x-c++src;text/x-chdr;text/x-csrc;text/x-java;text/x-moc;text/x-pascal;text/x-tcl;text/x-tex;application/x-shellscript;text/x-c;text/x-c++; +Exec=emacsclient -c %F +Icon=emacs +Type=Application +Terminal=false +Categories=Development;TextEditor; +StartupWMClass=Emacsd +Keywords=Text;Editor; commit 8e82baf5a730ff542118ddba5b76afdc1db643f6 Author: Damien Cassou Date: Sun Aug 9 14:48:22 2020 +0200 Add the new library hierarchy.el * lisp/emacs-lisp/hierarchy.el: New file. diff --git a/etc/NEWS b/etc/NEWS index b983b290d7..8118272070 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -737,6 +737,10 @@ The recentf files are no longer backed up. ** Miscellaneous +*** The new library hierarchy.el has been added. +It's a library to create, query, navigate and display hierarchy +structures. + --- *** The width of the buffer-name column in 'list-buffers' is now dynamic. The width now depends of the width of the window, but will never be diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el new file mode 100644 index 0000000000..8cef029c4c --- /dev/null +++ b/lisp/emacs-lisp/hierarchy.el @@ -0,0 +1,579 @@ +;;; hierarchy.el --- Library to create and display hierarchy structures -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Damien Cassou +;; Maintainer: emacs-devel@gnu.org + +;; 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: + +;; Library to create, query, navigate and display hierarchy structures. + +;; Creation: After having created a hierarchy with `hierarchy-new', +;; populate it by calling `hierarchy-add-tree' or +;; `hierarchy-add-trees'. You can then optionally sort its element +;; with `hierarchy-sort'. + +;; Querying: You can learn more about your hierarchy by using +;; functions such as `hierarchy-roots', `hierarchy-has-item', +;; `hierarchy-length', `hierarchy-parent', `hierarchy-descendant-p'. + +;; Navigation: When your hierarchy is ready, you can use +;; `hierarchy-map-item', `hierarchy-map', and `map-tree' to apply +;; functions to elements of the hierarchy. + +;; Display: You can display a hierarchy as a tabulated list using +;; `hierarchy-tabulated-display' and as an expandable/foldable tree +;; using `hierarchy-convert-to-tree-widget'. The +;; `hierarchy-labelfn-*' functions will help you display each item of +;; the hierarchy the way you want it. + +;;; Limitation: + +;; - Current implementation uses #'equal to find and distinguish +;; elements. Support for user-provided equality definition is +;; desired but not yet implemented; +;; +;; - nil can't be added to a hierarchy; +;; +;; - the hierarchy is computed eagerly. + +;;; Code: + +(require 'seq) +(require 'map) +(require 'subr-x) +(require 'cl-lib) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Helpers +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct (hierarchy + (:constructor hierarchy--make) + (:conc-name hierarchy--)) + (roots (list)) ; list of the hierarchy roots (no parent) + (parents (make-hash-table :test 'equal)) ; map an item to its parent + (children (make-hash-table :test 'equal)) ; map an item to its childre + ;; cache containing the set of all items in the hierarchy + (seen-items (make-hash-table :test 'equal))) ; map an item to t + +(defun hierarchy--seen-items-add (hierarchy item) + "In HIERARCHY, add ITEM to seen items." + (map-put! (hierarchy--seen-items hierarchy) item t)) + +(defun hierarchy--compute-roots (hierarchy) + "Search roots of HIERARCHY and return them." + (cl-set-difference + (map-keys (hierarchy--seen-items hierarchy)) + (map-keys (hierarchy--parents hierarchy)) + :test #'equal)) + +(defun hierarchy--sort-roots (hierarchy sortfn) + "Compute, sort and store the roots of HIERARCHY. + +SORTFN is a function taking two items of the hierarchy as parameter and +returning non-nil if the first parameter is lower than the second." + (setf (hierarchy--roots hierarchy) + (sort (hierarchy--compute-roots hierarchy) + sortfn))) + +(defun hierarchy--add-relation (hierarchy item parent acceptfn) + "In HIERARCHY, add ITEM as child of PARENT. + +ACCEPTFN is a function returning non-nil if its parameter (any object) +should be an item of the hierarchy." + (let* ((existing-parent (hierarchy-parent hierarchy item)) + (has-parent-p (funcall acceptfn existing-parent))) + (cond + ((and has-parent-p (not (equal existing-parent parent))) + (error "An item (%s) can only have one parent: '%s' vs '%s'" + item existing-parent parent)) + ((not has-parent-p) + (let ((existing-children (map-elt (hierarchy--children hierarchy) + parent (list)))) + (map-put! (hierarchy--children hierarchy) + parent (append existing-children (list item)))) + (map-put! (hierarchy--parents hierarchy) item parent))))) + +(defun hierarchy--set-equal (list1 list2 &rest cl-keys) + "Return non-nil if LIST1 and LIST2 have same elements. + +I.e., if every element of LIST1 also appears in LIST2 and if +every element of LIST2 also appears in LIST1. + +CL-KEYS are key-value pairs just like in `cl-subsetp'. Supported +keys are :key and :test." + (and (apply 'cl-subsetp list1 list2 cl-keys) + (apply 'cl-subsetp list2 list1 cl-keys))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Creation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun hierarchy-new () + "Create a hierarchy and return it." + (hierarchy--make)) + +(defun hierarchy-add-tree (hierarchy item parentfn &optional childrenfn acceptfn) + "In HIERARCHY, add ITEM. + +PARENTFN is either nil or a function defining the child-to-parent +relationship: this function takes an item as parameter and should return +the parent of this item in the hierarchy. If the item has no parent in the +hierarchy (i.e., it should be a root), the function should return an object +not accepted by acceptfn (i.e., nil for the default value of acceptfn). + +CHILDRENFN is either nil or a function defining the parent-to-children +relationship: this function takes an item as parameter and should return a +list of children of this item in the hierarchy. + +If both PARENTFN and CHILDRENFN are non-nil, the results of PARENTFN and +CHILDRENFN are expected to be coherent with each other. + +ACCEPTFN is a function returning non-nil if its parameter (any object) +should be an item of the hierarchy. By default, ACCEPTFN returns non-nil +if its parameter is non-nil." + (unless (hierarchy-has-item hierarchy item) + (let ((acceptfn (or acceptfn #'identity))) + (hierarchy--seen-items-add hierarchy item) + (let ((parent (and parentfn (funcall parentfn item)))) + (when (funcall acceptfn parent) + (hierarchy--add-relation hierarchy item parent acceptfn) + (hierarchy-add-tree hierarchy parent parentfn childrenfn))) + (let ((children (and childrenfn (funcall childrenfn item)))) + (mapc (lambda (child) + (when (funcall acceptfn child) + (hierarchy--add-relation hierarchy child item acceptfn) + (hierarchy-add-tree hierarchy child parentfn childrenfn))) + children))))) + +(defun hierarchy-add-trees (hierarchy items parentfn &optional childrenfn acceptfn) + "Call `hierarchy-add-tree' on HIERARCHY and each element of ITEMS. + +PARENTFN, CHILDRENFN and ACCEPTFN have the same meaning as in `hierarchy-add'." + (seq-map (lambda (item) + (hierarchy-add-tree hierarchy item parentfn childrenfn acceptfn)) + items)) + +(defun hierarchy-add-list (hierarchy list &optional wrap childrenfn) + "Add to HIERARCHY the sub-lists in LIST. + +If WRAP is non-nil, allow duplicate items in LIST by wraping each +item in a cons (id . item). The root's id is 1. + +CHILDRENFN is a function (defaults to `cdr') taking LIST as a +parameter which should return LIST's children (a list). Each +child is (recursively) passed as a parameter to CHILDRENFN to get +its own children. Because of this parameter, LIST can be +anything, not necessarily a list." + (let* ((childrenfn (or childrenfn #'cdr)) + (id 0) + (wrapfn (lambda (item) + (if wrap + (cons (setq id (1+ id)) item) + item))) + (unwrapfn (if wrap #'cdr #'identity))) + (hierarchy-add-tree + hierarchy (funcall wrapfn list) nil + (lambda (item) + (mapcar wrapfn (funcall childrenfn + (funcall unwrapfn item))))) + hierarchy)) + +(defun hierarchy-from-list (list &optional wrap childrenfn) + "Create and return a hierarchy built from LIST. + +This function passes LIST, WRAP and CHILDRENFN unchanged to +`hierarchy-add-list'." + (hierarchy-add-list (hierarchy-new) list wrap childrenfn)) + +(defun hierarchy-sort (hierarchy &optional sortfn) + "Modify HIERARCHY so that its roots and item's children are sorted. + +SORTFN is a function taking two items of the hierarchy as parameter and +returning non-nil if the first parameter is lower than the second. By +default, SORTFN is `string-lessp'." + (let ((sortfn (or sortfn #'string-lessp))) + (hierarchy--sort-roots hierarchy sortfn) + (mapc (lambda (parent) + (setf + (map-elt (hierarchy--children hierarchy) parent) + (sort (map-elt (hierarchy--children hierarchy) parent) sortfn))) + (map-keys (hierarchy--children hierarchy))))) + +(defun hierarchy-extract-tree (hierarchy item) + "Return a copy of HIERARCHY with ITEM's descendants and parents." + (if (not (hierarchy-has-item hierarchy item)) + nil + (let ((tree (hierarchy-new))) + (hierarchy-add-tree tree item + (lambda (each) (hierarchy-parent hierarchy each)) + (lambda (each) + (when (or (equal each item) + (hierarchy-descendant-p hierarchy each item)) + (hierarchy-children hierarchy each)))) + tree))) + +(defun hierarchy-copy (hierarchy) + "Return a copy of HIERARCHY. + +Items in HIERARCHY are shared, but structure is not." + (hierarchy-map-hierarchy (lambda (item _) (identity item)) hierarchy)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Querying +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun hierarchy-items (hierarchy) + "Return a list of all items of HIERARCHY." + (map-keys (hierarchy--seen-items hierarchy))) + +(defun hierarchy-has-item (hierarchy item) + "Return t if HIERARCHY includes ITEM." + (map-contains-key (hierarchy--seen-items hierarchy) item)) + +(defun hierarchy-empty-p (hierarchy) + "Return t if HIERARCHY is empty." + (= 0 (hierarchy-length hierarchy))) + +(defun hierarchy-length (hierarchy) + "Return the number of items in HIERARCHY." + (hash-table-count (hierarchy--seen-items hierarchy))) + +(defun hierarchy-has-root (hierarchy item) + "Return t if one of HIERARCHY's roots is ITEM. + +A root is an item with no parent." + (seq-contains-p (hierarchy-roots hierarchy) item)) + +(defun hierarchy-roots (hierarchy) + "Return all roots of HIERARCHY. + +A root is an item with no parent." + (let ((roots (hierarchy--roots hierarchy))) + (or roots + (hierarchy--compute-roots hierarchy)))) + +(defun hierarchy-leafs (hierarchy &optional node) + "Return all leafs of HIERARCHY. + +A leaf is an item with no child. + +If NODE is an item of HIERARCHY, only return leafs under NODE." + (let ((leafs (cl-set-difference + (map-keys (hierarchy--seen-items hierarchy)) + (map-keys (hierarchy--children hierarchy))))) + (if (hierarchy-has-item hierarchy node) + (seq-filter (lambda (item) + (hierarchy-descendant-p hierarchy item node)) + leafs) + leafs))) + +(defun hierarchy-parent (hierarchy item) + "In HIERARCHY, return parent of ITEM." + (map-elt (hierarchy--parents hierarchy) item)) + +(defun hierarchy-children (hierarchy parent) + "In HIERARCHY, return children of PARENT." + (map-elt (hierarchy--children hierarchy) parent (list))) + +(defun hierarchy-child-p (hierarchy item1 item2) + "In HIERARCHY, return non-nil if and only if ITEM1 is a child of ITEM2." + (equal (hierarchy-parent hierarchy item1) item2)) + +(defun hierarchy-descendant-p (hierarchy item1 item2) + "In HIERARCHY, return non-nil if and only if ITEM1 is a descendant of ITEM2. + +ITEM1 is a descendant of ITEM2 if and only if both are items of HIERARCHY +and either: + +- ITEM1 is child of ITEM2, or +- ITEM1's parent is a descendant of ITEM2." + (and + (hierarchy-has-item hierarchy item1) + (hierarchy-has-item hierarchy item2) + (or + (hierarchy-child-p hierarchy item1 item2) + (hierarchy-descendant-p + hierarchy (hierarchy-parent hierarchy item1) item2)))) + +(defun hierarchy-equal (hierarchy1 hierarchy2) + "Return t if HIERARCHY1 and HIERARCHY2 are equal. + +Two equal hierarchies share the same items and the same +relationships among them." + (and (hierarchy-p hierarchy1) + (hierarchy-p hierarchy2) + (= (hierarchy-length hierarchy1) (hierarchy-length hierarchy2)) + ;; parents are the same + (seq-every-p (lambda (child) + (equal (hierarchy-parent hierarchy1 child) + (hierarchy-parent hierarchy2 child))) + (map-keys (hierarchy--parents hierarchy1))) + ;; children are the same + (seq-every-p (lambda (parent) + (hierarchy--set-equal + (hierarchy-children hierarchy1 parent) + (hierarchy-children hierarchy2 parent) + :test #'equal)) + (map-keys (hierarchy--children hierarchy1))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Navigation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun hierarchy-map-item (func item hierarchy &optional indent) + "Return the result of applying FUNC to ITEM and its descendants in HIERARCHY. + +This function navigates the tree top-down: FUNCTION is first called on item +and then on each of its children. Results are concatenated in a list. + +INDENT is a number (default 0) representing the indentation of ITEM in +HIERARCHY. FUNC should take 2 argument: the item and its indentation +level." + (let ((indent (or indent 0))) + (cons + (funcall func item indent) + (seq-mapcat (lambda (child) (hierarchy-map-item func child + hierarchy (1+ indent))) + (hierarchy-children hierarchy item))))) + +(defun hierarchy-map (func hierarchy &optional indent) + "Return the result of applying FUNC to each element of HIERARCHY. + +This function navigates the tree top-down: FUNCTION is first called on each +root. To do so, it calls `hierarchy-map-item' on each root +sequentially. Results are concatenated in a list. + +FUNC should take 2 arguments: the item and its indentation level. + +INDENT is a number (default 0) representing the indentation of HIERARCHY's +roots." + (let ((indent (or indent 0))) + (seq-mapcat (lambda (root) (hierarchy-map-item func root hierarchy indent)) + (hierarchy-roots hierarchy)))) + +(defun hierarchy-map-tree (function hierarchy &optional item indent) + "Apply FUNCTION on each item of HIERARCHY under ITEM. + +This function navigates the tree bottom-up: FUNCTION is first called on +leafs and the result is passed as parameter when calling FUNCTION on +parents. + +FUNCTION should take 3 parameters: the current item, its indentation +level (a number), and a list representing the result of applying +`hierarchy-map-tree' to each child of the item. + +INDENT is 0 by default and is passed as second parameter to FUNCTION. +INDENT is incremented by 1 at each level of the tree. + +This function returns the result of applying FUNCTION to ITEM (the first +root if nil)." + (let ((item (or item (car (hierarchy-roots hierarchy)))) + (indent (or indent 0))) + (funcall function item indent + (mapcar (lambda (child) + (hierarchy-map-tree function hierarchy + child (1+ indent))) + (hierarchy-children hierarchy item))))) + +(defun hierarchy-map-hierarchy (function hierarchy) + "Apply FUNCTION to each item of HIERARCHY in a new hierarchy. + +FUNCTION should take 2 parameters, the current item and its +indentation level (a number), and should return an item to be +added to the new hierarchy." + (let* ((items (make-hash-table :test #'equal)) + (transform (lambda (item) (map-elt items item)))) + ;; Make 'items', a table mapping original items to their + ;; transformation + (hierarchy-map (lambda (item indent) + (map-put! items item (funcall function item indent))) + hierarchy) + (hierarchy--make + :roots (mapcar transform (hierarchy-roots hierarchy)) + :parents (let ((result (make-hash-table :test #'equal))) + (map-apply (lambda (child parent) + (map-put! result + (funcall transform child) + (funcall transform parent))) + (hierarchy--parents hierarchy)) + result) + :children (let ((result (make-hash-table :test #'equal))) + (map-apply (lambda (parent children) + (map-put! result + (funcall transform parent) + (seq-map transform children))) + (hierarchy--children hierarchy)) + result) + :seen-items (let ((result (make-hash-table :test #'equal))) + (map-apply (lambda (item v) + (map-put! result + (funcall transform item) + v)) + (hierarchy--seen-items hierarchy)) + result)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Display +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun hierarchy-labelfn-indent (labelfn &optional indent-string) + "Return a function rendering LABELFN indented with INDENT-STRING. + +INDENT-STRING defaults to a 2-space string. Indentation is +multiplied by the depth of the displayed item." + (let ((indent-string (or indent-string " "))) + (lambda (item indent) + (dotimes (_ indent) (insert indent-string)) + (funcall labelfn item indent)))) + +(defun hierarchy-labelfn-button (labelfn actionfn) + "Return a function rendering LABELFN in a button. + +Clicking the button triggers ACTIONFN. ACTIONFN is a function +taking an item of HIERARCHY and an indentation value (a number) +as input. This function is called when an item is clicked. The +return value of ACTIONFN is ignored." + (lambda (item indent) + (let ((start (point))) + (funcall labelfn item indent) + (make-text-button start (point) + 'action (lambda (_) (funcall actionfn item indent)))))) + +(defun hierarchy-labelfn-button-if (labelfn buttonp actionfn) + "Return a function rendering LABELFN as a button if BUTTONP. + +Pass LABELFN and ACTIONFN to `hierarchy-labelfn-button' if +BUTTONP is non-nil. Otherwise, render LABELFN without making it +a button. + +BUTTONP is a function taking an item of HIERARCHY and an +indentation value (a number) as input." + (lambda (item indent) + (if (funcall buttonp item indent) + (funcall (hierarchy-labelfn-button labelfn actionfn) item indent) + (funcall labelfn item indent)))) + +(defun hierarchy-labelfn-to-string (labelfn item indent) + "Execute LABELFN on ITEM and INDENT. Return result as a string." + (with-temp-buffer + (funcall labelfn item indent) + (buffer-substring (point-min) (point-max)))) + +(defun hierarchy-print (hierarchy &optional to-string) + "Insert HIERARCHY in current buffer as plain text. + +Use TO-STRING to convert each element to a string. TO-STRING is +a function taking an item of HIERARCHY as input and returning a +string. If nil, TO-STRING defaults to a call to `format' with \"%s\"." + (let ((to-string (or to-string (lambda (item) (format "%s" item))))) + (hierarchy-map + (hierarchy-labelfn-indent (lambda (item _) + (insert (funcall to-string item) "\n"))) + hierarchy))) + +(defun hierarchy-to-string (hierarchy &optional to-string) + "Return a string representing HIERARCHY. + +TO-STRING is passed unchanged to `hierarchy-print'." + (with-temp-buffer + (hierarchy-print hierarchy to-string) + (buffer-substring (point-min) (point-max)))) + +(defun hierarchy-tabulated-imenu-action (_item-name position) + "Move to ITEM-NAME at POSITION in current buffer." + (goto-char position) + (back-to-indentation)) + +(define-derived-mode hierarchy-tabulated-mode tabulated-list-mode "Hierarchy tabulated" + "Major mode to display a hierarchy as a tabulated list." + (setq-local imenu-generic-expression + ;; debbugs: 26457 - Cannot pass a function to + ;; imenu-generic-expression. Add + ;; `hierarchy-tabulated-imenu-action' to the end of the + ;; list when bug is fixed + '(("Item" "^[[:space:]]+\\(?1:.+\\)$" 1)))) + +(defun hierarchy-tabulated-display (hierarchy labelfn &optional buffer) + "Display HIERARCHY as a tabulated list in `hierarchy-tabulated-mode'. + +LABELFN is a function taking an item of HIERARCHY and an indentation +level (a number) as input and inserting a string to be displayed in the +table. + +The tabulated list is displayed in BUFFER, or a newly created buffer if +nil. The buffer is returned." + (let ((buffer (or buffer (generate-new-buffer "hierarchy-tabulated")))) + (with-current-buffer buffer + (hierarchy-tabulated-mode) + (setq tabulated-list-format + (vector '("Item name" 0 nil))) + (setq tabulated-list-entries + (hierarchy-map (lambda (item indent) + (list item (vector (hierarchy-labelfn-to-string + labelfn item indent)))) + hierarchy)) + (tabulated-list-init-header) + (tabulated-list-print)) + buffer)) + +(declare-function widget-convert "wid-edit") +(defun hierarchy-convert-to-tree-widget (hierarchy labelfn) + "Return a tree-widget for HIERARCHY. + +LABELFN is a function taking an item of HIERARCHY and an indentation +value (a number) as parameter and inserting a string to be displayed as a +node label." + (require 'wid-edit) + (require 'tree-widget) + (hierarchy-map-tree (lambda (item indent children) + (widget-convert + 'tree-widget + :tag (hierarchy-labelfn-to-string labelfn item indent) + :args children)) + hierarchy)) + +(defun hierarchy-tree-display (hierarchy labelfn &optional buffer) + "Display HIERARCHY as a tree widget in a new buffer. + +HIERARCHY and LABELFN are passed unchanged to +`hierarchy-convert-to-tree-widget'. + +The tree widget is displayed in BUFFER, or a newly created buffer if +nil. The buffer is returned." + (let ((buffer (or buffer (generate-new-buffer "*hierarchy-tree*"))) + (tree-widget (hierarchy-convert-to-tree-widget hierarchy labelfn))) + (with-current-buffer buffer + (setq-local buffer-read-only t) + (let ((inhibit-read-only t)) + (erase-buffer) + (widget-create tree-widget) + (goto-char (point-min)) + (special-mode))) + buffer)) + +(provide 'hierarchy) + +;;; hierarchy.el ends here diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el new file mode 100644 index 0000000000..23cfc79d84 --- /dev/null +++ b/test/lisp/emacs-lisp/hierarchy-tests.el @@ -0,0 +1,556 @@ +;;; hierarchy-tests.el --- Tests for hierarchy.el + +;; Copyright (C) 2017-2019 Damien Cassou + +;; Author: Damien Cassou +;; Maintainer: emacs-devel@gnu.org + +;; 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: + +;; Tests for hierarchy.el + +;;; Code: + +(require 'ert) +(require 'hierarchy) + +(defun hierarchy-animals () + "Create a sorted animal hierarchy." + (let ((parentfn (lambda (item) (cl-case item + (dove 'bird) + (pigeon 'bird) + (bird 'animal) + (dolphin 'animal) + (cow 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'dove parentfn) + (hierarchy-add-tree hierarchy 'pigeon parentfn) + (hierarchy-add-tree hierarchy 'dolphin parentfn) + (hierarchy-add-tree hierarchy 'cow parentfn) + (hierarchy-sort hierarchy) + hierarchy)) + +(ert-deftest hierarchy-add-one-root () + (let ((parentfn (lambda (_) nil)) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'animal parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))))) + +(ert-deftest hierarchy-add-one-item-with-parent () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'bird parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))))) + +(ert-deftest hierarchy-add-one-item-with-parent-and-grand-parent () + (let ((parentfn (lambda (item) + (cl-case item + (dove 'bird) + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'dove parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove))))) + +(ert-deftest hierarchy-add-same-root-twice () + (let ((parentfn (lambda (_) nil)) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'animal parentfn) + (hierarchy-add-tree hierarchy 'animal parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))))) + +(ert-deftest hierarchy-add-same-child-twice () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'bird parentfn) + (hierarchy-add-tree hierarchy 'bird parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))))) + +(ert-deftest hierarchy-add-item-and-its-parent () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'bird parentfn) + (hierarchy-add-tree hierarchy 'animal parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))))) + +(ert-deftest hierarchy-add-item-and-its-child () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'animal parentfn) + (hierarchy-add-tree hierarchy 'bird parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))))) + +(ert-deftest hierarchy-add-two-items-sharing-parent () + (let ((parentfn (lambda (item) + (cl-case item + (dove 'bird) + (pigeon 'bird)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'dove parentfn) + (hierarchy-add-tree hierarchy 'pigeon parentfn) + (should (equal (hierarchy-roots hierarchy) '(bird))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon))))) + +(ert-deftest hierarchy-add-two-hierarchies () + (let ((parentfn (lambda (item) + (cl-case item + (dove 'bird) + (circle 'shape)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'dove parentfn) + (hierarchy-add-tree hierarchy 'circle parentfn) + (should (equal (hierarchy-roots hierarchy) '(bird shape))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove))) + (should (equal (hierarchy-children hierarchy 'shape) '(circle))))) + +(ert-deftest hierarchy-add-with-childrenfn () + (let ((childrenfn (lambda (item) + (cl-case item + (animal '(bird)) + (bird '(dove pigeon))))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'animal nil childrenfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon))))) + +(ert-deftest hierarchy-add-with-parentfn-and-childrenfn () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal) + (animal 'life-form)))) + (childrenfn (lambda (item) + (cl-case item + (bird '(dove pigeon)) + (pigeon '(ashy-wood-pigeon))))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'bird parentfn childrenfn) + (should (equal (hierarchy-roots hierarchy) '(life-form))) + (should (equal (hierarchy-children hierarchy 'life-form) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon))) + (should (equal (hierarchy-children hierarchy 'pigeon) '(ashy-wood-pigeon))))) + +(ert-deftest hierarchy-add-twice-with-parentfn-and-childrenfn () + (let* ((parentfn (lambda (item) + (cl-case item + (dove 'bird) + (bird 'animal)))) + (childrenfn (lambda (item) + (cl-case item + (animal '(bird)) + (bird '(dove))))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'bird parentfn childrenfn) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove))))) + +(ert-deftest hierarchy-add-trees () + (let ((parentfn (lambda (item) + (cl-case item + (dove 'bird) + (pigeon 'bird) + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-trees hierarchy '(dove pigeon) parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon))))) + +(ert-deftest hierarchy-from-list () + (let ((hierarchy (hierarchy-from-list + '(animal (bird (dove) + (pigeon)) + (cow) + (dolphin))))) + (hierarchy-sort hierarchy (lambda (item1 item2) + (string< (car item1) + (car item2)))) + (should (equal (hierarchy-to-string hierarchy (lambda (item) (symbol-name (car item)))) + "animal\n bird\n dove\n pigeon\n cow\n dolphin\n")))) + +(ert-deftest hierarchy-from-list-with-duplicates () + (let ((hierarchy (hierarchy-from-list + '(a (b) (b)) + t))) + (hierarchy-sort hierarchy (lambda (item1 item2) + ;; sort by ID + (< (car item1) (car item2)))) + (should (equal (hierarchy-length hierarchy) 3)) + (should (equal (hierarchy-to-string + hierarchy + (lambda (item) + (format "%s(%s)" + (cadr item) + (car item)))) + "a(1)\n b(2)\n b(3)\n")))) + +(ert-deftest hierarchy-from-list-with-childrenfn () + (let ((hierarchy (hierarchy-from-list + "abc" + nil + (lambda (item) + (when (string= item "abc") + (split-string item "" t)))))) + (hierarchy-sort hierarchy (lambda (item1 item2) (string< item1 item2))) + (should (equal (hierarchy-length hierarchy) 4)) + (should (equal (hierarchy-to-string hierarchy) + "abc\n a\n b\n c\n")))) + +(ert-deftest hierarchy-add-relation-check-error-when-different-parent () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'bird parentfn) + (should-error + (hierarchy--add-relation hierarchy 'bird 'cow #'identity)))) + +(ert-deftest hierarchy-empty-p-return-non-nil-for-empty () + (should (hierarchy-empty-p (hierarchy-new)))) + +(ert-deftest hierarchy-empty-p-return-nil-for-non-empty () + (should-not (hierarchy-empty-p (hierarchy-animals)))) + +(ert-deftest hierarchy-length-of-empty-is-0 () + (should (equal (hierarchy-length (hierarchy-new)) 0))) + +(ert-deftest hierarchy-length-of-non-empty-counts-items () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal) + (dove 'bird) + (pigeon 'bird)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'dove parentfn) + (hierarchy-add-tree hierarchy 'pigeon parentfn) + (should (equal (hierarchy-length hierarchy) 4)))) + +(ert-deftest hierarchy-has-root () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal) + (dove 'bird) + (pigeon 'bird)))) + (hierarchy (hierarchy-new))) + (should-not (hierarchy-has-root hierarchy 'animal)) + (should-not (hierarchy-has-root hierarchy 'bird)) + (hierarchy-add-tree hierarchy 'dove parentfn) + (hierarchy-add-tree hierarchy 'pigeon parentfn) + (should (hierarchy-has-root hierarchy 'animal)) + (should-not (hierarchy-has-root hierarchy 'bird)))) + +(ert-deftest hierarchy-leafs () + (let ((animals (hierarchy-animals))) + (should (equal (hierarchy-leafs animals) + '(dove pigeon dolphin cow))))) + +(ert-deftest hierarchy-leafs-includes-lonely-roots () + (let ((parentfn (lambda (item) nil)) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'foo parentfn) + (should (equal (hierarchy-leafs hierarchy) + '(foo))))) + +(ert-deftest hierarchy-leafs-of-node () + (let ((animals (hierarchy-animals))) + (should (equal (hierarchy-leafs animals 'cow) '())) + (should (equal (hierarchy-leafs animals 'animal) '(dove pigeon dolphin cow))) + (should (equal (hierarchy-leafs animals 'bird) '(dove pigeon))) + (should (equal (hierarchy-leafs animals 'dove) '())))) + +(ert-deftest hierarchy-child-p () + (let ((animals (hierarchy-animals))) + (should (hierarchy-child-p animals 'dove 'bird)) + (should (hierarchy-child-p animals 'bird 'animal)) + (should (hierarchy-child-p animals 'cow 'animal)) + (should-not (hierarchy-child-p animals 'cow 'bird)) + (should-not (hierarchy-child-p animals 'bird 'cow)) + (should-not (hierarchy-child-p animals 'animal 'dove)) + (should-not (hierarchy-child-p animals 'animal 'bird)))) + +(ert-deftest hierarchy-descendant () + (let ((animals (hierarchy-animals))) + (should (hierarchy-descendant-p animals 'dove 'animal)) + (should (hierarchy-descendant-p animals 'dove 'bird)) + (should (hierarchy-descendant-p animals 'bird 'animal)) + (should (hierarchy-descendant-p animals 'cow 'animal)) + (should-not (hierarchy-descendant-p animals 'cow 'bird)) + (should-not (hierarchy-descendant-p animals 'bird 'cow)) + (should-not (hierarchy-descendant-p animals 'animal 'dove)) + (should-not (hierarchy-descendant-p animals 'animal 'bird)))) + +(ert-deftest hierarchy-descendant-if-not-same () + (let ((animals (hierarchy-animals))) + (should-not (hierarchy-descendant-p animals 'cow 'cow)) + (should-not (hierarchy-descendant-p animals 'dove 'dove)) + (should-not (hierarchy-descendant-p animals 'bird 'bird)) + (should-not (hierarchy-descendant-p animals 'animal 'animal)))) + +;; keywords supported: :test :key +(ert-deftest hierarchy--set-equal () + (should (hierarchy--set-equal '(1 2 3) '(1 2 3))) + (should (hierarchy--set-equal '(1 2 3) '(3 2 1))) + (should (hierarchy--set-equal '(3 2 1) '(1 2 3))) + (should-not (hierarchy--set-equal '(2 3) '(3 2 1))) + (should-not (hierarchy--set-equal '(1 2 3) '(2 3))) + (should-not (hierarchy--set-equal '("1" "2") '("2" "1") :test #'eq)) + (should (hierarchy--set-equal '("1" "2") '("2" "1") :test #'equal)) + (should-not (hierarchy--set-equal '(1 2) '(-1 -2))) + (should (hierarchy--set-equal '(1 2) '(-1 -2) :key #'abs)) + (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)))) + (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :key #'car)) + (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :test #'equal)) + (should (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :key #'car :test #'equal))) + +(ert-deftest hierarchy-equal-returns-true-for-same-hierarchy () + (let ((animals (hierarchy-animals))) + (should (hierarchy-equal animals animals)) + (should (hierarchy-equal (hierarchy-animals) animals)))) + +(ert-deftest hierarchy-equal-returns-true-for-hierarchy-copies () + (let ((animals (hierarchy-animals))) + (should (hierarchy-equal animals (hierarchy-copy animals))))) + +(ert-deftest hierarchy-map-item-on-leaf () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-map-item (lambda (item indent) (cons item indent)) + 'cow + animals))) + (should (equal result '((cow . 0)))))) + +(ert-deftest hierarchy-map-item-on-leaf-with-indent () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-map-item (lambda (item indent) (cons item indent)) + 'cow + animals + 2))) + (should (equal result '((cow . 2)))))) + +(ert-deftest hierarchy-map-item-on-parent () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-map-item (lambda (item indent) (cons item indent)) + 'bird + animals))) + (should (equal result '((bird . 0) (dove . 1) (pigeon . 1)))))) + +(ert-deftest hierarchy-map-item-on-grand-parent () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-map-item (lambda (item indent) (cons item indent)) + 'animal + animals))) + (should (equal result '((animal . 0) (bird . 1) (dove . 2) (pigeon . 2) + (cow . 1) (dolphin . 1)))))) + +(ert-deftest hierarchy-map-conses () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-map (lambda (item indent) + (cons item indent)) + animals))) + (should (equal result '((animal . 0) + (bird . 1) + (dove . 2) + (pigeon . 2) + (cow . 1) + (dolphin . 1)))))) + +(ert-deftest hierarchy-map-tree () + (let ((animals (hierarchy-animals))) + (should (equal (hierarchy-map-tree (lambda (item indent children) + (list item indent children)) + animals) + '(animal + 0 + ((bird 1 ((dove 2 nil) (pigeon 2 nil))) + (cow 1 nil) + (dolphin 1 nil))))))) + +(ert-deftest hierarchy-map-hierarchy-keeps-hierarchy () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-map-hierarchy (lambda (item _) (identity item)) + animals))) + (should (hierarchy-equal animals result)))) + +(ert-deftest hierarchy-map-applies-function () + (let* ((animals (hierarchy-animals)) + (parentfn (lambda (item) + (cond + ((equal item "bird") "animal") + ((equal item "dove") "bird") + ((equal item "pigeon") "bird") + ((equal item "cow") "animal") + ((equal item "dolphin") "animal")))) + (expected (hierarchy-new))) + (hierarchy-add-tree expected "dove" parentfn) + (hierarchy-add-tree expected "pigeon" parentfn) + (hierarchy-add-tree expected "cow" parentfn) + (hierarchy-add-tree expected "dolphin" parentfn) + (should (hierarchy-equal + (hierarchy-map-hierarchy (lambda (item _) (symbol-name item)) animals) + expected)))) + +(ert-deftest hierarchy-extract-tree () + (let* ((animals (hierarchy-animals)) + (birds (hierarchy-extract-tree animals 'bird))) + (hierarchy-sort birds) + (should (equal (hierarchy-roots birds) '(animal))) + (should (equal (hierarchy-children birds 'animal) '(bird))) + (should (equal (hierarchy-children birds 'bird) '(dove pigeon))))) + +(ert-deftest hierarchy-extract-tree-nil-if-not-in-hierarchy () + (let* ((animals (hierarchy-animals))) + (should-not (hierarchy-extract-tree animals 'foobar)))) + +(ert-deftest hierarchy-items-of-empty-hierarchy-is-empty () + (should (seq-empty-p (hierarchy-items (hierarchy-new))))) + +(ert-deftest hierarchy-items-returns-sequence-of-same-length () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-items animals))) + (should (= (seq-length result) (hierarchy-length animals))))) + +(ert-deftest hierarchy-items-return-all-elements-of-hierarchy () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-items animals))) + (should (equal (seq-sort #'string< result) '(animal bird cow dolphin dove pigeon))))) + +(ert-deftest hierarchy-labelfn-indent-no-indent-if-0 () + (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (labelfn (hierarchy-labelfn-indent labelfn-base))) + (should (equal + (with-temp-buffer + (funcall labelfn "bar" 0) + (buffer-substring (point-min) (point-max))) + "foo")))) + +(ert-deftest hierarchy-labelfn-indent-three-times-if-3 () + (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (labelfn (hierarchy-labelfn-indent labelfn-base))) + (should (equal + (with-temp-buffer + (funcall labelfn "bar" 3) + (buffer-substring (point-min) (point-max))) + " foo")))) + +(ert-deftest hierarchy-labelfn-indent-default-indent-string () + (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (labelfn (hierarchy-labelfn-indent labelfn-base))) + (should (equal + (with-temp-buffer + (funcall labelfn "bar" 1) + (buffer-substring (point-min) (point-max))) + " foo")))) + +(ert-deftest hierarchy-labelfn-indent-custom-indent-string () + (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (labelfn (hierarchy-labelfn-indent labelfn-base "###")) + (content (with-temp-buffer + (funcall labelfn "bar" 1) + (buffer-substring (point-min) (point-max))))) + (should (equal content "###foo")))) + +(ert-deftest hierarchy-labelfn-button-propertize () + (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (actionfn #'identity) + (labelfn (hierarchy-labelfn-button labelfn-base actionfn)) + (properties (with-temp-buffer + (funcall labelfn "bar" 1) + (text-properties-at 1)))) + (should (equal (car properties) 'action)))) + +(ert-deftest hierarchy-labelfn-button-execute-labelfn () + (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (actionfn #'identity) + (labelfn (hierarchy-labelfn-button labelfn-base actionfn)) + (content (with-temp-buffer + (funcall labelfn "bar" 1) + (buffer-substring-no-properties (point-min) (point-max))))) + (should (equal content "foo")))) + +(ert-deftest hierarchy-labelfn-button-if-does-not-button-unless-condition () + (let ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (spy-count 0) + (condition (lambda (_item _indent) nil))) + (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count))))) + (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil) + (should (equal spy-count 0))))) + +(ert-deftest hierarchy-labelfn-button-if-does-button-when-condition () + (let ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (spy-count 0) + (condition (lambda (_item _indent) t))) + (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count))))) + (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil) + (should (equal spy-count 1))))) + +(ert-deftest hierarchy-labelfn-to-string () + (let ((labelfn (lambda (item _indent) (insert item)))) + (should (equal (hierarchy-labelfn-to-string labelfn "foo" 1) "foo")))) + +(ert-deftest hierarchy-print () + (let* ((animals (hierarchy-animals)) + (result (with-temp-buffer + (hierarchy-print animals) + (buffer-substring-no-properties (point-min) (point-max))))) + (should (equal result "animal\n bird\n dove\n pigeon\n cow\n dolphin\n")))) + +(ert-deftest hierarchy-to-string () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-to-string animals))) + (should (equal result "animal\n bird\n dove\n pigeon\n cow\n dolphin\n")))) + +(ert-deftest hierarchy-tabulated-display () + (let* ((animals (hierarchy-animals)) + (labelfn (lambda (item _indent) (insert (symbol-name item)))) + (contents (with-temp-buffer + (hierarchy-tabulated-display animals labelfn (current-buffer)) + (buffer-substring-no-properties (point-min) (point-max))))) + (should (equal contents "animal\nbird\ndove\npigeon\ncow\ndolphin\n")))) + +(ert-deftest hierarchy-sort-non-root-nodes () + (let* ((animals (hierarchy-animals))) + (should (equal (hierarchy-roots animals) '(animal))) + (should (equal (hierarchy-children animals 'animal) '(bird cow dolphin))) + (should (equal (hierarchy-children animals 'bird) '(dove pigeon))))) + +(ert-deftest hierarchy-sort-roots () + (let* ((organisms (hierarchy-new)) + (parentfn (lambda (item) + (cl-case item + (oak 'plant) + (bird 'animal))))) + (hierarchy-add-tree organisms 'oak parentfn) + (hierarchy-add-tree organisms 'bird parentfn) + (hierarchy-sort organisms) + (should (equal (hierarchy-roots organisms) '(animal plant))))) + +(provide 'hierarchy-tests) +;;; hierarchy-tests.el ends here commit d586bae501a3d6ec8e6a8088d05b0abfa541dece Author: Andrii Kolomoiets Date: Sun Aug 9 14:35:26 2020 +0200 vc-hg: use 'hg summary' to populate vc-dir headers * lisp/vc/vc-hg.el (vc-hg-dir-extra-headers): Use 'hg summary' command. (vc-hg-dir-extra-header): Remove unused function. * etc/NEWS: Mention changes to vc-hg.el (bug#38387). diff --git a/etc/NEWS b/etc/NEWS index 25ee6e1123..b983b290d7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -236,6 +236,11 @@ Bookmark locations can refer to VC directory buffers. *** New user option 'vc-hg-create-bookmark' controls whether a bookmark or branch will be created when you invoke 'C-u C-x v s' ('vc-create-tag'). +--- +*** 'vc-hg' now uses 'hg summary' command to populate extra 'vc-dir' +headers. + + ** Gnus --- diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 09f804357e..cb0657e70a 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1384,25 +1384,28 @@ REV is the revision to check out into WORKFILE." (vc-run-delayed (vc-hg-after-dir-status update-function))) -(defun vc-hg-dir-extra-header (name &rest commands) - (concat (propertize name 'face 'font-lock-type-face) - (propertize - (with-temp-buffer - (apply 'vc-hg-command (current-buffer) 0 nil commands) - (buffer-substring-no-properties (point-min) (1- (point-max)))) - 'face 'font-lock-variable-name-face))) - (defun vc-hg-dir-extra-headers (dir) - "Generate extra status headers for a Mercurial tree." + "Generate extra status headers for a repository in DIR. +This runs the command \"hg summary\"." (let ((default-directory dir)) - (concat - (vc-hg-dir-extra-header "Root : " "root") "\n" - (vc-hg-dir-extra-header "Branch : " "id" "-b") "\n" - (vc-hg-dir-extra-header "Tags : " "id" "-t") ; "\n" - ;; these change after each commit - ;; (vc-hg-dir-extra-header "Local num : " "id" "-n") "\n" - ;; (vc-hg-dir-extra-header "Global id : " "id" "-i") - ))) + (with-temp-buffer + (vc-hg-command t 0 nil "summary") + (goto-char (point-min)) + (mapconcat + #'identity + (let (result) + (while (not (eobp)) + (push + (let ((entry (if (looking-at "\\([^ ].*\\): \\(.*\\)") + (cons (capitalize (match-string 1)) (match-string 2)) + (cons "" (buffer-substring (point) (line-end-position)))))) + (concat + (propertize (format "%-11s: " (car entry)) 'face 'font-lock-type-face) + (propertize (cdr entry) 'face 'font-lock-variable-name-face))) + result) + (forward-line)) + (nreverse result)) + "\n")))) (defun vc-hg-log-incoming (buffer remote-location) (vc-setup-buffer buffer) commit c789c3aac66943497f771896ec13bae618f86a01 Author: Andrii Kolomoiets Date: Sun Aug 9 14:30:55 2020 +0200 vc-hg-create-tag: Possibility to create a branch * lisp/vc/vc-hg.el (vc-hg-create-bookmark): New user option. (vc-hg-create-tag): Use it (bug#38425). diff --git a/etc/NEWS b/etc/NEWS index 1e4fe47c59..25ee6e1123 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -232,6 +232,10 @@ their 'default-directory' under VC. *** Support for bookmark.el. Bookmark locations can refer to VC directory buffers. +--- +*** New user option 'vc-hg-create-bookmark' controls whether a bookmark +or branch will be created when you invoke 'C-u C-x v s' ('vc-create-tag'). + ** Gnus --- diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 95ced7b8d0..09f804357e 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -186,6 +186,16 @@ highlighting the Log View buffer." :group 'vc-hg :version "24.5") +(defcustom vc-hg-create-bookmark t + "This controls whether `vc-create-tag' will create a bookmark or branch. +If nil, named branch will be created. +If t, bookmark will be created. +If `ask', you will be prompted for a branch type." + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (const :tag "Ask" ask)) + :version "28.1") + ;; Clear up the cache to force vc-call to check again and discover ;; new functions when we reload this file. @@ -625,10 +635,18 @@ Optional arg REVISION is a revision to annotate from." ;;; Tag system (defun vc-hg-create-tag (dir name branchp) - "Attach the tag NAME to the state of the working copy." + "Create tag NAME in repo in DIR. Create branch if BRANCHP. +Variable `vc-hg-create-bookmark' controls what kind of branch will be created." (let ((default-directory dir)) - (and (vc-hg-command nil 0 nil "status") - (vc-hg-command nil 0 nil (if branchp "bookmark" "tag") name)))) + (vc-hg-command nil 0 nil + (if branchp + (if (if (eq vc-hg-create-bookmark 'ask) + (yes-or-no-p "Create bookmark instead of branch? ") + vc-hg-create-bookmark) + "bookmark" + "branch") + "tag") + name))) (defun vc-hg-retrieve-tag (dir name _update) "Retrieve the version tagged by NAME of all registered files at or below DIR." commit 2ed502d2a76e93ecd5366a6ec3926894e4fbe827 Author: Tino Calancha Date: Sun Aug 9 14:18:09 2020 +0200 Add constants for shell command output buffer names Buffers `*Shell Command Output*' and `*Async Shell Command*' have been around since a long time; used across several libraries, they are de facto output buffers for shell commands. * lisp/simple.el (shell-command-buffer-name) (shell-command-buffer-name-async): New variables. * lisp/dired-aux.el * lisp/gnus/gnus-sum.el * lisp/gnus/gnus-win.el * lisp/ibuf-ext.el * lisp/net/tramp.el: Use them. * etc/NEWS (Changes in Emacs 28.1): Announce this change. * doc/emacs/misc.texi (Single Shell) * doc/misc/tramp.texi (Remote processes): Update manual (bug#39138). diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index e7547ebff7..cb9fc61f32 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -724,13 +724,15 @@ See the Eshell Info manual, which is distributed with Emacs. @kindex M-! @findex shell-command +@vindex shell-command-buffer-name @kbd{M-!} (@code{shell-command}) reads a line of text using the minibuffer and executes it as a shell command, in a subshell made just for that command. Standard input for the command comes from the null device. If the shell command produces any output, the output appears -either in the echo area (if it is short), or in an Emacs buffer named -@file{*Shell Command Output*}, displayed in another window (if the -output is long). The variables @code{resize-mini-windows} and +either in the echo area (if it is short), or in an Emacs buffer, +displayed in another window (if the output is long). The name of +this buffer is taken from the constant @code{shell-command-buffer-name}. +The variables @code{resize-mini-windows} and @code{max-mini-window-height} (@pxref{Minibuffer Edit}) control when Emacs should consider the output to be too long for the echo area. @@ -758,15 +760,16 @@ which is impossible to ignore. @kindex M-& @findex async-shell-command +@vindex shell-command-buffer-name-async A shell command that ends in @samp{&} is executed @dfn{asynchronously}, and you can continue to use Emacs as it runs. You can also type @kbd{M-&} (@code{async-shell-command}) to execute a shell command asynchronously; this is exactly like calling @kbd{M-!} with a trailing @samp{&}, except that you do not need the @samp{&}. -The default output buffer for asynchronous shell commands is named -@samp{*Async Shell Command*}. Emacs inserts the output into this -buffer as it comes in, whether or not the buffer is visible in a -window. +The constant @code{shell-command-buffer-name-async} stores the name +of the default output buffer for asynchronous shell commands. +Emacs inserts the output into this buffer as it comes in, +whether or not the buffer is visible in a window. @vindex async-shell-command-buffer If you want to run more than one asynchronous shell command at the @@ -804,7 +807,7 @@ old region and replaces it with the output from the shell command. see what keys are in the buffer. If the buffer contains a GnuPG key, type @kbd{C-x h M-| gpg @key{RET}} to feed the entire buffer contents to @command{gpg}. This will output the list of keys to the -@file{*Shell Command Output*} buffer. +buffer named @code{shell-command-buffer-name}. @vindex shell-file-name The above commands use the shell specified by the variable diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 56cd220e20..ae6fe3d9ea 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3379,7 +3379,7 @@ host. Example: @end example @command{tail} command outputs continuously to the local buffer, -@file{*Async Shell Command*} +named @code{shell-command-buffer-name-async} @kbd{M-x auto-revert-tail-mode @key{RET}} runs similarly showing continuous output. diff --git a/etc/NEWS b/etc/NEWS index 9dffd0f714..1e4fe47c59 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -80,6 +80,11 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 ++++ +** The new constants 'shell-command-buffer-name' and +'shell-command-buffer-name-async' store the default buffer names +for the output of shell commands. + ** Support for '(box . SIZE)' 'cursor-type'. By default, 'box' cursor always has a filled box shape. But if you specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 6587d039b7..84d8c36f45 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -688,7 +688,7 @@ are executed in the background on each file sequentially waiting for each command to terminate before running the next command. In shell syntax this means separating the individual commands with `;'. -The output appears in the buffer `*Async Shell Command*'." +The output appears in the buffer `shell-command-buffer-name-async'." (interactive (let ((files (dired-get-marked-files t current-prefix-arg nil nil t))) (list @@ -727,7 +727,7 @@ it, write `*\"\"' in place of just `*'. This is equivalent to just If COMMAND ends in `&', `;', or `;&', it is executed in the background asynchronously, and the output appears in the buffer -`*Async Shell Command*'. When operating on multiple files and COMMAND +`shell-command-buffer-name-async'. When operating on multiple files and COMMAND ends in `&', the shell command is executed on each file in parallel. However, when COMMAND ends in `;' or `;&' then commands are executed in the background on each file sequentially waiting for each command @@ -735,7 +735,7 @@ to terminate before running the next command. You can also use `dired-do-async-shell-command' that automatically adds `&'. Otherwise, COMMAND is executed synchronously, and the output -appears in the buffer `*Shell Command Output*'. +appears in the buffer `shell-command-buffer-name'. This feature does not try to redisplay Dired buffers afterward, as there's no telling what files COMMAND may have changed. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 719498a033..4363860eac 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -12284,7 +12284,7 @@ no matter what the properties `:decode' and `:headers' are." (interactive (gnus-interactive "P\ny")) (require 'gnus-art) (let* ((articles (gnus-summary-work-articles n)) - (result-buffer "*Shell Command Output*") + (result-buffer shell-command-buffer-name) (all-headers (not (memq sym '(nil r)))) (gnus-save-all-headers (or all-headers gnus-save-all-headers)) (raw (eq sym 'r)) diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 36b2835036..baa3146e64 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -142,7 +142,7 @@ used to display Gnus windows." (pipe (vertical 1.0 (summary 0.25 point) - ("*Shell Command Output*" 1.0))) + (shell-command-buffer-name 1.0))) (bug (vertical 1.0 (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5)) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index bfb9787a96..c9ca1f8742 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -504,7 +504,7 @@ format. See `ibuffer-update-saved-filters-format' and (ibuffer-forward-line 0)) (defun ibuffer--maybe-erase-shell-cmd-output () - (let ((buf (get-buffer "*Shell Command Output*"))) + (let ((buf (get-buffer shell-command-buffer-name))) (when (and (buffer-live-p buf) (not shell-command-dont-erase-buffer) (not (zerop (buffer-size buf)))) @@ -517,7 +517,7 @@ format. See `ibuffer-update-saved-filters-format' and :opstring "Shell command executed on" :before (ibuffer--maybe-erase-shell-cmd-output) :modifier-p nil) - (let ((out-buf (get-buffer-create "*Shell Command Output*"))) + (let ((out-buf (get-buffer-create shell-command-buffer-name))) (with-current-buffer out-buf (goto-char (point-max))) (call-shell-region (point-min) (point-max) command nil out-buf))) @@ -542,7 +542,7 @@ format. See `ibuffer-update-saved-filters-format' and :modifier-p nil) (let ((file (and (not (buffer-modified-p)) buffer-file-name)) - (out-buf (get-buffer-create "*Shell Command Output*"))) + (out-buf (get-buffer-create shell-command-buffer-name))) (unless (and file (file-exists-p file)) (setq file (make-temp-file diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index d1b2935a3c..fdf26f6b78 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3815,8 +3815,8 @@ support symbolic links." (current-buffer)) (t (get-buffer-create (if asynchronous - "*Async Shell Command*" - "*Shell Command Output*"))))) + shell-command-buffer-name-async + shell-command-buffer-name))))) (error-buffer (cond ((bufferp error-buffer) error-buffer) diff --git a/lisp/simple.el b/lisp/simple.el index 2f92238e64..6c9584aaa3 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3369,6 +3369,14 @@ which is defined in the `warnings' library.\n") (setq buffer-undo-list nil) t)) +;;;; Shell commands + +(defconst shell-command-buffer-name "*Shell Command Output*" + "Name of the output buffer for shell commands.") + +(defconst shell-command-buffer-name-async "*Async Shell Command*" + "Name of the output buffer for asynchronous shell commands.") + (defvar shell-command-history nil "History list for some commands that read shell commands. @@ -3433,7 +3441,7 @@ to `shell-command-history'." (defcustom async-shell-command-buffer 'confirm-new-buffer "What to do when the output buffer is used by another shell command. This option specifies how to resolve the conflict where a new command -wants to direct its output to the buffer `*Async Shell Command*', +wants to direct its output to the buffer `shell-command-buffer-name-async', but this buffer is already taken by another running shell command. The value `confirm-kill-process' is used to ask for confirmation before @@ -3585,14 +3593,14 @@ whose `car' is BUFFER." Like `shell-command', but adds `&' at the end of COMMAND to execute it asynchronously. -The output appears in the buffer `*Async Shell Command*'. +The output appears in the buffer `shell-command-buffer-name-async'. That buffer is in shell mode. You can configure `async-shell-command-buffer' to specify what to do -when the `*Async Shell Command*' buffer is already taken by another +when the `shell-command-buffer-name-async' buffer is already taken by another running shell command. To run COMMAND without displaying the output in a window you can configure `display-buffer-alist' to use the action -`display-buffer-no-window' for the buffer `*Async Shell Command*'. +`display-buffer-no-window' for the buffer `shell-command-buffer-name-async'. In Elisp, you will often be better served by calling `start-process' directly, since it offers more control and does not impose the use of @@ -3628,12 +3636,12 @@ If `shell-command-prompt-show-cwd' is non-nil, show the current directory in the prompt. If COMMAND ends in `&', execute it asynchronously. -The output appears in the buffer `*Async Shell Command*'. +The output appears in the buffer `shell-command-buffer-name-async'. That buffer is in shell mode. You can also use `async-shell-command' that automatically adds `&'. Otherwise, COMMAND is executed synchronously. The output appears in -the buffer `*Shell Command Output*'. If the output is short enough to +the buffer `shell-command-buffer-name'. If the output is short enough to display in the echo area (which is determined by the variables `resize-mini-windows' and `max-mini-window-height'), it is shown there, but it is nonetheless available in buffer `*Shell Command @@ -3756,7 +3764,7 @@ impose the use of a shell (with its need to quote arguments)." (if (string-match "[ \t]*&[ \t]*\\'" command) ;; Command ending with ampersand means asynchronous. (let* ((buffer (get-buffer-create - (or output-buffer "*Async Shell Command*"))) + (or output-buffer shell-command-buffer-name-async))) (bname (buffer-name buffer)) (proc (get-buffer-process buffer)) (directory default-directory)) @@ -3908,7 +3916,7 @@ and are used only if a pop-up buffer is displayed." error-buffer display-error-buffer region-noncontiguous-p) "Execute string COMMAND in inferior shell with region as input. -Normally display output (if any) in temp buffer `*Shell Command Output*'; +Normally display output (if any) in temp buffer `shell-command-buffer-name'; Prefix arg means replace the region with it. Return the exit code of COMMAND. @@ -3927,7 +3935,7 @@ in the echo area or in a buffer. If the output is short enough to display in the echo area \(determined by the variable `max-mini-window-height' if `resize-mini-windows' is non-nil), it is shown there. -Otherwise it is displayed in the buffer `*Shell Command Output*'. +Otherwise it is displayed in the buffer `shell-command-buffer-name'. The output is available in that buffer in both cases. If there is output and an error, a message about the error @@ -3937,7 +3945,7 @@ Optional fourth arg OUTPUT-BUFFER specifies where to put the command's output. If the value is a buffer or buffer name, erase that buffer and insert the output there; a non-nil value of `shell-command-dont-erase-buffer' prevent to erase the buffer. -If the value is nil, use the buffer `*Shell Command Output*'. +If the value is nil, use the buffer `shell-command-buffer-name'. Any other non-nil value means to insert the output in the current buffer after START. @@ -4006,7 +4014,7 @@ characters." (funcall region-insert-function output)) (t (let ((buffer (get-buffer-create - (or output-buffer "*Shell Command Output*")))) + (or output-buffer shell-command-buffer-name)))) (with-current-buffer buffer (erase-buffer) (funcall region-insert-function output)) @@ -4025,7 +4033,7 @@ characters." (list t error-file) t))) ;; It is rude to delete a buffer that the command is not using. - ;; (let ((shell-buffer (get-buffer "*Shell Command Output*"))) + ;; (let ((shell-buffer (get-buffer shell-command-buffer-name))) ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) ;; (kill-buffer shell-buffer))) ;; Don't muck with mark unless REPLACE says we should. @@ -4033,12 +4041,13 @@ characters." ;; No prefix argument: put the output in a temp buffer, ;; replacing its entire contents. (let ((buffer (get-buffer-create - (or output-buffer "*Shell Command Output*")))) + (or output-buffer shell-command-buffer-name)))) (set-buffer-major-mode buffer) ; Enable globalized modes (bug#38111) (unwind-protect (if (and (eq buffer (current-buffer)) (or (memq shell-command-dont-erase-buffer '(nil erase)) - (and (not (eq buffer (get-buffer "*Shell Command Output*"))) + (and (not (eq buffer (get-buffer + shell-command-buffer-name))) (not (region-active-p))))) ;; If the input is the same buffer as the output, ;; delete everything but the specified region, commit db77e9a0da934ba40950bc1306df61b6785843e0 Author: Jorge P. de Morais Neto Date: Sun Aug 9 13:47:13 2020 +0200 TUTORIAL: "buffer" vs "file" consistency; capitalize Dired * etc/tutorials/TUTORIAL: For consistency with C-x s ("save some buffers") and for accuracy, describe C-x C-s as "Save buffer to file"), and then C-x s as "Save some buffers to their files" (bug#39359). Also capitalize "Dired". Copyright-paperwork-exempt: yes diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL index eb3acde9c0..227c13f3e3 100644 --- a/etc/tutorials/TUTORIAL +++ b/etc/tutorials/TUTORIAL @@ -612,11 +612,11 @@ but it also means that you need a convenient way to save the first file's buffer. Having to switch back to that buffer, in order to save it with C-x C-s, would be a nuisance. So we have - C-x s Save some buffers + C-x s Save some buffers to their files -C-x s asks you about each buffer which contains changes that you have -not saved. It asks you, for each such buffer, whether to save the -buffer. +C-x s asks you about each file-visiting buffer which contains changes +that you have not saved. It asks you, for each such buffer, whether +to save the buffer to its file. >> Insert a line of text, then type C-x s. It should ask you whether to save the buffer named TUTORIAL. @@ -660,8 +660,8 @@ as by a mail handling utility. There are many C-x commands. Here is a list of the ones you have learned: C-x C-f Find file - C-x C-s Save file - C-x s Save some buffers + C-x C-s Save buffer to file + C-x s Save some buffers to their files C-x C-b List buffers C-x b Switch buffer C-x C-c Quit Emacs @@ -1081,7 +1081,7 @@ corresponding command names (such as C-x C-f beside find-file). You can learn more about Emacs by reading its manual, either as a printed book, or inside Emacs (use the Help menu or type C-h r). Two features that you may like especially are completion, which saves -typing, and dired, which simplifies file handling. +typing, and Dired, which simplifies file handling. Completion is a way to avoid unnecessary typing. For instance, if you want to switch to the *Messages* buffer, you can type C-x b *M commit 55bcb3f7e05c01d86778f1a2b7caccf72124614d Author: Lars Ingebrigtsen Date: Sun Aug 9 13:12:27 2020 +0200 Make solar commands in Calendar less beepy * lisp/calendar/solar.el (solar-setup): Remove a (beep) that's been in this code since 1992 (bug#42774). diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 20a20df460..635bdd8f11 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -209,7 +209,6 @@ Returns nil if nothing was entered." (defun solar-setup () "Prompt for `calendar-longitude', `calendar-latitude', `calendar-time-zone'." - (beep) (or calendar-longitude (setq calendar-longitude (solar-get-number commit 71a79f755113aa9fc11315873c5038933ba7ac2a Author: Basil L. Contovounesios Date: Sun Aug 9 11:53:44 2020 +0100 ; Fix typo in last change to calendar.el * lisp/calendar/calendar.el (calendar-use-numeric-time-zones): Fix typo in docstring. diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 9a6c78a50e..0efb2bc660 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1063,7 +1063,7 @@ calendar." (defcustom calendar-use-numeric-time-zones nil "If nil, use symbolic time zones like \"CET\" when displaying dates. -If non-nil, use numeric time zines like \"+0100\"." +If non-nil, use numeric time zones like \"+0100\"." :type 'boolean :version "28.1" :group 'calendar) commit 54770707ad7bbb6ef9ad636ee71e08bea5347715 Author: Lars Ingebrigtsen Date: Sun Aug 9 13:05:37 2020 +0200 Add a command line (and MIME handler) function to start eww * lisp/net/eww.el (eww-browse): New command (bug#42768) to be used from the command line. * doc/misc/eww.texi (Command Line): Document it. diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index f9901b6fd7..85be112402 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -52,6 +52,7 @@ modify this GNU manual.'' * Overview:: * Basics:: * Advanced:: +* Command Line:: Appendices * History and Acknowledgments:: @@ -337,6 +338,21 @@ thus allowing for the use of the usual substitutions, such as @code{\[eww-reload]} for the current key binding of the @code{eww-reload} command. +@node Command Line +@chapter Command Line Usage + +It can be convenient to start eww directly from the command line. The +@code{eww-browse} function can be used for that: + +@example +emacs -f eww-browse https://gnu.org +@end example + +This also allows registering Emacs as a @acronym{MIME} handler for the +@samp{"text/x-uri"} media type. How to do that varies between +systems, but typically you'd register the handler to call @samp{"emacs +-f eww-browse %u"}. + @node History and Acknowledgments @appendix History and Acknowledgments diff --git a/etc/NEWS b/etc/NEWS index 2f204a5b4b..9dffd0f714 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -603,6 +603,12 @@ mode buffer. ** EWW ++++ +*** New Emacs command line convenience function. +The 'eww-browse' command has been added, which allows you to register +Emacs as a MIME handler for "text/x-uri", and will call eww on the +supplied URL. Usage example: emacs -f eww-browse https://gnu.org + +++ *** 'eww-download-directory' will now use the XDG location, if defined. However, if "~/Downloads/" already exists, that will continue to be diff --git a/lisp/net/eww.el b/lisp/net/eww.el index edb2f729c8..e7170b3e6d 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -276,6 +276,24 @@ This list can be customized via `eww-suggest-uris'." (push uri uris))))) (nreverse uris))) +;;;###autoload +(defun eww-browse () + "Function to be run to parse command line URLs. +This is meant to be used for MIME handlers or command line use. + +Setting the handler for \"text/x-uri;\" to +\"emacs -f eww-browse %u\" will then start up Emacs and call eww +to browse the url. + +This can also be used on the command line directly: + + emacs -f eww-browse https://gnu.org + +will start Emacs and browse the GNU web site." + (interactive) + (eww (pop command-line-args-left))) + + ;;;###autoload (defun eww (url &optional arg buffer) "Fetch URL and render the page. commit 1888c6cb96309bd1fd359f19b25c734ab5d4f224 Author: Lars Ingebrigtsen Date: Sun Aug 9 12:55:15 2020 +0200 Doc string fix for message-mailto * lisp/gnus/message.el (message-mailto): Doc string fix. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 61d9c60247..ab625be9e3 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8810,9 +8810,9 @@ used to take the screenshot." ;;;###autoload (defun message-mailto () - "Function to be run to parse command line mailto: links. + "Command to parse command line mailto: links. This is meant to be used for MIME handlers: Setting the handler -for \"x-scheme-handler/mailto;\" to \"emacs -fn message-mailto %u\" +for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\" will then start up Emacs ready to compose mail." (interactive) ;; Send email commit 5732d8ee9a23900d697d76eac07db1ac89ba4fbf Author: Lars Ingebrigtsen Date: Sun Aug 9 12:52:02 2020 +0200 Slight code clean-up in message-mailto * lisp/gnus/message.el (message-mailto): Clean up code slightly. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 0aca31ac88..61d9c60247 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8817,8 +8817,7 @@ will then start up Emacs ready to compose mail." (interactive) ;; Send email (message-mail) - (message-mailto-1 (car command-line-args-left)) - (setq command-line-args-left (cdr command-line-args-left))) + (message-mailto-1 (pop command-line-args-left))) (defun message-mailto-1 (url) (let ((args (message-parse-mailto-url url))) commit 3c728d4c69f2abe991ef84787ae1014ad1cd29d2 Author: Lars Ingebrigtsen Date: Sun Aug 9 12:34:23 2020 +0200 Add a variable to allow displaying numeric time zones * lisp/calendar/calendar.el (calendar-use-numeric-time-zones): New variable. * doc/emacs/calendar.texi (Sunrise/Sunset): Document it (bug#33149). * lisp/calendar/cal-dst.el (calendar-standard-time-zone-name): Use it. (calendar-daylight-time-zone-name): Ditto. * lisp/calendar/solar.el (sunrise-sunset): Adjust usage. (solar-equinoxes-solstices): Ditto. diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi index fe51ad35d7..31db815df7 100644 --- a/doc/emacs/calendar.texi +++ b/doc/emacs/calendar.texi @@ -625,6 +625,11 @@ your time zone. Emacs displays the times of sunrise and sunset @emph{corrected for daylight saving time}. @xref{Daylight Saving}, for how daylight saving time is determined. +@vindex calendar-use-numeric-time-zones + If you want to display numerical time zones (like @samp{"+0100"}) +instead of symbolic time zones (like @samp{"CET"}), set the +@code{calendar-use-numeric-time-zones} variable to non-@code{nil}. + As a user, you might find it convenient to set the calendar location variables for your usual physical location in your @file{.emacs} file. If you are a system administrator, you may want to set these variables diff --git a/etc/NEWS b/etc/NEWS index 71c037631a..2f204a5b4b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -194,6 +194,13 @@ The presence of a space between an open paren and a symbol now is taken as a statement by the programmer that this should be indented as a data list rather than as a piece of code. +** Calendar + +*** New variable 'calendar-use-numeric-time-zones' to use numeric time zones. +If non-nil, functions that display time zones (like the 'S' command in +calendar mode that displays the sunrise time) will display time zones +like "+0100" instead of "CET". + ** Dired *** New user option 'dired-mark-region' affects all Dired commands diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index 3db12e668a..af6acaf09a 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -350,17 +350,29 @@ If the locale never uses daylight saving time, set this to 0." :group 'calendar-dst) (defcustom calendar-standard-time-zone-name - (or (nth 2 calendar-current-time-zone-cache) "EST") + (if calendar-use-numeric-time-zones + (if calendar-current-time-zone-cache + (format-time-string + "%z" 0 (* 60 (car calendar-current-time-zone-cache))) + "+0000") + (or (nth 2 calendar-current-time-zone-cache) "EST")) "Abbreviated name of standard time zone at `calendar-location-name'. For example, \"EST\" in New York City, \"PST\" for Los Angeles." :type 'string + :version "28.1" :group 'calendar-dst) (defcustom calendar-daylight-time-zone-name - (or (nth 3 calendar-current-time-zone-cache) "EDT") + (if calendar-use-numeric-time-zones + (if calendar-current-time-zone-cache + (format-time-string + "%z" 0 (* 60 (cadr calendar-current-time-zone-cache))) + "+0000") + (or (nth 3 calendar-current-time-zone-cache) "EDT")) "Abbreviated name of daylight saving time zone at `calendar-location-name'. For example, \"EDT\" in New York City, \"PDT\" for Los Angeles." :type 'string + :version "28.1" :group 'calendar-dst) (defcustom calendar-daylight-savings-starts-time diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 1d5b9479e2..9a6c78a50e 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1061,6 +1061,13 @@ calendar." :type 'boolean :group 'holidays) +(defcustom calendar-use-numeric-time-zones nil + "If nil, use symbolic time zones like \"CET\" when displaying dates. +If non-nil, use numeric time zines like \"+0100\"." + :type 'boolean + :version "28.1" + :group 'calendar) + ;;; End of user options. (calendar-recompute-layout-variables) diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 6a813e9ee8..20a20df460 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -840,7 +840,9 @@ This function is suitable for execution in an init file." "E" "W")))))) (calendar-standard-time-zone-name (if (< arg 16) calendar-standard-time-zone-name - (cond ((zerop calendar-time-zone) "UTC") + (cond ((zerop calendar-time-zone) + (if calendar-use-numeric-time-zones + "+0100" "UTC")) ((< calendar-time-zone 0) (format "UTC%dmin" calendar-time-zone)) (t (format "UTC+%dmin" calendar-time-zone))))) @@ -1013,7 +1015,10 @@ Requires floating point." (let* ((m displayed-month) (y displayed-year) (calendar-standard-time-zone-name - (if calendar-time-zone calendar-standard-time-zone-name "UTC")) + (cond + (calendar-time-zone calendar-standard-time-zone-name) + (calendar-use-numeric-time-zones "+0100") + (t "UTC"))) (calendar-daylight-savings-starts (if calendar-time-zone calendar-daylight-savings-starts)) (calendar-daylight-savings-ends commit f3e0da29a248a2dc7dd7d640f8280b10bfc288f9 Author: Lars Ingebrigtsen Date: Sun Aug 9 10:41:59 2020 +0200 Remove superfluous code from the previous '' sql string fix * lisp/progmodes/sql.el (sql-mode): Remove setting that's now superfluous from previous check-in. diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 8e3191c9b4..a70b5ed60d 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -4230,7 +4230,6 @@ must tell Emacs. Here's how to do that in your init file: ;; escaped apostrophes within strings: (setq-local syntax-propertize-function sql--syntax-propertize-escaped-apostrophe) - (setq-local parse-sexp-lookup-properties t) ; just to make sure it is used ;; Set syntax and font-face highlighting ;; Catch changes to sql-product and highlight accordingly (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591